/[lmdze]/trunk/libf/bibio/initfluxsto.f
ViewVC logotype

Contents of /trunk/libf/bibio/initfluxsto.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3 - (show annotations)
Wed Feb 27 13:16:39 2008 UTC (16 years, 2 months ago) by guez
File size: 6213 byte(s)
Initial import
1 !
2 ! $Header: /home/cvsroot/LMDZ4/libf/bibio/initfluxsto.F,v 1.1.1.1 2004/05/19 12:53:05 lmdzadmin Exp $
3 !
4 subroutine initfluxsto
5 . (infile,tstep,t_ops,t_wrt,nq,
6 . fileid,filevid,filedid)
7
8 USE IOIPSL
9 USE histcom
10
11
12 C
13 C Routine d'initialisation des ecritures des fichiers histoires LMDZ
14 C au format IOIPSL
15 C
16 C Appels succesifs des routines: histbeg
17 C histhori
18 C histver
19 C histdef
20 C histend
21 C
22 C Entree:
23 C
24 C infile: nom du fichier histoire a creer
25 C day0,anne0: date de reference
26 C tstep: duree du pas de temps en seconde
27 C t_ops: frequence de l'operation pour IOIPSL
28 C t_wrt: frequence d'ecriture sur le fichier
29 C nq: nombre de traceurs
30 C
31 C Sortie:
32 C fileid: ID du fichier netcdf cree
33 C filevid:ID du fichier netcdf pour la grille v
34 C
35 C L. Fairhead, LMD, 03/99
36 C
37 C =====================================================================
38 C
39 C Declarations
40 use dimens_m
41 use paramet_m
42 use comconst
43 use comvert
44 use logic
45 use comgeom
46 use serre
47 use temps, only: annee_ref, day_ref, itau_dyn
48 use ener
49 implicit none
50
51 C Arguments
52 C
53 character*(*) infile
54 integer*4 itau
55 real tstep, t_ops, t_wrt
56 integer fileid, filevid,filedid
57 integer nq,ndex(1)
58 real nivd(1)
59
60 C Variables locales
61 C
62 integer tau0
63 real zjulian
64 character*3 str
65 character*10 ctrac
66 integer iq
67 real rlong(iip1,jjp1), rlat(iip1,jjp1),rl(1,1)
68 integer uhoriid, vhoriid, thoriid, zvertiid,dhoriid,dvertiid
69 integer ii,jj
70 integer zan, idayref
71 logical ok_sync
72 C
73 C Initialisations
74 C
75 pi = 4. * atan (1.)
76 str='q '
77 ctrac = 'traceur '
78 ok_sync = .true.
79 C
80 C Appel a histbeg: creation du fichier netcdf et initialisations diverses
81 C
82
83 zan = annee_ref
84 idayref = day_ref
85 CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
86 tau0 = itau_dyn
87
88 do jj = 1, jjp1
89 do ii = 1, iip1
90 rlong(ii,jj) = rlonu(ii) * 180. / pi
91 rlat(ii,jj) = rlatu(jj) * 180. / pi
92 enddo
93 enddo
94
95 call histbeg_totreg(infile, iip1, rlong(:,1), jjp1, rlat(1,:),
96 . 1, iip1, 1, jjp1,
97 . tau0, zjulian, tstep, uhoriid, fileid)
98 C
99 C Creation du fichier histoire pour la grille en V (oblige pour l'instant,
100 C IOIPSL ne permet pas de grilles avec des nombres de point differents dans
101 C un meme fichier)
102
103
104 do jj = 1, jjm
105 do ii = 1, iip1
106 rlong(ii,jj) = rlonv(ii) * 180. / pi
107 rlat(ii,jj) = rlatv(jj) * 180. / pi
108 enddo
109 enddo
110
111 call histbeg_totreg('fluxstokev.nc', iip1, rlong(:,1), jjm,
112 . rlat(1,:),1, iip1, 1, jjm,
113 . tau0, zjulian, tstep, vhoriid, filevid)
114
115 rl(1,1) = 1.
116 call histbeg_regular('defstoke.nc', 1, rl, 1, rl,
117 . 1, 1, 1, 1,
118 . tau0, zjulian, tstep, dhoriid, filedid)
119
120 C
121 C Appel a histhori pour rajouter les autres grilles horizontales
122 C
123 do jj = 1, jjp1
124 do ii = 1, iip1
125 rlong(ii,jj) = rlonv(ii) * 180. / pi
126 rlat(ii,jj) = rlatu(jj) * 180. / pi
127 enddo
128 enddo
129
130 call histhori(fileid, iip1, rlong, jjp1, rlat, 'scalar',
131 . 'Grille points scalaires', thoriid)
132
133 C
134 C Appel a histvert pour la grille verticale
135 C
136 call histvert(fileid, 'sig_s', 'Niveaux sigma',
137 . 'sigma_level',
138 . llm, nivsigs, zvertiid)
139 C Pour le fichier V
140 call histvert(filevid, 'sig_s', 'Niveaux sigma',
141 . 'sigma_level',
142 . llm, nivsigs, zvertiid)
143 c pour le fichier def
144 nivd(1) = 1
145 call histvert(filedid, 'sig_s', 'Niveaux sigma',
146 . 'sigma_level',
147 . 1, nivd, dvertiid)
148
149 C
150 C Appels a histdef pour la definition des variables a sauvegarder
151
152 CALL histdef(fileid, "phis", "Surface geop. height", "-",
153 . iip1,jjp1,thoriid, 1,1,1, -99, 32,
154 . "once", t_ops, t_wrt)
155
156 CALL histdef(fileid, "aire", "Grid area", "-",
157 . iip1,jjp1,thoriid, 1,1,1, -99, 32,
158 . "once", t_ops, t_wrt)
159
160 CALL histdef(filedid, "dtvr", "tps dyn", "s",
161 . 1,1,dhoriid, 1,1,1, -99, 32,
162 . "once", t_ops, t_wrt)
163
164 CALL histdef(filedid, "istdyn", "tps stock", "s",
165 . 1,1,dhoriid, 1,1,1, -99, 32,
166 . "once", t_ops, t_wrt)
167
168 CALL histdef(filedid, "istphy", "tps stock phy", "s",
169 . 1,1,dhoriid, 1,1,1, -99, 32,
170 . "once", t_ops, t_wrt)
171
172
173 C
174 C Masse
175 C
176 call histdef(fileid, 'masse', 'Masse', 'kg',
177 . iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
178 . 32, 'inst(X)', t_ops, t_wrt)
179 C
180 C Pbaru
181 C
182 call histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s',
183 . iip1, jjp1, uhoriid, llm, 1, llm, zvertiid,
184 . 32, 'inst(X)', t_ops, t_wrt)
185
186 C
187 C Pbarv
188 C
189 call histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s',
190 . iip1, jjm, vhoriid, llm, 1, llm, zvertiid,
191 . 32, 'inst(X)', t_ops, t_wrt)
192 C
193 C w
194 C
195 call histdef(fileid, 'w', 'flx de masse vert', 'kg m/s',
196 . iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
197 . 32, 'inst(X)', t_ops, t_wrt)
198
199 C
200 C Temperature potentielle
201 C
202 call histdef(fileid, 'teta', 'temperature potentielle', '-',
203 . iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
204 . 32, 'inst(X)', t_ops, t_wrt)
205 C
206
207 C
208 C Geopotentiel
209 C
210 call histdef(fileid, 'phi', 'geopotentiel instantane', '-',
211 . iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
212 . 32, 'inst(X)', t_ops, t_wrt)
213 C
214 C Fin
215 C
216 call histend(fileid)
217 call histend(filevid)
218 call histend(filedid)
219 if (ok_sync) then
220 call histsync(fileid)
221 call histsync(filevid)
222 call histsync(filedid)
223 endif
224
225 return
226 end

  ViewVC Help
Powered by ViewVC 1.1.21