/[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 42 by guez, Thu Mar 24 11:52:41 2011 UTC revision 54 by guez, Tue Dec 6 15:07:04 2011 UTC
# Line 3  MODULE startdyn Line 3  MODULE startdyn
3    ! From startvar.F, version 1.4    ! From startvar.F, version 1.4
4    ! 2006/01/27 15:14:22 Fairhead    ! 2006/01/27 15:14:22 Fairhead
5    
6    IMPLICIT NONE    INTEGER iml_dyn, jml_dyn, llm_dyn
   
   private  
   public start_init_dyn, start_inter_3d  
   
   INTEGER fid_dyn, iml_dyn, jml_dyn, llm_dyn, ttm_dyn  
7    
8    REAL, ALLOCATABLE:: lon_ini(:), lat_ini(:)    REAL, ALLOCATABLE:: lon_ini(:), lat_ini(:)
9    ! (longitude and latitude from the input file, converted to rad)    ! (longitude and latitude from the input file, converted to rad)
# Line 19  CONTAINS Line 14  CONTAINS
14    
15    SUBROUTINE start_init_dyn(tsol_2d, psol)    SUBROUTINE start_init_dyn(tsol_2d, psol)
16    
     ! Host associated variables appearing and modified in this procedure :  
     ! iml_dyn, jml_dyn, llm_dyn, ttm_dyn, fid_dyn, lon_ini, lat_ini, levdyn_ini  
   
17      USE flincom, only: flininfo, flinopen_nozoom      USE flincom, only: flininfo, flinopen_nozoom
     use flinget_m, only: flinget  
18      use comgeom, only: aire_2d, apoln, apols      use comgeom, only: aire_2d, apoln, apols
19      use conf_dat2d_m, only: conf_dat2d      use conf_dat2d_m, only: conf_dat2d
20      use inter_barxy_m, only: inter_barxy      use inter_barxy_m, only: inter_barxy
# Line 31  CONTAINS Line 22  CONTAINS
22      use dimens_m, only: iim, jjm      use dimens_m, only: iim, jjm
23      use gr_int_dyn_m, only: gr_int_dyn      use gr_int_dyn_m, only: gr_int_dyn
24      use start_init_orog_m, only: phis      use start_init_orog_m, only: phis
     use start_init_phys_m, only: start_init_phys  
25      use nr_util, only: assert, pi      use nr_util, only: assert, pi
26        use netcdf, only: nf90_nowrite
27        use netcdf95, only: nf95_open, nf95_close, nf95_get_var, nf95_inq_varid
28    
29      REAL, intent(out):: tsol_2d(:, :)      REAL, intent(in):: tsol_2d(:, :) ! (iim + 1, jjm + 1)
30      REAL, intent(out):: psol(:, :) ! surface pressure, in Pa      REAL, intent(out):: psol(:, :) ! (iim + 1, jjm + 1) surface pressure, in Pa
31    
32      ! Local:      ! Local:
33    
34      REAL date, dt      REAL date, dt
35      INTEGER itau(1)      INTEGER itau(1), ncid, varid, fid_dyn, ttm_dyn
36      REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)      REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)
37    
38      REAL, ALLOCATABLE:: lon_dyn(:, :), lat_dyn(:, :)      REAL, ALLOCATABLE:: lon_dyn(:, :), lat_dyn(:, :)
# Line 57  CONTAINS Line 49  CONTAINS
49           "start_init_dyn size 1")           "start_init_dyn size 1")
50      call assert((/size(tsol_2d, 2), size(psol, 2)/) == jjm + 1, &      call assert((/size(tsol_2d, 2), size(psol, 2)/) == jjm + 1, &
51           "start_init_dyn size 2")           "start_init_dyn size 2")
52    
53      CALL flininfo('ECDYN.nc', iml_dyn, jml_dyn, llm_dyn, ttm_dyn, fid_dyn)      CALL flininfo('ECDYN.nc', iml_dyn, jml_dyn, llm_dyn, ttm_dyn, fid_dyn)
54      print *, "iml_dyn = ", iml_dyn, ", jml_dyn = ", jml_dyn, &      print *, "iml_dyn = ", iml_dyn, ", jml_dyn = ", jml_dyn, &
55           ", llm_dyn = ", llm_dyn, ", ttm_dyn = ", ttm_dyn           ", llm_dyn = ", llm_dyn, ", ttm_dyn = ", ttm_dyn
56    
57      ALLOCATE(lat_dyn(iml_dyn, jml_dyn))      ALLOCATE(lat_dyn(iml_dyn, jml_dyn))
58      ALLOCATE(lon_dyn(iml_dyn, jml_dyn))      allocate(lon_dyn(iml_dyn, jml_dyn), levdyn_ini(llm_dyn))
     ALLOCATE(levdyn_ini(llm_dyn))  
59    
60      CALL flinopen_nozoom(iml_dyn, jml_dyn, llm_dyn, &      CALL flinopen_nozoom(iml_dyn, jml_dyn, llm_dyn, lon_dyn, lat_dyn, &
61           lon_dyn, lat_dyn, levdyn_ini, ttm_dyn, itau, date, dt, fid_dyn)           levdyn_ini, ttm_dyn, itau, date, dt, fid_dyn)
62    
63      ALLOCATE(var_ana(iml_dyn, jml_dyn))      ALLOCATE(var_ana(iml_dyn, jml_dyn), lon_rad(iml_dyn), lon_ini(iml_dyn))
     ALLOCATE(lon_rad(iml_dyn))  
     ALLOCATE(lon_ini(iml_dyn))  
64    
65      IF (MAXVAL(lon_dyn) > pi) THEN      IF (MAXVAL(lon_dyn) > pi) THEN
66         ! Assume "lon_dyn" is in degrees         ! Assume "lon_dyn" is in degrees
# Line 79  CONTAINS Line 69  CONTAINS
69         lon_ini = lon_dyn(:, 1)         lon_ini = lon_dyn(:, 1)
70      ENDIF      ENDIF
71    
72      ALLOCATE(lat_rad(jml_dyn))      ALLOCATE(lat_rad(jml_dyn), lat_ini(jml_dyn))
     ALLOCATE(lat_ini(jml_dyn))  
73    
74      IF (MAXVAL(lat_dyn) > pi) THEN      IF (MAXVAL(lat_dyn) > pi) THEN
75         lat_ini = lat_dyn(1, :) * pi / 180.         lat_ini = lat_dyn(1, :) * pi / 180.
# Line 88  CONTAINS Line 77  CONTAINS
77         lat_ini = lat_dyn(1, :)         lat_ini = lat_dyn(1, :)
78      ENDIF      ENDIF
79    
80        call nf95_open('ECDYN.nc', nf90_nowrite, ncid)
81    
82      ! 'Z': Surface geopotential      ! 'Z': Surface geopotential
83      CALL flinget(fid_dyn, 'Z', iml_dyn, jml_dyn, 0, ttm_dyn, 1, 1, var_ana)      call nf95_inq_varid(ncid, 'Z', varid)
84        call nf95_get_var(ncid, varid, var_ana)
85      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)
86      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), &
87           rlatv, tmp_var)           rlatv, tmp_var)
88      z = gr_int_dyn(tmp_var)      z = gr_int_dyn(tmp_var)
89    
90      ! 'SP': Surface pressure      ! 'SP': Surface pressure
91      CALL flinget(fid_dyn, 'SP', iml_dyn, jml_dyn, 0, ttm_dyn, 1, 1, var_ana)      call nf95_inq_varid(ncid, 'SP', varid)
92        call nf95_get_var(ncid, varid, 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      psol = gr_int_dyn(tmp_var)      psol = gr_int_dyn(tmp_var)
97      CALL start_init_phys(tsol_2d)  
98        call nf95_close(ncid)
99    
100      psol(:iim, :) = psol(:iim, :) &      psol(:iim, :) = psol(:iim, :) &
101           * (1. + (z(:iim, :) - phis(:iim, :)) / 287. / tsol_2d(:iim, :))           * (1. + (z(:iim, :) - phis(:iim, :)) / 287. / tsol_2d(:iim, :))
# Line 113  CONTAINS Line 107  CONTAINS
107    
108    END SUBROUTINE start_init_dyn    END SUBROUTINE start_init_dyn
109    
   !********************************  
   
   subroutine start_inter_3d(varname, lon_in2, lat_in2, pls_in, var3d)  
   
     ! This procedure gets a 3D variable from a file and interpolates it.  
   
     use flinget_m, only: flinget  
     use nr_util, only: assert_eq  
     use numer_rec, only: spline, splint  
     use inter_barxy_m, only: inter_barxy  
     use gr_int_dyn_m, only: gr_int_dyn  
     use conf_dat3d_m, only: conf_dat3d  
   
     CHARACTER(len=*), intent(in):: varname  
     REAL, intent(in):: lon_in2(:) ! (iml)  
     REAL, intent(in):: lat_in2(:)  
     REAL, intent(in):: pls_in(:, :, :) ! (iml, jml, lml)  
     REAL, intent(out):: var3d(:, :, :) ! (iml, jml, lml)  
   
     ! LOCAL:  
     INTEGER iml, jml, lml  
     INTEGER ii, ij, il  
     REAL lon_rad(iml_dyn), lat_rad(jml_dyn)  
     REAL lev_dyn(llm_dyn)  
     REAL var_tmp2d(size(lon_in2)-1, size(pls_in, 2))  
     real var_tmp3d(size(lon_in2), size(pls_in, 2), llm_dyn)  
     REAL ax(llm_dyn), ay(llm_dyn), yder(llm_dyn)  
     real var_ana3d(iml_dyn, jml_dyn, llm_dyn)  
   
     !--------------------------------  
   
     print *, "Call sequence information: start_inter_3d"  
   
     iml = assert_eq(size(pls_in, 1), size(lon_in2), size(var3d, 1), &  
          "start_inter_3d iml")  
     jml = assert_eq(size(pls_in, 2), size(var3d, 2), "start_inter_3d jml")  
     lml = assert_eq(size(pls_in, 3), size(var3d, 3), "start_inter_3d lml")  
   
     print *, "iml = ", iml, ", jml = ", jml  
     print *, "varname = ", varname  
     print *, 'Going into flinget to extract the 3D field.'  
     CALL flinget(fid_dyn, varname, iml_dyn, jml_dyn, llm_dyn, ttm_dyn, 1, 1, &  
          var_ana3d)  
     CALL conf_dat3d(lon_ini, lat_ini, levdyn_ini, lon_rad, lat_rad, lev_dyn, &  
          var_ana3d)  
   
     DO il = 1, llm_dyn  
        CALL inter_barxy(lon_rad, lat_rad(:jml_dyn-1), var_ana3d(:, :, il), &  
             lon_in2(:iml-1), lat_in2, var_tmp2d)  
        var_tmp3d(:, :, il) = gr_int_dyn(var_tmp2d)  
     ENDDO  
   
     ! Pour l'interpolation verticale, on interpole du haut de l'atmosphère  
     ! vers le sol :  
     ax = lev_dyn(llm_dyn:1:-1)  
     DO ij=1, jml  
        DO ii=1, iml-1  
           ay = var_tmp3d(ii, ij, llm_dyn:1:-1)  
           yder = SPLINE(ax, ay)  
           do il=1, lml  
              var3d(ii, ij, il) = SPLINT(ax, ay, yder, pls_in(ii, ij, il))  
           END do  
        ENDDO  
     ENDDO  
     var3d(iml, :, :) = var3d(1, :, :)  
   
   END subroutine start_inter_3d  
   
110  END MODULE startdyn  END MODULE startdyn
Legend:
Removed from v.42  
changed lines
  Added in v.54
  ViewVC Help
Powered by ViewVC 1.1.21