/[lmdze]/trunk/libf/dyn3d/startdyn.f90
ViewVC logotype

Diff of /trunk/libf/dyn3d/startdyn.f90

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

revision 32 by guez, Tue Apr 6 17:52:58 2010 UTC revision 43 by guez, Fri Apr 8 12:43:31 2011 UTC
# Line 27  CONTAINS Line 27  CONTAINS
27      use comgeom, only: aire_2d, apoln, apols      use comgeom, only: aire_2d, apoln, apols
28      use conf_dat2d_m, only: conf_dat2d      use conf_dat2d_m, only: conf_dat2d
29      use inter_barxy_m, only: inter_barxy      use inter_barxy_m, only: inter_barxy
     use comconst, only: pi  
30      use comgeom, only: rlonu, rlatv      use comgeom, only: rlonu, rlatv
31      use dimens_m, only: iim, jjm      use dimens_m, only: iim, jjm
32      use gr_int_dyn_m, only: gr_int_dyn      use gr_int_dyn_m, only: gr_int_dyn
33      use start_init_orog_m, only: phis      use start_init_orog_m, only: phis
34      use start_init_phys_m, only: start_init_phys      use start_init_phys_m, only: start_init_phys
35        use nr_util, only: assert, pi
36    
37      REAL, intent(out):: tsol_2d(:, :)      REAL, intent(in):: tsol_2d(:, :) ! (iim + 1, jjm + 1)
38      REAL, intent(out):: psol(:, :) ! surface pressure, in Pa      REAL, intent(out):: psol(:, :) ! (iim + 1, jjm + 1) surface pressure, in Pa
39    
40      ! Local:      ! Local:
41    
42      REAL date, dt      REAL date, dt
43      INTEGER itau(1)      INTEGER itau(1)
     INTEGER i, j  
   
     CHARACTER(len=120) physfname  
   
44      REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)      REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)
45    
46      REAL, ALLOCATABLE:: lon_dyn(:, :), lat_dyn(:, :)      REAL, ALLOCATABLE:: lon_dyn(:, :), lat_dyn(:, :)
47      ! (longitude and latitude from the input file, in rad or degrees)      ! (longitude and latitude from the input file, in rad or degrees)
48    
49      REAL, ALLOCATABLE:: var_ana(:, :), z(:, :)      REAL, ALLOCATABLE:: var_ana(:, :)
50        real z(iim + 1, jjm + 1)
51      real tmp_var(iim, jjm + 1)      real tmp_var(iim, jjm + 1)
     REAL, ALLOCATABLE:: xppn(:), xpps(:)  
52    
53      !--------------------------      !--------------------------
54    
55      print *, "Call sequence information: start_init_dyn"      print *, "Call sequence information: start_init_dyn"
56      if (any((/size(tsol_2d, 1), size(psol, 1)/) /= iim + 1)) stop &      call assert((/size(tsol_2d, 1), size(psol, 1)/) == iim + 1, &
57           "start_init_phys size 1"           "start_init_dyn size 1")
58      if (any((/size(tsol_2d, 2), size(psol, 2)/) /= jjm + 1)) stop &      call assert((/size(tsol_2d, 2), size(psol, 2)/) == jjm + 1, &
59           "start_init_phys size 2"           "start_init_dyn size 2")
60      physfname = 'ECDYN.nc'      CALL flininfo('ECDYN.nc', iml_dyn, jml_dyn, llm_dyn, ttm_dyn, fid_dyn)
     print *, 'Opening the surface analysis'  
     CALL flininfo(physfname, iml_dyn, jml_dyn, llm_dyn, ttm_dyn, fid_dyn)  
     print *, 'Values read from "' // trim(physfname) // '":'  
61      print *, "iml_dyn = ", iml_dyn, ", jml_dyn = ", jml_dyn, &      print *, "iml_dyn = ", iml_dyn, ", jml_dyn = ", jml_dyn, &
62           ", llm_dyn = ", llm_dyn, ", ttm_dyn = ", ttm_dyn           ", llm_dyn = ", llm_dyn, ", ttm_dyn = ", ttm_dyn
63    
# Line 79  CONTAINS Line 72  CONTAINS
72      ALLOCATE(lon_rad(iml_dyn))      ALLOCATE(lon_rad(iml_dyn))
73      ALLOCATE(lon_ini(iml_dyn))      ALLOCATE(lon_ini(iml_dyn))
74    
75      IF (MAXVAL(lon_dyn(:, :)) > pi) THEN      IF (MAXVAL(lon_dyn) > pi) THEN
76         ! Assume "lon_dyn" is in degrees         ! Assume "lon_dyn" is in degrees
77         lon_ini(:) = lon_dyn(:, 1) * pi / 180.         lon_ini = lon_dyn(:, 1) * pi / 180.
78      ELSE      ELSE
79         lon_ini(:) = lon_dyn(:, 1)         lon_ini = lon_dyn(:, 1)
80      ENDIF      ENDIF
81    
82      ALLOCATE(lat_rad(jml_dyn))      ALLOCATE(lat_rad(jml_dyn))
83      ALLOCATE(lat_ini(jml_dyn))      ALLOCATE(lat_ini(jml_dyn))
84    
85      IF (MAXVAL(lat_dyn(:, :)) > pi) THEN      IF (MAXVAL(lat_dyn) > pi) THEN
86         lat_ini(:) = lat_dyn(1, :) * pi / 180.         lat_ini = lat_dyn(1, :) * pi / 180.
87      ELSE      ELSE
88         lat_ini(:) = lat_dyn(1, :)         lat_ini = lat_dyn(1, :)
89      ENDIF      ENDIF
90    
     ALLOCATE(z(iim + 1, jjm + 1))  
   
91      ! 'Z': Surface geopotential      ! 'Z': Surface geopotential
92      CALL flinget(fid_dyn, 'Z', iml_dyn, jml_dyn, 0, ttm_dyn, 1, 1, var_ana)      CALL flinget(fid_dyn, 'Z', iml_dyn, jml_dyn, 0, ttm_dyn, 1, 1, var_ana)
93      CALL conf_dat2d(lon_ini, lat_ini, lon_rad, lat_rad, var_ana)      CALL conf_dat2d(lon_ini, lat_ini, lon_rad, lat_rad, var_ana)
94      CALL inter_barxy(lon_rad, lat_rad(:jml_dyn -1), var_ana, rlonu(:iim), &      CALL inter_barxy(lon_rad, lat_rad(:jml_dyn -1), var_ana, rlonu(:iim), &
95           rlatv, tmp_var)           rlatv, tmp_var)
96      z(:, :) = gr_int_dyn(tmp_var)      z = gr_int_dyn(tmp_var)
97    
98      ! 'SP': Surface pressure      ! 'SP': Surface pressure
99      CALL flinget(fid_dyn, 'SP', iml_dyn, jml_dyn, 0, ttm_dyn, 1, 1, var_ana)      CALL flinget(fid_dyn, 'SP', iml_dyn, jml_dyn, 0, ttm_dyn, 1, 1, var_ana)
100      CALL conf_dat2d(lon_ini, lat_ini, lon_rad, lat_rad, var_ana)      CALL conf_dat2d(lon_ini, lat_ini, lon_rad, lat_rad, var_ana)
101      CALL inter_barxy(lon_rad, lat_rad(:jml_dyn -1), var_ana, rlonu(:iim), &      CALL inter_barxy(lon_rad, lat_rad(:jml_dyn -1), var_ana, rlonu(:iim), &
102           rlatv, tmp_var)           rlatv, tmp_var)
103      psol(:, :) = gr_int_dyn(tmp_var)      psol = gr_int_dyn(tmp_var)
     CALL start_init_phys(tsol_2d)  
104    
105      ! PSOL is computed in Pascals      psol(:iim, :) = psol(:iim, :) &
106             * (1. + (z(:iim, :) - phis(:iim, :)) / 287. / tsol_2d(:iim, :))
     DO j = 1, jjm + 1  
        DO i = 1, iim  
           psol(i, j) = psol(i, j) &  
                * (1. + (z(i, j) - phis(i, j)) / 287. / tsol_2d(i, j))  
        ENDDO  
     ENDDO  
107      psol(iim + 1, :) = psol(1, :)      psol(iim + 1, :) = psol(1, :)
108    
109      ALLOCATE(xppn(iim))      psol(:, 1) = SUM(aire_2d(:iim, 1) * psol(:iim, 1)) / apoln
110      ALLOCATE(xpps(iim))      psol(:, jjm + 1) = SUM(aire_2d(:iim, jjm + 1) * psol(:iim, jjm + 1)) &
111             / apols
     DO  i = 1, iim  
        xppn(i) = aire_2d( i, 1) * psol( i, 1)  
        xpps(i) = aire_2d( i, jjm + 1) * psol( i, jjm + 1)  
     ENDDO  
   
     psol(:, 1) = SUM(xppn)/apoln  
     psol(:, jjm + 1) = SUM(xpps)/apols  
112    
113    END SUBROUTINE start_init_dyn    END SUBROUTINE start_init_dyn
114    
# Line 139  CONTAINS Line 116  CONTAINS
116    
117    subroutine start_inter_3d(varname, lon_in2, lat_in2, pls_in, var3d)    subroutine start_inter_3d(varname, lon_in2, lat_in2, pls_in, var3d)
118    
119      ! This procedure gets a 3D variable from a file and does the      ! This procedure gets a 3D variable from a file and interpolates it.
     ! interpolations needed.  
120    
121      use flinget_m, only: flinget      use flinget_m, only: flinget
122      use numer_rec, only: assert_eq, spline, splint      use nr_util, only: assert_eq
123        use numer_rec, only: spline, splint
124      use inter_barxy_m, only: inter_barxy      use inter_barxy_m, only: inter_barxy
125      use gr_int_dyn_m, only: gr_int_dyn      use gr_int_dyn_m, only: gr_int_dyn
126      use conf_dat3d_m, only: conf_dat3d      use conf_dat3d_m, only: conf_dat3d
127    
128      CHARACTER(len=*), intent(in):: varname      CHARACTER(len=*), intent(in):: varname
129      REAL, intent(in):: lon_in2(:), lat_in2(:)      REAL, intent(in):: lon_in2(:) ! (iml)
130      REAL, intent(in):: pls_in(:, :, :)      REAL, intent(in):: lat_in2(:)
131      REAL, intent(out):: var3d(:, :, :)      REAL, intent(in):: pls_in(:, :, :) ! (iml, jml, lml)
132        REAL, intent(out):: var3d(:, :, :) ! (iml, jml, lml)
133    
134      ! LOCAL:      ! LOCAL:
135      INTEGER iml, jml, lml      INTEGER iml, jml, lml
# Line 174  CONTAINS Line 152  CONTAINS
152    
153      print *, "iml = ", iml, ", jml = ", jml      print *, "iml = ", iml, ", jml = ", jml
154      print *, "varname = ", varname      print *, "varname = ", varname
     print *, "iml_dyn = ", iml_dyn, ", jml_dyn = ", jml_dyn, &  
          ", llm_dyn = ", llm_dyn, ", ttm_dyn = ", ttm_dyn  
155      print *, 'Going into flinget to extract the 3D field.'      print *, 'Going into flinget to extract the 3D field.'
156      CALL flinget(fid_dyn, varname, iml_dyn, jml_dyn, llm_dyn, ttm_dyn, 1, 1, &      CALL flinget(fid_dyn, varname, iml_dyn, jml_dyn, llm_dyn, ttm_dyn, 1, 1, &
157           var_ana3d)           var_ana3d)
   
158      CALL conf_dat3d(lon_ini, lat_ini, levdyn_ini, lon_rad, lat_rad, lev_dyn, &      CALL conf_dat3d(lon_ini, lat_ini, levdyn_ini, lon_rad, lat_rad, lev_dyn, &
159           var_ana3d)           var_ana3d)
160    
# Line 191  CONTAINS Line 166  CONTAINS
166    
167      ! Pour l'interpolation verticale, on interpole du haut de l'atmosphère      ! Pour l'interpolation verticale, on interpole du haut de l'atmosphère
168      ! vers le sol :      ! vers le sol :
169      ax(:) = lev_dyn(llm_dyn:1:-1)      ax = lev_dyn(llm_dyn:1:-1)
170      DO ij=1, jml      DO ij=1, jml
171         DO ii=1, iml-1         DO ii=1, iml-1
172            ay(:) = var_tmp3d(ii, ij, llm_dyn:1:-1)            ay = var_tmp3d(ii, ij, llm_dyn:1:-1)
173            yder(:) = SPLINE(ax, ay)            yder = SPLINE(ax, ay)
174            do il=1, lml            do il=1, lml
175               var3d(ii, ij, il) = SPLINT(ax, ay, yder, pls_in(ii, ij, il))               var3d(ii, ij, il) = SPLINT(ax, ay, yder, pls_in(ii, ij, il))
176            END do            END do
Legend:
Removed from v.32  
changed lines
  Added in v.43
  ViewVC Help
Powered by ViewVC 1.1.21