Context Navigation

initfluxsto_p.F @ 1790

Last change on this file since 1790 was 1707, checked in by Laurent Fairhead, 12 years ago

Version testing basée sur la r1706

Testing release based on r1706

File size: 7.6 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
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	if (mpi_rank==0) then
206	nivd(1) = 1
207	call histvert(filedid, 'sig_s', 'Niveaux sigma',
208	. 'sigma_level',
209	. 1, nivd, dvertiid)
210	endif
211	C
212	C Appels a histdef pour la definition des variables a sauvegarder
213
214	CALL histdef(fileid, "phis", "Surface geop. height", "-",
215	. iip1,jjn,thoriid, 1,1,1, -99, 32,
216	. "once", t_ops, t_wrt)
217
218	CALL histdef(fileid, "aire", "Grid area", "-",
219	. iip1,jjn,thoriid, 1,1,1, -99, 32,
220	. "once", t_ops, t_wrt)
221
222	if (mpi_rank==0) then
223
224	CALL histdef(filedid, "dtvr", "tps dyn", "s",
225	. 1,1,dhoriid, 1,1,1, -99, 32,
226	. "once", t_ops, t_wrt)
227
228	CALL histdef(filedid, "istdyn", "tps stock", "s",
229	. 1,1,dhoriid, 1,1,1, -99, 32,
230	. "once", t_ops, t_wrt)
231
232	CALL histdef(filedid, "istphy", "tps stock phy", "s",
233	. 1,1,dhoriid, 1,1,1, -99, 32,
234	. "once", t_ops, t_wrt)
235
236	endif
237	C
238	C Masse
239	C
240	call histdef(fileid, 'masse', 'Masse', 'kg',
241	. iip1, jjn, thoriid, llm, 1, llm, zvertiid,
242	. 32, 'inst(X)', t_ops, t_wrt)
243	C
244	C Pbaru
245	C
246	call histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s',
247	. iip1, jjn, uhoriid, llm, 1, llm, zvertiid,
248	. 32, 'inst(X)', t_ops, t_wrt)
249
250	C
251	C Pbarv
252	C
253	if (pole_sud) jjn=jj_nb-1
254
255	call histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s',
256	. iip1, jjn, vhoriid, llm, 1, llm, zvertiid,
257	. 32, 'inst(X)', t_ops, t_wrt)
258	C
259	C w
260	C
261	if (pole_sud) jjn=jj_nb
262	call histdef(fileid, 'w', 'flx de masse vert', 'kg m/s',
263	. iip1, jjn, thoriid, llm, 1, llm, zvertiid,
264	. 32, 'inst(X)', t_ops, t_wrt)
265
266	C
267	C Temperature potentielle
268	C
269	call histdef(fileid, 'teta', 'temperature potentielle', '-',
270	. iip1, jjn, thoriid, llm, 1, llm, zvertiid,
271	. 32, 'inst(X)', t_ops, t_wrt)
272	C
273
274	C
275	C Geopotentiel
276	C
277	call histdef(fileid, 'phi', 'geopotentiel instantane', '-',
278	. iip1, jjn, thoriid, llm, 1, llm, zvertiid,
279	. 32, 'inst(X)', t_ops, t_wrt)
280	C
281	C Fin
282	C
283	call histend(fileid)
284	call histend(filevid)
285	if (mpi_rank==0) call histend(filedid)
286	if (ok_sync) then
287	call histsync(fileid)
288	call histsync(filevid)
289	if (mpi_rank==0) call histsync(filedid)
290	endif
291
292	#else
293	write(lunout,*)'initfluxsto_p: Needs IOIPSL to function'
294	#endif
295	! #endif of #ifdef CPP_IOIPSL
296	return
297	end

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

Download in other formats:

Original Format