/[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

trunk/libf/dyn3d/grid_noro_m.f90 revision 3 by guez, Wed Feb 27 13:16:39 2008 UTC trunk/libf/phylmd/Orography/grid_noro_m.f90 revision 52 by guez, Fri Sep 23 12:28:01 2011 UTC
# Line 1  Line 1 
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, &
# Line 41  contains Line 37  contains
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 nrutil, 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
# Line 59  contains Line 55  contains
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    
# Line 141  contains Line 137  contains
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    
# Line 190  contains Line 186  contains
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
# Line 255  contains Line 251  contains
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    
# Line 274  contains Line 270  contains
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
# Line 324  contains Line 320  contains
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, :)
# Line 396  contains Line 392  contains
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
Legend:
Removed from v.3  
changed lines
  Added in v.52
  ViewVC Help
Powered by ViewVC 1.1.21