source: trunk/LMDZ.COMMON/libf/dyn3d_common/inithist.F @ 3493

Last change on this file since 3493 was 1422, checked in by milmd, 10 years ago

In GENERIC, MARS and COMMON models replace some include files by modules (usefull for decoupling physics with dynamics).

File size: 5.6 KB
Line 
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       USE comvert_mod, ONLY: presnivs
13       USE comconst_mod, ONLY: pi
14       USE temps_mod, ONLY: itau_dyn
15
16      implicit none
17
18C
19C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
20C   au format IOIPSL
21C
22C   Appels succesifs des routines: histbeg
23C                                  histhori
24C                                  histver
25C                                  histdef
26C                                  histend
27C
28C   Entree:
29C
30C      infile: nom du fichier histoire a creer
31C      day0,anne0: date de reference
32C      tstep: duree du pas de temps en seconde
33C      t_ops: frequence de l'operation pour IOIPSL
34C      t_wrt: frequence d'ecriture sur le fichier
35C      nq: nombre de traceurs
36C
37C
38C   L. Fairhead, LMD, 03/99
39C
40C =====================================================================
41C
42C   Declarations
43#include "dimensions.h"
44#include "paramet.h"
45#include "comgeom.h"
46#include "iniprint.h"
47
48C   Arguments
49C
50      integer day0, anne0
51      real tstep, t_ops, t_wrt
52
53#ifdef CPP_IOIPSL
54! This routine needs IOIPSL to work
55C   Variables locales
56C
57      integer tau0
58      real zjulian
59      integer iq
60      real rlong(iip1,jjp1), rlat(iip1,jjp1)
61      integer uhoriid, vhoriid, thoriid, zvertiid
62      integer ii,jj
63      integer zan, dayref
64C
65C  Initialisations
66C
67      pi = 4. * atan (1.)
68C
69C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
70C         
71
72      zan = anne0
73      dayref = day0
74      CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
75      tau0 = itau_dyn
76     
77! -------------------------------------------------------------
78! Creation des 3 fichiers pour les grilles horizontales U,V,Scal
79! -------------------------------------------------------------
80!Grille U     
81      do jj = 1, jjp1
82        do ii = 1, iip1
83          rlong(ii,jj) = rlonu(ii) * 180. / pi
84          rlat(ii,jj) = rlatu(jj) * 180. / pi
85        enddo
86      enddo
87       
88      call histbeg(dynhistu_file, iip1, rlong(:,1), jjp1, rlat(1,:),
89     .             1, iip1, 1, jjp1,
90     .             tau0, zjulian, tstep, uhoriid, histuid)
91
92! Grille V
93      do jj = 1, jjm
94        do ii = 1, iip1
95          rlong(ii,jj) = rlonv(ii) * 180. / pi
96          rlat(ii,jj) = rlatv(jj) * 180. / pi
97        enddo
98      enddo
99
100      call histbeg(dynhistv_file, iip1, rlong(:,1), jjm, rlat(1,:),
101     .             1, iip1, 1, jjm,
102     .             tau0, zjulian, tstep, vhoriid, histvid)
103
104!Grille Scalaire
105      do jj = 1, jjp1
106        do ii = 1, iip1
107          rlong(ii,jj) = rlonv(ii) * 180. / pi
108          rlat(ii,jj) = rlatu(jj) * 180. / pi
109        enddo
110      enddo
111
112      call histbeg(dynhist_file, iip1, rlong(:,1), jjp1, rlat(1,:),
113     .             1, iip1, 1, jjp1,
114     .             tau0, zjulian, tstep, thoriid, histid)
115! -------------------------------------------------------------
116C  Appel a histvert pour la grille verticale
117! -------------------------------------------------------------
118      call histvert(histid, 'presnivs', 'Niveaux pression','mb',
119     .              llm, presnivs/100., zvertiid,'down')
120      call histvert(histvid, 'presnivs', 'Niveaux pression','mb',
121     .              llm, presnivs/100., zvertiid,'down')
122      call histvert(histuid, 'presnivs', 'Niveaux pression','mb',
123     .              llm, presnivs/100., zvertiid,'down')
124C
125! -------------------------------------------------------------
126C  Appels a histdef pour la definition des variables a sauvegarder
127! -------------------------------------------------------------
128C
129C  Vents U
130C
131      call histdef(histuid, 'u', 'vent u', 'm/s',
132     .             iip1, jjp1, uhoriid, llm, 1, llm, zvertiid,
133     .             32, 'inst(X)', t_ops, t_wrt)
134C
135C  Vents V
136C
137      call histdef(histvid, 'v', 'vent v', 'm/s',
138     .             iip1, jjm, vhoriid, llm, 1, llm, zvertiid,
139     .             32, 'inst(X)', t_ops, t_wrt)
140
141C
142C  Temperature potentielle
143C
144      call histdef(histid, 'teta', 'temperature potentielle', '-',
145     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
146     .             32, 'inst(X)', t_ops, t_wrt)
147C
148C  Geopotentiel
149C
150      call histdef(histid, 'phi', 'geopotentiel', '-',
151     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
152     .             32, 'inst(X)', t_ops, t_wrt)
153C
154C  Traceurs
155C
156!
157!        DO iq=1,nqtot
158!          call histdef(histid, ttext(iq),  ttext(iq), '-',
159!     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
160!     .             32, 'inst(X)', t_ops, t_wrt)
161!        enddo
162!C
163C  Masse
164C
165      call histdef(histid, 'masse', 'masse', 'kg',
166     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
167     .             32, 'inst(X)', t_ops, t_wrt)
168C
169C  Pression au sol
170C
171      call histdef(histid, 'ps', 'pression naturelle au sol', 'Pa',
172     .             iip1, jjp1, thoriid, 1, 1, 1, -99,
173     .             32, 'inst(X)', t_ops, t_wrt)
174C
175C  Geopotentiel au sol
176!C
177!      call histdef(histid, 'phis', 'geopotentiel au sol', '-',
178!     .             iip1, jjp1, thoriid, 1, 1, 1, -99,
179!     .             32, 'inst(X)', t_ops, t_wrt)
180!C
181C  Fin
182C
183      call histend(histid)
184      call histend(histuid)
185      call histend(histvid)
186#else
187! tell the user this routine should be run with ioipsl
188      write(lunout,*)"inithist: Warning this routine should not be",
189     &               " used without ioipsl"
190#endif
191! of #ifdef CPP_IOIPSL
192      return
193      end
Note: See TracBrowser for help on using the repository browser.