GCC Code Coverage Report


Directory: ./
File: dyn3d_common/initfluxsto.f
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 45 0.0%
Branches: 0 16 0.0%

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