Context Navigation

initfluxsto_p.F @ 1583

Last change on this file since 1583 was 1279, checked in by Laurent Fairhead, 16 years ago
Merged LMDZ4-dev branch changes r1241:1278 into the trunk Running trunk and LMDZ4-dev in LMDZOR configuration on local machine (sequential) and SX8 (4-proc) yields identical results (restart and restartphy are identical binarily) Log history from r1241 to r1278 is available by switching to source:LMDZ4/branches/LMDZ4-dev-20091210
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 1279 2009-12-10 09:02:56Z jghattas $
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