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