Context Navigation

initfluxsto_p.F @ 2598

Last change on this file since 2598 was 2598, checked in by Ehouarn Millour, 8 years ago
Cleanup in the dynamics: turn serre.h into module serre_mod.F90 EM
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory
File size: 7.7 KB

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

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

Download in other formats:

Original Format