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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 31 - (show annotations)
Thu Apr 1 14:59:19 2010 UTC (14 years, 1 month ago) by guez
File size: 5687 byte(s)
Split "vlsplt.f" in single-procedure files. Gathered the files in
directory "dyn3d/Vlsplt".

Defined "pbarum(:, 1, :)" and "pbarum(:, jjm + 1, :)" in procedure
"groupe".

1 SUBROUTINE initphysto(infile,rlon,rlat,tstep,t_ops,t_wrt,nq,fileid)
2
3 ! From phylmd/initphysto.F,v 1.2 2004/06/22 11:45:32
4 ! Routine d'initialisation des ecritures des fichiers histoires LMDZ
5 ! au format IOIPSL
6
7 ! Appels succesifs des routines: histbeg
8 ! histhori
9 ! histver
10 ! histdef
11 ! histend
12
13 ! Entree:
14
15 ! infile: nom du fichier histoire a creer
16 ! day0,anne0: date de reference
17 ! tstep: duree du pas de temps en seconde
18 ! t_ops: frequence de l'operation pour IOIPSL
19 ! t_wrt: frequence d'ecriture sur le fichier
20 ! nq: nombre de traceurs
21
22 ! Sortie:
23 ! fileid: ID du fichier netcdf cree
24 ! filevid:ID du fichier netcdf pour la grille v
25
26 ! L. Fairhead, 03/99
27
28 USE calendar
29 USE histcom
30 USE dimens_m
31 USE paramet_m
32 USE comconst
33 USE indicesol
34 USE dimphy
35 USE logic
36 USE comgeom
37 USE serre
38 USE temps
39 USE ener
40
41 IMPLICIT NONE
42
43 ! Arguments
44 CHARACTER*(*) infile
45 INTEGER nhoriid, i
46 REAL, INTENT (IN) :: tstep
47 REAL t_ops, t_wrt
48 INTEGER fileid, filevid
49 INTEGER nq, l
50 REAL nivsigs(llm)
51
52 ! Variables locales
53
54 INTEGER tau0
55 REAL zjulian
56 CHARACTER*3 str
57 CHARACTER*10 ctrac
58 INTEGER iq
59 INTEGER uhoriid, vhoriid, thoriid, zvertiid
60 INTEGER ii, jj
61 INTEGER zan, idayref
62 LOGICAL ok_sync
63 REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
64
65 REAL, INTENT (IN) :: rlon(klon), rlat(klon)
66
67 !-----------------------------------------------------
68
69 ! Initialisations
70
71 pi = 4.*atan(1.)
72 str = 'q '
73 ctrac = 'traceur '
74 ok_sync = .TRUE.
75
76 ! Appel a histbeg: creation du fichier netcdf et initialisations
77 ! diverses
78
79 zan = annee_ref
80 idayref = day_ref
81 CALL ymds2ju(zan,1,idayref,0.0,zjulian)
82 tau0 = 0
83
84 CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon)
85 DO i = 1, iim
86 zx_lon(i,1) = rlon(i+1)
87 zx_lon(i,jjm+1) = rlon(i+1)
88 END DO
89 CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlat,zx_lat)
90
91
92 CALL histbeg_totreg(infile,zx_lon(:,1),zx_lat(1,:),1,iim,1,jjm+1,tau0, &
93 zjulian,tstep,nhoriid,fileid)
94
95 ! Appel a histvert pour la grille verticale
96
97 DO l = 1, llm
98 nivsigs(l) = float(l)
99 END DO
100
101 CALL histvert(fileid,'sig_s','Niveaux sigma','sigma_level',llm,nivsigs, &
102 zvertiid)
103
104 ! Appels a histdef pour la definition des variables a sauvegarder
105
106 CALL histdef(fileid,'phis','Surface geop. height','-',iim,jjm+1,nhoriid, &
107 1,1,1,-99,'once',t_ops,t_wrt)
108
109 CALL histdef(fileid,'aire','Grid area','-',iim,jjm+1,nhoriid,1,1,1,-99, &
110 'once',t_ops,t_wrt)
111
112 CALL histdef(fileid,'dtime','tps phys ','s',1,1,nhoriid,1,1,1,-99, &
113 'once',t_ops,t_wrt)
114
115 CALL histdef(fileid,'istphy','tps stock','s',1,1,nhoriid,1,1,1,-99, &
116 'once',t_ops,t_wrt)
117
118 ! T
119
120 CALL histdef(fileid,'t','Temperature','K',iim,jjm+1,nhoriid,llm,1,llm, &
121 zvertiid,'inst(X)',t_ops,t_wrt)
122
123 CALL histdef(fileid,'mfu','flx m. pan. mt','kg m/s',iim,jjm+1,nhoriid, &
124 llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
125
126 CALL histdef(fileid,'mfd','flx m. pan. des','kg m/s',iim,jjm+1,nhoriid, &
127 llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
128
129
130 ! en_u
131
132 CALL histdef(fileid,'en_u','flx ent pan mt','kg m/s',iim,jjm+1,nhoriid, &
133 llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
134
135 CALL histdef(fileid,'de_u','flx det pan mt','kg m/s',iim,jjm+1,nhoriid, &
136 llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
137
138
139 ! en_d
140
141 CALL histdef(fileid,'en_d','flx ent pan dt','kg m/s',iim,jjm+1,nhoriid, &
142 llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
143
144
145
146 ! de_d
147
148 CALL histdef(fileid,'de_d','flx det pan dt','kg m/s',iim,jjm+1,nhoriid, &
149 llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
150
151 ! coefh frac_impa,frac_nucl
152
153 CALL histdef(fileid,'coefh',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
154 zvertiid,'inst(X)',t_ops,t_wrt)
155
156 ! abderrahmane le 16 09 02
157 CALL histdef(fileid,'fm_th',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
158 zvertiid,'inst(X)',t_ops,t_wrt)
159
160 CALL histdef(fileid,'en_th',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
161 zvertiid,'inst(X)',t_ops,t_wrt)
162 ! fin aj
163
164 CALL histdef(fileid,'frac_impa',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
165 zvertiid,'inst(X)',t_ops,t_wrt)
166
167 CALL histdef(fileid,'frac_nucl',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
168 zvertiid,'inst(X)',t_ops,t_wrt)
169
170
171 ! pyu1
172
173 CALL histdef(fileid,'pyu1',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
174 'inst(X)',t_ops,t_wrt)
175
176
177 ! pyv1
178
179 CALL histdef(fileid,'pyv1',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
180 'inst(X)',t_ops,t_wrt)
181
182 CALL histdef(fileid,'ftsol1',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
183 'inst(X)',t_ops,t_wrt)
184
185
186 ! ftsol2
187
188 CALL histdef(fileid,'ftsol2',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
189 'inst(X)',t_ops,t_wrt)
190
191
192 ! ftsol3
193
194 CALL histdef(fileid,'ftsol3',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
195 'inst(X)',t_ops,t_wrt)
196
197
198 ! ftsol4
199
200 CALL histdef(fileid,'ftsol4',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
201 'inst(X)',t_ops,t_wrt)
202
203
204 ! rain
205
206 CALL histdef(fileid,'rain',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
207 'inst(X)',t_ops,t_wrt)
208
209
210 ! psrf1
211
212 CALL histdef(fileid,'psrf1',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
213 'inst(X)',t_ops,t_wrt)
214
215
216 ! psrf2
217
218 CALL histdef(fileid,'psrf2',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
219 'inst(X)',t_ops,t_wrt)
220
221
222 ! psrf3
223
224 CALL histdef(fileid,'psrf3',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
225 'inst(X)',t_ops,t_wrt)
226
227
228 ! psrf4
229
230 CALL histdef(fileid,'psrf4',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
231 'inst(X)',t_ops,t_wrt)
232
233 CALL histend(fileid)
234 IF (ok_sync) CALL histsync
235
236 END SUBROUTINE initphysto

  ViewVC Help
Powered by ViewVC 1.1.21