/[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 42 by guez, Thu Mar 24 11:52:41 2011 UTC revision 43 by guez, Fri Apr 8 12:43:31 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:: 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, flinclo      USE flincom, only: flininfo, flinopen_nozoom, flinclo
13      use flinget_m, only: flinget      use flinget_m, only: flinget
# Line 18  CONTAINS Line 16  CONTAINS
16      use gr_int_dyn_m, only: gr_int_dyn      use gr_int_dyn_m, only: gr_int_dyn
17      use comgeom, only: rlonu, rlatv      use comgeom, only: rlonu, rlatv
18      use dimens_m, only: iim, jjm      use dimens_m, only: iim, jjm
19        use nr_util, only: assert
20    
21      REAL, intent(out):: tsol_2d(:, :)      REAL, intent(out):: tsol_2d(:, :), qsol_2d(:, :) ! (iim + 1, jjm + 1)
22    
23      ! Variables local to the procedure:      ! Variables local to the procedure:
24    
25      INTEGER fid_phys, iml_phys, jml_phys      INTEGER fid_phys, iml_phys, jml_phys
26      REAL, ALLOCATABLE, DIMENSION(:, :):: lon_phys, lat_phys      REAL, ALLOCATABLE, DIMENSION(:, :):: lon_phys, lat_phys
27      REAL:: date, dt      REAL date, dt
28      REAL, DIMENSION(:), ALLOCATABLE:: levphys_ini      REAL, ALLOCATABLE:: levphys_ini(:)
29      !ac  
30      INTEGER:: itau(1)      INTEGER:: itau(1)
31      INTEGER::  llm_tmp, ttm_tmp      INTEGER::  llm_tmp, ttm_tmp
32    
# Line 39  CONTAINS Line 38  CONTAINS
38      !-----------------------------------      !-----------------------------------
39    
40      print *, "Call sequence information: start_init_phys"      print *, "Call sequence information: start_init_phys"
41      if (any(shape(tsol_2d) /= (/iim + 1, jjm + 1/))) stop "start_init_phys"  
42        call assert((/size(tsol_2d, 1), size(qsol_2d, 1)/) == iim + 1, &
43             "start_init_phys 1")
44        call assert((/size(tsol_2d, 2), size(qsol_2d, 2)/) == jjm + 1, &
45             "start_init_phys 2")
46    
47      CALL flininfo('ECPHY.nc', iml_phys, jml_phys, llm_tmp, ttm_tmp, fid_phys)      CALL flininfo('ECPHY.nc', iml_phys, jml_phys, llm_tmp, ttm_tmp, fid_phys)
48    
49      ALLOCATE(lat_phys(iml_phys, jml_phys))      ALLOCATE(lat_phys(iml_phys, jml_phys))
# Line 58  CONTAINS Line 62  CONTAINS
62      ALLOCATE(lon_rad(iml_phys))      ALLOCATE(lon_rad(iml_phys))
63      ALLOCATE(lon_ini(iml_phys))      ALLOCATE(lon_ini(iml_phys))
64    
65      IF ( MAXVAL(lon_phys(:, :)) > 2.0 * ASIN(1.0) ) THEN      IF ( MAXVAL(lon_phys) > 2.0 * ASIN(1.0) ) THEN
66         lon_ini(:) = lon_phys(:, 1) * 2.0 * ASIN(1.0) / 180.0         lon_ini = lon_phys(:, 1) * 2.0 * ASIN(1.0) / 180.0
67      ELSE      ELSE
68         lon_ini(:) = lon_phys(:, 1)         lon_ini = lon_phys(:, 1)
69      ENDIF      ENDIF
70    
71      ALLOCATE(lat_rad(jml_phys))      ALLOCATE(lat_rad(jml_phys))
72      ALLOCATE(lat_ini(jml_phys))      ALLOCATE(lat_ini(jml_phys))
73    
74      IF ( MAXVAL(lat_phys(:, :)) > 2.0 * ASIN(1.0) ) THEN      IF ( MAXVAL(lat_phys) > 2.0 * ASIN(1.0) ) THEN
75         lat_ini(:) = lat_phys(1, :) * 2.0 * ASIN(1.0) / 180.0         lat_ini = lat_phys(1, :) * 2.0 * ASIN(1.0) / 180.0
76      ELSE      ELSE
77         lat_ini(:) = lat_phys(1, :)         lat_ini = lat_phys(1, :)
78      ENDIF      ENDIF
79    
80      ! We get the two standard variables      ! We get the two standard variables
# Line 81  CONTAINS Line 85  CONTAINS
85      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), &
86           rlatv, tmp_var)           rlatv, tmp_var)
87    
88      tsol_2d(:, :) = gr_int_dyn(tmp_var)      tsol_2d = gr_int_dyn(tmp_var)
89    
     ALLOCATE(qsol_2d(iim + 1, jjm + 1))  
90      ! Soil moisture      ! Soil moisture
91      CALL flinget(fid_phys, 'CDSW', iml_phys, jml_phys, &      CALL flinget(fid_phys, 'CDSW', iml_phys, jml_phys, &
92           llm_tmp, ttm_tmp, 1, 1, var_ana)           llm_tmp, ttm_tmp, 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_phys -1), var_ana, rlonu(:iim), &      CALL inter_barxy(lon_rad, lat_rad(:jml_phys -1), var_ana, rlonu(:iim), &
95              rlatv, tmp_var)              rlatv, tmp_var)
96      qsol_2d(:, :) = gr_int_dyn(tmp_var)      qsol_2d = gr_int_dyn(tmp_var)
97    
98      CALL flinclo(fid_phys)      CALL flinclo(fid_phys)
99    
Legend:
Removed from v.42  
changed lines
  Added in v.43
  ViewVC Help
Powered by ViewVC 1.1.21