source: LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inithist.F90 @ 5118

Last change on this file since 5118 was 5118, checked in by abarral, 4 months ago

Replace iniprint.h by lmdz_iniprint.f90
(lint) along the way

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 5.1 KB
Line 
1! $Id: inithist.F90 5118 2024-07-24 14:39:59Z abarral $
2
3SUBROUTINE inithist(day0, anne0, tstep, t_ops, t_wrt)
4
5  USE IOIPSL
6  USE infotrac, ONLY: nqtot
7  USE com_io_dyn_mod, ONLY: histid, histvid, histuid, &
8          dynhist_file, dynhistv_file, dynhistu_file
9  USE comconst_mod, ONLY: pi
10  USE comvert_mod, ONLY: presnivs
11  USE temps_mod, ONLY: itau_dyn
12  USE lmdz_description, ONLY: descript
13  USE lmdz_iniprint, ONLY: lunout, prt_level
14
15  IMPLICIT NONE
16
17  !
18  !   Routine d'initialisation des ecritures des fichiers histoires LMDZ
19  !   au format IOIPSL
20  !
21  !   Appels succesifs des routines: histbeg
22  !                              histhori
23  !                              histver
24  !                              histdef
25  !                              histend
26  !
27  !   Entree:
28  !
29  !  infile: nom du fichier histoire a creer
30  !  day0,anne0: date de reference
31  !  tstep: duree du pas de temps en seconde
32  !  t_ops: frequence de l'operation pour IOIPSL
33  !  t_wrt: frequence d'ecriture sur le fichier
34  !  nq: nombre de traceurs
35  !
36  !
37  !   L. Fairhead, LMD, 03/99
38  !
39  ! =====================================================================
40  !
41  !   Declarations
42  include "dimensions.h"
43  include "paramet.h"
44  include "comgeom.h"
45
46  !   Arguments
47  !
48  INTEGER :: day0, anne0
49  REAL :: tstep, t_ops, t_wrt
50
51  ! This routine needs IOIPSL to work
52  !   Variables locales
53  !
54  INTEGER :: tau0
55  REAL :: zjulian
56  INTEGER :: iq
57  REAL :: rlong(iip1, jjp1), rlat(iip1, jjp1)
58  INTEGER :: uhoriid, vhoriid, thoriid, zvertiid
59  INTEGER :: ii, jj
60  INTEGER :: zan, dayref
61  !
62  !  Initialisations
63  !
64  pi = 4. * atan (1.)
65  !
66  !  Appel a histbeg: creation du fichier netcdf et initialisations diverses
67  !
68
69  zan = anne0
70  dayref = day0
71  CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
72  tau0 = itau_dyn
73
74  ! -------------------------------------------------------------
75  ! Creation des 3 fichiers pour les grilles horizontales U,V,Scal
76  ! -------------------------------------------------------------
77  !Grille U
78  do jj = 1, jjp1
79    do ii = 1, iip1
80      rlong(ii, jj) = rlonu(ii) * 180. / pi
81      rlat(ii, jj) = rlatu(jj) * 180. / pi
82    enddo
83  enddo
84
85  CALL histbeg(dynhistu_file, iip1, rlong(:, 1), jjp1, rlat(1, :), &
86          1, iip1, 1, jjp1, &
87          tau0, zjulian, tstep, uhoriid, histuid)
88
89  ! Grille V
90  do jj = 1, jjm
91    do ii = 1, iip1
92      rlong(ii, jj) = rlonv(ii) * 180. / pi
93      rlat(ii, jj) = rlatv(jj) * 180. / pi
94    enddo
95  enddo
96
97  CALL histbeg(dynhistv_file, iip1, rlong(:, 1), jjm, rlat(1, :), &
98          1, iip1, 1, jjm, &
99          tau0, zjulian, tstep, vhoriid, histvid)
100
101  !Grille Scalaire
102  do jj = 1, jjp1
103    do ii = 1, iip1
104      rlong(ii, jj) = rlonv(ii) * 180. / pi
105      rlat(ii, jj) = rlatu(jj) * 180. / pi
106    enddo
107  enddo
108
109  CALL histbeg(dynhist_file, iip1, rlong(:, 1), jjp1, rlat(1, :), &
110          1, iip1, 1, jjp1, &
111          tau0, zjulian, tstep, thoriid, histid)
112  ! -------------------------------------------------------------
113  !  Appel a histvert pour la grille verticale
114  ! -------------------------------------------------------------
115  CALL histvert(histid, 'presnivs', 'Niveaux pression', 'mb', &
116          llm, presnivs / 100., zvertiid, 'down')
117  CALL histvert(histvid, 'presnivs', 'Niveaux pression', 'mb', &
118          llm, presnivs / 100., zvertiid, 'down')
119  CALL histvert(histuid, 'presnivs', 'Niveaux pression', 'mb', &
120          llm, presnivs / 100., zvertiid, 'down')
121  !
122  ! -------------------------------------------------------------
123  !  Appels a histdef pour la definition des variables a sauvegarder
124  ! -------------------------------------------------------------
125  !
126  !  Vents U
127  !
128  CALL histdef(histuid, 'u', 'vent u', 'm/s', &
129          iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, &
130          32, 'inst(X)', t_ops, t_wrt)
131  !
132  !  Vents V
133  !
134  CALL histdef(histvid, 'v', 'vent v', 'm/s', &
135          iip1, jjm, vhoriid, llm, 1, llm, zvertiid, &
136          32, 'inst(X)', t_ops, t_wrt)
137
138  !
139  !  Temperature potentielle
140  !
141  CALL histdef(histid, 'teta', 'temperature potentielle', '-', &
142          iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
143          32, 'inst(X)', t_ops, t_wrt)
144  !
145  !  Geopotentiel
146  !
147  CALL histdef(histid, 'phi', 'geopotentiel', '-', &
148          iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
149          32, 'inst(X)', t_ops, t_wrt)
150  !
151  !  Traceurs
152  !
153
154  !    DO iq=1,nqtot
155  !      CALL histdef(histid, tracers(iq)%name,
156  !                           tracers(iq)%longName, '-',
157  ! .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
158  ! .             32, 'inst(X)', t_ops, t_wrt)
159  !    enddo
160  !C
161  !  Masse
162  !
163  CALL histdef(histid, 'masse', 'masse', 'kg', &
164          iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
165          32, 'inst(X)', t_ops, t_wrt)
166  !
167  !  Pression au sol
168  !
169  CALL histdef(histid, 'ps', 'pression naturelle au sol', 'Pa', &
170          iip1, jjp1, thoriid, 1, 1, 1, -99, &
171          32, 'inst(X)', t_ops, t_wrt)
172  !
173  !  Geopotentiel au sol
174  !C
175  !  CALL histdef(histid, 'phis', 'geopotentiel au sol', '-',
176  ! .             iip1, jjp1, thoriid, 1, 1, 1, -99,
177  ! .             32, 'inst(X)', t_ops, t_wrt)
178  !C
179  !  Fin
180  !
181  CALL histend(histid)
182  CALL histend(histuid)
183  CALL histend(histvid)
184END SUBROUTINE  inithist
Note: See TracBrowser for help on using the repository browser.