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

Contents of /trunk/dyn3d/start_init_phys_m.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 36 - (show annotations)
Thu Dec 2 17:11:04 2010 UTC (13 years, 5 months ago) by guez
Original Path: trunk/libf/dyn3d/start_init_phys_m.f90
File size: 3048 byte(s)
Now using the library "NR_util".

1 MODULE start_init_phys_m
2
3 ! From startvar.F, version 1.4
4 ! 2006/01/27 15:14:22 Fairhead
5
6 IMPLICIT NONE
7
8 REAL, ALLOCATABLE, SAVE, DIMENSION(:, :):: qsol_2d
9
10 CONTAINS
11
12 SUBROUTINE start_init_phys(tsol_2d)
13
14 USE flincom, only: flininfo, flinopen_nozoom, flinclo
15 use flinget_m, only: flinget
16 use conf_dat2d_m, only: conf_dat2d
17 use inter_barxy_m, only: inter_barxy
18 use gr_int_dyn_m, only: gr_int_dyn
19 use comgeom, only: rlonu, rlatv
20 use dimens_m, only: iim, jjm
21
22 REAL, intent(out):: tsol_2d(:, :)
23
24 ! LOCAL
25
26 INTEGER fid_phys, iml_phys, jml_phys
27 REAL, ALLOCATABLE, DIMENSION(:, :):: lon_phys, lat_phys
28 REAL:: date, dt
29 REAL, DIMENSION(:), ALLOCATABLE:: levphys_ini
30 !ac
31 INTEGER:: itau(1)
32 INTEGER:: llm_tmp, ttm_tmp
33
34 REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)
35 REAL, ALLOCATABLE:: lon_ini(:), lat_ini(:)
36 REAL, ALLOCATABLE:: var_ana(:, :)
37 real tmp_var(iim, jjm + 1)
38
39 !-----------------------------------
40
41 print *, "Call sequence information: start_init_phys"
42 if (any(shape(tsol_2d) /= (/iim + 1, jjm + 1/))) stop "start_init_phys"
43 CALL flininfo('ECPHY.nc', iml_phys, jml_phys, llm_tmp, ttm_tmp, fid_phys)
44
45 ALLOCATE(lat_phys(iml_phys, jml_phys))
46 ALLOCATE(lon_phys(iml_phys, jml_phys))
47 ALLOCATE(levphys_ini(llm_tmp))
48
49 CALL flinopen_nozoom(iml_phys, jml_phys, &
50 llm_tmp, lon_phys, lat_phys, levphys_ini, ttm_tmp, &
51 itau, date, dt, fid_phys)
52
53 DEALLOCATE(levphys_ini)
54
55 ! Allocate the space we will need to get the data out of this file
56 ALLOCATE(var_ana(iml_phys, jml_phys))
57
58 ! In case we have a file which is in degrees we do the transformation
59 ALLOCATE(lon_rad(iml_phys))
60 ALLOCATE(lon_ini(iml_phys))
61
62 IF ( MAXVAL(lon_phys(:, :)) > 2.0 * ASIN(1.0) ) THEN
63 lon_ini(:) = lon_phys(:, 1) * 2.0 * ASIN(1.0) / 180.0
64 ELSE
65 lon_ini(:) = lon_phys(:, 1)
66 ENDIF
67
68 ALLOCATE(lat_rad(jml_phys))
69 ALLOCATE(lat_ini(jml_phys))
70
71 IF ( MAXVAL(lat_phys(:, :)) > 2.0 * ASIN(1.0) ) THEN
72 lat_ini(:) = lat_phys(1, :) * 2.0 * ASIN(1.0) / 180.0
73 ELSE
74 lat_ini(:) = lat_phys(1, :)
75 ENDIF
76
77 ! We get the two standard varibales
78 ! Surface temperature
79 ! 'ST' : Surface temperature
80 CALL flinget(fid_phys, 'ST', iml_phys, jml_phys, &
81 llm_tmp, ttm_tmp, 1, 1, var_ana)
82 CALL conf_dat2d(lon_ini, lat_ini, lon_rad, lat_rad, var_ana)
83 CALL inter_barxy(lon_rad, lat_rad(:jml_phys -1), var_ana, rlonu(:iim), &
84 rlatv, tmp_var)
85
86 tsol_2d(:, :) = gr_int_dyn(tmp_var)
87
88 ALLOCATE(qsol_2d(iim + 1, jjm + 1))
89 ! Soil moisture
90 CALL flinget(fid_phys, 'CDSW', iml_phys, jml_phys, &
91 llm_tmp, ttm_tmp, 1, 1, var_ana)
92 CALL conf_dat2d(lon_ini, lat_ini, lon_rad, lat_rad, var_ana)
93 CALL inter_barxy(lon_rad, lat_rad(:jml_phys -1), var_ana, rlonu(:iim), &
94 rlatv, tmp_var)
95 qsol_2d(:, :) = gr_int_dyn(tmp_var)
96
97 CALL flinclo(fid_phys)
98
99 END SUBROUTINE start_init_phys
100
101 END MODULE start_init_phys_m

  ViewVC Help
Powered by ViewVC 1.1.21