/[lmdze]/trunk/libf/phylmd/Orography/grid_noro_m.f90
ViewVC logotype

Diff of /trunk/libf/phylmd/Orography/grid_noro_m.f90

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

revision 69 by guez, Wed Nov 14 16:59:30 2012 UTC revision 70 by guez, Mon Jun 24 15:39:52 2013 UTC
# Line 9  contains Line 9  contains
9    
10      ! From dyn3d/grid_noro.F, version 1.1.1.1 2004/05/19 12:53:06      ! From dyn3d/grid_noro.F, version 1.1.1.1 2004/05/19 12:53:06
11    
12      ! Authors: F. Lott, Z. X. Li, A. Harzallah and L. Fairhead      ! Authors: François Lott, Laurent Li, A. Harzallah and Laurent
13        ! Fairhead
14    
15        ! Compute the parameters of the sub-grid scale orography scheme as
16        ! described in Lott and Miller (1997) and Lott (1999).
17    
     ! Compute the parameters of the SSO scheme as described in  
     ! Lott and Miller (1997) and Lott (1999).  
18      ! Target points are on a rectangular grid:      ! Target points are on a rectangular grid:
19      ! jjm + 1 latitudes including North and South Poles;      ! jjm + 1 latitudes including North and South Poles;
20      ! iim + 1 longitudes, with periodicity: longitude(iim + 1) = longitude(1)      ! iim + 1 longitudes, with periodicity: longitude(iim + 1) = longitude(1)
# Line 20  contains Line 22  contains
22    
23      ! The parameters a, b, c, d represent the limite of the target      ! The parameters a, b, c, d represent the limite of the target
24      ! gridpoint region. The means over this region are calculated from      ! gridpoint region. The means over this region are calculated from
25      ! USN data, ponderated by a weight proportional to the surface      ! US Navy data, ponderated by a weight proportional to the surface
26      ! occupied by the data inside the model gridpoint area. In most      ! occupied by the data inside the model gridpoint area. In most
27      ! circumstances, this weight is the ratio between the surface of      ! circumstances, this weight is the ratio between the surface of
28      ! the USN gridpoint area and the surface of the model gridpoint      ! the US Navy gridpoint area and the surface of the model gridpoint
29      ! area. See "grid_noto.txt".      ! area. See "grid_noto.txt".
30    
31      use dimens_m, only: iim, jjm      use dimens_m, only: iim, jjm
# Line 34  contains Line 36  contains
36      REAL, intent(in):: zdata(:, :) ! input field      REAL, intent(in):: zdata(:, :) ! input field
37      REAL, intent(in):: x(:), y(:) ! ccordinates output field      REAL, intent(in):: x(:), y(:) ! ccordinates output field
38    
39      ! Correlations of USN orography gradients:      ! Correlations of US Navy orography gradients:
   
40      REAL, intent(out):: zphi(:, :)      REAL, intent(out):: zphi(:, :)
41      real, intent(out):: zmea(:, :) ! Mean orography      real, intent(out):: zmea(:, :) ! Mean orography
42      real, intent(out):: zstd(:, :) ! Standard deviation      real, intent(out):: zstd(:, :) ! Standard deviation
43      REAL zsig(:, :) ! Slope      REAL, intent(out):: zsig(:, :) ! Slope
44      real zgam(:, :) ! Anisotropy      real, intent(out):: zgam(:, :) ! Anisotropy
45      real zthe(:, :) ! Orientation of the small axis      real, intent(out):: zthe(:, :) ! Orientation of the small axis
46      REAL, intent(out):: zpic(:, :) ! Maximum altitude      REAL, intent(out):: zpic(:, :) ! Maximum altitude
47      real, intent(out):: zval(:, :) ! Minimum altitude      real, intent(out):: zval(:, :) ! Minimum altitude
48    
# Line 62  contains Line 63  contains
63      REAL zytzy(iim + 1, jjm + 1), zxtzy(iim + 1, jjm + 1)      REAL zytzy(iim + 1, jjm + 1), zxtzy(iim + 1, jjm + 1)
64      REAL weight(iim + 1, jjm + 1)      REAL weight(iim + 1, jjm + 1)
65    
66      ! Correlations of USN orography gradients:      ! Correlations of US Navy orography gradients:
67      REAL, dimension(iusn + 2 * iext, jusn + 2):: zxtzxusn, zytzyusn, zxtzyusn      REAL, dimension(iusn + 2 * iext, jusn + 2):: zxtzxusn, zytzyusn, zxtzyusn
68    
69      real mask_tmp(size(x), size(y))      real mask_tmp(size(x), size(y))
70      real num_tot(iim + 1, jjm + 1), num_lan(iim + 1, jjm + 1)      real num_tot(iim + 1, jjm + 1), num_lan(iim + 1, jjm + 1)
71    
72      REAL a(iim + 1), b(iim + 1), c(jjm + 1), d(jjm + 1)      REAL a(iim + 1), b(iim + 1), c(jjm + 1), d(jjm + 1)
73      real rad, weighx, weighy, xincr, xk, xp, xm, xw, xq, xl      real weighx, weighy, xincr, xk, xp, xm, xw, xq, xl
74      real zbordnor, zdeltax, zbordsud, zdeltay, zbordoue, zlenx, zleny, zmeasud      real zbordnor, zdeltax, zbordsud, zdeltay, zbordoue, zlenx, zleny, zmeasud
75      real zllmpic, zllmmea, zllmgam, zllmthe, zllmstd, zllmsig, zllmval      real zllmpic, zllmmea, zllmgam, zllmthe, zllmstd, zllmsig, zllmval
76      real zpicnor, zminthe, zsigsud, zstdnor, zstdsud, zvalsud, zvalnor      real zpicnor, zminthe, zsigsud, zstdnor, zstdsud, zvalsud, zvalnor
77      real zweinor, zweisud, zsignor, zpicsud, zmeanor, zbordest      real zweinor, zweisud, zsignor, zpicsud, zmeanor, zbordest
78      integer ii, i, jj, j      integer ii, i, jj, j
79        real, parameter:: rad = 6371229.
80    
81      !-------------------------------      !-------------------------------
82    
# Line 92  contains Line 94  contains
94           size(zval, 2), size(mask, 2)/) == jjm + 1, "grid_noro jjm")           size(zval, 2), size(mask, 2)/) == jjm + 1, "grid_noro jjm")
95    
96      print *, "Paramètres de l'orographie à l'échelle sous-maille"      print *, "Paramètres de l'orographie à l'échelle sous-maille"
     rad = 6371229.  
97      zdeltay = 2. * pi / real(jusn) * rad      zdeltay = 2. * pi / real(jusn) * rad
98    
99      ! Extension of the USN database to POCEED computations at boundaries:      ! Extension of the US Navy database for computations at boundaries:
100    
101      DO j = 1, jusn      DO j = 1, jusn
102         yusn(j + 1) = ydata(j)         yusn(j + 1) = ydata(j)
# Line 150  contains Line 151  contains
151      zpic = - 1E10      zpic = - 1E10
152      zval = 1E10      zval = 1E10
153    
154      ! COMPUTE SLOPES CORRELATIONS ON USN GRID      ! Compute slopes correlations on US Navy grid
155    
156      zytzyusn = 0.      zytzyusn = 0.
157      zxtzxusn = 0.      zxtzxusn = 0.
# Line 179  contains Line 180  contains
180               zdeltax = zdeltay * cos(yusn(j))               zdeltax = zdeltay * cos(yusn(j))
181               zbordnor = (c(jj) - yusn(j) + xincr) * rad               zbordnor = (c(jj) - yusn(j) + xincr) * rad
182               zbordsud = (yusn(j) - d(jj) + xincr) * rad               zbordsud = (yusn(j) - d(jj) + xincr) * rad
183               weighy = AMAX1(0., amin1(zbordnor, zbordsud, zleny))               weighy = MAX(0., min(zbordnor, zbordsud, zleny))
184               IF (weighy /= 0) THEN               IF (weighy /= 0) THEN
185                  DO i = 2, iusn + 2 * iext - 1                  DO i = 2, iusn + 2 * iext - 1
186                     zbordest = (xusn(i) - a(ii) + xincr) * rad * cos(yusn(j))                     zbordest = (xusn(i) - a(ii) + xincr) * rad * cos(yusn(j))
187                     zbordoue = (b(ii) + xincr - xusn(i)) * rad * cos(yusn(j))                     zbordoue = (b(ii) + xincr - xusn(i)) * rad * cos(yusn(j))
188                     weighx = AMAX1(0., amin1(zbordest, zbordoue, zlenx))                     weighx = MAX(0., min(zbordest, zbordoue, zlenx))
189                     IF (weighx /= 0) THEN                     IF (weighx /= 0) THEN
190                        num_tot(ii, jj) = num_tot(ii, jj) + 1.                        num_tot(ii, jj) = num_tot(ii, jj) + 1.
191                        if (zusn(i, j) >= 1.) then                        if (zusn(i, j) >= 1.) then
# Line 202  contains Line 203  contains
203                        ! mean                        ! mean
204                        zmea(ii, jj) = zmea(ii, jj) + zusn(i, j) * weighx * weighy                        zmea(ii, jj) = zmea(ii, jj) + zusn(i, j) * weighx * weighy
205                        ! peacks                        ! peacks
206                        zpic(ii, jj) = amax1(zpic(ii, jj), zusn(i, j))                        zpic(ii, jj) = max(zpic(ii, jj), zusn(i, j))
207                        ! valleys                        ! valleys
208                        zval(ii, jj) = amin1(zval(ii, jj), zusn(i, j))                        zval(ii, jj) = min(zval(ii, jj), zusn(i, j))
209                     ENDIF                     ENDIF
210                  ENDDO                  ENDDO
211               ENDIF               ENDIF
# Line 212  contains Line 213  contains
213         ENDDO         ENDDO
214      ENDDO      ENDDO
215    
216      if (any(weight == 0.)) stop "zero weight in grid_noro"      if (any(weight == 0.)) then
217           print *, "zero weight in grid_noro"
218           stop 1
219        end if
220    
221      ! COMPUTE PARAMETERS NEEDED BY THE LOTT & MILLER (1997) AND      ! COMPUTE PARAMETERS NEEDED BY THE LOTT & MILLER (1997) AND
222      ! LOTT (1999) SSO SCHEME.      ! LOTT (1999) SSO SCHEME.
# Line 260  contains Line 264  contains
264      CALL MVA9(zxtzy)      CALL MVA9(zxtzy)
265      CALL MVA9(zytzy)      CALL MVA9(zytzy)
266    
267      ! Masque prenant en compte maximum de terre. On seuille à 10 % de      ! Masque prenant en compte maximum de terre. On met un seuil à 10
268      ! terre car en dessous les paramètres de surface n'ont pas de      ! % de terre car en dessous les paramètres de surface n'ont pas de
269      ! sens.      ! sens.
270      mask_tmp = 0.      mask_tmp = 0.
271      WHERE (mask >= 0.1) mask_tmp = 1.      WHERE (mask >= 0.1) mask_tmp = 1.
# Line 290  contains Line 294  contains
294            zpic(ii, jj) = zpic(ii, jj) * mask_tmp(ii, jj)            zpic(ii, jj) = zpic(ii, jj) * mask_tmp(ii, jj)
295            zval(ii, jj) = zval(ii, jj) * mask_tmp(ii, jj)            zval(ii, jj) = zval(ii, jj) * mask_tmp(ii, jj)
296            zstd(ii, jj) = zstd(ii, jj) * mask_tmp(ii, jj)            zstd(ii, jj) = zstd(ii, jj) * mask_tmp(ii, jj)
297            zllmmea = AMAX1(zmea(ii, jj), zllmmea)            zllmmea = MAX(zmea(ii, jj), zllmmea)
298            zllmstd = AMAX1(zstd(ii, jj), zllmstd)            zllmstd = MAX(zstd(ii, jj), zllmstd)
299            zllmsig = AMAX1(zsig(ii, jj), zllmsig)            zllmsig = MAX(zsig(ii, jj), zllmsig)
300            zllmgam = AMAX1(zgam(ii, jj), zllmgam)            zllmgam = MAX(zgam(ii, jj), zllmgam)
301            zllmthe = AMAX1(zthe(ii, jj), zllmthe)            zllmthe = MAX(zthe(ii, jj), zllmthe)
302            zminthe = amin1(zthe(ii, jj), zminthe)            zminthe = min(zthe(ii, jj), zminthe)
303            zllmpic = AMAX1(zpic(ii, jj), zllmpic)            zllmpic = MAX(zpic(ii, jj), zllmpic)
304            zllmval = AMAX1(zval(ii, jj), zllmval)            zllmval = MAX(zval(ii, jj), zllmval)
305         ENDDO         ENDDO
306      ENDDO      ENDDO
307    
Legend:
Removed from v.69  
changed lines
  Added in v.70
  ViewVC Help
Powered by ViewVC 1.1.21