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

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

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

revision 77 by guez, Fri Nov 15 18:45:49 2013 UTC revision 78 by guez, Wed Feb 5 17:51:07 2014 UTC
# Line 34  contains Line 34  contains
34    
35      REAL, intent(in):: xdata(:), ydata(:) ! coordinates of input field      REAL, intent(in):: xdata(:), ydata(:) ! coordinates of input field
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(:) ! coordinates of output field
38    
39      ! Correlations of US Navy orography gradients:      ! Correlations of US Navy orography gradients:
40      REAL, intent(out):: zphi(:, :)      REAL, intent(out):: zphi(:, :)
# Line 58  contains Line 58  contains
58      REAL zusn(iusn + 2 * iext, jusn + 2)      REAL zusn(iusn + 2 * iext, jusn + 2)
59    
60      ! Intermediate fields (correlations of orography gradient)      ! Intermediate fields (correlations of orography gradient)
61        REAL, dimension(iim + 1, jjm + 1):: ztz, zxtzx, zytzy, zxtzy, weight
     REAL ztz(iim + 1, jjm + 1), zxtzx(iim + 1, jjm + 1)  
     REAL zytzy(iim + 1, jjm + 1), zxtzy(iim + 1, jjm + 1)  
     REAL weight(iim + 1, jjm + 1)  
62    
63      ! Correlations of US Navy orography gradients:      ! Correlations of US Navy orography gradients:
64      REAL, dimension(iusn + 2 * iext, jusn + 2):: zxtzxusn, zytzyusn, zxtzyusn      REAL, dimension(iusn + 2 * iext, jusn + 2):: zxtzxusn, zytzyusn, zxtzyusn
65    
66      real mask_tmp(size(x), size(y))      real, dimension(iim + 1, jjm + 1):: mask_tmp, num_tot, num_lan, zmea0
     real num_tot(iim + 1, jjm + 1), num_lan(iim + 1, jjm + 1)  
   
67      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)
68      real weighx, weighy, xincr, xk, xp, xm, xw, xq, xl      real weighx, weighy, xincr, xk, xp, xm, xw, xq, xl
69      real zbordnor, zdeltax, zbordsud, zdeltay, zbordoue, zlenx, zleny, zmeasud      real zbordnor, zdeltax, zbordsud, zdeltay, zbordoue, zlenx, zleny, zmeasud
# Line 121  contains Line 116  contains
116         zusn(i + iusn / 2 + iext, jusn + 2) = zusn(i, jusn + 1)         zusn(i + iusn / 2 + iext, jusn + 2) = zusn(i, jusn + 1)
117      ENDDO      ENDDO
118    
119      ! COMPUTE LIMITS OF MODEL GRIDPOINT AREA (REGULAR GRID)      ! Compute limits of model gridpoint area (regular grid)
120    
121      a(1) = x(1) - (x(2) - x(1)) / 2.0      a(1) = x(1) - (x(2) - x(1)) / 2.0
122      b(1) = (x(1) + x(2)) / 2.0      b(1) = (x(1) + x(2)) / 2.0
# Line 167  contains Line 162  contains
162         ENDDO         ENDDO
163      ENDDO      ENDDO
164    
165      ! SUMMATION OVER GRIDPOINT AREA      ! Summation over gridpoint area
166    
167      zleny = pi / real(jusn) * rad      zleny = pi / real(jusn) * rad
168      xincr = pi / 2. / real(jusn)      xincr = pi / 2. / real(jusn)
# Line 218  contains Line 213  contains
213         stop 1         stop 1
214      end if      end if
215    
216      ! COMPUTE PARAMETERS NEEDED BY THE LOTT & MILLER (1997) AND      ! Compute parameters needed by the Lott & Miller (1997) and Lott
217      ! LOTT (1999) SSO SCHEME.      ! (1999) subgrid-scale orographic scheme.
218    
219      zllmmea = 0.      zllmmea = 0.
220      zllmstd = 0.      zllmstd = 0.
# Line 232  contains Line 227  contains
227      DO ii = 1, iim + 1      DO ii = 1, iim + 1
228         DO jj = 1, jjm + 1         DO jj = 1, jjm + 1
229            mask(ii, jj) = num_lan(ii, jj) / num_tot(ii, jj)            mask(ii, jj) = num_lan(ii, jj) / num_tot(ii, jj)
230            ! Mean Orography:            ! Mean orography:
231            zmea (ii, jj) = zmea (ii, jj) / weight(ii, jj)            zmea (ii, jj) = zmea (ii, jj) / weight(ii, jj)
232            zxtzx(ii, jj) = zxtzx(ii, jj) / weight(ii, jj)            zxtzx(ii, jj) = zxtzx(ii, jj) / weight(ii, jj)
233            zytzy(ii, jj) = zytzy(ii, jj) / weight(ii, jj)            zytzy(ii, jj) = zytzy(ii, jj) / weight(ii, jj)
# Line 243  contains Line 238  contains
238         ENDDO         ENDDO
239      ENDDO      ENDDO
240    
241      ! CORRECT VALUES OF HORIZONTAL SLOPE NEAR THE POLES:      ! Correct values of horizontal slope near the poles:
242      DO ii = 1, iim + 1      DO ii = 1, iim + 1
243         zxtzx(ii, 1) = zxtzx(ii, 2)         zxtzx(ii, 1) = zxtzx(ii, 2)
244         zxtzx(ii, jjm + 1) = zxtzx(ii, jjm)         zxtzx(ii, jjm + 1) = zxtzx(ii, jjm)
# Line 253  contains Line 248  contains
248         zytzy(ii, jjm + 1) = zytzy(ii, jjm)         zytzy(ii, jjm + 1) = zytzy(ii, jjm)
249      ENDDO      ENDDO
250    
251      ! FILTERS TO SMOOTH OUT FIELDS FOR INPUT INTO SSO SCHEME.      zmea0 = zmea ! not smoothed
252    
253        ! Filters to smooth out fields for input into subgrid-scale
254        ! orographic scheme.
255    
256      ! FIRST FILTER, MOVING AVERAGE OVER 9 POINTS.      ! First filter, moving average over 9 points.
257      CALL MVA9(zmea)      CALL MVA9(zmea)
258      CALL MVA9(zstd)      CALL MVA9(zstd)
259      CALL MVA9(zpic)      CALL MVA9(zpic)
# Line 267  contains Line 265  contains
265      ! Masque prenant en compte maximum de terre. On met un seuil à 10      ! Masque prenant en compte maximum de terre. On met un seuil à 10
266      ! % de 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
267      ! sens.      ! sens.
268      mask_tmp = 0.      mask_tmp = merge(1., 0., mask >= 0.1)
     WHERE (mask >= 0.1) mask_tmp = 1.  
269    
270      DO ii = 1, iim      DO ii = 1, iim
271         DO jj = 1, jjm + 1         DO jj = 1, jjm + 1
# Line 289  contains Line 286  contains
286            zgam(ii, jj) = xp / xq * mask_tmp(ii, jj)            zgam(ii, jj) = xp / xq * mask_tmp(ii, jj)
287            ! angle theta:            ! angle theta:
288            zthe(ii, jj) = 57.29577951 * atan2(xm, xl) / 2. * mask_tmp(ii, jj)            zthe(ii, jj) = 57.29577951 * atan2(xm, xl) / 2. * mask_tmp(ii, jj)
289            zphi(ii, jj) = zmea(ii, jj) * mask_tmp(ii, jj)            zphi(ii, jj) = zmea0(ii, jj) * mask_tmp(ii, jj)
290            zmea(ii, jj) = zmea(ii, jj) * mask_tmp(ii, jj)            zmea(ii, jj) = zmea(ii, jj) * mask_tmp(ii, jj)
291            zpic(ii, jj) = zpic(ii, jj) * mask_tmp(ii, jj)            zpic(ii, jj) = zpic(ii, jj) * mask_tmp(ii, jj)
292            zval(ii, jj) = zval(ii, jj) * mask_tmp(ii, jj)            zval(ii, jj) = zval(ii, jj) * mask_tmp(ii, jj)
Legend:
Removed from v.77  
changed lines
  Added in v.78
  ViewVC Help
Powered by ViewVC 1.1.21