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