My Project
 All Classes Files Functions Variables Macros
inithist_p.F
Go to the documentation of this file.
1 !
2 ! $Id: inithist_p.F 1279 2009-12-10 09:02:56Z fairhead $
3 !
4  subroutine inithist_p(infile,day0,anne0,tstep,t_ops,t_wrt,
5  . fileid,filevid)
6 
7 #ifdef CPP_IOIPSL
8 ! This routine needs IOIPSL
9  USE ioipsl
10 #endif
11  use parallel
12  use write_field
13  use misc_mod
14  USE infotrac
15 
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 infile: nom du fichier histoire a creer
31 C day0,anne0: date de reference
32 C tstep: duree du pas de temps en seconde
33 C t_ops: frequence de l'operation pour IOIPSL
34 C t_wrt: frequence d'ecriture sur le fichier
35 C
36 C Sortie:
37 C fileid: ID du fichier netcdf cree
38 C filevid:ID du fichier netcdf pour la grille v
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 "comconst.h"
48 #include "comvert.h"
49 #include "comgeom.h"
50 #include "temps.h"
51 #include "ener.h"
52 #include "logic.h"
53 #include "description.h"
54 #include "serre.h"
55 #include "iniprint.h"
56 
57 C Arguments
58 C
59  character*(*) infile
60  integer*4 day0, anne0
61  real tstep, t_ops, t_wrt
62  integer fileid, filevid
63 
64 #ifdef CPP_IOIPSL
65 ! This routine needs IOIPSL
66 C Variables locales
67 C
68  integer tau0
69  real zjulian
70  integer iq
71  real rlong(iip1,jjp1), rlat(iip1,jjp1)
72  integer uhoriid, vhoriid, thoriid, zvertiid
73  integer ii,jj
74  integer zan, dayref
75  integer :: jjb,jje,jjn
76 
77 ! definition du domaine d'ecriture pour le rebuild
78 
79  INTEGER,DIMENSION(2) :: ddid
80  INTEGER,DIMENSION(2) :: dsg
81  INTEGER,DIMENSION(2) :: dsl
82  INTEGER,DIMENSION(2) :: dpf
83  INTEGER,DIMENSION(2) :: dpl
84  INTEGER,DIMENSION(2) :: dhs
85  INTEGER,DIMENSION(2) :: dhe
86 
87  INTEGER :: dynu_domain_id
88  INTEGER :: dynv_domain_id
89 
90 C
91 C Initialisations
92 C
93  if (adjust) return
94 
95  pi = 4. * atan(1.)
96 C
97 C Appel a histbeg: creation du fichier netcdf et initialisations diverses
98 C
99 
100  zan = anne0
101  dayref = day0
102  CALL ymds2ju(zan, 1, dayref, 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 
117  ddid=(/ 1,2 /)
118  dsg=(/ iip1,jjp1 /)
119  dsl=(/ iip1,jjn /)
120  dpf=(/ 1,jjb /)
121  dpl=(/ iip1,jje /)
122  dhs=(/ 0,0 /)
123  dhe=(/ 0,0 /)
124 
125  call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
126  . 'box',dynu_domain_id)
127 
128  call histbeg(trim(infile),iip1, rlong(:,1), jjn,
129  . rlat(1,jjb:jje), 1, iip1, 1, jjn, tau0,
130  . zjulian, tstep, uhoriid, fileid,dynu_domain_id)
131 C
132 C Creation du fichier histoire pour la grille en V (oblige pour l'instant,
133 C IOIPSL ne permet pas de grilles avec des nombres de point differents dans
134 C un meme fichier)
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('dyn_histv', iip1, rlong(:,1), jjn, rlat(1,jjb:jje),
161  . 1, iip1, 1, jjn, tau0, zjulian, tstep, vhoriid,
162  . filevid,dynv_domain_id)
163 C
164 C Appel a histhori pour rajouter les autres grilles horizontales
165 C
166 
167  do jj = 1, jjp1
168  do ii = 1, iip1
169  rlong(ii,jj) = rlonv(ii) * 180. / pi
170  rlat(ii,jj) = rlatu(jj) * 180. / pi
171  enddo
172  enddo
173 
174  jjb=jj_begin
175  jje=jj_end
176  jjn=jj_nb
177 
178  call histhori(fileid, iip1, rlong(:,jjb:jje),jjn,rlat(:,jjb:jje),
179  . 'scalar','Grille points scalaires', thoriid)
180 C
181 C Appel a histvert pour la grille verticale
182 C
183  call histvert(fileid, 'sig_s', 'Niveaux sigma','-',
184  . llm, nivsigs, zvertiid)
185 C Pour le fichier V
186  call histvert(filevid, 'sig_s', 'Niveaux sigma','-',
187  . llm, nivsigs, zvertiid)
188 C
189 C Appels a histdef pour la definition des variables a sauvegarder
190 C
191 C Vents U
192 C
193  jjn=jj_nb
194 
195  call histdef(fileid, 'ucov', 'vents u covariants', 'm/s',
196  . iip1, jjn, uhoriid, llm, 1, llm, zvertiid,
197  . 32, 'inst(X)', t_ops, t_wrt)
198 C
199 C Vents V
200 C
201  if (pole_sud) jjn=jj_nb-1
202 
203  call histdef(filevid, 'vcov', 'vents v covariants', 'm/s',
204  . iip1, jjn, vhoriid, llm, 1, llm, zvertiid,
205  . 32, 'inst(X)', t_ops, t_wrt)
206 
207 C
208 C Temperature potentielle
209 C
210  jjn=jj_nb
211 
212  call histdef(fileid, 'teta', 'temperature potentielle', '-',
213  . iip1, jjn, thoriid, llm, 1, llm, zvertiid,
214  . 32, 'inst(X)', t_ops, t_wrt)
215 C
216 C Geopotentiel
217 C
218  call histdef(fileid, 'phi', 'geopotentiel instantane', '-',
219  . iip1, jjn, thoriid, llm, 1, llm, zvertiid,
220  . 32, 'inst(X)', t_ops, t_wrt)
221 C
222 C Traceurs
223 C
224  DO iq=1,nqtot
225  call histdef(fileid, ttext(iq), ttext(iq), '-',
226  . iip1, jjn, thoriid, llm, 1, llm, zvertiid,
227  . 32, 'inst(X)', t_ops, t_wrt)
228  enddo
229 C
230 C Masse
231 C
232  call histdef(fileid, 'masse', 'masse', 'kg',
233  . iip1, jjn, thoriid, 1, 1, 1, -99,
234  . 32, 'inst(X)', t_ops, t_wrt)
235 C
236 C Pression au sol
237 C
238  call histdef(fileid, 'ps', 'pression naturelle au sol', 'Pa',
239  . iip1, jjn, thoriid, 1, 1, 1, -99,
240  . 32, 'inst(X)', t_ops, t_wrt)
241 C
242 C Pression au sol
243 C
244  call histdef(fileid, 'phis', 'geopotentiel au sol', '-',
245  . iip1, jjn, thoriid, 1, 1, 1, -99,
246  . 32, 'inst(X)', t_ops, t_wrt)
247 C
248 C Fin
249 C
250  call histend(fileid)
251  call histend(filevid)
252 #else
253  write(lunout,*)'inithist_p: Needs IOIPSL to function'
254 #endif
255 ! #endif of #ifdef CPP_IOIPSL
256  return
257  end