Context Navigation

initfluxsto_p.F @ 1202

Last change on this file since 1202 was 1186, checked in by Ehouarn Millour, 15 years ago

Cleanup around IOIPSL, so that LMDZ dynamics may be used without IOIPSL.

moved ersatz IOIPSL routines (ioipsl_* , taken from IOIPSLv2_1_8, so that 'getin' function may be used even if not using the IOIPSL library) from dyn3d/dyn3dpar to bibio.
enclosed 'use ioipsl' instruction with #ifdef CPP_IOIPSL cpp keys.

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 7.6 KB

Line
1	!
2	! $Id: initfluxsto_p.F 1186 2009-06-18 09:20:44Z fairhead $
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
13	use Write_field
14	use misc_mod
15
16	implicit none
17
18	C
19	C Routine d'initialisation des ecritures des fichiers histoires LMDZ
20	C au format IOIPSL
21	C
22	C Appels succesifs des routines: histbeg
23	C histhori
24	C histver
25	C histdef
26	C histend
27	C
28	C Entree:
29	C
30	C infile: nom du fichier histoire a creer
31	C day0,anne0: date de reference
32	C tstep: duree du pas de temps en seconde
33	C t_ops: frequence de l'operation pour IOIPSL
34	C t_wrt: frequence d'ecriture sur le fichier
35	C
36	C Sortie:
37	C fileid: ID du fichier netcdf cree
38	C filevid:ID du fichier netcdf pour la grille v
39	C
40	C L. Fairhead, LMD, 03/99
41	C
42	C =====================================================================
43	C
44	C Declarations
45	#include "dimensions.h"
46	#include "paramet.h"
47	#include "comconst.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 "serre.h"
55	#include "iniprint.h"
56
57	C Arguments
58	C
59	character() infile
60	real tstep, t_ops, t_wrt
61	integer fileid, filevid,filedid
62
63	#ifdef CPP_IOIPSL
64	! This routine needs IOIPSL
65	C Variables locales
66	C
67	real nivd(1)
68	integer tau0
69	real zjulian
70	character*3 str
71	character*10 ctrac
72	integer iq
73	real rlong(iip1,jjp1), rlat(iip1,jjp1),rl(1,1)
74	integer uhoriid, vhoriid, thoriid, zvertiid,dhoriid,dvertiid
75	integer ii,jj
76	integer zan, idayref
77	logical ok_sync
78	integer :: jjb,jje,jjn
79
80	! definition du domaine d'ecriture pour le rebuild
81
82	INTEGER,DIMENSION(2) :: ddid
83	INTEGER,DIMENSION(2) :: dsg
84	INTEGER,DIMENSION(2) :: dsl
85	INTEGER,DIMENSION(2) :: dpf
86	INTEGER,DIMENSION(2) :: dpl
87	INTEGER,DIMENSION(2) :: dhs
88	INTEGER,DIMENSION(2) :: dhe
89
90	INTEGER :: dynu_domain_id
91	INTEGER :: dynv_domain_id
92
93	C
94	C Initialisations
95	C
96	pi = 4. * atan (1.)
97	str='q '
98	ctrac = 'traceur '
99	ok_sync = .true.
100	C
101	C Appel a histbeg: creation du fichier netcdf et initialisations diverses
102	C
103
104	zan = annee_ref
105	idayref = day_ref
106	CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
107	tau0 = itau_dyn
108
109	do jj = 1, jjp1
110	do ii = 1, iip1
111	rlong(ii,jj) = rlonu(ii) * 180. / pi
112	rlat(ii,jj) = rlatu(jj) * 180. / pi
113	enddo
114	enddo
115
116	jjb=jj_begin
117	jje=jj_end
118	jjn=jj_nb
119
120	ddid=(/ 1,2 /)
121	dsg=(/ iip1,jjp1 /)
122	dsl=(/ iip1,jjn /)
123	dpf=(/ 1,jjb /)
124	dpl=(/ iip1,jje /)
125	dhs=(/ 0,0 /)
126	dhe=(/ 0,0 /)
127
128	call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
129	. 'box',dynu_domain_id)
130
131	call histbeg(trim(infile),iip1, rlong(:,1), jjn, rlat(1,jjb:jje),
132	. 1, iip1, 1, jjn, tau0, zjulian, tstep, uhoriid,
133	. fileid,dynu_domain_id)
134	C
135	C Creation du fichier histoire pour la grille en V (oblige pour l'instant,
136	C IOIPSL ne permet pas de grilles avec des nombres de point differents dans
137	C un meme fichier)
138
139
140	do jj = 1, jjm
141	do ii = 1, iip1
142	rlong(ii,jj) = rlonv(ii) * 180. / pi
143	rlat(ii,jj) = rlatv(jj) * 180. / pi
144	enddo
145	enddo
146
147	jjb=jj_begin
148	jje=jj_end
149	jjn=jj_nb
150	if (pole_sud) jje=jj_end-1
151	if (pole_sud) jjn=jj_nb-1
152
153	ddid=(/ 1,2 /)
154	dsg=(/ iip1,jjm /)
155	dsl=(/ iip1,jjn /)
156	dpf=(/ 1,jjb /)
157	dpl=(/ iip1,jje /)
158	dhs=(/ 0,0 /)
159	dhe=(/ 0,0 /)
160
161	call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
162	. 'box',dynv_domain_id)
163
164	call histbeg('fluxstokev',iip1, rlong(:,1), jjn, rlat(1,jjb:jje),
165	. 1, iip1, 1, jjn,tau0, zjulian, tstep, vhoriid,
166	. filevid,dynv_domain_id)
167
168	rl(1,1) = 1.
169
170	if (mpi_rank==0) then
171
172	call histbeg('defstoke.nc', 1, rl, 1, rl,
173	. 1, 1, 1, 1,
174	. tau0, zjulian, tstep, dhoriid, filedid)
175
176	endif
177	C
178	C Appel a histhori pour rajouter les autres grilles horizontales
179	C
180	do jj = 1, jjp1
181	do ii = 1, iip1
182	rlong(ii,jj) = rlonv(ii) * 180. / pi
183	rlat(ii,jj) = rlatu(jj) * 180. / pi
184	enddo
185	enddo
186
187	jjb=jj_begin
188	jje=jj_end
189	jjn=jj_nb
190
191	call histhori(fileid, iip1, rlong(:,jjb:jje),jjn,rlat(:,jjb:jje),
192	. 'scalar','Grille points scalaires', thoriid)
193
194	C
195	C Appel a histvert pour la grille verticale
196	C
197	call histvert(fileid, 'sig_s', 'Niveaux sigma',
198	. 'sigma_level',
199	. llm, nivsigs, zvertiid)
200	C Pour le fichier V
201	call histvert(filevid, 'sig_s', 'Niveaux sigma',
202	. 'sigma_level',
203	. llm, nivsigs, zvertiid)
204	c pour le fichier def
205	nivd(1) = 1
206	call histvert(filedid, 'sig_s', 'Niveaux sigma',
207	. 'sigma_level',
208	. 1, nivd, dvertiid)
209
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	call histend(filedid)
285	if (ok_sync) then
286	call histsync(fileid)
287	call histsync(filevid)
288	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