source: LMDZ6/branches/IPSLCM6.0.13/libf/dyn3dmem/inithist_loc.F @ 3033

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