Context Navigation

initfluxsto_p.F @ 3093

Last change on this file since 3093 was 1422, checked in by milmd, 10 years ago
In GENERIC, MARS and COMMON models replace some include files by modules (usefull for decoupling physics with dynamics).
File size: 7.7 KB

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

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

Download in other formats:

Original Format