Context Navigation

inithist_loc.F @ 3761

Last change on this file since 3761 was 2622, checked in by Ehouarn Millour, 8 years ago
Some code tidying: turn ener.h into ener_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.6 KB

Line
1	!
2	! $Id: initdynav_p.F 1279 2009-12-10 09:02:56Z fairhead $
3	!
4	subroutine inithist_loc(day0,anne0,tstep,t_ops,t_wrt)
5
6	#ifdef CPP_IOIPSL
7	! This routine needs IOIPSL
8	USE IOIPSL
9	#endif
10	USE parallel_lmdz
11	use Write_field
12	use misc_mod
13	USE infotrac
14	use com_io_dyn_mod, only : histid,histvid,histuid, &
15	& dynhist_file,dynhistv_file,dynhistu_file
16	USE comconst_mod, ONLY: pi
17	USE comvert_mod, ONLY: presnivs
18	USE temps_mod, ONLY: itau_dyn
19
20	implicit none
21
22	C
23	C Routine d'initialisation des ecritures des fichiers histoires LMDZ
24	C au format IOIPSL
25	C
26	C Appels succesifs des routines: histbeg
27	C histhori
28	C histver
29	C histdef
30	C histend
31	C
32	C Entree:
33	C
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 nq: nombre de traceurs
39	C
40	C
41	C L. Fairhead, LMD, 03/99
42	C
43	C =====================================================================
44	C
45	C Declarations
46	include "dimensions.h"
47	include "paramet.h"
48	include "comgeom.h"
49	include "description.h"
50	include "iniprint.h"
51
52	C Arguments
53	C
54	integer day0, anne0
55	real tstep, t_ops, t_wrt
56
57	#ifdef CPP_IOIPSL
58	! This routine needs IOIPSL
59	C Variables locales
60	C
61	integer tau0
62	real zjulian
63	integer iq
64	real rlong(iip1,jjp1), rlat(iip1,jjp1)
65	integer uhoriid, vhoriid, thoriid
66	integer zvertiid,zvertiidv,zvertiidu
67	integer ii,jj
68	integer zan, dayref
69	integer :: jjb,jje,jjn
70
71	! definition du domaine d'ecriture pour le rebuild
72
73	INTEGER,DIMENSION(2) :: ddid
74	INTEGER,DIMENSION(2) :: dsg
75	INTEGER,DIMENSION(2) :: dsl
76	INTEGER,DIMENSION(2) :: dpf
77	INTEGER,DIMENSION(2) :: dpl
78	INTEGER,DIMENSION(2) :: dhs
79	INTEGER,DIMENSION(2) :: dhe
80
81	INTEGER :: dynhist_domain_id
82	INTEGER :: dynhistv_domain_id
83	INTEGER :: dynhistu_domain_id
84
85	if (adjust) return
86
87	C
88	C Initialisations
89	C
90	pi = 4. * atan (1.)
91	C
92	C Appel a histbeg: creation du fichier netcdf et initialisations diverses
93	C
94
95	zan = anne0
96	dayref = day0
97	CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
98	tau0 = itau_dyn
99
100	do jj = 1, jjp1
101	do ii = 1, iip1
102	rlong(ii,jj) = rlonv(ii) * 180. / pi
103	rlat(ii,jj) = rlatu(jj) * 180. / pi
104	enddo
105	enddo
106
107
108	! Creation de 3 fichiers pour les differentes grilles horizontales
109	! Restriction de IOIPSL: seulement 2 coordonnees dans le meme fichier
110	! Grille Scalaire
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
125	call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
126	. 'box',dynhist_domain_id)
127
128	call histbeg(dynhist_file,iip1, rlong(:,1), jjn,
129	. rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0,
130	. zjulian, tstep, thoriid,
131	. histid,dynhist_domain_id)
132
133
134	C Creation du fichier histoire pour les grilles en V et U (oblige pour l'instant,
135	C IOIPSL ne permet pas de grilles avec des nombres de point differents dans
136	C un meme fichier)
137	! Grille V
138
139	jjb=jj_begin
140	jje=jj_end
141	jjn=jj_nb
142	IF (pole_sud) jjn=jjn-1
143	IF (pole_sud) jje=jje-1
144
145	do jj = jjb, jje
146	do ii = 1, iip1
147	rlong(ii,jj) = rlonv(ii) * 180. / pi
148	rlat(ii,jj) = rlatv(jj) * 180. / pi
149	enddo
150	enddo
151
152	ddid=(/ 1,2 /)
153	dsg=(/ iip1,jjm /)
154	dsl=(/ iip1,jjn /)
155	dpf=(/ 1,jjb /)
156	dpl=(/ iip1,jje /)
157	dhs=(/ 0,0 /)
158	dhe=(/ 0,0 /)
159
160
161	call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
162	. 'box',dynhistv_domain_id)
163
164	call histbeg(dynhistv_file,iip1, rlong(:,1), jjn,
165	. rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0,
166	. zjulian, tstep, vhoriid,
167	. histvid,dynhistv_domain_id)
168
169	! Grille U
170
171	do jj = 1, jjp1
172	do ii = 1, iip1
173	rlong(ii,jj) = rlonu(ii) * 180. / pi
174	rlat(ii,jj) = rlatu(jj) * 180. / pi
175	enddo
176	enddo
177
178	jjb=jj_begin
179	jje=jj_end
180	jjn=jj_nb
181
182	ddid=(/ 1,2 /)
183	dsg=(/ iip1,jjp1 /)
184	dsl=(/ iip1,jjn /)
185	dpf=(/ 1,jjb /)
186	dpl=(/ iip1,jje /)
187	dhs=(/ 0,0 /)
188	dhe=(/ 0,0 /)
189
190
191	call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
192	. 'box',dynhistu_domain_id)
193
194	call histbeg(dynhistu_file,iip1, rlong(:,1), jjn,
195	. rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0,
196	. zjulian, tstep, uhoriid,
197	. histuid,dynhistu_domain_id)
198
199
200	! -------------------------------------------------------------
201	C Appel a histvert pour la grille verticale
202	! -------------------------------------------------------------
203	call histvert(histid, 'presnivs', 'Niveaux pression','mb',
204	. llm, presnivs/100., zvertiid,'down')
205	call histvert(histvid, 'presnivs', 'Niveaux pression','mb',
206	. llm, presnivs/100., zvertiidv,'down')
207	call histvert(histuid, 'presnivs', 'Niveaux pression','mb',
208	. llm, presnivs/100., zvertiidu,'down')
209
210	C
211	! -------------------------------------------------------------
212	C Appels a histdef pour la definition des variables a sauvegarder
213	! -------------------------------------------------------------
214	C
215	C Vents U
216	C
217	jjn=jj_nb
218	call histdef(histuid, 'u', 'vent u',
219	. 'm/s', iip1, jjn, uhoriid, llm, 1, llm, zvertiidu,
220	. 32, 'inst(X)', t_ops, t_wrt)
221
222	C
223	C Vents V
224	C
225	if (pole_sud) jjn=jj_nb-1
226	call histdef(histvid, 'v', 'vent v',
227	. 'm/s', iip1, jjn, vhoriid, llm, 1, llm, zvertiidv,
228	. 32, 'inst(X)', t_ops, t_wrt)
229
230	C
231	C Temperature
232	C
233	jjn=jj_nb
234	call histdef(histid, 'temp', 'temperature', 'K',
235	. iip1, jjn, thoriid, llm, 1, llm, zvertiid,
236	. 32, 'inst(X)', t_ops, t_wrt)
237	C
238	C Temperature potentielle
239	C
240	call histdef(histid, 'theta', 'temperature potentielle', 'K',
241	. iip1, jjn, thoriid, llm, 1, llm, zvertiid,
242	. 32, 'inst(X)', t_ops, t_wrt)
243
244
245	C
246	C Geopotentiel
247	C
248	call histdef(histid, 'phi', 'geopotentiel', '-',
249	. iip1, jjn, thoriid, llm, 1, llm, zvertiid,
250	. 32, 'inst(X)', t_ops, t_wrt)
251	C
252	C Traceurs
253	C
254	! DO iq=1,nqtot
255	! call histdef(histid, ttext(iq), ttext(iq), '-',
256	! . iip1, jjn, thoriid, llm, 1, llm, zvertiid,
257	! . 32, 'inst(X)', t_ops, t_wrt)
258	! enddo
259	C
260	C Masse
261	C
262	call histdef(histid, 'masse', 'masse', 'kg',
263	. iip1, jjn, thoriid, llm, 1, llm, zvertiid,
264	. 32, 'inst(X)', t_ops, t_wrt)
265	C
266	C Pression au sol
267	C
268	call histdef(histid, 'ps', 'pression naturelle au sol', 'Pa',
269	. iip1, jjn, thoriid, 1, 1, 1, -99,
270	. 32, 'inst(X)', t_ops, t_wrt)
271	C
272	C Geopotentiel au sol
273	C
274	! call histdef(histid, 'phis', 'geopotentiel au sol', '-',
275	! . iip1, jjn, thoriid, 1, 1, 1, -99,
276	! . 32, 'inst(X)', t_ops, t_wrt)
277	C
278	C Fin
279	C
280	call histend(histid)
281	call histend(histuid)
282	call histend(histvid)
283	#else
284	write(lunout,*)'inithist_loc: Needs IOIPSL to function'
285	#endif
286	! #endif of #ifdef CPP_IOIPSL
287	end

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

Download in other formats:

Original Format