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

Diff of /trunk/dyn3d/start_init_phys_m.f

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

revision 30 by guez, Thu Apr 1 09:07:28 2010 UTC revision 48 by guez, Tue Jul 19 12:54:20 2011 UTC
# Line 5  MODULE start_init_phys_m Line 5  MODULE start_init_phys_m
5    
6    IMPLICIT NONE    IMPLICIT NONE
7    
   REAL, ALLOCATABLE, SAVE, DIMENSION(:, :):: qsol_2d  
   
8  CONTAINS  CONTAINS
9    
10    SUBROUTINE start_init_phys(tsol_2d)    SUBROUTINE start_init_phys(tsol_2d, qsol_2d)
11    
12      USE flincom, only: flininfo, flinopen_nozoom, flinget, flinclo      USE flincom, only: flininfo, flinopen_nozoom, flinclo
13      use conf_dat2d_m, only: conf_dat2d      use conf_dat2d_m, only: conf_dat2d
14      use inter_barxy_m, only: inter_barxy      use inter_barxy_m, only: inter_barxy
15      use gr_int_dyn_m, only: gr_int_dyn      use gr_int_dyn_m, only: gr_int_dyn
16      use comgeom, only: rlonu, rlatv      use comgeom, only: rlonu, rlatv
17      use dimens_m, only: iim, jjm      use dimens_m, only: iim, jjm
18        use nr_util, only: assert
19        use netcdf, only: nf90_nowrite
20        use netcdf95, only: nf95_open, nf95_close, nf95_get_var, nf95_inq_varid
21    
22      REAL, intent(out):: tsol_2d(:, :)      REAL, intent(out):: tsol_2d(:, :), qsol_2d(:, :) ! (iim + 1, jjm + 1)
23    
24      !  LOCAL      ! Variables local to the procedure:
25    
26      INTEGER fid_phys, iml_phys, jml_phys      INTEGER fid_phys, iml_phys, jml_phys, ncid, varid
27      REAL, ALLOCATABLE, DIMENSION(:, :):: lon_phys, lat_phys      REAL, ALLOCATABLE, DIMENSION(:, :):: lon_phys, lat_phys
28      REAL:: date, dt      REAL date, dt
29      REAL, DIMENSION(:), ALLOCATABLE:: levphys_ini      REAL, ALLOCATABLE:: levphys_ini(:)
     !ac  
     INTEGER:: itau(1)  
     INTEGER::  llm_tmp, ttm_tmp  
30    
31      CHARACTER(len=120) physfname      INTEGER itau(1)
32      LOGICAL:: check=.TRUE.      INTEGER  llm_tmp, ttm_tmp
33    
34      REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)      REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)
35      REAL, ALLOCATABLE:: lon_ini(:), lat_ini(:)      REAL, ALLOCATABLE:: lon_ini(:), lat_ini(:)
# Line 41  CONTAINS Line 39  CONTAINS
39      !-----------------------------------      !-----------------------------------
40    
41      print *, "Call sequence information: start_init_phys"      print *, "Call sequence information: start_init_phys"
42      if (any(shape(tsol_2d) /= (/iim + 1, jjm + 1/))) stop "start_init_phys"  
43      physfname = 'ECPHY.nc'      call assert((/size(tsol_2d, 1), size(qsol_2d, 1)/) == iim + 1, &
44      IF ( check ) print *, 'Opening the surface analysis'           "start_init_phys 1")
45      CALL flininfo(physfname, iml_phys, jml_phys, llm_tmp, ttm_tmp, fid_phys)      call assert((/size(tsol_2d, 2), size(qsol_2d, 2)/) == jjm + 1, &
46             "start_init_phys 2")
47    
48        CALL flininfo('ECPHY.nc', iml_phys, jml_phys, llm_tmp, ttm_tmp, fid_phys)
49    
50      ALLOCATE(lat_phys(iml_phys, jml_phys))      ALLOCATE(lat_phys(iml_phys, jml_phys))
51      ALLOCATE(lon_phys(iml_phys, jml_phys))      ALLOCATE(lon_phys(iml_phys, jml_phys))
52      ALLOCATE(levphys_ini(llm_tmp))      ALLOCATE(levphys_ini(llm_tmp))
53    
54      CALL flinopen_nozoom(physfname, iml_phys, jml_phys,  &      CALL flinopen_nozoom(iml_phys, jml_phys, llm_tmp, lon_phys, lat_phys, &
55           llm_tmp, lon_phys, lat_phys, levphys_ini, ttm_tmp,  &           levphys_ini, ttm_tmp, itau, date, dt, fid_phys)
56           itau, date, dt, fid_phys)      CALL flinclo(fid_phys)
57    
58      DEALLOCATE(levphys_ini)      DEALLOCATE(levphys_ini)
59    
# Line 63  CONTAINS Line 64  CONTAINS
64      ALLOCATE(lon_rad(iml_phys))      ALLOCATE(lon_rad(iml_phys))
65      ALLOCATE(lon_ini(iml_phys))      ALLOCATE(lon_ini(iml_phys))
66    
67      IF ( MAXVAL(lon_phys(:, :)) > 2.0 * ASIN(1.0) ) THEN      IF ( MAXVAL(lon_phys) > 2.0 * ASIN(1.0) ) THEN
68         lon_ini(:) = lon_phys(:, 1) * 2.0 * ASIN(1.0) / 180.0         lon_ini = lon_phys(:, 1) * 2.0 * ASIN(1.0) / 180.0
69      ELSE      ELSE
70         lon_ini(:) = lon_phys(:, 1)         lon_ini = lon_phys(:, 1)
71      ENDIF      ENDIF
72    
73      ALLOCATE(lat_rad(jml_phys))      ALLOCATE(lat_rad(jml_phys))
74      ALLOCATE(lat_ini(jml_phys))      ALLOCATE(lat_ini(jml_phys))
75    
76      IF ( MAXVAL(lat_phys(:, :)) > 2.0 * ASIN(1.0) ) THEN      IF ( MAXVAL(lat_phys) > 2.0 * ASIN(1.0) ) THEN
77         lat_ini(:) = lat_phys(1, :) * 2.0 * ASIN(1.0) / 180.0         lat_ini = lat_phys(1, :) * 2.0 * ASIN(1.0) / 180.0
78      ELSE      ELSE
79         lat_ini(:) = lat_phys(1, :)         lat_ini = lat_phys(1, :)
80      ENDIF      ENDIF
81    
82      !   We get the two standard varibales      call nf95_open('ECPHY.nc', nf90_nowrite, ncid)
83      !   Surface temperature  
84      ! 'ST'            : Surface temperature      ! We get the two standard variables
85      CALL flinget(fid_phys, 'ST', iml_phys, jml_phys,  &      ! 'ST': surface temperature
86           llm_tmp, ttm_tmp, 1, 1, var_ana)      call nf95_inq_varid(ncid, 'ST', varid)
87        call nf95_get_var(ncid, varid, var_ana)
88      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)
89      CALL inter_barxy(lon_rad, lat_rad(:jml_phys -1), var_ana, rlonu(:iim), &      CALL inter_barxy(lon_rad, lat_rad(:jml_phys -1), var_ana, rlonu(:iim), &
90           rlatv, tmp_var)           rlatv, tmp_var)
91        tsol_2d = gr_int_dyn(tmp_var)
92    
     tsol_2d(:, :) = gr_int_dyn(tmp_var)  
   
     ALLOCATE(qsol_2d(iim + 1, jjm + 1))  
93      ! Soil moisture      ! Soil moisture
94      CALL flinget(fid_phys, 'CDSW', iml_phys, jml_phys, &      call nf95_inq_varid(ncid, 'CDSW', varid)
95           llm_tmp, ttm_tmp, 1, 1, var_ana)      call nf95_get_var(ncid, varid, var_ana)
96      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)
97      CALL inter_barxy(lon_rad, lat_rad(:jml_phys -1), var_ana, rlonu(:iim), &      CALL inter_barxy(lon_rad, lat_rad(:jml_phys -1), var_ana, rlonu(:iim), &
98              rlatv, tmp_var)              rlatv, tmp_var)
99      qsol_2d(:, :) = gr_int_dyn(tmp_var)      qsol_2d = gr_int_dyn(tmp_var)
100    
101      CALL flinclo(fid_phys)      call nf95_close(ncid)
102    
103    END SUBROUTINE start_init_phys    END SUBROUTINE start_init_phys
104    
Legend:
Removed from v.30  
changed lines
  Added in v.48
  ViewVC Help
Powered by ViewVC 1.1.21