My Project
 All Classes Files Functions Variables Macros
initfluxsto.F
Go to the documentation of this file.
1 !
2 ! $Id: initfluxsto.F 1279 2009-12-10 09:02:56Z fairhead $
3 !
4  subroutine initfluxsto
5  . (infile,tstep,t_ops,t_wrt,
6  . fileid,filevid,filedid)
7 
8 #ifdef CPP_IOIPSL
9  USE ioipsl
10 #endif
11  implicit none
12 
13 C
14 C Routine d'initialisation des ecritures des fichiers histoires LMDZ
15 C au format IOIPSL
16 C
17 C Appels succesifs des routines: histbeg
18 C histhori
19 C histver
20 C histdef
21 C histend
22 C
23 C Entree:
24 C
25 C infile: nom du fichier histoire a creer
26 C day0,anne0: date de reference
27 C tstep: duree du pas de temps en seconde
28 C t_ops: frequence de l'operation pour IOIPSL
29 C t_wrt: frequence d'ecriture sur le fichier
30 C
31 C Sortie:
32 C fileid: ID du fichier netcdf cree
33 C filevid:ID du fichier netcdf pour la grille v
34 C
35 C L. Fairhead, LMD, 03/99
36 C
37 C =====================================================================
38 C
39 C Declarations
40 #include "dimensions.h"
41 #include "paramet.h"
42 #include "comconst.h"
43 #include "comvert.h"
44 #include "comgeom.h"
45 #include "temps.h"
46 #include "ener.h"
47 #include "logic.h"
48 #include "description.h"
49 #include "serre.h"
50 #include "iniprint.h"
51 
52 C Arguments
53 C
54  character*(*) infile
55  real tstep, t_ops, t_wrt
56  integer fileid, filevid,filedid
57 
58 #ifdef CPP_IOIPSL
59 ! This routine needs IOIPSL to work
60 C Variables locales
61 C
62  real nivd(1)
63  integer tau0
64  real zjulian
65  character*3 str
66  character*10 ctrac
67  integer iq
68  real rlong(iip1,jjp1), rlat(iip1,jjp1),rl(1,1)
69  integer uhoriid, vhoriid, thoriid, zvertiid,dhoriid,dvertiid
70  integer ii,jj
71  integer zan, idayref
72  logical ok_sync
73 C
74 C Initialisations
75 C
76  pi = 4. * atan(1.)
77  str='q '
78  ctrac = 'traceur '
79  ok_sync = .true.
80 C
81 C Appel a histbeg: creation du fichier netcdf et initialisations diverses
82 C
83 
84  zan = annee_ref
85  idayref = day_ref
86  CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
87  tau0 = itau_dyn
88 
89  do jj = 1, jjp1
90  do ii = 1, iip1
91  rlong(ii,jj) = rlonu(ii) * 180. / pi
92  rlat(ii,jj) = rlatu(jj) * 180. / pi
93  enddo
94  enddo
95 
96  call histbeg(infile, iip1, rlong(:,1), jjp1, rlat(1,:),
97  . 1, iip1, 1, jjp1,
98  . tau0, zjulian, tstep, uhoriid, fileid)
99 C
100 C Creation du fichier histoire pour la grille en V (oblige pour l'instant,
101 C IOIPSL ne permet pas de grilles avec des nombres de point differents dans
102 C un meme fichier)
103 
104 
105  do jj = 1, jjm
106  do ii = 1, iip1
107  rlong(ii,jj) = rlonv(ii) * 180. / pi
108  rlat(ii,jj) = rlatv(jj) * 180. / pi
109  enddo
110  enddo
111 
112  call histbeg('fluxstokev.nc', iip1, rlong(:,1), jjm, rlat(1,:),
113  . 1, iip1, 1, jjm,
114  . tau0, zjulian, tstep, vhoriid, filevid)
115 
116  rl(1,1) = 1.
117  call histbeg('defstoke.nc', 1, rl, 1, rl,
118  . 1, 1, 1, 1,
119  . tau0, zjulian, tstep, dhoriid, filedid)
120 
121 C
122 C Appel a histhori pour rajouter les autres grilles horizontales
123 C
124  do jj = 1, jjp1
125  do ii = 1, iip1
126  rlong(ii,jj) = rlonv(ii) * 180. / pi
127  rlat(ii,jj) = rlatu(jj) * 180. / pi
128  enddo
129  enddo
130 
131  call histhori(fileid, iip1, rlong, jjp1, rlat, 'scalar',
132  . 'Grille points scalaires', thoriid)
133 
134 C
135 C Appel a histvert pour la grille verticale
136 C
137  call histvert(fileid, 'sig_s', 'Niveaux sigma',
138  . 'sigma_level',
139  . llm, nivsigs, zvertiid)
140 C Pour le fichier V
141  call histvert(filevid, 'sig_s', 'Niveaux sigma',
142  . 'sigma_level',
143  . llm, nivsigs, zvertiid)
144 c pour le fichier def
145  nivd(1) = 1
146  call histvert(filedid, 'sig_s', 'Niveaux sigma',
147  . 'sigma_level',
148  . 1, nivd, dvertiid)
149 
150 C
151 C Appels a histdef pour la definition des variables a sauvegarder
152 
153  CALL histdef(fileid, "phis", "Surface geop. height", "-",
154  . iip1,jjp1,thoriid, 1,1,1, -99, 32,
155  . "once", t_ops, t_wrt)
156 
157  CALL histdef(fileid, "aire", "Grid area", "-",
158  . iip1,jjp1,thoriid, 1,1,1, -99, 32,
159  . "once", t_ops, t_wrt)
160 
161  CALL histdef(filedid, "dtvr", "tps dyn", "s",
162  . 1,1,dhoriid, 1,1,1, -99, 32,
163  . "once", t_ops, t_wrt)
164 
165  CALL histdef(filedid, "istdyn", "tps stock", "s",
166  . 1,1,dhoriid, 1,1,1, -99, 32,
167  . "once", t_ops, t_wrt)
168 
169  CALL histdef(filedid, "istphy", "tps stock phy", "s",
170  . 1,1,dhoriid, 1,1,1, -99, 32,
171  . "once", t_ops, t_wrt)
172 
173 
174 C
175 C Masse
176 C
177  call histdef(fileid, 'masse', 'Masse', 'kg',
178  . iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
179  . 32, 'inst(X)', t_ops, t_wrt)
180 C
181 C Pbaru
182 C
183  call histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s',
184  . iip1, jjp1, uhoriid, llm, 1, llm, zvertiid,
185  . 32, 'inst(X)', t_ops, t_wrt)
186 
187 C
188 C Pbarv
189 C
190  call histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s',
191  . iip1, jjm, vhoriid, llm, 1, llm, zvertiid,
192  . 32, 'inst(X)', t_ops, t_wrt)
193 C
194 C w
195 C
196  call histdef(fileid, 'w', 'flx de masse vert', 'kg m/s',
197  . iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
198  . 32, 'inst(X)', t_ops, t_wrt)
199 
200 C
201 C Temperature potentielle
202 C
203  call histdef(fileid, 'teta', 'temperature potentielle', '-',
204  . iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
205  . 32, 'inst(X)', t_ops, t_wrt)
206 C
207 
208 C
209 C Geopotentiel
210 C
211  call histdef(fileid, 'phi', 'geopotentiel instantane', '-',
212  . iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
213  . 32, 'inst(X)', t_ops, t_wrt)
214 C
215 C Fin
216 C
217  call histend(fileid)
218  call histend(filevid)
219  call histend(filedid)
220  if (ok_sync) then
221  call histsync(fileid)
222  call histsync(filevid)
223  call histsync(filedid)
224  endif
225 
226 #else
227 ! tell the user this routine should be run with ioipsl
228  write(lunout,*)"initfluxsto: Warning this routine should not be",
229  & " used without ioipsl"
230 #endif
231 ! of #ifdef CPP_IOIPSL
232  return
233  end