1 |
module grid_noro_m |
module grid_noro_m |
2 |
|
|
|
! Clean: no C preprocessor directive, no include line |
|
|
|
|
3 |
implicit none |
implicit none |
4 |
|
|
|
private mva9 |
|
|
|
|
5 |
contains |
contains |
6 |
|
|
7 |
SUBROUTINE grid_noro(xdata, ydata, zdata, x, y, zphi, zmea, zstd, zsig, & |
SUBROUTINE grid_noro(xdata, ydata, zdata, x, y, zphi, zmea, zstd, zsig, & |
37 |
! (d) |
! (d) |
38 |
|
|
39 |
use dimens_m, only: iim, jjm |
use dimens_m, only: iim, jjm |
40 |
use comconst, only: pi |
use nr_util, only: assert, pi |
41 |
use numer_rec, only: assert |
use mva9_m, only: mva9 |
42 |
|
|
43 |
REAL, intent(in):: xdata(:), ydata(:) ! coordinates of input field |
REAL, intent(in):: xdata(:), ydata(:) ! coordinates of input field |
44 |
REAL, intent(in):: zdata(:, :) ! input field |
REAL, intent(in):: zdata(:, :) ! input field |
55 |
REAL, intent(out):: zpic(:, :) ! Maximum altitude |
REAL, intent(out):: zpic(:, :) ! Maximum altitude |
56 |
real, intent(out):: zval(:, :) ! Minimum altitude |
real, intent(out):: zval(:, :) ! Minimum altitude |
57 |
|
|
58 |
real, intent(out):: mask(:, :) |
real, intent(out):: mask(:, :) ! fraction of land |
59 |
|
|
60 |
! Variables local to the procedure: |
! Variables local to the procedure: |
61 |
|
|
137 |
zusn(i, jusn+2)=zusn(i+iusn/2, jusn+1) |
zusn(i, jusn+2)=zusn(i+iusn/2, jusn+1) |
138 |
zusn(i+iusn/2+iext, jusn+2)=zusn(i, jusn+1) |
zusn(i+iusn/2+iext, jusn+2)=zusn(i, jusn+1) |
139 |
ENDDO |
ENDDO |
140 |
! |
|
141 |
! COMPUTE LIMITS OF MODEL GRIDPOINT AREA |
! COMPUTE LIMITS OF MODEL GRIDPOINT AREA |
142 |
! ( REGULAR GRID) |
! ( REGULAR GRID) |
143 |
|
|
186 |
ENDDO |
ENDDO |
187 |
|
|
188 |
! SUMMATION OVER GRIDPOINT AREA |
! SUMMATION OVER GRIDPOINT AREA |
189 |
! |
|
190 |
zleny=pi/real(jusn)*rad |
zleny=pi/real(jusn)*rad |
191 |
xincr=pi/2./real(jusn) |
xincr=pi/2./real(jusn) |
192 |
DO ii = 1, iim+1 |
DO ii = 1, iim+1 |
251 |
zxtzy(ii, jj)=zxtzy(ii, jj)/weight(ii, jj) |
zxtzy(ii, jj)=zxtzy(ii, jj)/weight(ii, jj) |
252 |
ztz(ii, jj) =ztz(ii, jj)/weight(ii, jj) |
ztz(ii, jj) =ztz(ii, jj)/weight(ii, jj) |
253 |
! Standard deviation: |
! Standard deviation: |
254 |
zstd(ii, jj)=sqrt(AMAX1(0., ztz(ii, jj)-zmea(ii, jj)**2)) |
zstd(ii, jj)=sqrt(MAX(0., ztz(ii, jj) - zmea(ii, jj)**2)) |
255 |
ENDDO |
ENDDO |
256 |
ENDDO |
ENDDO |
257 |
|
|
270 |
|
|
271 |
! FIRST FILTER, MOVING AVERAGE OVER 9 POINTS. |
! FIRST FILTER, MOVING AVERAGE OVER 9 POINTS. |
272 |
|
|
273 |
CALL MVA9(zmea, iim+1, jjm+1) |
CALL MVA9(zmea) |
274 |
CALL MVA9(zstd, iim+1, jjm+1) |
CALL MVA9(zstd) |
275 |
CALL MVA9(zpic, iim+1, jjm+1) |
CALL MVA9(zpic) |
276 |
CALL MVA9(zval, iim+1, jjm+1) |
CALL MVA9(zval) |
277 |
CALL MVA9(zxtzx, iim+1, jjm+1) |
CALL MVA9(zxtzx) |
278 |
CALL MVA9(zxtzy, iim+1, jjm+1) |
CALL MVA9(zxtzy) |
279 |
CALL MVA9(zytzy, iim+1, jjm+1) |
CALL MVA9(zytzy) |
280 |
|
|
281 |
! Masque prenant en compte maximum de terre |
! Masque prenant en compte maximum de terre |
282 |
! On seuil a 10% de terre de terre car en dessous les parametres |
! On seuil a 10% de terre de terre car en dessous les parametres |
320 |
zllmval=AMAX1(zval(ii, jj), zllmval) |
zllmval=AMAX1(zval(ii, jj), zllmval) |
321 |
ENDDO |
ENDDO |
322 |
ENDDO |
ENDDO |
323 |
print *, ' MEAN ORO:', zllmmea |
print *, 'MEAN ORO: ', zllmmea |
324 |
print *, ' ST. DEV.:', zllmstd |
print *, 'ST. DEV.: ', zllmstd |
325 |
print *, ' PENTE:', zllmsig |
print *, 'PENTE: ', zllmsig |
326 |
print *, ' ANISOTROP:', zllmgam |
print *, 'ANISOTROP: ', zllmgam |
327 |
print *, ' ANGLE:', zminthe, zllmthe |
print *, 'ANGLE: ', zminthe, zllmthe |
328 |
print *, ' pic:', zllmpic |
print *, 'pic: ', zllmpic |
329 |
print *, ' val:', zllmval |
print *, 'val: ', zllmval |
330 |
|
|
331 |
! gamma and theta a 1. and 0. at poles |
! gamma and theta a 1. and 0. at poles |
332 |
zmea(iim+1, :)=zmea(1, :) |
zmea(iim+1, :)=zmea(1, :) |
392 |
|
|
393 |
END SUBROUTINE grid_noro |
END SUBROUTINE grid_noro |
394 |
|
|
|
!****************************************** |
|
|
|
|
|
SUBROUTINE MVA9(X, IMAR, JMAR) |
|
|
|
|
|
! From dyn3d/grid_noro.F, v 1.1.1.1 2004/05/19 12:53:06 |
|
|
|
|
|
! MAKE A MOVING AVERAGE OVER 9 GRIDPOINTS OF THE X FIELDS |
|
|
|
|
|
integer, intent(in):: imar, jmar |
|
|
REAL, intent(inout):: X(IMAR, JMAR) |
|
|
|
|
|
integer, PARAMETER:: ISMo=300, JSMo=200 |
|
|
real XF(ISMo, JSMo) |
|
|
real WEIGHTpb(-1:1, -1:1) |
|
|
real sum |
|
|
integer i, is, js, j |
|
|
|
|
|
if(imar>ismo) stop 'surdimensionner ismo dans mva9 (grid_noro)' |
|
|
if(jmar>jsmo) stop 'surdimensionner jsmo dans mva9 (grid_noro)' |
|
|
|
|
|
SUM=0. |
|
|
DO IS=-1, 1 |
|
|
DO JS=-1, 1 |
|
|
WEIGHTpb(IS, JS)=1./FLOAT((1+IS**2)*(1+JS**2)) |
|
|
SUM=SUM+WEIGHTpb(IS, JS) |
|
|
ENDDO |
|
|
ENDDO |
|
|
|
|
|
DO IS=-1, 1 |
|
|
DO JS=-1, 1 |
|
|
WEIGHTpb(IS, JS)=WEIGHTpb(IS, JS)/SUM |
|
|
ENDDO |
|
|
ENDDO |
|
|
|
|
|
DO J=2, JMAR-1 |
|
|
DO I=2, IMAR-1 |
|
|
XF(I, J)=0. |
|
|
DO IS=-1, 1 |
|
|
DO JS=-1, 1 |
|
|
XF(I, J)=XF(I, J)+X(I+IS, J+JS)*WEIGHTpb(IS, JS) |
|
|
ENDDO |
|
|
ENDDO |
|
|
ENDDO |
|
|
ENDDO |
|
|
|
|
|
DO J=2, JMAR-1 |
|
|
XF(1, J)=0. |
|
|
IS=IMAR-1 |
|
|
DO JS=-1, 1 |
|
|
XF(1, J)=XF(1, J)+X(IS, J+JS)*WEIGHTpb(-1, JS) |
|
|
ENDDO |
|
|
DO IS=0, 1 |
|
|
DO JS=-1, 1 |
|
|
XF(1, J)=XF(1, J)+X(1+IS, J+JS)*WEIGHTpb(IS, JS) |
|
|
ENDDO |
|
|
ENDDO |
|
|
XF(IMAR, J)=XF(1, J) |
|
|
ENDDO |
|
|
|
|
|
DO I=1, IMAR |
|
|
XF(I, 1)=XF(I, 2) |
|
|
XF(I, JMAR)=XF(I, JMAR-1) |
|
|
ENDDO |
|
|
|
|
|
DO I=1, IMAR |
|
|
DO J=1, JMAR |
|
|
X(I, J)=XF(I, J) |
|
|
ENDDO |
|
|
ENDDO |
|
|
|
|
|
END SUBROUTINE MVA9 |
|
|
|
|
395 |
end module grid_noro_m |
end module grid_noro_m |