/[lmdze]/trunk/dyn3d/startdyn.f
ViewVC logotype

Diff of /trunk/dyn3d/startdyn.f

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

revision 20 by guez, Wed Oct 15 16:19:57 2008 UTC revision 48 by guez, Tue Jul 19 12:54:20 2011 UTC
# Line 22  CONTAINS Line 22  CONTAINS
22      ! Host associated variables appearing and modified in this procedure :      ! Host associated variables appearing and modified in this procedure :
23      ! iml_dyn, jml_dyn, llm_dyn, ttm_dyn, fid_dyn, lon_ini, lat_ini, levdyn_ini      ! iml_dyn, jml_dyn, llm_dyn, ttm_dyn, fid_dyn, lon_ini, lat_ini, levdyn_ini
24    
25      USE ioipsl, only: flininfo, flinopen_nozoom, flinget      USE flincom, only: flininfo, flinopen_nozoom
26      use comgeom, only: aire_2d, apoln, apols      use comgeom, only: aire_2d, apoln, apols
27      use conf_dat2d_m, only: conf_dat2d      use conf_dat2d_m, only: conf_dat2d
28      use inter_barxy_m, only: inter_barxy      use inter_barxy_m, only: inter_barxy
     use comconst, only: pi  
29      use comgeom, only: rlonu, rlatv      use comgeom, only: rlonu, rlatv
30      use dimens_m, only: iim, jjm      use dimens_m, only: iim, jjm
31      use gr_int_dyn_m, only: gr_int_dyn      use gr_int_dyn_m, only: gr_int_dyn
32      use start_init_orog_m, only: phis      use start_init_orog_m, only: phis
33      use start_init_phys_m, only: start_init_phys      use start_init_phys_m, only: start_init_phys
34        use nr_util, only: assert, pi
35        use netcdf, only: nf90_nowrite
36        use netcdf95, only: nf95_open, nf95_close, nf95_get_var, nf95_inq_varid
37    
38      REAL, intent(out):: tsol_2d(:, :)      REAL, intent(in):: tsol_2d(:, :) ! (iim + 1, jjm + 1)
39      REAL, intent(out):: psol(:, :) ! surface pressure, in Pa      REAL, intent(out):: psol(:, :) ! (iim + 1, jjm + 1) surface pressure, in Pa
40    
41      ! Local:      ! Local:
42    
43      REAL date, dt      REAL date, dt
44      INTEGER itau(1)      INTEGER itau(1), ncid, varid
     INTEGER i, j  
   
     CHARACTER(len=120) physfname  
   
45      REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)      REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)
46    
47      REAL, ALLOCATABLE:: lon_dyn(:, :), lat_dyn(:, :)      REAL, ALLOCATABLE:: lon_dyn(:, :), lat_dyn(:, :)
48      ! (longitude and latitude from the input file, in rad or degrees)      ! (longitude and latitude from the input file, in rad or degrees)
49    
50      REAL, ALLOCATABLE:: var_ana(:, :), z(:, :)      REAL, ALLOCATABLE:: var_ana(:, :)
51        real z(iim + 1, jjm + 1)
52      real tmp_var(iim, jjm + 1)      real tmp_var(iim, jjm + 1)
     REAL, ALLOCATABLE:: xppn(:), xpps(:)  
53    
54      !--------------------------      !--------------------------
55    
56      print *, "Call sequence information: start_init_dyn"      print *, "Call sequence information: start_init_dyn"
57      if (any((/size(tsol_2d, 1), size(psol, 1)/) /= iim + 1)) stop &      call assert((/size(tsol_2d, 1), size(psol, 1)/) == iim + 1, &
58           "start_init_phys size 1"           "start_init_dyn size 1")
59      if (any((/size(tsol_2d, 2), size(psol, 2)/) /= jjm + 1)) stop &      call assert((/size(tsol_2d, 2), size(psol, 2)/) == jjm + 1, &
60           "start_init_phys size 2"           "start_init_dyn size 2")
61      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) // '":'  
62      print *, "iml_dyn = ", iml_dyn, ", jml_dyn = ", jml_dyn, &      print *, "iml_dyn = ", iml_dyn, ", jml_dyn = ", jml_dyn, &
63           ", llm_dyn = ", llm_dyn, ", ttm_dyn = ", ttm_dyn           ", llm_dyn = ", llm_dyn, ", ttm_dyn = ", ttm_dyn
64    
# Line 71  CONTAINS Line 66  CONTAINS
66      ALLOCATE(lon_dyn(iml_dyn, jml_dyn))      ALLOCATE(lon_dyn(iml_dyn, jml_dyn))
67      ALLOCATE(levdyn_ini(llm_dyn))      ALLOCATE(levdyn_ini(llm_dyn))
68    
69      CALL flinopen_nozoom(physfname, iml_dyn, jml_dyn, llm_dyn, &      CALL flinopen_nozoom(iml_dyn, jml_dyn, llm_dyn, &
70           lon_dyn, lat_dyn, levdyn_ini, ttm_dyn, itau, date, dt, fid_dyn)           lon_dyn, lat_dyn, levdyn_ini, ttm_dyn, itau, date, dt, fid_dyn)
71    
72      ALLOCATE(var_ana(iml_dyn, jml_dyn))      ALLOCATE(var_ana(iml_dyn, jml_dyn))
73      ALLOCATE(lon_rad(iml_dyn))      ALLOCATE(lon_rad(iml_dyn))
74      ALLOCATE(lon_ini(iml_dyn))      ALLOCATE(lon_ini(iml_dyn))
75    
76      IF (MAXVAL(lon_dyn(:, :)) > pi) THEN      IF (MAXVAL(lon_dyn) > pi) THEN
77         ! Assume "lon_dyn" is in degrees         ! Assume "lon_dyn" is in degrees
78         lon_ini(:) = lon_dyn(:, 1) * pi / 180.         lon_ini = lon_dyn(:, 1) * pi / 180.
79      ELSE      ELSE
80         lon_ini(:) = lon_dyn(:, 1)         lon_ini = lon_dyn(:, 1)
81      ENDIF      ENDIF
82    
83      ALLOCATE(lat_rad(jml_dyn))      ALLOCATE(lat_rad(jml_dyn))
84      ALLOCATE(lat_ini(jml_dyn))      ALLOCATE(lat_ini(jml_dyn))
85    
86      IF (MAXVAL(lat_dyn(:, :)) > pi) THEN      IF (MAXVAL(lat_dyn) > pi) THEN
87         lat_ini(:) = lat_dyn(1, :) * pi / 180.         lat_ini = lat_dyn(1, :) * pi / 180.
88      ELSE      ELSE
89         lat_ini(:) = lat_dyn(1, :)         lat_ini = lat_dyn(1, :)
90      ENDIF      ENDIF
91    
92      ALLOCATE(z(iim + 1, jjm + 1))      call nf95_open('ECDYN.nc', nf90_nowrite, ncid)
93    
94      ! 'Z': Surface geopotential      ! 'Z': Surface geopotential
95      CALL flinget(fid_dyn, 'Z', iml_dyn, jml_dyn, 0, ttm_dyn, 1, 1, var_ana)      call nf95_inq_varid(ncid, 'Z', varid)
96        call nf95_get_var(ncid, varid, var_ana)
97      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)
98      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), &
99           rlatv, tmp_var)           rlatv, tmp_var)
100      z(:, :) = gr_int_dyn(tmp_var)      z = gr_int_dyn(tmp_var)
101    
102      ! 'SP': Surface pressure      ! 'SP': Surface pressure
103      CALL flinget(fid_dyn, 'SP', iml_dyn, jml_dyn, 0, ttm_dyn, 1, 1, var_ana)      call nf95_inq_varid(ncid, 'SP', varid)
104        call nf95_get_var(ncid, varid, var_ana)
105      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)
106      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), &
107           rlatv, tmp_var)           rlatv, tmp_var)
108      psol(:, :) = gr_int_dyn(tmp_var)      psol = gr_int_dyn(tmp_var)
     CALL start_init_phys(tsol_2d)  
109    
110      ! PSOL is computed in Pascals      call nf95_close(ncid)
111    
112      DO j = 1, jjm + 1      psol(:iim, :) = psol(:iim, :) &
113         DO i = 1, iim           * (1. + (z(:iim, :) - phis(:iim, :)) / 287. / tsol_2d(:iim, :))
           psol(i, j) = psol(i, j) &  
                * (1. + (z(i, j) - phis(i, j)) / 287. / tsol_2d(i, j))  
        ENDDO  
     ENDDO  
114      psol(iim + 1, :) = psol(1, :)      psol(iim + 1, :) = psol(1, :)
115    
116      ALLOCATE(xppn(iim))      psol(:, 1) = SUM(aire_2d(:iim, 1) * psol(:iim, 1)) / apoln
117      ALLOCATE(xpps(iim))      psol(:, jjm + 1) = SUM(aire_2d(:iim, jjm + 1) * psol(:iim, jjm + 1)) &
118             / 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  
119    
120    END SUBROUTINE start_init_dyn    END SUBROUTINE start_init_dyn
121    
122    !********************************    !********************************
123    
124    function start_inter_3d(varname, lon_in2, lat_in2, pls_in)    subroutine start_inter_3d(varname, lon_in2, lat_in2, pls_in, var3d)
125    
126      ! 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.  
127    
128      USE ioipsl, only: flinget      use nr_util, only: assert_eq
129      use numer_rec, only: assert_eq, spline, splint      use numer_rec, only: spline, splint
130      use inter_barxy_m, only: inter_barxy      use inter_barxy_m, only: inter_barxy
131      use gr_int_dyn_m, only: gr_int_dyn      use gr_int_dyn_m, only: gr_int_dyn
132      use conf_dat3d_m, only: conf_dat3d      use conf_dat3d_m, only: conf_dat3d
133        use netcdf, only: nf90_nowrite
134        use netcdf95, only: nf95_open, nf95_close, nf95_get_var, nf95_inq_varid
135    
136      CHARACTER(len=*), intent(in):: varname      CHARACTER(len=*), intent(in):: varname
137      REAL, intent(in):: lon_in2(:), lat_in2(:)      REAL, intent(in):: lon_in2(:) ! (iml)
138      REAL, intent(in):: pls_in(:, :, :)      REAL, intent(in):: lat_in2(:)
139        REAL, intent(in):: pls_in(:, :, :) ! (iml, jml, lml)
140      REAL start_inter_3d(size(lon_in2), size(pls_in, 2), size(pls_in, 3))      REAL, intent(out):: var3d(:, :, :) ! (iml, jml, lml)
141    
142      ! LOCAL:      ! LOCAL:
143      INTEGER iml, jml, lml      INTEGER iml, jml, lml, ncid, varid
144      INTEGER ii, ij, il      INTEGER ii, ij, il
145      REAL lon_rad(iml_dyn), lat_rad(jml_dyn)      REAL lon_rad(iml_dyn), lat_rad(jml_dyn)
146      REAL lev_dyn(llm_dyn)      REAL lev_dyn(llm_dyn)
# Line 167  CONTAINS Line 153  CONTAINS
153    
154      print *, "Call sequence information: start_inter_3d"      print *, "Call sequence information: start_inter_3d"
155    
156      iml = assert_eq(size(pls_in, 1), size(lon_in2), "start_inter_3d iml")      iml = assert_eq(size(pls_in, 1), size(lon_in2), size(var3d, 1), &
157      jml = size(pls_in, 2)           "start_inter_3d iml")
158      lml = size(pls_in, 3)      jml = assert_eq(size(pls_in, 2), size(var3d, 2), "start_inter_3d jml")
159        lml = assert_eq(size(pls_in, 3), size(var3d, 3), "start_inter_3d lml")
160    
161      print *, "iml = ", iml, ", jml = ", jml      print *, "iml = ", iml, ", jml = ", jml
162      print *, "fid_dyn = ", fid_dyn, ", varname = ", varname      print *, "varname = ", varname
163      print *, "iml_dyn = ", iml_dyn, ", jml_dyn = ", jml_dyn, &      call nf95_open('ECDYN.nc', nf90_nowrite, ncid)
164           ", llm_dyn = ", llm_dyn, ", ttm_dyn = ", ttm_dyn      call nf95_inq_varid(ncid, varname, varid)
165      print *, 'Going into flinget to extract the 3D field.'      call nf95_get_var(ncid, varid, var_ana3d)
166      CALL flinget(fid_dyn, varname, iml_dyn, jml_dyn, llm_dyn, ttm_dyn, 1, 1, &      call nf95_close(ncid)
          var_ana3d)  
   
167      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, &
168           var_ana3d)           var_ana3d)
169    
# Line 190  CONTAINS Line 175  CONTAINS
175    
176      ! Pour l'interpolation verticale, on interpole du haut de l'atmosphère      ! Pour l'interpolation verticale, on interpole du haut de l'atmosphère
177      ! vers le sol :      ! vers le sol :
178      ax(:) = lev_dyn(llm_dyn:1:-1)      ax = lev_dyn(llm_dyn:1:-1)
179      DO ij=1, jml      DO ij=1, jml
180         DO ii=1, iml-1         DO ii=1, iml-1
181            ay(:) = var_tmp3d(ii, ij, llm_dyn:1:-1)            ay = var_tmp3d(ii, ij, llm_dyn:1:-1)
182            yder(:) = SPLINE(ax, ay)            yder = SPLINE(ax, ay)
183            do il=1, lml            do il=1, lml
184               start_inter_3d(ii, ij, il) &               var3d(ii, ij, il) = SPLINT(ax, ay, yder, pls_in(ii, ij, il))
                   = SPLINT(ax, ay, yder, pls_in(ii, ij, il))  
185            END do            END do
186         ENDDO         ENDDO
187      ENDDO      ENDDO
188      start_inter_3d(iml, :, :) = start_inter_3d(1, :, :)      var3d(iml, :, :) = var3d(1, :, :)
189    
190    END function start_inter_3d    END subroutine start_inter_3d
191    
192  END MODULE startdyn  END MODULE startdyn
Legend:
Removed from v.20  
changed lines
  Added in v.48
  ViewVC Help
Powered by ViewVC 1.1.21