source: LMDZ4/branches/LMDZ4_AR5/libf/dyn3dpar/inithist_p.F @ 4295

Last change on this file since 4295 was 1279, checked in by Laurent Fairhead, 15 years ago

Merged LMDZ4-dev branch changes r1241:1278 into the trunk
Running trunk and LMDZ4-dev in LMDZOR configuration on local
machine (sequential) and SX8 (4-proc) yields identical results
(restart and restartphy are identical binarily)
Log history from r1241 to r1278 is available by switching to
source:LMDZ4/branches/LMDZ4-dev-20091210

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 6.5 KB
Line 
1!
2! $Id: inithist_p.F 1279 2009-12-10 09:02:56Z fhourdin $
3!
4      subroutine inithist_p(infile,day0,anne0,tstep,t_ops,t_wrt,
5     .                      fileid,filevid)
6
7#ifdef CPP_IOIPSL
8! This routine needs IOIPSL
9       USE IOIPSL
10#endif
11       use parallel
12       use Write_field
13       use misc_mod
14       USE infotrac
15
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      infile: nom du fichier histoire a creer
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
36C   Sortie:
37C      fileid: ID du fichier netcdf cree
38C      filevid:ID du fichier netcdf pour la grille v
39C
40C   L. Fairhead, LMD, 03/99
41C
42C =====================================================================
43C
44C   Declarations
45#include "dimensions.h"
46#include "paramet.h"
47#include "comconst.h"
48#include "comvert.h"
49#include "comgeom.h"
50#include "temps.h"
51#include "ener.h"
52#include "logic.h"
53#include "description.h"
54#include "serre.h"
55#include "iniprint.h"
56
57C   Arguments
58C
59      character*(*) infile
60      integer*4 day0, anne0
61      real tstep, t_ops, t_wrt
62      integer fileid, filevid
63
64#ifdef CPP_IOIPSL
65! This routine needs IOIPSL
66C   Variables locales
67C
68      integer tau0
69      real zjulian
70      integer iq
71      real rlong(iip1,jjp1), rlat(iip1,jjp1)
72      integer uhoriid, vhoriid, thoriid, zvertiid
73      integer ii,jj
74      integer zan, dayref
75      integer :: jjb,jje,jjn
76
77! definition du domaine d'ecriture pour le rebuild
78
79      INTEGER,DIMENSION(2) :: ddid
80      INTEGER,DIMENSION(2) :: dsg
81      INTEGER,DIMENSION(2) :: dsl
82      INTEGER,DIMENSION(2) :: dpf
83      INTEGER,DIMENSION(2) :: dpl
84      INTEGER,DIMENSION(2) :: dhs
85      INTEGER,DIMENSION(2) :: dhe
86     
87      INTEGER :: dynu_domain_id
88      INTEGER :: dynv_domain_id
89
90C
91C  Initialisations
92C
93      if (adjust) return
94       
95      pi = 4. * atan (1.)
96C
97C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
98C         
99
100      zan = anne0
101      dayref = day0
102      CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
103      tau0 = itau_dyn
104     
105      do jj = 1, jjp1
106        do ii = 1, iip1
107          rlong(ii,jj) = rlonu(ii) * 180. / pi
108          rlat(ii,jj) = rlatu(jj) * 180. / pi
109        enddo
110      enddo
111     
112      jjb=jj_begin
113      jje=jj_end
114      jjn=jj_nb
115
116
117      ddid=(/ 1,2 /)
118      dsg=(/ iip1,jjp1 /)
119      dsl=(/ iip1,jjn /)
120      dpf=(/ 1,jjb /)
121      dpl=(/ iip1,jje /)
122      dhs=(/ 0,0 /)
123      dhe=(/ 0,0 /)
124
125      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
126     .                 'box',dynu_domain_id)
127     
128       call histbeg(trim(infile),iip1, rlong(:,1), jjn,
129     .              rlat(1,jjb:jje), 1, iip1, 1, jjn, tau0,
130     .              zjulian, tstep, uhoriid, fileid,dynu_domain_id)
131C
132C  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
133C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
134C  un meme fichier)
135
136      do jj = 1, jjm
137        do ii = 1, iip1
138          rlong(ii,jj) = rlonv(ii) * 180. / pi
139          rlat(ii,jj) = rlatv(jj) * 180. / pi
140        enddo
141      enddo
142
143      jjb=jj_begin
144      jje=jj_end
145      jjn=jj_nb
146      if (pole_sud) jje=jj_end-1
147      if (pole_sud) jjn=jj_nb-1
148
149      ddid=(/ 1,2 /)
150      dsg=(/ iip1,jjm /)
151      dsl=(/ iip1,jjn /)
152      dpf=(/ 1,jjb /)
153      dpl=(/ iip1,jje /)
154      dhs=(/ 0,0 /)
155      dhe=(/ 0,0 /)
156
157      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
158     .                 'box',dynv_domain_id)
159     
160      call histbeg('dyn_histv', iip1, rlong(:,1), jjn, rlat(1,jjb:jje),
161     .             1, iip1, 1, jjn, tau0, zjulian, tstep, vhoriid,
162     .             filevid,dynv_domain_id)
163C
164C  Appel a histhori pour rajouter les autres grilles horizontales
165C
166     
167      do jj = 1, jjp1
168        do ii = 1, iip1
169          rlong(ii,jj) = rlonv(ii) * 180. / pi
170          rlat(ii,jj) = rlatu(jj) * 180. / pi
171        enddo
172      enddo
173
174      jjb=jj_begin
175      jje=jj_end
176      jjn=jj_nb
177
178      call histhori(fileid, iip1, rlong(:,jjb:jje),jjn,rlat(:,jjb:jje),
179     .              'scalar','Grille points scalaires', thoriid)
180C
181C  Appel a histvert pour la grille verticale
182C
183      call histvert(fileid, 'sig_s', 'Niveaux sigma','-',
184     .              llm, nivsigs, zvertiid)
185C Pour le fichier V
186      call histvert(filevid, 'sig_s', 'Niveaux sigma','-',
187     .              llm, nivsigs, zvertiid)
188C
189C  Appels a histdef pour la definition des variables a sauvegarder
190C
191C  Vents U
192C
193      jjn=jj_nb
194
195      call histdef(fileid, 'ucov', 'vents u covariants', 'm/s',
196     .             iip1, jjn, uhoriid, llm, 1, llm, zvertiid,
197     .             32, 'inst(X)', t_ops, t_wrt)
198C
199C  Vents V
200C
201      if (pole_sud) jjn=jj_nb-1
202     
203      call histdef(filevid, 'vcov', 'vents v covariants', 'm/s',
204     .             iip1, jjn, vhoriid, llm, 1, llm, zvertiid,
205     .             32, 'inst(X)', t_ops, t_wrt)
206
207C
208C  Temperature potentielle
209C
210      jjn=jj_nb
211     
212      call histdef(fileid, 'teta', 'temperature potentielle', '-',
213     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
214     .             32, 'inst(X)', t_ops, t_wrt)
215C
216C  Geopotentiel
217C
218      call histdef(fileid, 'phi', 'geopotentiel instantane', '-',
219     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
220     .             32, 'inst(X)', t_ops, t_wrt)
221C
222C  Traceurs
223C
224        DO iq=1,nqtot
225          call histdef(fileid, ttext(iq),  ttext(iq), '-',
226     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
227     .             32, 'inst(X)', t_ops, t_wrt)
228        enddo
229C
230C  Masse
231C
232      call histdef(fileid, 'masse', 'masse', 'kg',
233     .             iip1, jjn, thoriid, 1, 1, 1, -99,
234     .             32, 'inst(X)', t_ops, t_wrt)
235C
236C  Pression au sol
237C
238      call histdef(fileid, 'ps', 'pression naturelle au sol', 'Pa',
239     .             iip1, jjn, thoriid, 1, 1, 1, -99,
240     .             32, 'inst(X)', t_ops, t_wrt)
241C
242C  Pression au sol
243C
244      call histdef(fileid, 'phis', 'geopotentiel au sol', '-',
245     .             iip1, jjn, thoriid, 1, 1, 1, -99,
246     .             32, 'inst(X)', t_ops, t_wrt)
247C
248C  Fin
249C
250      call histend(fileid)
251      call histend(filevid)
252#else
253      write(lunout,*)'inithist_p: Needs IOIPSL to function'
254#endif
255! #endif of #ifdef CPP_IOIPSL
256      return
257      end
Note: See TracBrowser for help on using the repository browser.