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

Last change on this file since 1972 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
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

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.

  • 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.4 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       implicit none
17
18C
19C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
20C   au format IOIPSL
21C
22C   Appels succesifs des routines: histbeg
23C                                  histhori
24C                                  histver
25C                                  histdef
26C                                  histend
27C
28C   Entree:
29C
30C      day0,anne0: date de reference
31C      tstep: duree du pas de temps en seconde
32C      t_ops: frequence de l'operation pour IOIPSL
33C      t_wrt: frequence d'ecriture sur le fichier
34C      nq: nombre de traceurs
35C
36C
37C   L. Fairhead, LMD, 03/99
38C
39C =====================================================================
40C
41C   Declarations
42#include "dimensions.h"
43#include "paramet.h"
44#include "comconst.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,jjp1 /)
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      jjb=jj_begin
174      jje=jj_end
175      jjn=jj_nb
176
177      ddid=(/ 1,2 /)
178      dsg=(/ iip1,jjp1 /)
179      dsl=(/ iip1,jjn /)
180      dpf=(/ 1,jjb /)
181      dpl=(/ iip1,jje /)
182      dhs=(/ 0,0 /)
183      dhe=(/ 0,0 /)
184
185
186      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
187     .                 'box',dynhistu_domain_id)
188             
189      call histbeg(dynhistu_file,iip1, rlong(:,1), jjn,
190     .             rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0,
191     .             zjulian, tstep, uhoriid,
192     .             histuid,dynhistu_domain_id)
193     
194     
195! -------------------------------------------------------------
196C  Appel a histvert pour la grille verticale
197! -------------------------------------------------------------
198      call histvert(histid, 'presnivs', 'Niveaux pression','mb',
199     .              llm, presnivs/100., zvertiid,'down')
200      call histvert(histvid, 'presnivs', 'Niveaux pression','mb',
201     .              llm, presnivs/100., zvertiidv,'down')
202      call histvert(histuid, 'presnivs', 'Niveaux pression','mb',
203     .              llm, presnivs/100., zvertiidu,'down')
204
205C
206! -------------------------------------------------------------
207C  Appels a histdef pour la definition des variables a sauvegarder
208! -------------------------------------------------------------
209C
210C  Vents U
211C
212      call histdef(histuid, 'u', 'vent u moyen ',
213     .             'm/s', iip1, jjp1, uhoriid, llm, 1, llm, zvertiidu,
214     .             32, 'ave(X)', t_ops, t_wrt)
215
216C
217C  Vents V
218C
219      call histdef(histvid, 'v', 'vent v moyen',
220     .             'm/s', iip1, jjm, vhoriid, llm, 1, llm, zvertiidv,
221     .             32, 'ave(X)', t_ops, t_wrt)
222
223C
224C  Temperature
225C
226      call histdef(histid, 'temp', 'temperature moyenne', 'K',
227     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
228     .             32, 'ave(X)', t_ops, t_wrt)
229C
230C  Temperature potentielle
231C
232      call histdef(histid, 'theta', 'temperature potentielle', 'K',
233     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
234     .             32, 'ave(X)', t_ops, t_wrt)
235
236
237C
238C  Geopotentiel
239C
240      call histdef(histid, 'phi', 'geopotentiel moyen', '-',
241     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
242     .             32, 'ave(X)', t_ops, t_wrt)
243C
244C  Traceurs
245C
246!        DO iq=1,nqtot
247!          call histdef(histid, ttext(iq), ttext(iq), '-',
248!     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
249!     .             32, 'ave(X)', t_ops, t_wrt)
250!        enddo
251C
252C  Masse
253C
254      call histdef(histid, 'masse', 'masse', 'kg',
255     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
256     .             32, 'ave(X)', t_ops, t_wrt)
257C
258C  Pression au sol
259C
260      call histdef(histid, 'ps', 'pression naturelle au sol', 'Pa',
261     .             iip1, jjp1, thoriid, 1, 1, 1, -99,
262     .             32, 'ave(X)', t_ops, t_wrt)
263C
264C  Pression au sol
265C
266!      call histdef(histid, 'phis', 'geopotentiel au sol', '-',
267!     .             iip1, jjn, thoriid, 1, 1, 1, -99,
268!     .             32, 'ave(X)', t_ops, t_wrt)
269C
270C  Fin
271C
272      call histend(histid)
273      call histend(histuid)
274      call histend(histvid)
275#else
276      write(lunout,*)'initdynav_p: Needs IOIPSL to function'
277#endif
278! #endif of #ifdef CPP_IOIPSL
279      return
280      end
Note: See TracBrowser for help on using the repository browser.