Context Navigation

inithist_loc.F @ 5435

Last change on this file since 5435 was 4368, checked in by lguez, 2 years ago
Sync latest trunk changes to Ocean_skin
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 com_io_dyn_mod, only : histid,histvid,histuid, &
14	& dynhist_file,dynhistv_file,dynhistu_file
15	USE comconst_mod, ONLY: pi
16	USE comvert_mod, ONLY: presnivs
17	USE temps_mod, ONLY: 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 day0,anne0: date de reference
34	C tstep: duree du pas de temps en seconde
35	C t_ops: frequence de l'operation pour IOIPSL
36	C t_wrt: frequence d'ecriture sur le fichier
37	C nq: nombre de traceurs
38	C
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 "comgeom.h"
48	include "description.h"
49	include "iniprint.h"
50
51	C Arguments
52	C
53	integer day0, anne0
54	real tstep, t_ops, t_wrt
55
56	#ifdef CPP_IOIPSL
57	! This routine needs IOIPSL
58	C Variables locales
59	C
60	integer tau0
61	real zjulian
62	integer iq
63	real rlong(iip1,jjp1), rlat(iip1,jjp1)
64	integer uhoriid, vhoriid, thoriid
65	integer zvertiid,zvertiidv,zvertiidu
66	integer ii,jj
67	integer zan, dayref
68	integer :: jjb,jje,jjn
69
70	! definition du domaine d'ecriture pour le rebuild
71
72	INTEGER,DIMENSION(2) :: ddid
73	INTEGER,DIMENSION(2) :: dsg
74	INTEGER,DIMENSION(2) :: dsl
75	INTEGER,DIMENSION(2) :: dpf
76	INTEGER,DIMENSION(2) :: dpl
77	INTEGER,DIMENSION(2) :: dhs
78	INTEGER,DIMENSION(2) :: dhe
79
80	INTEGER :: dynhist_domain_id
81	INTEGER :: dynhistv_domain_id
82	INTEGER :: dynhistu_domain_id
83
84	if (adjust) return
85
86	C
87	C Initialisations
88	C
89	pi = 4. * atan (1.)
90	C
91	C Appel a histbeg: creation du fichier netcdf et initialisations diverses
92	C
93
94	zan = anne0
95	dayref = day0
96	CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
97	tau0 = itau_dyn
98
99	do jj = 1, jjp1
100	do ii = 1, iip1
101	rlong(ii,jj) = rlonv(ii) * 180. / pi
102	rlat(ii,jj) = rlatu(jj) * 180. / pi
103	enddo
104	enddo
105
106
107	! Creation de 3 fichiers pour les differentes grilles horizontales
108	! Restriction de IOIPSL: seulement 2 coordonnees dans le meme fichier
109	! Grille Scalaire
110
111	jjb=jj_begin
112	jje=jj_end
113	jjn=jj_nb
114
115	ddid=(/ 1,2 /)
116	dsg=(/ iip1,jjp1 /)
117	dsl=(/ iip1,jjn /)
118	dpf=(/ 1,jjb /)
119	dpl=(/ iip1,jje /)
120	dhs=(/ 0,0 /)
121	dhe=(/ 0,0 /)
122
123
124	call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
125	. 'box',dynhist_domain_id)
126
127	call histbeg(dynhist_file,iip1, rlong(:,1), jjn,
128	. rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0,
129	. zjulian, tstep, thoriid,
130	. histid,dynhist_domain_id)
131
132
133	C Creation du fichier histoire pour les grilles en V et U (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	! Grille V
137
138	jjb=jj_begin
139	jje=jj_end
140	jjn=jj_nb
141	IF (pole_sud) jjn=jjn-1
142	IF (pole_sud) jje=jje-1
143
144	do jj = jjb, jje
145	do ii = 1, iip1
146	rlong(ii,jj) = rlonv(ii) * 180. / pi
147	rlat(ii,jj) = rlatv(jj) * 180. / pi
148	enddo
149	enddo
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
160	call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
161	. 'box',dynhistv_domain_id)
162
163	call histbeg(dynhistv_file,iip1, rlong(:,1), jjn,
164	. rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0,
165	. zjulian, tstep, vhoriid,
166	. histvid,dynhistv_domain_id)
167
168	! Grille U
169
170	do jj = 1, jjp1
171	do ii = 1, iip1
172	rlong(ii,jj) = rlonu(ii) * 180. / pi
173	rlat(ii,jj) = rlatu(jj) * 180. / pi
174	enddo
175	enddo
176
177	jjb=jj_begin
178	jje=jj_end
179	jjn=jj_nb
180
181	ddid=(/ 1,2 /)
182	dsg=(/ iip1,jjp1 /)
183	dsl=(/ iip1,jjn /)
184	dpf=(/ 1,jjb /)
185	dpl=(/ iip1,jje /)
186	dhs=(/ 0,0 /)
187	dhe=(/ 0,0 /)
188
189
190	call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
191	. 'box',dynhistu_domain_id)
192
193	call histbeg(dynhistu_file,iip1, rlong(:,1), jjn,
194	. rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0,
195	. zjulian, tstep, uhoriid,
196	. histuid,dynhistu_domain_id)
197
198
199	! -------------------------------------------------------------
200	C Appel a histvert pour la grille verticale
201	! -------------------------------------------------------------
202	call histvert(histid, 'presnivs', 'Niveaux pression','mb',
203	. llm, presnivs/100., zvertiid,'down')
204	call histvert(histvid, 'presnivs', 'Niveaux pression','mb',
205	. llm, presnivs/100., zvertiidv,'down')
206	call histvert(histuid, 'presnivs', 'Niveaux pression','mb',
207	. llm, presnivs/100., zvertiidu,'down')
208
209	C
210	! -------------------------------------------------------------
211	C Appels a histdef pour la definition des variables a sauvegarder
212	! -------------------------------------------------------------
213	C
214	C Vents U
215	C
216	jjn=jj_nb
217	call histdef(histuid, 'u', 'vent u',
218	. 'm/s', iip1, jjn, uhoriid, llm, 1, llm, zvertiidu,
219	. 32, 'inst(X)', t_ops, t_wrt)
220
221	C
222	C Vents V
223	C
224	if (pole_sud) jjn=jj_nb-1
225	call histdef(histvid, 'v', 'vent v',
226	. 'm/s', iip1, jjn, vhoriid, llm, 1, llm, zvertiidv,
227	. 32, 'inst(X)', t_ops, t_wrt)
228
229	C
230	C Temperature
231	C
232	jjn=jj_nb
233	call histdef(histid, 'temp', 'temperature', 'K',
234	. iip1, jjn, thoriid, llm, 1, llm, zvertiid,
235	. 32, 'inst(X)', t_ops, t_wrt)
236	C
237	C Temperature potentielle
238	C
239	call histdef(histid, 'theta', 'temperature potentielle', 'K',
240	. iip1, jjn, thoriid, llm, 1, llm, zvertiid,
241	. 32, 'inst(X)', t_ops, t_wrt)
242
243
244	C
245	C Geopotentiel
246	C
247	call histdef(histid, 'phi', 'geopotentiel', '-',
248	. iip1, jjn, thoriid, llm, 1, llm, zvertiid,
249	. 32, 'inst(X)', t_ops, t_wrt)
250	C
251	C Traceurs
252	C
253	! DO iq=1,nqtot
254	! call histdef(histid, tracers(iq)%name,
255	! . tracers(iq)%longName, '-',
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