/[lmdze]/trunk/phylmd/Orography/grid_noro_m.f
ViewVC logotype

Diff of /trunk/phylmd/Orography/grid_noro_m.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 52 by guez, Fri Sep 23 12:28:01 2011 UTC revision 68 by guez, Wed Nov 14 16:59:30 2012 UTC
# Line 14  contains Line 14  contains
14      ! Compute the parameters of the SSO scheme as described in      ! Compute the parameters of the SSO scheme as described in
15      ! Lott and Miller (1997) and Lott (1999).      ! Lott and Miller (1997) and Lott (1999).
16      ! Target points are on a rectangular grid:      ! Target points are on a rectangular grid:
17      ! jjm+1 latitudes including North and South Poles;      ! jjm + 1 latitudes including North and South Poles;
18      ! iim+1 longitudes, with periodicity: longitude(iim+1)=longitude(1)      ! iim + 1 longitudes, with periodicity: longitude(iim + 1) = longitude(1)
19      ! At the poles the field value is repeated iim+1 times.      ! At the poles the field value is repeated iim + 1 times.
20    
21      ! The parameters a, b, c, d represent the limite of the target      ! The parameters a, b, c, d represent the limite of the target
22      ! gridpoint region. The means over this region are calculated      ! gridpoint region. The means over this region are calculated from
23      ! from USN data, ponderated by a weight proportional to the      ! USN data, ponderated by a weight proportional to the surface
24      ! surface occupied by the data inside the model gridpoint area.      ! occupied by the data inside the model gridpoint area. In most
25      ! In most circumstances, this weight is the ratio between the      ! circumstances, this weight is the ratio between the surface of
26      ! surface of the USN gridpoint area and the surface of the      ! the USN gridpoint area and the surface of the model gridpoint
27      ! model gridpoint area.      ! area. See "grid_noto.txt".
   
     !           (c)  
     !        ----d-----  
     !        | . . . .|  
     !        |        |  
     !     (b)a . * . .b(a)  
     !        |        |  
     !        | . . . .|  
     !        ----c-----  
     !           (d)  
28    
29      use dimens_m, only: iim, jjm      use dimens_m, only: iim, jjm
30      use nr_util, only: assert, pi      use nr_util, only: assert, pi
# Line 46  contains Line 36  contains
36    
37      ! Correlations of USN orography gradients:      ! Correlations of USN orography gradients:
38    
39      REAL zphi(:, :)      REAL, intent(out):: zphi(:, :)
40      real, intent(out):: zmea(:, :) ! Mean orography      real, intent(out):: zmea(:, :) ! Mean orography
41      real, intent(out):: zstd(:, :) ! Standard deviation      real, intent(out):: zstd(:, :) ! Standard deviation
42      REAL zsig(:, :) ! Slope      REAL zsig(:, :) ! Slope
# Line 61  contains Line 51  contains
51    
52      ! In this version it is assumed that the input data come from      ! In this version it is assumed that the input data come from
53      ! the US Navy dataset:      ! the US Navy dataset:
54      integer, parameter:: iusn=2160, jusn=1080      integer, parameter:: iusn = 2160, jusn = 1080
55        integer, parameter:: iext = 216
56      integer, parameter:: iext=216      REAL xusn(iusn + 2 * iext), yusn(jusn + 2)
57      REAL xusn(iusn+2*iext), yusn(jusn+2)      REAL zusn(iusn + 2 * iext, jusn + 2)
58      REAL zusn(iusn+2*iext, jusn+2)  
59        ! Intermediate fields (correlations of orography gradient)
60      ! Intermediate fields  (correlations of orography gradient)  
61        REAL ztz(iim + 1, jjm + 1), zxtzx(iim + 1, jjm + 1)
62      REAL ztz(iim+1, jjm+1), zxtzx(iim+1, jjm+1)      REAL zytzy(iim + 1, jjm + 1), zxtzy(iim + 1, jjm + 1)
63      REAL zytzy(iim+1, jjm+1), zxtzy(iim+1, jjm+1)      REAL weight(iim + 1, jjm + 1)
     REAL weight(iim+1, jjm+1)  
64    
65      ! Correlations of USN orography gradients:      ! Correlations of USN orography gradients:
66        REAL, dimension(iusn + 2 * iext, jusn + 2):: zxtzxusn, zytzyusn, zxtzyusn
     REAL zxtzxusn(iusn+2*iext, jusn+2), zytzyusn(iusn+2*iext, jusn+2)  
     REAL zxtzyusn(iusn+2*iext, jusn+2)  
67    
68      real mask_tmp(size(x), size(y))      real mask_tmp(size(x), size(y))
69      real num_tot(2200, 1100), num_lan(2200, 1100)      real num_tot(iim + 1, jjm + 1), num_lan(iim + 1, jjm + 1)
70    
71      REAL a(2200), b(2200), c(1100), d(1100)      REAL a(iim + 1), b(iim + 1), c(jjm + 1), d(jjm + 1)
72      real rad, weighx, weighy, xincr, xk, xp, xm, xw, xq, xl      real rad, weighx, weighy, xincr, xk, xp, xm, xw, xq, xl
73      real zbordnor, zdeltax, zbordsud, zdeltay, zbordoue, zlenx, zleny, zmeasud      real zbordnor, zdeltax, zbordsud, zdeltay, zbordoue, zlenx, zleny, zmeasud
74      real zllmpic, zllmmea, zllmgam, zllmthe, zllmstd, zllmsig, zllmval      real zllmpic, zllmmea, zllmgam, zllmthe, zllmstd, zllmsig, zllmval
# Line 104  contains Line 91  contains
91           size(zsig, 2), size(zgam, 2), size(zthe, 2), size(zpic, 2), &           size(zsig, 2), size(zgam, 2), size(zthe, 2), size(zpic, 2), &
92           size(zval, 2), size(mask, 2)/) == jjm + 1, "grid_noro jjm")           size(zval, 2), size(mask, 2)/) == jjm + 1, "grid_noro jjm")
93    
     IF (iim > 2200 .OR. jjm > 1099) THEN  
        print *, "iim = ", iim, ", jjm = ", jjm  
        stop '"iim" or "jjm" is too big'  
     ENDIF  
   
94      print *, "Paramètres de l'orographie à l'échelle sous-maille"      print *, "Paramètres de l'orographie à l'échelle sous-maille"
95      rad = 6371229.      rad = 6371229.
96      zdeltay = 2. * pi / real(jusn) * rad      zdeltay = 2. * pi / real(jusn) * rad
97    
98      ! Extension of the USN database to POCEED computations at boundaries:      ! Extension of the USN database to POCEED computations at boundaries:
99    
100      DO j=1, jusn      DO j = 1, jusn
101         yusn(j+1)=ydata(j)         yusn(j + 1) = ydata(j)
102         DO i=1, iusn         DO i = 1, iusn
103            zusn(i+iext, j+1)=zdata(i, j)            zusn(i + iext, j + 1) = zdata(i, j)
104            xusn(i+iext)=xdata(i)            xusn(i + iext) = xdata(i)
105         ENDDO         ENDDO
106         DO i=1, iext         DO i = 1, iext
107            zusn(i, j+1)=zdata(iusn-iext+i, j)            zusn(i, j + 1) = zdata(iusn - iext + i, j)
108            xusn(i)=xdata(iusn-iext+i)-2.*pi            xusn(i) = xdata(iusn - iext + i) - 2. * pi
109            zusn(iusn+iext+i, j+1)=zdata(i, j)            zusn(iusn + iext + i, j + 1) = zdata(i, j)
110            xusn(iusn+iext+i)=xdata(i)+2.*pi            xusn(iusn + iext + i) = xdata(i) + 2. * pi
111         ENDDO         ENDDO
112      ENDDO      ENDDO
113    
114      yusn(1)=ydata(1)+(ydata(1)-ydata(2))      yusn(1) = ydata(1) + (ydata(1) - ydata(2))
115      yusn(jusn+2)=ydata(jusn)+(ydata(jusn)-ydata(jusn-1))      yusn(jusn + 2) = ydata(jusn) + (ydata(jusn) - ydata(jusn - 1))
116      DO i=1, iusn/2+iext      DO i = 1, iusn / 2 + iext
117         zusn(i, 1)=zusn(i+iusn/2, 2)         zusn(i, 1) = zusn(i + iusn / 2, 2)
118         zusn(i+iusn/2+iext, 1)=zusn(i, 2)         zusn(i + iusn / 2 + iext, 1) = zusn(i, 2)
119         zusn(i, jusn+2)=zusn(i+iusn/2, jusn+1)         zusn(i, jusn + 2) = zusn(i + iusn / 2, jusn + 1)
120         zusn(i+iusn/2+iext, jusn+2)=zusn(i, jusn+1)         zusn(i + iusn / 2 + iext, jusn + 2) = zusn(i, jusn + 1)
121      ENDDO      ENDDO
122    
123      ! COMPUTE LIMITS OF MODEL GRIDPOINT AREA      ! COMPUTE LIMITS OF MODEL GRIDPOINT AREA (REGULAR GRID)
     !     ( REGULAR GRID)  
124    
125      a(1) = x(1) - (x(2)-x(1))/2.0      a(1) = x(1) - (x(2) - x(1)) / 2.0
126      b(1) = (x(1)+x(2))/2.0      b(1) = (x(1) + x(2)) / 2.0
127      DO i = 2, iim      DO i = 2, iim
128         a(i) = b(i-1)         a(i) = b(i - 1)
129         b(i) = (x(i)+x(i+1))/2.0         b(i) = (x(i) + x(i + 1)) / 2.0
130      ENDDO      ENDDO
131      a(iim+1) = b(iim)      a(iim + 1) = b(iim)
132      b(iim+1) = x(iim+1) + (x(iim+1)-x(iim))/2.0      b(iim + 1) = x(iim + 1) + (x(iim + 1) - x(iim)) / 2.0
133    
134      c(1) = y(1) - (y(2)-y(1))/2.0      c(1) = y(1) - (y(2) - y(1)) / 2.0
135      d(1) = (y(1)+y(2))/2.0      d(1) = (y(1) + y(2)) / 2.0
136      DO j = 2, jjm      DO j = 2, jjm
137         c(j) = d(j-1)         c(j) = d(j - 1)
138         d(j) = (y(j)+y(j+1))/2.0         d(j) = (y(j) + y(j + 1)) / 2.0
139      ENDDO      ENDDO
140      c(jjm + 1) = d(jjm)      c(jjm + 1) = d(jjm)
141      d(jjm + 1) = y(jjm + 1) + (y(jjm + 1)-y(jjm))/2.0      d(jjm + 1) = y(jjm + 1) + (y(jjm + 1) - y(jjm)) / 2.0
142    
143      ! Initialisations :      ! Initialisations :
144      weight(:, :) = 0.      weight = 0.
145      zxtzx(:, :)  = 0.      zxtzx = 0.
146      zytzy(:, :)  = 0.      zytzy = 0.
147      zxtzy(:, :)  = 0.      zxtzy = 0.
148      ztz(:, :)    = 0.      ztz = 0.
149      zmea(:, :)   = 0.      zmea = 0.
150      zpic(:, :)  =-1.E+10      zpic = - 1E10
151      zval(:, :)  = 1.E+10      zval = 1E10
152    
153      !  COMPUTE SLOPES CORRELATIONS ON USN GRID      ! COMPUTE SLOPES CORRELATIONS ON USN GRID
154    
155      zytzyusn(:, :)=0.      zytzyusn = 0.
156      zxtzxusn(:, :)=0.      zxtzxusn = 0.
157      zxtzyusn(:, :)=0.      zxtzyusn = 0.
158    
159      DO j = 2, jusn+1      DO j = 2, jusn + 1
160         zdeltax=zdeltay*cos(yusn(j))         zdeltax = zdeltay * cos(yusn(j))
161         DO i = 2, iusn+2*iext-1         DO i = 2, iusn + 2 * iext - 1
162            zytzyusn(i, j)=(zusn(i, j+1)-zusn(i, j-1))**2/zdeltay**2            zytzyusn(i, j) = (zusn(i, j + 1) - zusn(i, j - 1))**2 / zdeltay**2
163            zxtzxusn(i, j)=(zusn(i+1, j)-zusn(i-1, j))**2/zdeltax**2            zxtzxusn(i, j) = (zusn(i + 1, j) - zusn(i - 1, j))**2 / zdeltax**2
164            zxtzyusn(i, j)=(zusn(i, j+1)-zusn(i, j-1))/zdeltay &            zxtzyusn(i, j) = (zusn(i, j + 1) - zusn(i, j - 1)) / zdeltay &
165                 *(zusn(i+1, j)-zusn(i-1, j))/zdeltax                 * (zusn(i + 1, j) - zusn(i - 1, j)) / zdeltax
166         ENDDO         ENDDO
167      ENDDO      ENDDO
168    
169      !  SUMMATION OVER GRIDPOINT AREA      ! SUMMATION OVER GRIDPOINT AREA
170    
171      zleny=pi/real(jusn)*rad      zleny = pi / real(jusn) * rad
172      xincr=pi/2./real(jusn)      xincr = pi / 2. / real(jusn)
173      DO ii = 1, iim+1      DO ii = 1, iim + 1
174         DO jj = 1, jjm + 1         DO jj = 1, jjm + 1
175            num_tot(ii, jj)=0.            num_tot(ii, jj) = 0.
176            num_lan(ii, jj)=0.            num_lan(ii, jj) = 0.
177            DO j = 2, jusn+1            DO j = 2, jusn + 1
178               zlenx=zleny*cos(yusn(j))               zlenx = zleny * cos(yusn(j))
179               zdeltax=zdeltay*cos(yusn(j))               zdeltax = zdeltay * cos(yusn(j))
180               zbordnor=(c(jj)-yusn(j)+xincr)*rad               zbordnor = (c(jj) - yusn(j) + xincr) * rad
181               zbordsud=(yusn(j)-d(jj)+xincr)*rad               zbordsud = (yusn(j) - d(jj) + xincr) * rad
182               weighy=AMAX1(0., amin1(zbordnor, zbordsud, zleny))               weighy = AMAX1(0., amin1(zbordnor, zbordsud, zleny))
183               IF (weighy /= 0) THEN               IF (weighy /= 0) THEN
184                  DO i = 2, iusn+2*iext-1                  DO i = 2, iusn + 2 * iext - 1
185                     zbordest=(xusn(i)-a(ii)+xincr)*rad*cos(yusn(j))                     zbordest = (xusn(i) - a(ii) + xincr) * rad * cos(yusn(j))
186                     zbordoue=(b(ii)+xincr-xusn(i))*rad*cos(yusn(j))                     zbordoue = (b(ii) + xincr - xusn(i)) * rad * cos(yusn(j))
187                     weighx=AMAX1(0., amin1(zbordest, zbordoue, zlenx))                     weighx = AMAX1(0., amin1(zbordest, zbordoue, zlenx))
188                     IF (weighx /= 0) THEN                     IF (weighx /= 0) THEN
189                        num_tot(ii, jj) = num_tot(ii, jj) + 1.                        num_tot(ii, jj) = num_tot(ii, jj) + 1.
190                        if (zusn(i, j) >= 1.) then                        if (zusn(i, j) >= 1.) then
191                           num_lan(ii, jj) = num_lan(ii, jj) + 1.                           num_lan(ii, jj) = num_lan(ii, jj) + 1.
192                        end if                        end if
193                        weight(ii, jj) = weight(ii, jj) + weighx * weighy                        weight(ii, jj) = weight(ii, jj) + weighx * weighy
194                        zxtzx(ii, jj)=zxtzx(ii, jj)+zxtzxusn(i, j)*weighx*weighy                        zxtzx(ii, jj) = zxtzx(ii, jj) &
195                        zytzy(ii, jj)=zytzy(ii, jj)+zytzyusn(i, j)*weighx*weighy                             + zxtzxusn(i, j) * weighx * weighy
196                        zxtzy(ii, jj)=zxtzy(ii, jj)+zxtzyusn(i, j)*weighx*weighy                        zytzy(ii, jj) = zytzy(ii, jj) &
197                               + zytzyusn(i, j) * weighx * weighy
198                          zxtzy(ii, jj) = zxtzy(ii, jj) &
199                               + zxtzyusn(i, j) * weighx * weighy
200                        ztz(ii, jj) = ztz(ii, jj) &                        ztz(ii, jj) = ztz(ii, jj) &
201                             + zusn(i, j) * zusn(i, j) * weighx * weighy                             + zusn(i, j) * zusn(i, j) * weighx * weighy
202                        ! mean                        ! mean
203                        zmea(ii, jj) =zmea(ii, jj)+zusn(i, j)*weighx*weighy                        zmea(ii, jj) = zmea(ii, jj) + zusn(i, j) * weighx * weighy
204                        ! peacks                        ! peacks
205                        zpic(ii, jj)=amax1(zpic(ii, jj), zusn(i, j))                        zpic(ii, jj) = amax1(zpic(ii, jj), zusn(i, j))
206                        ! valleys                        ! valleys
207                        zval(ii, jj)=amin1(zval(ii, jj), zusn(i, j))                        zval(ii, jj) = amin1(zval(ii, jj), zusn(i, j))
208                     ENDIF                     ENDIF
209                  ENDDO                  ENDDO
210               ENDIF               ENDIF
# Line 230  contains Line 214  contains
214    
215      if (any(weight == 0.)) stop "zero weight in grid_noro"      if (any(weight == 0.)) stop "zero weight in grid_noro"
216    
217      !  COMPUTE PARAMETERS NEEDED BY THE LOTT & MILLER (1997) AND      ! COMPUTE PARAMETERS NEEDED BY THE LOTT & MILLER (1997) AND
218      !  LOTT (1999) SSO SCHEME.      ! LOTT (1999) SSO SCHEME.
219    
220      zllmmea=0.      zllmmea = 0.
221      zllmstd=0.      zllmstd = 0.
222      zllmsig=0.      zllmsig = 0.
223      zllmgam=0.      zllmgam = 0.
224      zllmpic=0.      zllmpic = 0.
225      zllmval=0.      zllmval = 0.
226      zllmthe=0.      zllmthe = 0.
227      zminthe=0.      zminthe = 0.
228      DO ii = 1, iim+1      DO ii = 1, iim + 1
229         DO jj = 1, jjm + 1         DO jj = 1, jjm + 1
230            mask(ii, jj) = num_lan(ii, jj)/num_tot(ii, jj)            mask(ii, jj) = num_lan(ii, jj) / num_tot(ii, jj)
231            !  Mean Orography:            ! Mean Orography:
232            zmea (ii, jj)=zmea (ii, jj)/weight(ii, jj)            zmea (ii, jj) = zmea (ii, jj) / weight(ii, jj)
233            zxtzx(ii, jj)=zxtzx(ii, jj)/weight(ii, jj)            zxtzx(ii, jj) = zxtzx(ii, jj) / weight(ii, jj)
234            zytzy(ii, jj)=zytzy(ii, jj)/weight(ii, jj)            zytzy(ii, jj) = zytzy(ii, jj) / weight(ii, jj)
235            zxtzy(ii, jj)=zxtzy(ii, jj)/weight(ii, jj)            zxtzy(ii, jj) = zxtzy(ii, jj) / weight(ii, jj)
236            ztz(ii, jj)  =ztz(ii, jj)/weight(ii, jj)            ztz(ii, jj) = ztz(ii, jj) / weight(ii, jj)
237            !  Standard deviation:            ! Standard deviation:
238            zstd(ii, jj)=sqrt(MAX(0., ztz(ii, jj) - zmea(ii, jj)**2))            zstd(ii, jj) = sqrt(MAX(0., ztz(ii, jj) - zmea(ii, jj)**2))
239         ENDDO         ENDDO
240      ENDDO      ENDDO
241    
242      ! CORRECT VALUES OF HORIZONTAL SLOPE NEAR THE POLES:      ! CORRECT VALUES OF HORIZONTAL SLOPE NEAR THE POLES:
243        DO ii = 1, iim + 1
244      DO ii = 1, iim+1         zxtzx(ii, 1) = zxtzx(ii, 2)
245         zxtzx(ii, 1)=zxtzx(ii, 2)         zxtzx(ii, jjm + 1) = zxtzx(ii, jjm)
246         zxtzx(ii, jjm + 1)=zxtzx(ii, jjm)         zxtzy(ii, 1) = zxtzy(ii, 2)
247         zxtzy(ii, 1)=zxtzy(ii, 2)         zxtzy(ii, jjm + 1) = zxtzy(ii, jjm)
248         zxtzy(ii, jjm + 1)=zxtzy(ii, jjm)         zytzy(ii, 1) = zytzy(ii, 2)
249         zytzy(ii, 1)=zytzy(ii, 2)         zytzy(ii, jjm + 1) = zytzy(ii, jjm)
        zytzy(ii, jjm + 1)=zytzy(ii, jjm)  
250      ENDDO      ENDDO
251    
252      !  FILTERS TO SMOOTH OUT FIELDS FOR INPUT INTO SSO SCHEME.      ! FILTERS TO SMOOTH OUT FIELDS FOR INPUT INTO SSO SCHEME.
   
     !  FIRST FILTER, MOVING AVERAGE OVER 9 POINTS.  
253    
254        ! FIRST FILTER, MOVING AVERAGE OVER 9 POINTS.
255      CALL MVA9(zmea)      CALL MVA9(zmea)
256      CALL MVA9(zstd)      CALL MVA9(zstd)
257      CALL MVA9(zpic)      CALL MVA9(zpic)
# Line 278  contains Line 260  contains
260      CALL MVA9(zxtzy)      CALL MVA9(zxtzy)
261      CALL MVA9(zytzy)      CALL MVA9(zytzy)
262    
263      ! Masque prenant en compte maximum de terre      ! Masque prenant en compte maximum de terre. On seuille à 10 % de
264      ! On seuil a 10% de terre de terre car en dessous les parametres      ! terre car en dessous les paramètres de surface n'ont pas de
265      ! de surface n'ont pas de sens (PB)      ! sens.
266      mask_tmp= 0.      mask_tmp = 0.
267      WHERE (mask >= 0.1) mask_tmp = 1.      WHERE (mask >= 0.1) mask_tmp = 1.
268    
269      DO ii = 1, iim      DO ii = 1, iim
270         DO jj = 1, jjm + 1         DO jj = 1, jjm + 1
271            IF (weight(ii, jj) /= 0.) THEN            ! Coefficients K, L et M:
272               !  Coefficients K, L et M:            xk = (zxtzx(ii, jj) + zytzy(ii, jj)) / 2.
273               xk=(zxtzx(ii, jj)+zytzy(ii, jj))/2.            xl = (zxtzx(ii, jj) - zytzy(ii, jj)) / 2.
274               xl=(zxtzx(ii, jj)-zytzy(ii, jj))/2.            xm = zxtzy(ii, jj)
275               xm=zxtzy(ii, jj)            xp = xk - sqrt(xl**2 + xm**2)
276               xp=xk-sqrt(xl**2+xm**2)            xq = xk + sqrt(xl**2 + xm**2)
277               xq=xk+sqrt(xl**2+xm**2)            xw = 1e-8
278               xw=1.e-8            if(xp.le.xw) xp = 0.
279               if(xp.le.xw) xp=0.            if(xq.le.xw) xq = xw
280               if(xq.le.xw) xq=xw            if(abs(xm).le.xw) xm = xw * sign(1., xm)
281               if(abs(xm).le.xw) xm=xw*sign(1., xm)            ! modification pour masque de terre fractionnaire
282               !$$* PB modif pour maque de terre fractionnaire            ! slope:
283               ! slope:            zsig(ii, jj) = sqrt(xq) * mask_tmp(ii, jj)
284               zsig(ii, jj)=sqrt(xq)*mask_tmp(ii, jj)            ! isotropy:
285               ! isotropy:            zgam(ii, jj) = xp / xq * mask_tmp(ii, jj)
286               zgam(ii, jj)=xp/xq*mask_tmp(ii, jj)            ! angle theta:
287               ! angle theta:            zthe(ii, jj) = 57.29577951 * atan2(xm, xl) / 2. * mask_tmp(ii, jj)
288               zthe(ii, jj)=57.29577951*atan2(xm, xl)/2.*mask_tmp(ii, jj)            zphi(ii, jj) = zmea(ii, jj) * mask_tmp(ii, jj)
289               zphi(ii, jj)=zmea(ii, jj)*mask_tmp(ii, jj)            zmea(ii, jj) = zmea(ii, jj) * mask_tmp(ii, jj)
290               zmea(ii, jj)=zmea(ii, jj)*mask_tmp(ii, jj)            zpic(ii, jj) = zpic(ii, jj) * mask_tmp(ii, jj)
291               zpic(ii, jj)=zpic(ii, jj)*mask_tmp(ii, jj)            zval(ii, jj) = zval(ii, jj) * mask_tmp(ii, jj)
292               zval(ii, jj)=zval(ii, jj)*mask_tmp(ii, jj)            zstd(ii, jj) = zstd(ii, jj) * mask_tmp(ii, jj)
293               zstd(ii, jj)=zstd(ii, jj)*mask_tmp(ii, jj)            zllmmea = AMAX1(zmea(ii, jj), zllmmea)
294            ENDIF            zllmstd = AMAX1(zstd(ii, jj), zllmstd)
295            zllmmea=AMAX1(zmea(ii, jj), zllmmea)            zllmsig = AMAX1(zsig(ii, jj), zllmsig)
296            zllmstd=AMAX1(zstd(ii, jj), zllmstd)            zllmgam = AMAX1(zgam(ii, jj), zllmgam)
297            zllmsig=AMAX1(zsig(ii, jj), zllmsig)            zllmthe = AMAX1(zthe(ii, jj), zllmthe)
298            zllmgam=AMAX1(zgam(ii, jj), zllmgam)            zminthe = amin1(zthe(ii, jj), zminthe)
299            zllmthe=AMAX1(zthe(ii, jj), zllmthe)            zllmpic = AMAX1(zpic(ii, jj), zllmpic)
300            zminthe=amin1(zthe(ii, jj), zminthe)            zllmval = AMAX1(zval(ii, jj), zllmval)
           zllmpic=AMAX1(zpic(ii, jj), zllmpic)  
           zllmval=AMAX1(zval(ii, jj), zllmval)  
301         ENDDO         ENDDO
302      ENDDO      ENDDO
303    
304      print *, 'MEAN ORO: ', zllmmea      print *, 'MEAN ORO: ', zllmmea
305      print *, 'ST. DEV.: ', zllmstd      print *, 'ST. DEV.: ', zllmstd
306      print *, 'PENTE: ', zllmsig      print *, 'PENTE: ', zllmsig
# Line 328  contains Line 309  contains
309      print *, 'pic: ', zllmpic      print *, 'pic: ', zllmpic
310      print *, 'val: ', zllmval      print *, 'val: ', zllmval
311    
312      ! gamma and theta a 1. and 0. at poles      ! gamma and theta at 1. and 0. at poles
313      zmea(iim+1, :)=zmea(1, :)      zmea(iim + 1, :) = zmea(1, :)
314      zphi(iim+1, :)=zphi(1, :)      zphi(iim + 1, :) = zphi(1, :)
315      zpic(iim+1, :)=zpic(1, :)      zpic(iim + 1, :) = zpic(1, :)
316      zval(iim+1, :)=zval(1, :)      zval(iim + 1, :) = zval(1, :)
317      zstd(iim+1, :)=zstd(1, :)      zstd(iim + 1, :) = zstd(1, :)
318      zsig(iim+1, :)=zsig(1, :)      zsig(iim + 1, :) = zsig(1, :)
319      zgam(iim+1, :)=zgam(1, :)      zgam(iim + 1, :) = zgam(1, :)
320      zthe(iim+1, :)=zthe(1, :)      zthe(iim + 1, :) = zthe(1, :)
321    
322      zmeanor=0.      zmeanor = 0.
323      zmeasud=0.      zmeasud = 0.
324      zstdnor=0.      zstdnor = 0.
325      zstdsud=0.      zstdsud = 0.
326      zsignor=0.      zsignor = 0.
327      zsigsud=0.      zsigsud = 0.
328      zweinor=0.      zweinor = 0.
329      zweisud=0.      zweisud = 0.
330      zpicnor=0.      zpicnor = 0.
331      zpicsud=0.                                        zpicsud = 0.
332      zvalnor=0.      zvalnor = 0.
333      zvalsud=0.      zvalsud = 0.
334    
335      DO ii=1, iim      DO ii = 1, iim
336         zweinor=zweinor+              weight(ii,   1)         zweinor = zweinor + weight(ii, 1)
337         zweisud=zweisud+              weight(ii, jjm + 1)         zweisud = zweisud + weight(ii, jjm + 1)
338         zmeanor=zmeanor+zmea(ii,   1)*weight(ii,   1)         zmeanor = zmeanor + zmea(ii, 1) * weight(ii, 1)
339         zmeasud=zmeasud+zmea(ii, jjm + 1)*weight(ii, jjm + 1)         zmeasud = zmeasud + zmea(ii, jjm + 1) * weight(ii, jjm + 1)
340         zstdnor=zstdnor+zstd(ii,   1)*weight(ii,   1)         zstdnor = zstdnor + zstd(ii, 1) * weight(ii, 1)
341         zstdsud=zstdsud+zstd(ii, jjm + 1)*weight(ii, jjm + 1)         zstdsud = zstdsud + zstd(ii, jjm + 1) * weight(ii, jjm + 1)
342         zsignor=zsignor+zsig(ii,   1)*weight(ii,   1)         zsignor = zsignor + zsig(ii, 1) * weight(ii, 1)
343         zsigsud=zsigsud+zsig(ii, jjm + 1)*weight(ii, jjm + 1)         zsigsud = zsigsud + zsig(ii, jjm + 1) * weight(ii, jjm + 1)
344         zpicnor=zpicnor+zpic(ii,   1)*weight(ii,   1)         zpicnor = zpicnor + zpic(ii, 1) * weight(ii, 1)
345         zpicsud=zpicsud+zpic(ii, jjm + 1)*weight(ii, jjm + 1)         zpicsud = zpicsud + zpic(ii, jjm + 1) * weight(ii, jjm + 1)
346         zvalnor=zvalnor+zval(ii,   1)*weight(ii,   1)         zvalnor = zvalnor + zval(ii, 1) * weight(ii, 1)
347         zvalsud=zvalsud+zval(ii, jjm + 1)*weight(ii, jjm + 1)         zvalsud = zvalsud + zval(ii, jjm + 1) * weight(ii, jjm + 1)
348      ENDDO      ENDDO
349    
350      zmea(:,   1)=zmeanor/zweinor      zmea(:, 1) = zmeanor / zweinor
351      zmea(:, jjm + 1)=zmeasud/zweisud      zmea(:, jjm + 1) = zmeasud / zweisud
352    
353      zphi(:,   1)=zmeanor/zweinor      zphi(:, 1) = zmeanor / zweinor
354      zphi(:, jjm + 1)=zmeasud/zweisud      zphi(:, jjm + 1) = zmeasud / zweisud
355    
356      zpic(:,   1)=zpicnor/zweinor      zpic(:, 1) = zpicnor / zweinor
357      zpic(:, jjm + 1)=zpicsud/zweisud      zpic(:, jjm + 1) = zpicsud / zweisud
358    
359      zval(:,   1)=zvalnor/zweinor      zval(:, 1) = zvalnor / zweinor
360      zval(:, jjm + 1)=zvalsud/zweisud      zval(:, jjm + 1) = zvalsud / zweisud
361    
362      zstd(:,   1)=zstdnor/zweinor      zstd(:, 1) = zstdnor / zweinor
363      zstd(:, jjm + 1)=zstdsud/zweisud      zstd(:, jjm + 1) = zstdsud / zweisud
364    
365      zsig(:,   1)=zsignor/zweinor      zsig(:, 1) = zsignor / zweinor
366      zsig(:, jjm + 1)=zsigsud/zweisud      zsig(:, jjm + 1) = zsigsud / zweisud
367    
368      zgam(:,   1)=1.      zgam(:, 1) = 1.
369      zgam(:, jjm + 1)=1.      zgam(:, jjm + 1) = 1.
370    
371      zthe(:,   1)=0.      zthe(:, 1) = 0.
372      zthe(:, jjm + 1)=0.      zthe(:, jjm + 1) = 0.
373    
374    END SUBROUTINE grid_noro    END SUBROUTINE grid_noro
375    

Legend:
Removed from v.52  
changed lines
  Added in v.68

  ViewVC Help
Powered by ViewVC 1.1.21