/[lmdze]/trunk/libf/dyn3d/startdyn.f90
ViewVC logotype

Annotation of /trunk/libf/dyn3d/startdyn.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 39 - (hide annotations)
Tue Jan 25 15:11:05 2011 UTC (13 years, 4 months ago) by guez
File size: 5973 byte(s)
"pi" comes from "nr_util". Removed subroutine "initialize" in module
"comconst".

Copied the content of "fxy_sin.h" into "fxysinus", instead of getting
it from an "include" line. Removed file "fxy_sin.h".

"ps" has rank 2 in "gcm" and "dynetat0".

Assumed-shape for argument "q" of "integrd".

1 guez 3 MODULE startdyn
2    
3     ! From startvar.F, version 1.4
4     ! 2006/01/27 15:14:22 Fairhead
5    
6     IMPLICIT NONE
7    
8     private
9     public start_init_dyn, start_inter_3d
10    
11     INTEGER fid_dyn, iml_dyn, jml_dyn, llm_dyn, ttm_dyn
12    
13     REAL, ALLOCATABLE:: lon_ini(:), lat_ini(:)
14     ! (longitude and latitude from the input file, converted to rad)
15    
16     real, ALLOCATABLE:: levdyn_ini(:)
17    
18     CONTAINS
19    
20     SUBROUTINE start_init_dyn(tsol_2d, psol)
21    
22     ! Host associated variables appearing and modified in this procedure :
23     ! iml_dyn, jml_dyn, llm_dyn, ttm_dyn, fid_dyn, lon_ini, lat_ini, levdyn_ini
24    
25 guez 32 USE flincom, only: flininfo, flinopen_nozoom
26     use flinget_m, only: flinget
27 guez 3 use comgeom, only: aire_2d, apoln, apols
28     use conf_dat2d_m, only: conf_dat2d
29     use inter_barxy_m, only: inter_barxy
30     use comgeom, only: rlonu, rlatv
31     use dimens_m, only: iim, jjm
32     use gr_int_dyn_m, only: gr_int_dyn
33     use start_init_orog_m, only: phis
34     use start_init_phys_m, only: start_init_phys
35 guez 39 use nr_util, only: assert, pi
36 guez 3
37     REAL, intent(out):: tsol_2d(:, :)
38     REAL, intent(out):: psol(:, :) ! surface pressure, in Pa
39    
40     ! Local:
41    
42     REAL date, dt
43     INTEGER itau(1)
44     INTEGER i, j
45     REAL, ALLOCATABLE:: lon_rad(:), lat_rad(:)
46    
47     REAL, ALLOCATABLE:: lon_dyn(:, :), lat_dyn(:, :)
48     ! (longitude and latitude from the input file, in rad or degrees)
49    
50 guez 36 REAL, ALLOCATABLE:: var_ana(:, :)
51     real z(iim + 1, jjm + 1)
52 guez 3 real tmp_var(iim, jjm + 1)
53    
54     !--------------------------
55    
56     print *, "Call sequence information: start_init_dyn"
57 guez 36 call assert((/size(tsol_2d, 1), size(psol, 1)/) == iim + 1, &
58     "start_init_phys size 1")
59     call assert((/size(tsol_2d, 2), size(psol, 2)/) == jjm + 1, &
60     "start_init_phys size 2")
61     CALL flininfo('ECDYN.nc', iml_dyn, jml_dyn, llm_dyn, ttm_dyn, fid_dyn)
62 guez 3 print *, "iml_dyn = ", iml_dyn, ", jml_dyn = ", jml_dyn, &
63     ", llm_dyn = ", llm_dyn, ", ttm_dyn = ", ttm_dyn
64    
65     ALLOCATE(lat_dyn(iml_dyn, jml_dyn))
66     ALLOCATE(lon_dyn(iml_dyn, jml_dyn))
67     ALLOCATE(levdyn_ini(llm_dyn))
68    
69 guez 32 CALL flinopen_nozoom(iml_dyn, jml_dyn, llm_dyn, &
70 guez 3 lon_dyn, lat_dyn, levdyn_ini, ttm_dyn, itau, date, dt, fid_dyn)
71    
72     ALLOCATE(var_ana(iml_dyn, jml_dyn))
73     ALLOCATE(lon_rad(iml_dyn))
74     ALLOCATE(lon_ini(iml_dyn))
75    
76 guez 36 IF (MAXVAL(lon_dyn) > pi) THEN
77 guez 3 ! Assume "lon_dyn" is in degrees
78 guez 36 lon_ini = lon_dyn(:, 1) * pi / 180.
79 guez 3 ELSE
80 guez 36 lon_ini = lon_dyn(:, 1)
81 guez 3 ENDIF
82    
83     ALLOCATE(lat_rad(jml_dyn))
84     ALLOCATE(lat_ini(jml_dyn))
85    
86 guez 36 IF (MAXVAL(lat_dyn) > pi) THEN
87     lat_ini = lat_dyn(1, :) * pi / 180.
88 guez 3 ELSE
89 guez 36 lat_ini = lat_dyn(1, :)
90 guez 3 ENDIF
91    
92     ! 'Z': Surface geopotential
93     CALL flinget(fid_dyn, 'Z', iml_dyn, jml_dyn, 0, ttm_dyn, 1, 1, var_ana)
94     CALL conf_dat2d(lon_ini, lat_ini, lon_rad, lat_rad, var_ana)
95     CALL inter_barxy(lon_rad, lat_rad(:jml_dyn -1), var_ana, rlonu(:iim), &
96     rlatv, tmp_var)
97 guez 36 z = gr_int_dyn(tmp_var)
98 guez 3
99     ! 'SP': Surface pressure
100     CALL flinget(fid_dyn, 'SP', iml_dyn, jml_dyn, 0, ttm_dyn, 1, 1, var_ana)
101     CALL conf_dat2d(lon_ini, lat_ini, lon_rad, lat_rad, var_ana)
102     CALL inter_barxy(lon_rad, lat_rad(:jml_dyn -1), var_ana, rlonu(:iim), &
103     rlatv, tmp_var)
104 guez 36 psol = gr_int_dyn(tmp_var)
105 guez 3 CALL start_init_phys(tsol_2d)
106    
107 guez 36 psol(:iim, :) = psol(:iim, :) &
108     * (1. + (z(:iim, :) - phis(:iim, :)) / 287. / tsol_2d(:iim, :))
109 guez 3 psol(iim + 1, :) = psol(1, :)
110    
111 guez 36 psol(:, 1) = SUM(aire_2d(:iim, 1) * psol(:iim, 1)) / apoln
112     psol(:, jjm + 1) = SUM(aire_2d(:iim, jjm + 1) * psol(:iim, jjm + 1)) &
113     / apols
114 guez 3
115     END SUBROUTINE start_init_dyn
116    
117     !********************************
118    
119 guez 23 subroutine start_inter_3d(varname, lon_in2, lat_in2, pls_in, var3d)
120 guez 3
121 guez 36 ! This procedure gets a 3D variable from a file and interpolates it.
122 guez 3
123 guez 32 use flinget_m, only: flinget
124 guez 36 use nr_util, only: assert_eq
125     use numer_rec, only: spline, splint
126 guez 3 use inter_barxy_m, only: inter_barxy
127     use gr_int_dyn_m, only: gr_int_dyn
128     use conf_dat3d_m, only: conf_dat3d
129    
130     CHARACTER(len=*), intent(in):: varname
131 guez 36 REAL, intent(in):: lon_in2(:) ! (iml)
132     REAL, intent(in):: lat_in2(:)
133     REAL, intent(in):: pls_in(:, :, :) ! (iml, jml, lml)
134     REAL, intent(out):: var3d(:, :, :) ! (iml, jml, lml)
135 guez 3
136     ! LOCAL:
137     INTEGER iml, jml, lml
138     INTEGER ii, ij, il
139     REAL lon_rad(iml_dyn), lat_rad(jml_dyn)
140     REAL lev_dyn(llm_dyn)
141     REAL var_tmp2d(size(lon_in2)-1, size(pls_in, 2))
142     real var_tmp3d(size(lon_in2), size(pls_in, 2), llm_dyn)
143     REAL ax(llm_dyn), ay(llm_dyn), yder(llm_dyn)
144     real var_ana3d(iml_dyn, jml_dyn, llm_dyn)
145    
146     !--------------------------------
147    
148     print *, "Call sequence information: start_inter_3d"
149    
150 guez 23 iml = assert_eq(size(pls_in, 1), size(lon_in2), size(var3d, 1), &
151     "start_inter_3d iml")
152     jml = assert_eq(size(pls_in, 2), size(var3d, 2), "start_inter_3d jml")
153     lml = assert_eq(size(pls_in, 3), size(var3d, 3), "start_inter_3d lml")
154 guez 3
155     print *, "iml = ", iml, ", jml = ", jml
156 guez 23 print *, "varname = ", varname
157 guez 20 print *, 'Going into flinget to extract the 3D field.'
158 guez 3 CALL flinget(fid_dyn, varname, iml_dyn, jml_dyn, llm_dyn, ttm_dyn, 1, 1, &
159     var_ana3d)
160     CALL conf_dat3d(lon_ini, lat_ini, levdyn_ini, lon_rad, lat_rad, lev_dyn, &
161     var_ana3d)
162    
163     DO il = 1, llm_dyn
164     CALL inter_barxy(lon_rad, lat_rad(:jml_dyn-1), var_ana3d(:, :, il), &
165     lon_in2(:iml-1), lat_in2, var_tmp2d)
166     var_tmp3d(:, :, il) = gr_int_dyn(var_tmp2d)
167     ENDDO
168    
169     ! Pour l'interpolation verticale, on interpole du haut de l'atmosphère
170     ! vers le sol :
171 guez 36 ax = lev_dyn(llm_dyn:1:-1)
172 guez 3 DO ij=1, jml
173     DO ii=1, iml-1
174 guez 36 ay = var_tmp3d(ii, ij, llm_dyn:1:-1)
175     yder = SPLINE(ax, ay)
176 guez 3 do il=1, lml
177 guez 24 var3d(ii, ij, il) = SPLINT(ax, ay, yder, pls_in(ii, ij, il))
178 guez 3 END do
179     ENDDO
180     ENDDO
181 guez 23 var3d(iml, :, :) = var3d(1, :, :)
182 guez 3
183 guez 23 END subroutine start_inter_3d
184 guez 3
185     END MODULE startdyn

  ViewVC Help
Powered by ViewVC 1.1.21