/[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 40 by guez, Tue Feb 22 13:49:36 2011 UTC
# Line 41  contains Line 41  contains
41      !           (d)      !           (d)
42    
43      use dimens_m, only: iim, jjm      use dimens_m, only: iim, jjm
44      use comconst, only: pi      use nr_util, only: assert, pi
     use nrutil, only: assert  
45    
46      REAL, intent(in):: xdata(:), ydata(:) ! coordinates of input field      REAL, intent(in):: xdata(:), ydata(:) ! coordinates of input field
47      REAL, intent(in):: zdata(:, :) ! input field      REAL, intent(in):: zdata(:, :) ! input field
# Line 59  contains Line 58  contains
58      REAL, intent(out):: zpic(:, :) ! Maximum altitude      REAL, intent(out):: zpic(:, :) ! Maximum altitude
59      real, intent(out):: zval(:, :) ! Minimum altitude      real, intent(out):: zval(:, :) ! Minimum altitude
60    
61      real, intent(out):: mask(:, :)      real, intent(out):: mask(:, :) ! fraction of land
62    
63      ! Variables local to the procedure:      ! Variables local to the procedure:
64    
# Line 141  contains Line 140  contains
140         zusn(i, jusn+2)=zusn(i+iusn/2, jusn+1)         zusn(i, jusn+2)=zusn(i+iusn/2, jusn+1)
141         zusn(i+iusn/2+iext, jusn+2)=zusn(i, jusn+1)         zusn(i+iusn/2+iext, jusn+2)=zusn(i, jusn+1)
142      ENDDO      ENDDO
143      !    
144      ! COMPUTE LIMITS OF MODEL GRIDPOINT AREA      ! COMPUTE LIMITS OF MODEL GRIDPOINT AREA
145      !     ( REGULAR GRID)      !     ( REGULAR GRID)
146    
# Line 190  contains Line 189  contains
189      ENDDO      ENDDO
190    
191      !  SUMMATION OVER GRIDPOINT AREA      !  SUMMATION OVER GRIDPOINT AREA
192      !  
193      zleny=pi/real(jusn)*rad      zleny=pi/real(jusn)*rad
194      xincr=pi/2./real(jusn)      xincr=pi/2./real(jusn)
195      DO ii = 1, iim+1      DO ii = 1, iim+1
# Line 255  contains Line 254  contains
254            zxtzy(ii, jj)=zxtzy(ii, jj)/weight(ii, jj)            zxtzy(ii, jj)=zxtzy(ii, jj)/weight(ii, jj)
255            ztz(ii, jj)  =ztz(ii, jj)/weight(ii, jj)            ztz(ii, jj)  =ztz(ii, jj)/weight(ii, jj)
256            !  Standard deviation:            !  Standard deviation:
257            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))
258         ENDDO         ENDDO
259      ENDDO      ENDDO
260    
# Line 324  contains Line 323  contains
323            zllmval=AMAX1(zval(ii, jj), zllmval)            zllmval=AMAX1(zval(ii, jj), zllmval)
324         ENDDO         ENDDO
325      ENDDO      ENDDO
326      print *, '  MEAN ORO:', zllmmea      print *, 'MEAN ORO: ', zllmmea
327      print *, '  ST. DEV.:', zllmstd      print *, 'ST. DEV.: ', zllmstd
328      print *, '  PENTE:', zllmsig      print *, 'PENTE: ', zllmsig
329      print *, ' ANISOTROP:', zllmgam      print *, 'ANISOTROP: ', zllmgam
330      print *, '  ANGLE:', zminthe, zllmthe      print *, 'ANGLE: ', zminthe, zllmthe
331      print *, '  pic:', zllmpic      print *, 'pic: ', zllmpic
332      print *, '  val:', zllmval      print *, 'val: ', zllmval
333    
334      ! gamma and theta a 1. and 0. at poles      ! gamma and theta a 1. and 0. at poles
335      zmea(iim+1, :)=zmea(1, :)      zmea(iim+1, :)=zmea(1, :)
# Line 410  contains Line 409  contains
409      integer, PARAMETER:: ISMo=300, JSMo=200      integer, PARAMETER:: ISMo=300, JSMo=200
410      real XF(ISMo, JSMo)      real XF(ISMo, JSMo)
411      real WEIGHTpb(-1:1, -1:1)      real WEIGHTpb(-1:1, -1:1)
412      real sum      real my_sum
413      integer i, is, js, j      integer i, is, js, j
414    
415      if(imar>ismo) stop 'surdimensionner ismo dans mva9 (grid_noro)'      if(imar>ismo) stop 'surdimensionner ismo dans mva9 (grid_noro)'
416      if(jmar>jsmo) stop 'surdimensionner jsmo dans mva9 (grid_noro)'      if(jmar>jsmo) stop 'surdimensionner jsmo dans mva9 (grid_noro)'
417    
418      SUM=0.      MY_SUM=0.
419      DO IS=-1, 1      DO IS=-1, 1
420         DO JS=-1, 1         DO JS=-1, 1
421            WEIGHTpb(IS, JS)=1./FLOAT((1+IS**2)*(1+JS**2))            WEIGHTpb(IS, JS)=1./FLOAT((1+IS**2)*(1+JS**2))
422            SUM=SUM+WEIGHTpb(IS, JS)            MY_SUM=MY_SUM+WEIGHTpb(IS, JS)
423         ENDDO         ENDDO
424      ENDDO      ENDDO
425    
426      DO IS=-1, 1      DO IS=-1, 1
427         DO JS=-1, 1         DO JS=-1, 1
428            WEIGHTpb(IS, JS)=WEIGHTpb(IS, JS)/SUM            WEIGHTpb(IS, JS)=WEIGHTpb(IS, JS)/MY_SUM
429         ENDDO         ENDDO
430      ENDDO      ENDDO
431    
Legend:
Removed from v.3  
changed lines
  Added in v.40
  ViewVC Help
Powered by ViewVC 1.1.21