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