GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: dyn3d_common/inithist.F Lines: 0 34 0.0 %
Date: 2023-06-30 12:51:15 Branches: 0 24 0.0 %

Line Branch Exec Source
1
!
2
! $Id: inithist.F 4046 2021-12-15 22:18:49Z dcugnet $
3
!
4
      subroutine inithist(day0,anne0,tstep,t_ops,t_wrt)
5
6
#ifdef CPP_IOIPSL
7
       USE IOIPSL
8
#endif
9
       USE infotrac, ONLY : nqtot
10
       use com_io_dyn_mod, only : histid,histvid,histuid,               &
11
     &                        dynhist_file,dynhistv_file,dynhistu_file
12
       USE comconst_mod, ONLY: pi
13
       USE comvert_mod, ONLY: presnivs
14
       USE temps_mod, ONLY: itau_dyn
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      nq: nombre de traceurs
36
C
37
C
38
C   L. Fairhead, LMD, 03/99
39
C
40
C =====================================================================
41
C
42
C   Declarations
43
      include "dimensions.h"
44
      include "paramet.h"
45
      include "comgeom.h"
46
      include "description.h"
47
      include "iniprint.h"
48
49
C   Arguments
50
C
51
      integer day0, anne0
52
      real tstep, t_ops, t_wrt
53
54
#ifdef CPP_IOIPSL
55
! This routine needs IOIPSL to work
56
C   Variables locales
57
C
58
      integer tau0
59
      real zjulian
60
      integer iq
61
      real rlong(iip1,jjp1), rlat(iip1,jjp1)
62
      integer uhoriid, vhoriid, thoriid, zvertiid
63
      integer ii,jj
64
      integer zan, dayref
65
C
66
C  Initialisations
67
C
68
      pi = 4. * atan (1.)
69
C
70
C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
71
C
72
73
      zan = anne0
74
      dayref = day0
75
      CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
76
      tau0 = itau_dyn
77
78
! -------------------------------------------------------------
79
! Creation des 3 fichiers pour les grilles horizontales U,V,Scal
80
! -------------------------------------------------------------
81
!Grille U
82
      do jj = 1, jjp1
83
        do ii = 1, iip1
84
          rlong(ii,jj) = rlonu(ii) * 180. / pi
85
          rlat(ii,jj) = rlatu(jj) * 180. / pi
86
        enddo
87
      enddo
88
89
      call histbeg(dynhistu_file, iip1, rlong(:,1), jjp1, rlat(1,:),
90
     .             1, iip1, 1, jjp1,
91
     .             tau0, zjulian, tstep, uhoriid, histuid)
92
93
! Grille V
94
      do jj = 1, jjm
95
        do ii = 1, iip1
96
          rlong(ii,jj) = rlonv(ii) * 180. / pi
97
          rlat(ii,jj) = rlatv(jj) * 180. / pi
98
        enddo
99
      enddo
100
101
      call histbeg(dynhistv_file, iip1, rlong(:,1), jjm, rlat(1,:),
102
     .             1, iip1, 1, jjm,
103
     .             tau0, zjulian, tstep, vhoriid, histvid)
104
105
!Grille Scalaire
106
      do jj = 1, jjp1
107
        do ii = 1, iip1
108
          rlong(ii,jj) = rlonv(ii) * 180. / pi
109
          rlat(ii,jj) = rlatu(jj) * 180. / pi
110
        enddo
111
      enddo
112
113
      call histbeg(dynhist_file, iip1, rlong(:,1), jjp1, rlat(1,:),
114
     .             1, iip1, 1, jjp1,
115
     .             tau0, zjulian, tstep, thoriid, histid)
116
! -------------------------------------------------------------
117
C  Appel a histvert pour la grille verticale
118
! -------------------------------------------------------------
119
      call histvert(histid, 'presnivs', 'Niveaux pression','mb',
120
     .              llm, presnivs/100., zvertiid,'down')
121
      call histvert(histvid, 'presnivs', 'Niveaux pression','mb',
122
     .              llm, presnivs/100., zvertiid,'down')
123
      call histvert(histuid, 'presnivs', 'Niveaux pression','mb',
124
     .              llm, presnivs/100., zvertiid,'down')
125
C
126
! -------------------------------------------------------------
127
C  Appels a histdef pour la definition des variables a sauvegarder
128
! -------------------------------------------------------------
129
C
130
C  Vents U
131
C
132
      call histdef(histuid, 'u', 'vent u', 'm/s',
133
     .             iip1, jjp1, uhoriid, llm, 1, llm, zvertiid,
134
     .             32, 'inst(X)', t_ops, t_wrt)
135
C
136
C  Vents V
137
C
138
      call histdef(histvid, 'v', 'vent v', 'm/s',
139
     .             iip1, jjm, vhoriid, llm, 1, llm, zvertiid,
140
     .             32, 'inst(X)', t_ops, t_wrt)
141
142
C
143
C  Temperature potentielle
144
C
145
      call histdef(histid, 'teta', 'temperature potentielle', '-',
146
     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
147
     .             32, 'inst(X)', t_ops, t_wrt)
148
C
149
C  Geopotentiel
150
C
151
      call histdef(histid, 'phi', 'geopotentiel', '-',
152
     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
153
     .             32, 'inst(X)', t_ops, t_wrt)
154
C
155
C  Traceurs
156
C
157
!
158
!        DO iq=1,nqtot
159
!          call histdef(histid, tracers(iq)%name,
160
!                               tracers(iq)%longName, '-',
161
!     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
162
!     .             32, 'inst(X)', t_ops, t_wrt)
163
!        enddo
164
!C
165
C  Masse
166
C
167
      call histdef(histid, 'masse', 'masse', 'kg',
168
     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
169
     .             32, 'inst(X)', t_ops, t_wrt)
170
C
171
C  Pression au sol
172
C
173
      call histdef(histid, 'ps', 'pression naturelle au sol', 'Pa',
174
     .             iip1, jjp1, thoriid, 1, 1, 1, -99,
175
     .             32, 'inst(X)', t_ops, t_wrt)
176
C
177
C  Geopotentiel au sol
178
!C
179
!      call histdef(histid, 'phis', 'geopotentiel au sol', '-',
180
!     .             iip1, jjp1, thoriid, 1, 1, 1, -99,
181
!     .             32, 'inst(X)', t_ops, t_wrt)
182
!C
183
C  Fin
184
C
185
      call histend(histid)
186
      call histend(histuid)
187
      call histend(histvid)
188
#else
189
! tell the user this routine should be run with ioipsl
190
      write(lunout,*)"inithist: Warning this routine should not be",
191
     &               " used without ioipsl"
192
#endif
193
! of #ifdef CPP_IOIPSL
194
      return
195
      end