source: LMDZ5/branches/IPSLCM5A2.1/libf/dyn3dpar/inithist_p.F @ 5055

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

Cleanup in the dynamics: turn logic.h into module logic_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 2603 2016-07-25 09:31:56Z evignon $
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 "ener.h"
52#include "description.h"
53#include "iniprint.h"
54
55C   Arguments
56C
57      character*(*) infile
58      integer*4 day0, anne0
59      real tstep, t_ops, t_wrt
60      integer fileid, filevid
61
62#ifdef CPP_IOIPSL
63! This routine needs IOIPSL
64C   Variables locales
65C
66      integer tau0
67      real zjulian
68      integer iq
69      real rlong(iip1,jjp1), rlat(iip1,jjp1)
70      integer uhoriid, vhoriid, thoriid, zvertiid
71      integer ii,jj
72      integer zan, dayref
73      integer :: jjb,jje,jjn
74
75! definition du domaine d'ecriture pour le rebuild
76
77      INTEGER,DIMENSION(2) :: ddid
78      INTEGER,DIMENSION(2) :: dsg
79      INTEGER,DIMENSION(2) :: dsl
80      INTEGER,DIMENSION(2) :: dpf
81      INTEGER,DIMENSION(2) :: dpl
82      INTEGER,DIMENSION(2) :: dhs
83      INTEGER,DIMENSION(2) :: dhe
84     
85      INTEGER :: dynu_domain_id
86      INTEGER :: dynv_domain_id
87
88C
89C  Initialisations
90C
91      if (adjust) return
92       
93      pi = 4. * atan (1.)
94C
95C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
96C         
97
98      zan = anne0
99      dayref = day0
100      CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
101      tau0 = itau_dyn
102     
103      do jj = 1, jjp1
104        do ii = 1, iip1
105          rlong(ii,jj) = rlonu(ii) * 180. / pi
106          rlat(ii,jj) = rlatu(jj) * 180. / pi
107        enddo
108      enddo
109     
110      jjb=jj_begin
111      jje=jj_end
112      jjn=jj_nb
113
114
115      ddid=(/ 1,2 /)
116      dsg=(/ iip1,jjp1 /)
117      dsl=(/ iip1,jjn /)
118      dpf=(/ 1,jjb /)
119      dpl=(/ iip1,jje /)
120      dhs=(/ 0,0 /)
121      dhe=(/ 0,0 /)
122
123      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
124     .                 'box',dynu_domain_id)
125     
126       call histbeg(trim(infile),iip1, rlong(:,1), jjn,
127     .              rlat(1,jjb:jje), 1, iip1, 1, jjn, tau0,
128     .              zjulian, tstep, uhoriid, fileid,dynu_domain_id)
129C
130C  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
131C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
132C  un meme fichier)
133
134      do jj = 1, jjm
135        do ii = 1, iip1
136          rlong(ii,jj) = rlonv(ii) * 180. / pi
137          rlat(ii,jj) = rlatv(jj) * 180. / pi
138        enddo
139      enddo
140
141      jjb=jj_begin
142      jje=jj_end
143      jjn=jj_nb
144      if (pole_sud) jje=jj_end-1
145      if (pole_sud) jjn=jj_nb-1
146
147      ddid=(/ 1,2 /)
148      dsg=(/ iip1,jjm /)
149      dsl=(/ iip1,jjn /)
150      dpf=(/ 1,jjb /)
151      dpl=(/ iip1,jje /)
152      dhs=(/ 0,0 /)
153      dhe=(/ 0,0 /)
154
155      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
156     .                 'box',dynv_domain_id)
157     
158      call histbeg('dyn_histv', iip1, rlong(:,1), jjn, rlat(1,jjb:jje),
159     .             1, iip1, 1, jjn, tau0, zjulian, tstep, vhoriid,
160     .             filevid,dynv_domain_id)
161C
162C  Appel a histhori pour rajouter les autres grilles horizontales
163C
164     
165      do jj = 1, jjp1
166        do ii = 1, iip1
167          rlong(ii,jj) = rlonv(ii) * 180. / pi
168          rlat(ii,jj) = rlatu(jj) * 180. / pi
169        enddo
170      enddo
171
172      jjb=jj_begin
173      jje=jj_end
174      jjn=jj_nb
175
176      call histhori(fileid, iip1, rlong(:,jjb:jje),jjn,rlat(:,jjb:jje),
177     .              'scalar','Grille points scalaires', thoriid)
178C
179C  Appel a histvert pour la grille verticale
180C
181      call histvert(fileid, 'sig_s', 'Niveaux sigma','-',
182     .              llm, nivsigs, zvertiid)
183C Pour le fichier V
184      call histvert(filevid, 'sig_s', 'Niveaux sigma','-',
185     .              llm, nivsigs, zvertiid)
186C
187C  Appels a histdef pour la definition des variables a sauvegarder
188C
189C  Vents U
190C
191      jjn=jj_nb
192
193      call histdef(fileid, 'ucov', 'vents u covariants', 'm/s',
194     .             iip1, jjn, uhoriid, llm, 1, llm, zvertiid,
195     .             32, 'inst(X)', t_ops, t_wrt)
196C
197C  Vents V
198C
199      if (pole_sud) jjn=jj_nb-1
200     
201      call histdef(filevid, 'vcov', 'vents v covariants', 'm/s',
202     .             iip1, jjn, vhoriid, llm, 1, llm, zvertiid,
203     .             32, 'inst(X)', t_ops, t_wrt)
204
205C
206C  Temperature potentielle
207C
208      jjn=jj_nb
209     
210      call histdef(fileid, 'teta', 'temperature potentielle', '-',
211     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
212     .             32, 'inst(X)', t_ops, t_wrt)
213C
214C  Geopotentiel
215C
216      call histdef(fileid, 'phi', 'geopotentiel instantane', '-',
217     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
218     .             32, 'inst(X)', t_ops, t_wrt)
219C
220C  Traceurs
221C
222        DO iq=1,nqtot
223          call histdef(fileid, ttext(iq),  ttext(iq), '-',
224     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
225     .             32, 'inst(X)', t_ops, t_wrt)
226        enddo
227C
228C  Masse
229C
230      call histdef(fileid, 'masse', 'masse', 'kg',
231     .             iip1, jjn, thoriid, 1, 1, 1, -99,
232     .             32, 'inst(X)', t_ops, t_wrt)
233C
234C  Pression au sol
235C
236      call histdef(fileid, 'ps', 'pression naturelle au sol', 'Pa',
237     .             iip1, jjn, thoriid, 1, 1, 1, -99,
238     .             32, 'inst(X)', t_ops, t_wrt)
239C
240C  Pression au sol
241C
242      call histdef(fileid, 'phis', 'geopotentiel au sol', '-',
243     .             iip1, jjn, thoriid, 1, 1, 1, -99,
244     .             32, 'inst(X)', t_ops, t_wrt)
245C
246C  Fin
247C
248      call histend(fileid)
249      call histend(filevid)
250#else
251      write(lunout,*)'inithist_p: Needs IOIPSL to function'
252#endif
253! #endif of #ifdef CPP_IOIPSL
254      return
255      end
Note: See TracBrowser for help on using the repository browser.