source: LMDZ5/branches/IPSLCM6.0.12/libf/dyn3dpar/inithist_p.F @ 2965

Last change on this file since 2965 was 2622, checked in by Ehouarn Millour, 8 years ago

Some code tidying: turn ener.h into ener_mod.F90
EM

  • 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: 6.5 KB
Line 
1!
2! $Id: inithist_p.F 2622 2016-09-04 06:12:02Z fairhead $
3!
4      subroutine inithist_p(infile,day0,anne0,tstep,t_ops,t_wrt,
5     .                      fileid,filevid)
6
7#ifdef CPP_IOIPSL
8! This routine needs IOIPSL
9       USE IOIPSL
10#endif
11       USE parallel_lmdz
12       use Write_field
13       use misc_mod
14       USE infotrac
15       USE comconst_mod, ONLY: pi
16       USE comvert_mod, ONLY: nivsigs
17       USE temps_mod, ONLY: itau_dyn
18
19      implicit none
20
21C
22C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
23C   au format IOIPSL
24C
25C   Appels succesifs des routines: histbeg
26C                                  histhori
27C                                  histver
28C                                  histdef
29C                                  histend
30C
31C   Entree:
32C
33C      infile: nom du fichier histoire a creer
34C      day0,anne0: date de reference
35C      tstep: duree du pas de temps en seconde
36C      t_ops: frequence de l'operation pour IOIPSL
37C      t_wrt: frequence d'ecriture sur le fichier
38C
39C   Sortie:
40C      fileid: ID du fichier netcdf cree
41C      filevid:ID du fichier netcdf pour la grille v
42C
43C   L. Fairhead, LMD, 03/99
44C
45C =====================================================================
46C
47C   Declarations
48#include "dimensions.h"
49#include "paramet.h"
50#include "comgeom.h"
51#include "description.h"
52#include "iniprint.h"
53
54C   Arguments
55C
56      character*(*) infile
57      integer*4 day0, anne0
58      real tstep, t_ops, t_wrt
59      integer fileid, filevid
60
61#ifdef CPP_IOIPSL
62! This routine needs IOIPSL
63C   Variables locales
64C
65      integer tau0
66      real zjulian
67      integer iq
68      real rlong(iip1,jjp1), rlat(iip1,jjp1)
69      integer uhoriid, vhoriid, thoriid, zvertiid
70      integer ii,jj
71      integer zan, dayref
72      integer :: jjb,jje,jjn
73
74! definition du domaine d'ecriture pour le rebuild
75
76      INTEGER,DIMENSION(2) :: ddid
77      INTEGER,DIMENSION(2) :: dsg
78      INTEGER,DIMENSION(2) :: dsl
79      INTEGER,DIMENSION(2) :: dpf
80      INTEGER,DIMENSION(2) :: dpl
81      INTEGER,DIMENSION(2) :: dhs
82      INTEGER,DIMENSION(2) :: dhe
83     
84      INTEGER :: dynu_domain_id
85      INTEGER :: dynv_domain_id
86
87C
88C  Initialisations
89C
90      if (adjust) return
91       
92      pi = 4. * atan (1.)
93C
94C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
95C         
96
97      zan = anne0
98      dayref = day0
99      CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
100      tau0 = itau_dyn
101     
102      do jj = 1, jjp1
103        do ii = 1, iip1
104          rlong(ii,jj) = rlonu(ii) * 180. / pi
105          rlat(ii,jj) = rlatu(jj) * 180. / pi
106        enddo
107      enddo
108     
109      jjb=jj_begin
110      jje=jj_end
111      jjn=jj_nb
112
113
114      ddid=(/ 1,2 /)
115      dsg=(/ iip1,jjp1 /)
116      dsl=(/ iip1,jjn /)
117      dpf=(/ 1,jjb /)
118      dpl=(/ iip1,jje /)
119      dhs=(/ 0,0 /)
120      dhe=(/ 0,0 /)
121
122      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
123     .                 'box',dynu_domain_id)
124     
125       call histbeg(trim(infile),iip1, rlong(:,1), jjn,
126     .              rlat(1,jjb:jje), 1, iip1, 1, jjn, tau0,
127     .              zjulian, tstep, uhoriid, fileid,dynu_domain_id)
128C
129C  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
130C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
131C  un meme fichier)
132
133      do jj = 1, jjm
134        do ii = 1, iip1
135          rlong(ii,jj) = rlonv(ii) * 180. / pi
136          rlat(ii,jj) = rlatv(jj) * 180. / pi
137        enddo
138      enddo
139
140      jjb=jj_begin
141      jje=jj_end
142      jjn=jj_nb
143      if (pole_sud) jje=jj_end-1
144      if (pole_sud) jjn=jj_nb-1
145
146      ddid=(/ 1,2 /)
147      dsg=(/ iip1,jjm /)
148      dsl=(/ iip1,jjn /)
149      dpf=(/ 1,jjb /)
150      dpl=(/ iip1,jje /)
151      dhs=(/ 0,0 /)
152      dhe=(/ 0,0 /)
153
154      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
155     .                 'box',dynv_domain_id)
156     
157      call histbeg('dyn_histv', iip1, rlong(:,1), jjn, rlat(1,jjb:jje),
158     .             1, iip1, 1, jjn, tau0, zjulian, tstep, vhoriid,
159     .             filevid,dynv_domain_id)
160C
161C  Appel a histhori pour rajouter les autres grilles horizontales
162C
163     
164      do jj = 1, jjp1
165        do ii = 1, iip1
166          rlong(ii,jj) = rlonv(ii) * 180. / pi
167          rlat(ii,jj) = rlatu(jj) * 180. / pi
168        enddo
169      enddo
170
171      jjb=jj_begin
172      jje=jj_end
173      jjn=jj_nb
174
175      call histhori(fileid, iip1, rlong(:,jjb:jje),jjn,rlat(:,jjb:jje),
176     .              'scalar','Grille points scalaires', thoriid)
177C
178C  Appel a histvert pour la grille verticale
179C
180      call histvert(fileid, 'sig_s', 'Niveaux sigma','-',
181     .              llm, nivsigs, zvertiid)
182C Pour le fichier V
183      call histvert(filevid, 'sig_s', 'Niveaux sigma','-',
184     .              llm, nivsigs, zvertiid)
185C
186C  Appels a histdef pour la definition des variables a sauvegarder
187C
188C  Vents U
189C
190      jjn=jj_nb
191
192      call histdef(fileid, 'ucov', 'vents u covariants', 'm/s',
193     .             iip1, jjn, uhoriid, llm, 1, llm, zvertiid,
194     .             32, 'inst(X)', t_ops, t_wrt)
195C
196C  Vents V
197C
198      if (pole_sud) jjn=jj_nb-1
199     
200      call histdef(filevid, 'vcov', 'vents v covariants', 'm/s',
201     .             iip1, jjn, vhoriid, llm, 1, llm, zvertiid,
202     .             32, 'inst(X)', t_ops, t_wrt)
203
204C
205C  Temperature potentielle
206C
207      jjn=jj_nb
208     
209      call histdef(fileid, 'teta', 'temperature potentielle', '-',
210     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
211     .             32, 'inst(X)', t_ops, t_wrt)
212C
213C  Geopotentiel
214C
215      call histdef(fileid, 'phi', 'geopotentiel instantane', '-',
216     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
217     .             32, 'inst(X)', t_ops, t_wrt)
218C
219C  Traceurs
220C
221        DO iq=1,nqtot
222          call histdef(fileid, ttext(iq),  ttext(iq), '-',
223     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
224     .             32, 'inst(X)', t_ops, t_wrt)
225        enddo
226C
227C  Masse
228C
229      call histdef(fileid, 'masse', 'masse', 'kg',
230     .             iip1, jjn, thoriid, 1, 1, 1, -99,
231     .             32, 'inst(X)', t_ops, t_wrt)
232C
233C  Pression au sol
234C
235      call histdef(fileid, 'ps', 'pression naturelle au sol', 'Pa',
236     .             iip1, jjn, thoriid, 1, 1, 1, -99,
237     .             32, 'inst(X)', t_ops, t_wrt)
238C
239C  Pression au sol
240C
241      call histdef(fileid, 'phis', 'geopotentiel au sol', '-',
242     .             iip1, jjn, thoriid, 1, 1, 1, -99,
243     .             32, 'inst(X)', t_ops, t_wrt)
244C
245C  Fin
246C
247      call histend(fileid)
248      call histend(filevid)
249#else
250      write(lunout,*)'inithist_p: Needs IOIPSL to function'
251#endif
252! #endif of #ifdef CPP_IOIPSL
253      return
254      end
Note: See TracBrowser for help on using the repository browser.