Context Navigation

initfluxsto_p.F @ 2605

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

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

Download in other formats:

Original Format