source: LMDZ6/trunk/libf/dyn3d_common/inithist.F90 @ 5248

Last change on this file since 5248 was 5246, checked in by abarral, 23 hours ago

Convert fixed-form to free-form sources .F -> .{f,F}90
(WIP: some .F remain, will be handled in subsequent commits)

  • 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.3 KB
Line 
1!
2! $Id: inithist.F90 5246 2024-10-21 12:58:45Z abarral $
3!
4subroutine 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  !
19  !   Routine d'initialisation des ecritures des fichiers histoires LMDZ
20  !   au format IOIPSL
21  !
22  !   Appels succesifs des routines: histbeg
23  !                              histhori
24  !                              histver
25  !                              histdef
26  !                              histend
27  !
28  !   Entree:
29  !
30  !  infile: nom du fichier histoire a creer
31  !  day0,anne0: date de reference
32  !  tstep: duree du pas de temps en seconde
33  !  t_ops: frequence de l'operation pour IOIPSL
34  !  t_wrt: frequence d'ecriture sur le fichier
35  !  nq: nombre de traceurs
36  !
37  !
38  !   L. Fairhead, LMD, 03/99
39  !
40  ! =====================================================================
41  !
42  !   Declarations
43  include "dimensions.h"
44  include "paramet.h"
45  include "comgeom.h"
46  include "description.h"
47  include "iniprint.h"
48
49  !   Arguments
50  !
51  integer :: day0, anne0
52  real :: tstep, t_ops, t_wrt
53
54#ifdef CPP_IOIPSL
55  ! This routine needs IOIPSL to work
56  !   Variables locales
57  !
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  !
66  !  Initialisations
67  !
68  pi = 4. * atan (1.)
69  !
70  !  Appel a histbeg: creation du fichier netcdf et initialisations diverses
71  !
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  !  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  !
126  ! -------------------------------------------------------------
127  !  Appels a histdef pour la definition des variables a sauvegarder
128  ! -------------------------------------------------------------
129  !
130  !  Vents U
131  !
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  !
136  !  Vents V
137  !
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  !
143  !  Temperature potentielle
144  !
145  call histdef(histid, 'teta', 'temperature potentielle', '-', &
146        iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
147        32, 'inst(X)', t_ops, t_wrt)
148  !
149  !  Geopotentiel
150  !
151  call histdef(histid, 'phi', 'geopotentiel', '-', &
152        iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
153        32, 'inst(X)', t_ops, t_wrt)
154  !
155  !  Traceurs
156  !
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  !  Masse
166  !
167  call histdef(histid, 'masse', 'masse', 'kg', &
168        iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
169        32, 'inst(X)', t_ops, t_wrt)
170  !
171  !  Pression au sol
172  !
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  !
177  !  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  !  Fin
184  !
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
195end subroutine inithist
Note: See TracBrowser for help on using the repository browser.