source: LMDZ5/trunk/libf/dyn3dmem/initdynav_loc.F @ 1907

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