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

Contents of /trunk/phylmd/initphysto.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 92 - (show annotations)
Wed Mar 26 18:16:05 2014 UTC (10 years, 1 month ago) by guez
File size: 5857 byte(s)
Extracted procedures that were in module calendar into separate files.

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

  ViewVC Help
Powered by ViewVC 1.1.21