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