source: LMDZ6/trunk/libf/dyn3dmem/initdynav_loc.F @ 5167

Last change on this file since 5167 was 4050, checked in by dcugnet, 3 years ago

Second commit for new tracers.

  • include most of the keys in the tracers descriptor vector "tracers(:)".
  • fix in phylmdiso/cv3_routines: fq_* variables were used where their fxt_* counterparts were expected.
  • multiple IF(nqdesc(iq)>0) and IF(nqfils(iq)>0) tests suppressed, because they are not needed: "do ... enddo" loops with 0 upper bound are not executed.
  • remove French accents from comments (encoding problem) in phylmdiso/cv3_routines and phylmdiso/cv30_routines.
  • modifications in "isotopes_verif_mod", where the call to function "iso_verif_tag17_q_deltad_chn" in "iso_verif_tag17_q_deltad_chn" was not detected at linking stage, although defined in the same module (?).
  • 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
File size: 7.6 KB
Line 
1!
2! $Id: initdynav_p.F 1279 2009-12-10 09:02:56Z fairhead $
3!
4      subroutine initdynav_loc(day0,anne0,tstep,t_ops,t_wrt)
5
6#ifdef CPP_IOIPSL
7! This routine needs IOIPSL
8       USE IOIPSL
9#endif
10       USE parallel_lmdz
11       use Write_field
12       use misc_mod
13!       USE infotrac
14       use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid,       &
15     &        dynhistave_file,dynhistvave_file,dynhistuave_file
16       USE comconst_mod, ONLY: pi
17       USE comvert_mod, ONLY: presnivs
18       USE temps_mod, ONLY: itau_dyn
19       
20       implicit none
21
22C
23C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
24C   au format IOIPSL. Initialisation du fichier histoire moyenne.
25C
26C   Appels succesifs des routines: histbeg
27C                                  histhori
28C                                  histver
29C                                  histdef
30C                                  histend
31C
32C   Entree:
33C
34C      day0,anne0: date de reference
35C      tstep : frequence d'ecriture
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
42C   L. Fairhead, LMD, 03/99
43C
44C =====================================================================
45C
46C   Declarations
47      include "dimensions.h"
48      include "paramet.h"
49      include "comgeom.h"
50      include "description.h"
51      include "iniprint.h"
52
53C   Arguments
54C
55      integer*4 day0, anne0
56      real tstep, t_ops, t_wrt
57
58#ifdef CPP_IOIPSL
59! This routine needs IOIPSL
60C   Variables locales
61C
62      integer tau0
63      real zjulian
64      integer iq
65      real rlong(iip1,jjp1), rlat(iip1,jjp1)
66      integer uhoriid, vhoriid, thoriid
67      integer zvertiid,zvertiidv,zvertiidu
68      integer ii,jj
69      integer zan, dayref
70      integer :: jjb,jje,jjn
71
72! definition du domaine d'ecriture pour le rebuild
73
74      INTEGER,DIMENSION(2) :: ddid
75      INTEGER,DIMENSION(2) :: dsg
76      INTEGER,DIMENSION(2) :: dsl
77      INTEGER,DIMENSION(2) :: dpf
78      INTEGER,DIMENSION(2) :: dpl
79      INTEGER,DIMENSION(2) :: dhs
80      INTEGER,DIMENSION(2) :: dhe
81     
82      INTEGER :: dynhistave_domain_id
83      INTEGER :: dynhistvave_domain_id
84      INTEGER :: dynhistuave_domain_id
85     
86      if (adjust) return
87
88C
89C  Initialisations
90C
91      pi = 4. * atan (1.)
92C
93C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
94C         
95
96      zan = anne0
97      dayref = day0
98      CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
99      tau0 = itau_dyn
100     
101      do jj = 1, jjp1
102        do ii = 1, iip1
103          rlong(ii,jj) = rlonv(ii) * 180. / pi
104          rlat(ii,jj)  = rlatu(jj) * 180. / pi
105        enddo
106      enddo
107
108
109! Creation de 3 fichiers pour les differentes grilles horizontales
110! Restriction de IOIPSL: seulement 2 coordonnees dans le meme fichier
111! Grille Scalaire       
112
113      jjb=jj_begin
114      jje=jj_end
115      jjn=jj_nb
116
117      ddid=(/ 1,2 /)
118      dsg=(/ iip1,jjp1 /)
119      dsl=(/ iip1,jjn /)
120      dpf=(/ 1,jjb /)
121      dpl=(/ iip1,jje /)
122      dhs=(/ 0,0 /)
123      dhe=(/ 0,0 /)
124
125
126      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
127     .                 'box',dynhistave_domain_id)
128             
129      call histbeg(dynhistave_file,iip1, rlong(:,1), jjn,
130     .             rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0,
131     .             zjulian, tstep, thoriid,
132     .             histaveid,dynhistave_domain_id)
133
134
135C  Creation du fichier histoire pour les grilles en V et U (oblige pour l'instant,
136C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
137C  un meme fichier)
138! Grille V
139
140      jjb=jj_begin
141      jje=jj_end
142      jjn=jj_nb
143      IF (pole_sud) jjn=jjn-1
144      IF (pole_sud) jje=jje-1
145     
146      do jj = jjb, jje
147        do ii = 1, iip1
148          rlong(ii,jj) = rlonv(ii) * 180. / pi
149          rlat(ii,jj) = rlatv(jj) * 180. / pi
150        enddo
151      enddo
152
153      ddid=(/ 1,2 /)
154      dsg=(/ iip1,jjm /)
155      dsl=(/ iip1,jjn /)
156      dpf=(/ 1,jjb /)
157      dpl=(/ iip1,jje /)
158      dhs=(/ 0,0 /)
159      dhe=(/ 0,0 /)
160
161
162      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
163     .                 'box',dynhistvave_domain_id)
164
165      call histbeg(dynhistvave_file,iip1, rlong(:,1), jjn,
166     .             rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0,
167     .             zjulian, tstep, vhoriid,
168     .             histvaveid,dynhistvave_domain_id)
169     
170! Grille U
171
172      do jj = 1, jjp1
173        do ii = 1, iip1
174          rlong(ii,jj) = rlonu(ii) * 180. / pi
175          rlat(ii,jj) = rlatu(jj) * 180. / pi
176        enddo
177      enddo
178
179      jjb=jj_begin
180      jje=jj_end
181      jjn=jj_nb
182
183      ddid=(/ 1,2 /)
184      dsg=(/ iip1,jjp1 /)
185      dsl=(/ iip1,jjn /)
186      dpf=(/ 1,jjb /)
187      dpl=(/ iip1,jje /)
188      dhs=(/ 0,0 /)
189      dhe=(/ 0,0 /)
190
191
192      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
193     .                 'box',dynhistuave_domain_id)
194             
195      call histbeg(dynhistuave_file,iip1, rlong(:,1), jjn,
196     .             rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0,
197     .             zjulian, tstep, uhoriid,
198     .             histuaveid,dynhistuave_domain_id)
199     
200     
201C
202C  Appel a histvert pour la grille verticale
203C
204      call histvert(histaveid,'presnivs','Niveaux Pression
205     &     approximatifs','mb',llm, presnivs/100., zvertiid,'down')
206      call histvert(histuaveid,'presnivs','Niveaux Pression
207     &     approximatifs','mb',llm, presnivs/100., zvertiidv,'down')
208      call histvert(histvaveid,'presnivs','Niveaux Pression
209     &     approximatifs','mb',llm, presnivs/100., zvertiidu,'down')
210
211C
212C  Appels a histdef pour la definition des variables a sauvegarder
213C
214C  Vents U
215C
216      jjn=jj_nb
217      call histdef(histuaveid, 'u', 'vent u moyen ',
218     .             'm/s', iip1, jjn, uhoriid, llm, 1, llm, zvertiidu,
219     .             32, 'ave(X)', t_ops, t_wrt)
220
221C
222C  Vents V
223C
224      if (pole_sud) jjn=jj_nb-1
225      call histdef(histvaveid, 'v', 'vent v moyen',
226     .             'm/s', iip1, jjn, vhoriid, llm, 1, llm, zvertiidv,
227     .             32, 'ave(X)', t_ops, t_wrt)
228
229C
230C  Temperature
231C
232      jjn=jj_nb
233      call histdef(histaveid, 'temp', 'temperature moyenne', 'K',
234     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
235     .             32, 'ave(X)', t_ops, t_wrt)
236C
237C  Temperature potentielle
238C
239      call histdef(histaveid, 'theta', 'temperature potentielle', 'K',
240     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
241     .             32, 'ave(X)', t_ops, t_wrt)
242
243
244C
245C  Geopotentiel
246C
247      call histdef(histaveid, 'phi', 'geopotentiel moyen', '-',
248     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
249     .             32, 'ave(X)', t_ops, t_wrt)
250C
251C  Traceurs
252C
253!        DO iq=1,nqtot
254!          call histdef(histaveid, tracers(iq)%name,
255!     .                            tracers(iq)%longName, '-',
256!     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
257!     .             32, 'ave(X)', t_ops, t_wrt)
258!        enddo
259C
260C  Masse
261C
262      call histdef(histaveid, 'masse', 'masse moyenne', 'kg',
263     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
264     .             32, 'ave(X)', t_ops, t_wrt)
265C
266C  Pression au sol
267C
268      call histdef(histaveid, 'ps', 'pression naturelle au sol', 'Pa',
269     .             iip1, jjn, thoriid, 1, 1, 1, -99,
270     .             32, 'ave(X)', t_ops, t_wrt)
271C
272C  Geopotentiel au sol
273C
274!      call histdef(histaveid, 'phis', 'geopotentiel au sol', '-',
275!     .             iip1, jjn, thoriid, 1, 1, 1, -99,
276!     .             32, 'ave(X)', t_ops, t_wrt)
277C
278C  Fin
279C
280      call histend(histaveid)
281      call histend(histuaveid)
282      call histend(histvaveid)
283#else
284      write(lunout,*)'initdynav_loc: Needs IOIPSL to function'
285#endif
286! #endif of #ifdef CPP_IOIPSL
287      end
Note: See TracBrowser for help on using the repository browser.