/[lmdze]/trunk/libf/phylmd/initphysto.f
ViewVC logotype

Contents of /trunk/libf/phylmd/initphysto.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 15 - (show annotations)
Fri Aug 1 15:24:12 2008 UTC (15 years, 8 months ago) by guez
File size: 7799 byte(s) 
-- Minor modification of input/output:

Added variable "Sigma_O3_Royer" to "histday.nc". "ecrit_day" is not
modified in "physiq". Removed variables "pyu1", "pyv1", "ftsol1",
"ftsol2", "ftsol3", "ftsol4", "psrf1", "psrf2", "psrf3", "psrf4"
"mfu", "mfd", "en_u", "en_d", "de_d", "de_u", "coefh" from
"histrac.nc".

Variable "raz_date" of module "conf_gcm_m" has logical type instead of
integer type.

-- Should not change any result at run time:

Modified calls to "IOIPSL_Lionel" procedures because the interfaces of
these procedures have been simplified.

Changed name of variable in module "start_init_orog_m": "masque" to
"mask".

Created a module containing procedure "phyredem".

Removed arguments "punjours", "pdayref" and "ptimestep" of procedure
"iniphysiq".

Renamed procedure "gr_phy_write" to "gr_phy_write_2d". Created
procedure "gr_phy_write_3d".

Removed procedures "ini_undefstd", "moy_undefSTD", "calcul_STDlev",
"calcul_divers".
1 !
2 ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/initphysto.F,v 1.2 2004/06/22 11:45:32 lmdzadmin Exp $
3 !
4 C
5 C
6 subroutine initphysto
7 . (infile,
8 . rlon, rlat, tstep,t_ops,t_wrt,nq,fileid)
9
10 USE IOIPSL
11
12 use dimens_m
13 use paramet_m
14 use comconst
15 use indicesol
16 use dimphy
17 use logic
18 use comgeom
19 use serre
20 use temps
21 use ener
22 implicit none
23
24 C
25 C Routine d'initialisation des ecritures des fichiers histoires LMDZ
26 C au format IOIPSL
27 C
28 C Appels succesifs des routines: histbeg
29 C histhori
30 C histver
31 C histdef
32 C histend
33 C
34 C Entree:
35 C
36 C infile: nom du fichier histoire a creer
37 C day0,anne0: date de reference
38 C tstep: duree du pas de temps en seconde
39 C t_ops: frequence de l'operation pour IOIPSL
40 C t_wrt: frequence d'ecriture sur le fichier
41 C nq: nombre de traceurs
42 C
43 C Sortie:
44 C fileid: ID du fichier netcdf cree
45 C filevid:ID du fichier netcdf pour la grille v
46 C
47 C L. Fairhead, LMD, 03/99
48 C
49 C =====================================================================
50 C
51 C Declarations
52
53 C Arguments
54 character*(*) infile
55 integer*4 nhoriid, i
56 real, intent(in):: tstep
57 real t_ops, t_wrt
58 integer fileid, filevid
59 integer nq,l
60 real nivsigs(llm)
61
62 C Variables locales
63 C
64 integer tau0
65 real zjulian
66 character*3 str
67 character*10 ctrac
68 integer iq
69 integer uhoriid, vhoriid, thoriid, zvertiid
70 integer ii,jj
71 integer zan, idayref
72 logical ok_sync
73 REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
74 C
75 REAL, intent(in):: rlon(klon), rlat(klon)
76
77 C Initialisations
78 C
79 pi = 4. * atan (1.)
80 str='q '
81 ctrac = 'traceur '
82 ok_sync= .true.
83 C
84 C Appel a histbeg: creation du fichier netcdf et initialisations diverses
85 C
86
87 zan = annee_ref
88 idayref = day_ref
89 CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
90 tau0 = 0
91
92 CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon)
93 DO i = 1, iim
94 zx_lon(i,1) = rlon(i+1)
95 zx_lon(i,jjm+1) = rlon(i+1)
96 ENDDO
97 CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlat,zx_lat)
98
99
100 call histbeg_totreg(infile, zx_lon(:,1), zx_lat(1,:),
101 . 1, iim, 1, jjm+1,
102 . tau0, zjulian, tstep, nhoriid, fileid)
103
104 C Appel a histvert pour la grille verticale
105 C
106 DO l=1,llm
107 nivsigs(l)=float(l)
108 ENDDO
109
110 write(*,*) 'avant histvert ds initphysto'
111
112 call histvert(fileid, 'sig_s', 'Niveaux sigma',
113 . 'sigma_level',
114 . llm, nivsigs, zvertiid)
115 C
116 C Appels a histdef pour la definition des variables a sauvegarder
117 C
118 write(*,*) 'apres histvert ds initphysto'
119
120 CALL histdef(fileid, "phis", "Surface geop. height", "-",
121 . iim,jjm+1,nhoriid, 1,1,1, -99,
122 . "once", t_ops, t_wrt)
123 c
124 write(*,*) 'apres phis ds initphysto'
125
126 CALL histdef(fileid, "aire", "Grid area", "-",
127 . iim,jjm+1,nhoriid, 1,1,1, -99,
128 . "once", t_ops, t_wrt)
129 write(*,*) 'apres aire ds initphysto'
130
131 CALL histdef(fileid, "dtime", "tps phys ", "s",
132 . 1,1,nhoriid, 1,1,1, -99,
133 . "once", t_ops, t_wrt)
134
135 CALL histdef(fileid, "istphy", "tps stock", "s",
136 . 1,1,nhoriid, 1,1,1, -99,
137 . "once", t_ops, t_wrt)
138
139 C T
140 C
141 call histdef(fileid, 't', 'Temperature', 'K',
142 . iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
143 . 'inst(X)', t_ops, t_wrt)
144 write(*,*) 'apres t ds initphysto'
145 C mfu
146 C
147 call histdef(fileid, 'mfu', 'flx m. pan. mt', 'kg m/s',
148 . iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
149 . 'inst(X)', t_ops, t_wrt)
150 write(*,*) 'apres mfu ds initphysto'
151 C
152 C mfd
153 C
154 call histdef(fileid, 'mfd', 'flx m. pan. des', 'kg m/s',
155 . iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
156 . 'inst(X)', t_ops, t_wrt)
157
158 C
159 C en_u
160 C
161 call histdef(fileid, 'en_u', 'flx ent pan mt', 'kg m/s',
162 . iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
163 . 'inst(X)', t_ops, t_wrt)
164 write(*,*) 'apres en_u ds initphysto'
165 C
166 C de_u
167 C
168 call histdef(fileid, 'de_u', 'flx det pan mt', 'kg m/s',
169 . iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
170 . 'inst(X)', t_ops, t_wrt)
171
172 C
173 C en_d
174 C
175 call histdef(fileid, 'en_d', 'flx ent pan dt', 'kg m/s',
176 . iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
177 . 'inst(X)', t_ops, t_wrt)
178 C
179
180 C
181 C de_d
182 C
183 call histdef(fileid, 'de_d', 'flx det pan dt', 'kg m/s',
184 . iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
185 . 'inst(X)', t_ops, t_wrt)
186
187 c coefh frac_impa,frac_nucl
188
189 call histdef(fileid, "coefh", " ", " ",
190 . iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
191 . "inst(X)", t_ops, t_wrt)
192
193 c abderrahmane le 16 09 02
194 call histdef(fileid, "fm_th", " ", " ",
195 . iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
196 . "inst(X)", t_ops, t_wrt)
197
198 call histdef(fileid, "en_th", " ", " ",
199 . iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
200 . "inst(X)", t_ops, t_wrt)
201 c fin aj
202
203 write(*,*) 'apres coefh ds initphysto'
204
205 call histdef(fileid, 'frac_impa', ' ', ' ',
206 . iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
207 . 'inst(X)', t_ops, t_wrt)
208
209 call histdef(fileid, 'frac_nucl', ' ', ' ',
210 . iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
211 . 'inst(X)', t_ops, t_wrt)
212
213 c
214 c pyu1
215 c
216 CALL histdef(fileid, "pyu1", " ", " ",
217 . iim,jjm+1,nhoriid, 1,1,1, -99,
218 . "inst(X)", t_ops, t_wrt)
219
220 c
221 c pyv1
222 c
223 CALL histdef(fileid, "pyv1", " ", " ",
224 . iim,jjm+1,nhoriid, 1,1,1, -99,
225 . "inst(X)", t_ops, t_wrt)
226
227 write(*,*) 'apres pyv1 ds initphysto'
228 c
229 c ftsol1
230 c
231 call histdef(fileid, "ftsol1", " ", " ",
232 . iim, jjm+1, nhoriid, 1, 1,1, -99,
233 . "inst(X)", t_ops, t_wrt)
234
235 c
236 c ftsol2
237 c
238 call histdef(fileid, "ftsol2", " ", " ",
239 . iim, jjm+1, nhoriid, 1, 1,1, -99,
240 . "inst(X)", t_ops, t_wrt)
241
242 c
243 c ftsol3
244 c
245 call histdef(fileid, "ftsol3", " ", " ",
246 . iim, jjm+1, nhoriid, 1, 1,1, -99,
247 . "inst(X)", t_ops, t_wrt)
248
249 c
250 c ftsol4
251 c
252 call histdef(fileid, "ftsol4", " ", " ",
253 . iim, jjm+1, nhoriid, 1, 1,1, -99,
254 . "inst(X)", t_ops, t_wrt)
255
256 c
257 c rain
258 c
259 call histdef(fileid, "rain", " ", " ",
260 . iim, jjm+1, nhoriid, 1, 1,1, -99,
261 . "inst(X)", t_ops, t_wrt)
262
263 c
264 c psrf1
265 c
266 call histdef(fileid, "psrf1", " ", " ",
267 . iim, jjm+1, nhoriid, 1, 1, 1, -99,
268 . "inst(X)", t_ops, t_wrt)
269
270 c
271 c psrf2
272 c
273 call histdef(fileid, "psrf2", " ", " ",
274 . iim, jjm+1, nhoriid, 1, 1, 1, -99,
275 . "inst(X)", t_ops, t_wrt)
276
277 c
278 c psrf3
279 c
280 call histdef(fileid, "psrf3", " ", " ",
281 . iim, jjm+1, nhoriid, 1, 1, 1, -99,
282 . "inst(X)", t_ops, t_wrt)
283
284 c
285 c psrf4
286 c
287 call histdef(fileid, "psrf4", " ", " ",
288 . iim, jjm+1, nhoriid, 1, 1, 1, -99,
289 . "inst(X)", t_ops, t_wrt)
290
291 write(*,*) 'avant histend ds initphysto'
292
293 call histend(fileid)
294 c if (ok_sync) call histsync(fileid)
295 if (ok_sync) call histsync
296
297
298
299 return
300 end
  ViewVC Help
Powered by ViewVC 1.1.21