/[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

trunk/libf/dyn3d/start_init_phys_m.f90 revision 30 by guez, Thu Apr 1 09:07:28 2010 UTC trunk/dyn3d/start_init_phys_m.f revision 99 by guez, Wed Jul 2 18:39:15 2014 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    
     USE flincom, only: flininfo, flinopen_nozoom, flinget, flinclo  
     use conf_dat2d_m, only: conf_dat2d  
     use inter_barxy_m, only: inter_barxy  
     use gr_int_dyn_m, only: gr_int_dyn  
12      use comgeom, only: rlonu, rlatv      use comgeom, only: rlonu, rlatv
13        use conf_dat2d_m, only: conf_dat2d
14      use dimens_m, only: iim, jjm      use dimens_m, only: iim, jjm
15        use gr_int_dyn_m, only: gr_int_dyn
16        use inter_barxy_m, only: inter_barxy
17        use netcdf, only: nf90_nowrite
18        use netcdf95, only: nf95_open, nf95_close, nf95_get_var, nf95_inq_varid, &
19             nf95_gw_var, find_coord
20        use nr_util, only: assert, pi
21    
22      REAL, intent(out):: tsol_2d(:, :)      REAL, intent(out):: tsol_2d(:, :), qsol_2d(:, :) ! (iim + 1, jjm + 1)
   
     !  LOCAL  
   
     INTEGER fid_phys, iml_phys, jml_phys  
     REAL, ALLOCATABLE, DIMENSION(:, :):: lon_phys, lat_phys  
     REAL:: date, dt  
     REAL, DIMENSION(:), ALLOCATABLE:: levphys_ini  
     !ac  
     INTEGER:: itau(1)  
     INTEGER::  llm_tmp, ttm_tmp  
23    
24      CHARACTER(len=120) physfname      ! Variables local to the procedure:
     LOGICAL:: check=.TRUE.  
25    
26        INTEGER iml_phys, jml_phys, ncid, varid
27      REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)      REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)
28      REAL, ALLOCATABLE:: lon_ini(:), lat_ini(:)      REAL, pointer:: lon_ini(:), lat_ini(:) ! longitude and latitude in rad
29      REAL, ALLOCATABLE:: var_ana(:, :)      REAL, ALLOCATABLE:: var_ana(:, :)
30      real tmp_var(iim, jjm + 1)      real tmp_var(iim, jjm + 1)
31    
32      !-----------------------------------      !-----------------------------------
33    
34      print *, "Call sequence information: start_init_phys"      print *, "Call sequence information: start_init_phys"
     if (any(shape(tsol_2d) /= (/iim + 1, jjm + 1/))) stop "start_init_phys"  
     physfname = 'ECPHY.nc'  
     IF ( check ) print *, 'Opening the surface analysis'  
     CALL flininfo(physfname, iml_phys, jml_phys, llm_tmp, ttm_tmp, fid_phys)  
   
     ALLOCATE(lat_phys(iml_phys, jml_phys))  
     ALLOCATE(lon_phys(iml_phys, jml_phys))  
     ALLOCATE(levphys_ini(llm_tmp))  
   
     CALL flinopen_nozoom(physfname, iml_phys, jml_phys,  &  
          llm_tmp, lon_phys, lat_phys, levphys_ini, ttm_tmp,  &  
          itau, date, dt, fid_phys)  
35    
36      DEALLOCATE(levphys_ini)      call assert((/size(tsol_2d, 1), size(qsol_2d, 1)/) == iim + 1, &
37             "start_init_phys 1")
38        call assert((/size(tsol_2d, 2), size(qsol_2d, 2)/) == jjm + 1, &
39             "start_init_phys 2")
40    
41        call nf95_open('ECPHY.nc', nf90_nowrite, ncid)
42    
43        call find_coord(ncid, varid=varid, std_name="longitude")
44        call nf95_gw_var(ncid, varid, lon_ini)
45        lon_ini = lon_ini * pi / 180. ! convert to rad
46        iml_phys = size(lon_ini)
47    
48        call find_coord(ncid, varid=varid, std_name="latitude")
49        call nf95_gw_var(ncid, varid, lat_ini)
50        lat_ini = lat_ini * pi / 180. ! convert to rad
51        jml_phys = size(lat_ini)
52    
53      ! Allocate the space we will need to get the data out of this file      ! Allocate the space we will need to get the data out of this file
54      ALLOCATE(var_ana(iml_phys, jml_phys))      ALLOCATE(var_ana(iml_phys, jml_phys))
55    
     !   In case we have a file which is in degrees we do the transformation  
56      ALLOCATE(lon_rad(iml_phys))      ALLOCATE(lon_rad(iml_phys))
     ALLOCATE(lon_ini(iml_phys))  
   
     IF ( MAXVAL(lon_phys(:, :)) > 2.0 * ASIN(1.0) ) THEN  
        lon_ini(:) = lon_phys(:, 1) * 2.0 * ASIN(1.0) / 180.0  
     ELSE  
        lon_ini(:) = lon_phys(:, 1)  
     ENDIF  
   
57      ALLOCATE(lat_rad(jml_phys))      ALLOCATE(lat_rad(jml_phys))
     ALLOCATE(lat_ini(jml_phys))  
58    
59      IF ( MAXVAL(lat_phys(:, :)) > 2.0 * ASIN(1.0) ) THEN      ! Surface temperature:
60         lat_ini(:) = lat_phys(1, :) * 2.0 * ASIN(1.0) / 180.0      call nf95_inq_varid(ncid, 'ST', varid)
61      ELSE      call nf95_get_var(ncid, varid, var_ana)
        lat_ini(:) = lat_phys(1, :)  
     ENDIF  
   
     !   We get the two standard varibales  
     !   Surface temperature  
     ! 'ST'            : Surface temperature  
     CALL flinget(fid_phys, 'ST', iml_phys, jml_phys,  &  
          llm_tmp, ttm_tmp, 1, 1, var_ana)  
62      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)
63      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), &
64           rlatv, tmp_var)           rlatv, tmp_var)
65        tsol_2d = gr_int_dyn(tmp_var)
66    
67      tsol_2d(:, :) = gr_int_dyn(tmp_var)      ! Soil moisture:
68        call nf95_inq_varid(ncid, 'CDSW', varid)
69      ALLOCATE(qsol_2d(iim + 1, jjm + 1))      call nf95_get_var(ncid, varid, var_ana)
     ! Soil moisture  
     CALL flinget(fid_phys, 'CDSW', iml_phys, jml_phys, &  
          llm_tmp, ttm_tmp, 1, 1, var_ana)  
70      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)
71      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), &
72              rlatv, tmp_var)              rlatv, tmp_var)
73      qsol_2d(:, :) = gr_int_dyn(tmp_var)      qsol_2d = gr_int_dyn(tmp_var)
74    
75      CALL flinclo(fid_phys)      call nf95_close(ncid)
76        deallocate(lon_ini, lat_ini) ! pointers
77    
78    END SUBROUTINE start_init_phys    END SUBROUTINE start_init_phys
79    
Legend:
Removed from v.30  
changed lines
  Added in v.99
  ViewVC Help
Powered by ViewVC 1.1.21