source: LMDZ6/trunk/libf/dyn3dmem/inithist_loc.F @ 4744

Last change on this file since 4744 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 inithist_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 com_io_dyn_mod, only : histid,histvid,histuid,               &
14     &                        dynhist_file,dynhistv_file,dynhistu_file
15       USE comconst_mod, ONLY: pi
16       USE comvert_mod, ONLY: presnivs
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      day0,anne0: date de reference
34C      tstep: duree du pas de temps en seconde
35C      t_ops: frequence de l'operation pour IOIPSL
36C      t_wrt: frequence d'ecriture sur le fichier
37C      nq: nombre de traceurs
38C
39C
40C   L. Fairhead, LMD, 03/99
41C
42C =====================================================================
43C
44C   Declarations
45      include "dimensions.h"
46      include "paramet.h"
47      include "comgeom.h"
48      include "description.h"
49      include "iniprint.h"
50
51C   Arguments
52C
53      integer day0, anne0
54      real tstep, t_ops, t_wrt
55
56#ifdef CPP_IOIPSL
57! This routine needs IOIPSL
58C   Variables locales
59C
60      integer tau0
61      real zjulian
62      integer iq
63      real rlong(iip1,jjp1), rlat(iip1,jjp1)
64      integer uhoriid, vhoriid, thoriid
65      integer zvertiid,zvertiidv,zvertiidu
66      integer ii,jj
67      integer zan, dayref
68      integer :: jjb,jje,jjn
69
70! definition du domaine d'ecriture pour le rebuild
71
72      INTEGER,DIMENSION(2) :: ddid
73      INTEGER,DIMENSION(2) :: dsg
74      INTEGER,DIMENSION(2) :: dsl
75      INTEGER,DIMENSION(2) :: dpf
76      INTEGER,DIMENSION(2) :: dpl
77      INTEGER,DIMENSION(2) :: dhs
78      INTEGER,DIMENSION(2) :: dhe
79     
80      INTEGER :: dynhist_domain_id
81      INTEGER :: dynhistv_domain_id
82      INTEGER :: dynhistu_domain_id
83     
84      if (adjust) return
85
86C
87C  Initialisations
88C
89      pi = 4. * atan (1.)
90C
91C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
92C         
93
94      zan = anne0
95      dayref = day0
96      CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
97      tau0 = itau_dyn
98     
99      do jj = 1, jjp1
100        do ii = 1, iip1
101          rlong(ii,jj) = rlonv(ii) * 180. / pi
102          rlat(ii,jj)  = rlatu(jj) * 180. / pi
103        enddo
104      enddo
105
106
107! Creation de 3 fichiers pour les differentes grilles horizontales
108! Restriction de IOIPSL: seulement 2 coordonnees dans le meme fichier
109! Grille Scalaire       
110
111      jjb=jj_begin
112      jje=jj_end
113      jjn=jj_nb
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
124      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
125     .                 'box',dynhist_domain_id)
126             
127      call histbeg(dynhist_file,iip1, rlong(:,1), jjn,
128     .             rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0,
129     .             zjulian, tstep, thoriid,
130     .             histid,dynhist_domain_id)
131
132
133C  Creation du fichier histoire pour les grilles en V et U (oblige pour l'instant,
134C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
135C  un meme fichier)
136! Grille V
137
138      jjb=jj_begin
139      jje=jj_end
140      jjn=jj_nb
141      IF (pole_sud) jjn=jjn-1
142      IF (pole_sud) jje=jje-1
143     
144      do jj = jjb, jje
145        do ii = 1, iip1
146          rlong(ii,jj) = rlonv(ii) * 180. / pi
147          rlat(ii,jj) = rlatv(jj) * 180. / pi
148        enddo
149      enddo
150
151      ddid=(/ 1,2 /)
152      dsg=(/ iip1,jjm /)
153      dsl=(/ iip1,jjn /)
154      dpf=(/ 1,jjb /)
155      dpl=(/ iip1,jje /)
156      dhs=(/ 0,0 /)
157      dhe=(/ 0,0 /)
158
159
160      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
161     .                 'box',dynhistv_domain_id)
162
163      call histbeg(dynhistv_file,iip1, rlong(:,1), jjn,
164     .             rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0,
165     .             zjulian, tstep, vhoriid,
166     .             histvid,dynhistv_domain_id)
167     
168! Grille U
169
170      do jj = 1, jjp1
171        do ii = 1, iip1
172          rlong(ii,jj) = rlonu(ii) * 180. / pi
173          rlat(ii,jj) = rlatu(jj) * 180. / pi
174        enddo
175      enddo
176
177      jjb=jj_begin
178      jje=jj_end
179      jjn=jj_nb
180
181      ddid=(/ 1,2 /)
182      dsg=(/ iip1,jjp1 /)
183      dsl=(/ iip1,jjn /)
184      dpf=(/ 1,jjb /)
185      dpl=(/ iip1,jje /)
186      dhs=(/ 0,0 /)
187      dhe=(/ 0,0 /)
188
189
190      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
191     .                 'box',dynhistu_domain_id)
192             
193      call histbeg(dynhistu_file,iip1, rlong(:,1), jjn,
194     .             rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0,
195     .             zjulian, tstep, uhoriid,
196     .             histuid,dynhistu_domain_id)
197     
198     
199! -------------------------------------------------------------
200C  Appel a histvert pour la grille verticale
201! -------------------------------------------------------------
202      call histvert(histid, 'presnivs', 'Niveaux pression','mb',
203     .              llm, presnivs/100., zvertiid,'down')
204      call histvert(histvid, 'presnivs', 'Niveaux pression','mb',
205     .              llm, presnivs/100., zvertiidv,'down')
206      call histvert(histuid, 'presnivs', 'Niveaux pression','mb',
207     .              llm, presnivs/100., zvertiidu,'down')
208
209C
210! -------------------------------------------------------------
211C  Appels a histdef pour la definition des variables a sauvegarder
212! -------------------------------------------------------------
213C
214C  Vents U
215C
216      jjn=jj_nb
217      call histdef(histuid, 'u', 'vent u',
218     .             'm/s', iip1, jjn, uhoriid, llm, 1, llm, zvertiidu,
219     .             32, 'inst(X)', t_ops, t_wrt)
220
221C
222C  Vents V
223C
224      if (pole_sud) jjn=jj_nb-1
225      call histdef(histvid, 'v', 'vent v',
226     .             'm/s', iip1, jjn, vhoriid, llm, 1, llm, zvertiidv,
227     .             32, 'inst(X)', t_ops, t_wrt)
228
229C
230C  Temperature
231C
232      jjn=jj_nb
233      call histdef(histid, 'temp', 'temperature', 'K',
234     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
235     .             32, 'inst(X)', t_ops, t_wrt)
236C
237C  Temperature potentielle
238C
239      call histdef(histid, 'theta', 'temperature potentielle', 'K',
240     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
241     .             32, 'inst(X)', t_ops, t_wrt)
242
243
244C
245C  Geopotentiel
246C
247      call histdef(histid, 'phi', 'geopotentiel', '-',
248     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
249     .             32, 'inst(X)', t_ops, t_wrt)
250C
251C  Traceurs
252C
253!        DO iq=1,nqtot
254!          call histdef(histid, tracers(iq)%name,
255!     .             tracers(iq)%longName, '-',
256!     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
257!     .             32, 'inst(X)', t_ops, t_wrt)
258!        enddo
259C
260C  Masse
261C
262      call histdef(histid, 'masse', 'masse', 'kg',
263     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
264     .             32, 'inst(X)', t_ops, t_wrt)
265C
266C  Pression au sol
267C
268      call histdef(histid, 'ps', 'pression naturelle au sol', 'Pa',
269     .             iip1, jjn, thoriid, 1, 1, 1, -99,
270     .             32, 'inst(X)', t_ops, t_wrt)
271C
272C  Geopotentiel au sol
273C
274!      call histdef(histid, 'phis', 'geopotentiel au sol', '-',
275!     .             iip1, jjn, thoriid, 1, 1, 1, -99,
276!     .             32, 'inst(X)', t_ops, t_wrt)
277C
278C  Fin
279C
280      call histend(histid)
281      call histend(histuid)
282      call histend(histvid)
283#else
284      write(lunout,*)'inithist_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.