source: LMDZ5/trunk/libf/dyn3dmem/inithist_loc.F @ 2597

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

Cleanup in the dynamics: get rid of comconst.h, make it a module comconst_mod.
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
File size: 7.7 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 infotrac
14       use com_io_dyn_mod, only : histid,histvid,histuid,               &
15     &                        dynhist_file,dynhistv_file,dynhistu_file
16       USE comconst_mod, ONLY: pi
17       implicit none
18
19C
20C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
21C   au format IOIPSL
22C
23C   Appels succesifs des routines: histbeg
24C                                  histhori
25C                                  histver
26C                                  histdef
27C                                  histend
28C
29C   Entree:
30C
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 "comvert.h"
46      include "comgeom.h"
47      include "temps.h"
48      include "ener.h"
49      include "logic.h"
50      include "description.h"
51      include "serre.h"
52      include "iniprint.h"
53
54C   Arguments
55C
56      integer day0, anne0
57      real tstep, t_ops, t_wrt
58
59#ifdef CPP_IOIPSL
60! This routine needs IOIPSL
61C   Variables locales
62C
63      integer tau0
64      real zjulian
65      integer iq
66      real rlong(iip1,jjp1), rlat(iip1,jjp1)
67      integer uhoriid, vhoriid, thoriid
68      integer zvertiid,zvertiidv,zvertiidu
69      integer ii,jj
70      integer zan, dayref
71      integer :: jjb,jje,jjn
72
73! definition du domaine d'ecriture pour le rebuild
74
75      INTEGER,DIMENSION(2) :: ddid
76      INTEGER,DIMENSION(2) :: dsg
77      INTEGER,DIMENSION(2) :: dsl
78      INTEGER,DIMENSION(2) :: dpf
79      INTEGER,DIMENSION(2) :: dpl
80      INTEGER,DIMENSION(2) :: dhs
81      INTEGER,DIMENSION(2) :: dhe
82     
83      INTEGER :: dynhist_domain_id
84      INTEGER :: dynhistv_domain_id
85      INTEGER :: dynhistu_domain_id
86     
87      if (adjust) return
88
89C
90C  Initialisations
91C
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) = rlonv(ii) * 180. / pi
105          rlat(ii,jj)  = rlatu(jj) * 180. / pi
106        enddo
107      enddo
108
109
110! Creation de 3 fichiers pour les differentes grilles horizontales
111! Restriction de IOIPSL: seulement 2 coordonnees dans le meme fichier
112! Grille Scalaire       
113
114      jjb=jj_begin
115      jje=jj_end
116      jjn=jj_nb
117
118      ddid=(/ 1,2 /)
119      dsg=(/ iip1,jjp1 /)
120      dsl=(/ iip1,jjn /)
121      dpf=(/ 1,jjb /)
122      dpl=(/ iip1,jje /)
123      dhs=(/ 0,0 /)
124      dhe=(/ 0,0 /)
125
126
127      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
128     .                 'box',dynhist_domain_id)
129             
130      call histbeg(dynhist_file,iip1, rlong(:,1), jjn,
131     .             rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0,
132     .             zjulian, tstep, thoriid,
133     .             histid,dynhist_domain_id)
134
135
136C  Creation du fichier histoire pour les grilles en V et U (oblige pour l'instant,
137C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
138C  un meme fichier)
139! Grille V
140
141      jjb=jj_begin
142      jje=jj_end
143      jjn=jj_nb
144      IF (pole_sud) jjn=jjn-1
145      IF (pole_sud) jje=jje-1
146     
147      do jj = jjb, jje
148        do ii = 1, iip1
149          rlong(ii,jj) = rlonv(ii) * 180. / pi
150          rlat(ii,jj) = rlatv(jj) * 180. / pi
151        enddo
152      enddo
153
154      ddid=(/ 1,2 /)
155      dsg=(/ iip1,jjm /)
156      dsl=(/ iip1,jjn /)
157      dpf=(/ 1,jjb /)
158      dpl=(/ iip1,jje /)
159      dhs=(/ 0,0 /)
160      dhe=(/ 0,0 /)
161
162
163      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
164     .                 'box',dynhistv_domain_id)
165
166      call histbeg(dynhistv_file,iip1, rlong(:,1), jjn,
167     .             rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0,
168     .             zjulian, tstep, vhoriid,
169     .             histvid,dynhistv_domain_id)
170     
171! Grille U
172
173      do jj = 1, jjp1
174        do ii = 1, iip1
175          rlong(ii,jj) = rlonu(ii) * 180. / pi
176          rlat(ii,jj) = rlatu(jj) * 180. / pi
177        enddo
178      enddo
179
180      jjb=jj_begin
181      jje=jj_end
182      jjn=jj_nb
183
184      ddid=(/ 1,2 /)
185      dsg=(/ iip1,jjp1 /)
186      dsl=(/ iip1,jjn /)
187      dpf=(/ 1,jjb /)
188      dpl=(/ iip1,jje /)
189      dhs=(/ 0,0 /)
190      dhe=(/ 0,0 /)
191
192
193      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
194     .                 'box',dynhistu_domain_id)
195             
196      call histbeg(dynhistu_file,iip1, rlong(:,1), jjn,
197     .             rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0,
198     .             zjulian, tstep, uhoriid,
199     .             histuid,dynhistu_domain_id)
200     
201     
202! -------------------------------------------------------------
203C  Appel a histvert pour la grille verticale
204! -------------------------------------------------------------
205      call histvert(histid, 'presnivs', 'Niveaux pression','mb',
206     .              llm, presnivs/100., zvertiid,'down')
207      call histvert(histvid, 'presnivs', 'Niveaux pression','mb',
208     .              llm, presnivs/100., zvertiidv,'down')
209      call histvert(histuid, 'presnivs', 'Niveaux pression','mb',
210     .              llm, presnivs/100., zvertiidu,'down')
211
212C
213! -------------------------------------------------------------
214C  Appels a histdef pour la definition des variables a sauvegarder
215! -------------------------------------------------------------
216C
217C  Vents U
218C
219      jjn=jj_nb
220      call histdef(histuid, 'u', 'vent u',
221     .             'm/s', iip1, jjn, uhoriid, llm, 1, llm, zvertiidu,
222     .             32, 'inst(X)', t_ops, t_wrt)
223
224C
225C  Vents V
226C
227      if (pole_sud) jjn=jj_nb-1
228      call histdef(histvid, 'v', 'vent v',
229     .             'm/s', iip1, jjn, vhoriid, llm, 1, llm, zvertiidv,
230     .             32, 'inst(X)', t_ops, t_wrt)
231
232C
233C  Temperature
234C
235      jjn=jj_nb
236      call histdef(histid, 'temp', 'temperature', 'K',
237     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
238     .             32, 'inst(X)', t_ops, t_wrt)
239C
240C  Temperature potentielle
241C
242      call histdef(histid, 'theta', 'temperature potentielle', 'K',
243     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
244     .             32, 'inst(X)', t_ops, t_wrt)
245
246
247C
248C  Geopotentiel
249C
250      call histdef(histid, 'phi', 'geopotentiel', '-',
251     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
252     .             32, 'inst(X)', t_ops, t_wrt)
253C
254C  Traceurs
255C
256!        DO iq=1,nqtot
257!          call histdef(histid, ttext(iq), ttext(iq), '-',
258!     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
259!     .             32, 'inst(X)', t_ops, t_wrt)
260!        enddo
261C
262C  Masse
263C
264      call histdef(histid, 'masse', 'masse', 'kg',
265     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
266     .             32, 'inst(X)', t_ops, t_wrt)
267C
268C  Pression au sol
269C
270      call histdef(histid, 'ps', 'pression naturelle au sol', 'Pa',
271     .             iip1, jjn, thoriid, 1, 1, 1, -99,
272     .             32, 'inst(X)', t_ops, t_wrt)
273C
274C  Geopotentiel au sol
275C
276!      call histdef(histid, 'phis', 'geopotentiel au sol', '-',
277!     .             iip1, jjn, thoriid, 1, 1, 1, -99,
278!     .             32, 'inst(X)', t_ops, t_wrt)
279C
280C  Fin
281C
282      call histend(histid)
283      call histend(histuid)
284      call histend(histvid)
285#else
286      write(lunout,*)'inithist_loc: Needs IOIPSL to function'
287#endif
288! #endif of #ifdef CPP_IOIPSL
289      end
Note: See TracBrowser for help on using the repository browser.