LMDZ
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_lmdz
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
itau_dyn
!$Id && itau_dyn
Definition: temps.h:15
ymds2ju
!$Id zjulian!correction pour l heure initiale!jyg!jyg CALL ymds2ju(annee_ref, 1, day_ref, hour, zjulian)!jyg CALL histbeg_phy("histrac"
initfluxsto_p
subroutine initfluxsto_p(infile, tstep, t_ops, t_wrt, fileid, filevid, filedid)
Definition: initfluxsto_p.F:7
parallel_lmdz::mpi_rank
integer, save mpi_rank
Definition: parallel_lmdz.F90:18
parallel_lmdz::jj_end
integer, save jj_end
Definition: parallel_lmdz.F90:20
parallel_lmdz::mpi_size
integer, save mpi_size
Definition: parallel_lmdz.F90:17
parallel_lmdz::jj_begin
integer, save jj_begin
Definition: parallel_lmdz.F90:19
parallel_lmdz::pole_sud
logical, save pole_sud
Definition: parallel_lmdz.F90:25
llm
!$Id Turb_fcg_gcssold get_uvd hqturb_gcssold endif!large scale llm day day1 day day1 *dt_toga endif!time annee_ref dt_toga u_toga vq_toga w_prof vq_prof llm day day1 day day1 *dt_dice endif!time annee_ref dt_dice swup_dice vg_dice omega_dice tg_prof vg_profd w_profd omega_profd!do llm!print llm l llm
Definition: 1D_interp_cases.h:103
pi
!$Id mode_top_bound COMMON comconstr && pi
Definition: comconst.h:7
rlatu
!$Header!CDK comgeom COMMON comgeom rlatu
Definition: comgeom.h:25
misc_mod
Definition: misc_mod.F90:1
nivsigs
!$Id nivsigs(llm)
histvert
!$Id zjulian!correction pour l heure initiale!jyg!jyg CALL nid_tra CALL histvert(nid_tra,"presnivs","Vertical levels","Pa", klev, presnivs, nvert,"down") zsto
day_ref
!$Id day_ref
Definition: temps.h:15
parallel_lmdz
Definition: parallel_lmdz.F90:4
jjp1
!$Header jjp1
Definition: paramet.h:14
rlonu
!$Header!CDK comgeom COMMON comgeom rlonu
Definition: comgeom.h:25
rlatv
!$Header!CDK comgeom COMMON comgeom rlatv
Definition: comgeom.h:25
write_field
Definition: write_field.F90:4
parallel_lmdz::jj_nb
integer, save jj_nb
Definition: parallel_lmdz.F90:21
true
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
Definition: calcul_STDlev.h:139
histbeg
c c zjulian c cym CALL iim cym klev iim cym jjmp1 cym On stoke le fichier bilKP instantanne s jmax_ins print On stoke le fichier bilKP instantanne s s cym cym nid_bilKPins ENDIF c cIM BEG c cIM cf AM BEG region cym CALL histbeg("histbilKP_ins", iim, zx_lon(:, 1), cym.jjmp1, zx_lat(1,:), cym.imin_ins, imax_ins-imin_ins+1, cym.jmin_ins, jmax_ins-jmin_ins+1, cym.itau_phy, zjulian, dtime, cym.nhori, nid_bilKPins) CALL histbeg_phy("histbilKP_ins"
annee_ref
!$Id annee_ref
Definition: temps.h:15
lunout
!$Header!gestion des impressions de sorties et de débogage la sortie standard prt_level COMMON comprint lunout
Definition: iniprint.h:7
rlonv
!$Header!CDK comgeom COMMON comgeom rlonv
Definition: comgeom.h:25