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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 9 - (show annotations)
Mon Mar 31 13:58:05 2008 UTC (16 years, 1 month ago) by guez
File size: 6193 byte(s)
New variables "*_dir" in "g95.mk".
Corrected some bugs: "etat0_lim" works, but not "gcm".

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

  ViewVC Help
Powered by ViewVC 1.1.21