Context Navigation

initfluxsto_p.F @ 1146

Last change on this file since 1146 was 1146, checked in by Laurent Fairhead, 15 years ago
Réintegration dans le tronc des modifications issues de la branche LMDZ-dev comprises entre la révision 1074 et 1145 Validation: une simulation de 1 jour en séquentiel sur PC donne les mêmes résultats entre la trunk et la dev LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 7.4 KB

Line
1	!
2	! $Header$
3	!
4	subroutine initfluxsto_p
5	. (infile,tstep,t_ops,t_wrt,
6	. fileid,filevid,filedid)
7
8	USE IOIPSL
9	use parallel
10	use Write_field
11	use misc_mod
12
13	implicit none
14
15	C
16	C Routine d'initialisation des ecritures des fichiers histoires LMDZ
17	C au format IOIPSL
18	C
19	C Appels succesifs des routines: histbeg
20	C histhori
21	C histver
22	C histdef
23	C histend
24	C
25	C Entree:
26	C
27	C infile: nom du fichier histoire a creer
28	C day0,anne0: date de reference
29	C tstep: duree du pas de temps en seconde
30	C t_ops: frequence de l'operation pour IOIPSL
31	C t_wrt: frequence d'ecriture sur le fichier
32	C
33	C Sortie:
34	C fileid: ID du fichier netcdf cree
35	C filevid:ID du fichier netcdf pour la grille v
36	C
37	C L. Fairhead, LMD, 03/99
38	C
39	C =====================================================================
40	C
41	C Declarations
42	#include "dimensions.h"
43	#include "paramet.h"
44	#include "comconst.h"
45	#include "comvert.h"
46	#include "comgeom.h"
47	#include "temps.h"
48	#include "ener.h"
49	#include "logic.h"
50	#include "description.h"
51	#include "serre.h"
52
53	C Arguments
54	C
55	character() infile
56	integer*4 itau
57	real tstep, t_ops, t_wrt
58	integer fileid, filevid,filedid
59	integer ndex(1)
60	real nivd(1)
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	real rlong(iip1,jjp1), rlat(iip1,jjp1),rl(1,1)
70	integer uhoriid, vhoriid, thoriid, zvertiid,dhoriid,dvertiid
71	integer ii,jj
72	integer zan, idayref
73	logical ok_sync
74	integer :: jjb,jje,jjn
75
76	! definition du domaine d'ecriture pour le rebuild
77
78	INTEGER,DIMENSION(2) :: ddid
79	INTEGER,DIMENSION(2) :: dsg
80	INTEGER,DIMENSION(2) :: dsl
81	INTEGER,DIMENSION(2) :: dpf
82	INTEGER,DIMENSION(2) :: dpl
83	INTEGER,DIMENSION(2) :: dhs
84	INTEGER,DIMENSION(2) :: dhe
85
86	INTEGER :: dynu_domain_id
87	INTEGER :: dynv_domain_id
88
89	C
90	C Initialisations
91	C
92	pi = 4. * atan (1.)
93	str='q '
94	ctrac = 'traceur '
95	ok_sync = .true.
96	C
97	C Appel a histbeg: creation du fichier netcdf et initialisations diverses
98	C
99
100	zan = annee_ref
101	idayref = day_ref
102	CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
103	tau0 = itau_dyn
104
105	do jj = 1, jjp1
106	do ii = 1, iip1
107	rlong(ii,jj) = rlonu(ii) * 180. / pi
108	rlat(ii,jj) = rlatu(jj) * 180. / pi
109	enddo
110	enddo
111
112	jjb=jj_begin
113	jje=jj_end
114	jjn=jj_nb
115
116	ddid=(/ 1,2 /)
117	dsg=(/ iip1,jjp1 /)
118	dsl=(/ iip1,jjn /)
119	dpf=(/ 1,jjb /)
120	dpl=(/ iip1,jje /)
121	dhs=(/ 0,0 /)
122	dhe=(/ 0,0 /)
123
124	call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
125	. 'box',dynu_domain_id)
126
127	call histbeg(trim(infile),iip1, rlong(:,1), jjn, rlat(1,jjb:jje),
128	. 1, iip1, 1, jjn, tau0, zjulian, tstep, uhoriid,
129	. fileid,dynu_domain_id)
130	C
131	C Creation du fichier histoire pour la grille en V (oblige pour l'instant,
132	C IOIPSL ne permet pas de grilles avec des nombres de point differents dans
133	C un meme fichier)
134
135
136	do jj = 1, jjm
137	do ii = 1, iip1
138	rlong(ii,jj) = rlonv(ii) * 180. / pi
139	rlat(ii,jj) = rlatv(jj) * 180. / pi
140	enddo
141	enddo
142
143	jjb=jj_begin
144	jje=jj_end
145	jjn=jj_nb
146	if (pole_sud) jje=jj_end-1
147	if (pole_sud) jjn=jj_nb-1
148
149	ddid=(/ 1,2 /)
150	dsg=(/ iip1,jjm /)
151	dsl=(/ iip1,jjn /)
152	dpf=(/ 1,jjb /)
153	dpl=(/ iip1,jje /)
154	dhs=(/ 0,0 /)
155	dhe=(/ 0,0 /)
156
157	call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
158	. 'box',dynv_domain_id)
159
160	call histbeg('fluxstokev',iip1, rlong(:,1), jjn, rlat(1,jjb:jje),
161	. 1, iip1, 1, jjn,tau0, zjulian, tstep, vhoriid,
162	. filevid,dynv_domain_id)
163
164	rl(1,1) = 1.
165
166	if (mpi_rank==0) then
167
168	call histbeg('defstoke.nc', 1, rl, 1, rl,
169	. 1, 1, 1, 1,
170	. tau0, zjulian, tstep, dhoriid, filedid)
171
172	endif
173	C
174	C Appel a histhori pour rajouter les autres grilles horizontales
175	C
176	do jj = 1, jjp1
177	do ii = 1, iip1
178	rlong(ii,jj) = rlonv(ii) * 180. / pi
179	rlat(ii,jj) = rlatu(jj) * 180. / pi
180	enddo
181	enddo
182
183	jjb=jj_begin
184	jje=jj_end
185	jjn=jj_nb
186
187	call histhori(fileid, iip1, rlong(:,jjb:jje),jjn,rlat(:,jjb:jje),
188	. 'scalar','Grille points scalaires', thoriid)
189
190	C
191	C Appel a histvert pour la grille verticale
192	C
193	call histvert(fileid, 'sig_s', 'Niveaux sigma',
194	. 'sigma_level',
195	. llm, nivsigs, zvertiid)
196	C Pour le fichier V
197	call histvert(filevid, 'sig_s', 'Niveaux sigma',
198	. 'sigma_level',
199	. llm, nivsigs, zvertiid)
200	c pour le fichier def
201	nivd(1) = 1
202	call histvert(filedid, 'sig_s', 'Niveaux sigma',
203	. 'sigma_level',
204	. 1, nivd, dvertiid)
205
206	C
207	C Appels a histdef pour la definition des variables a sauvegarder
208
209	CALL histdef(fileid, "phis", "Surface geop. height", "-",
210	. iip1,jjn,thoriid, 1,1,1, -99, 32,
211	. "once", t_ops, t_wrt)
212
213	CALL histdef(fileid, "aire", "Grid area", "-",
214	. iip1,jjn,thoriid, 1,1,1, -99, 32,
215	. "once", t_ops, t_wrt)
216
217	if (mpi_rank==0) then
218
219	CALL histdef(filedid, "dtvr", "tps dyn", "s",
220	. 1,1,dhoriid, 1,1,1, -99, 32,
221	. "once", t_ops, t_wrt)
222
223	CALL histdef(filedid, "istdyn", "tps stock", "s",
224	. 1,1,dhoriid, 1,1,1, -99, 32,
225	. "once", t_ops, t_wrt)
226
227	CALL histdef(filedid, "istphy", "tps stock phy", "s",
228	. 1,1,dhoriid, 1,1,1, -99, 32,
229	. "once", t_ops, t_wrt)
230
231	endif
232	C
233	C Masse
234	C
235	call histdef(fileid, 'masse', 'Masse', 'kg',
236	. iip1, jjn, thoriid, llm, 1, llm, zvertiid,
237	. 32, 'inst(X)', t_ops, t_wrt)
238	C
239	C Pbaru
240	C
241	call histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s',
242	. iip1, jjn, uhoriid, llm, 1, llm, zvertiid,
243	. 32, 'inst(X)', t_ops, t_wrt)
244
245	C
246	C Pbarv
247	C
248	if (pole_sud) jjn=jj_nb-1
249
250	call histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s',
251	. iip1, jjn, vhoriid, llm, 1, llm, zvertiid,
252	. 32, 'inst(X)', t_ops, t_wrt)
253	C
254	C w
255	C
256	if (pole_sud) jjn=jj_nb
257	call histdef(fileid, 'w', 'flx de masse vert', 'kg m/s',
258	. iip1, jjn, thoriid, llm, 1, llm, zvertiid,
259	. 32, 'inst(X)', t_ops, t_wrt)
260
261	C
262	C Temperature potentielle
263	C
264	call histdef(fileid, 'teta', 'temperature potentielle', '-',
265	. iip1, jjn, thoriid, llm, 1, llm, zvertiid,
266	. 32, 'inst(X)', t_ops, t_wrt)
267	C
268
269	C
270	C Geopotentiel
271	C
272	call histdef(fileid, 'phi', 'geopotentiel instantane', '-',
273	. iip1, jjn, thoriid, llm, 1, llm, zvertiid,
274	. 32, 'inst(X)', t_ops, t_wrt)
275	C
276	C Fin
277	C
278	call histend(fileid)
279	call histend(filevid)
280	call histend(filedid)
281	if (ok_sync) then
282	call histsync(fileid)
283	call histsync(filevid)
284	call histsync(filedid)
285	endif
286
287	return
288	end

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format