source: LMDZ5/trunk/libf/dyn3dmem/initfluxsto_p.F @ 2602

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

Cleanup in the dynamics: turn temps.h into module temps_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.8 KB
Line 
1!
2! $Id$
3!
4      subroutine initfluxsto_p
5     .  (infile,tstep,t_ops,t_wrt,
6     .                    fileid,filevid,filedid)
7
8#ifdef CPP_IOIPSL
9! This routine needs IOIPSL
10       USE IOIPSL
11#endif
12       USE parallel_lmdz
13       use Write_field
14       use misc_mod
15       USE comconst_mod, ONLY: pi
16       USE comvert_mod, ONLY: nivsigs
17       USE temps_mod, ONLY: annee_ref, day_ref, itau_dyn
18       
19      implicit none
20
21C
22C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
23C   au format IOIPSL
24C
25C   Appels succesifs des routines: histbeg
26C                                  histhori
27C                                  histver
28C                                  histdef
29C                                  histend
30C
31C   Entree:
32C
33C      infile: nom du fichier histoire a creer
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
39C   Sortie:
40C      fileid: ID du fichier netcdf cree
41C      filevid:ID du fichier netcdf pour la grille v
42C
43C   L. Fairhead, LMD, 03/99
44C
45C =====================================================================
46C
47C   Declarations
48      include "dimensions.h"
49      include "paramet.h"
50      include "comgeom.h"
51      include "ener.h"
52      include "logic.h"
53      include "description.h"
54      include "iniprint.h"
55
56C   Arguments
57C
58      character*(*) infile
59      real tstep, t_ops, t_wrt
60      integer fileid, filevid,filedid
61
62#ifdef CPP_IOIPSL
63! This routine needs IOIPSL
64C   Variables locales
65C
66      real nivd(1)
67      integer tau0
68      real zjulian
69      character*3 str
70      character*10 ctrac
71      integer iq
72      real rlong(iip1,jjp1), rlat(iip1,jjp1),rl(1,1)
73      integer uhoriid, vhoriid, thoriid, zvertiid,dhoriid,dvertiid
74      integer ii,jj
75      integer zan, idayref
76      logical ok_sync
77      integer :: jjb,jje,jjn
78
79! definition du domaine d'ecriture pour le rebuild
80
81      INTEGER,DIMENSION(2) :: ddid
82      INTEGER,DIMENSION(2) :: dsg
83      INTEGER,DIMENSION(2) :: dsl
84      INTEGER,DIMENSION(2) :: dpf
85      INTEGER,DIMENSION(2) :: dpl
86      INTEGER,DIMENSION(2) :: dhs
87      INTEGER,DIMENSION(2) :: dhe
88     
89      INTEGER :: dynu_domain_id
90      INTEGER :: dynv_domain_id
91
92C
93C  Initialisations
94C
95      pi = 4. * atan (1.)
96      str='q  '
97      ctrac = 'traceur   '
98      ok_sync = .true.
99C
100C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
101C         
102
103      zan = annee_ref
104      idayref = day_ref
105      CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
106      tau0 = itau_dyn
107       
108        do jj = 1, jjp1
109        do ii = 1, iip1
110          rlong(ii,jj) = rlonu(ii) * 180. / pi
111          rlat(ii,jj) = rlatu(jj) * 180. / pi
112        enddo
113      enddo
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      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
128     .                 'box',dynu_domain_id)
129       
130      call histbeg(trim(infile),iip1, rlong(:,1), jjn, rlat(1,jjb:jje),
131     .             1, iip1, 1, jjn, tau0, zjulian, tstep, uhoriid,
132     .             fileid,dynu_domain_id)
133C
134C  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
135C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
136C  un meme fichier)
137
138
139      do jj = 1, jjm
140        do ii = 1, iip1
141          rlong(ii,jj) = rlonv(ii) * 180. / pi
142          rlat(ii,jj) = rlatv(jj) * 180. / pi
143        enddo
144      enddo
145
146      jjb=jj_begin
147      jje=jj_end
148      jjn=jj_nb
149      if (pole_sud) jje=jj_end-1
150      if (pole_sud) jjn=jj_nb-1
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      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
161     .                 'box',dynv_domain_id)
162     
163      call histbeg('fluxstokev',iip1, rlong(:,1), jjn, rlat(1,jjb:jje),
164     .             1, iip1, 1, jjn,tau0, zjulian, tstep, vhoriid,
165     .             filevid,dynv_domain_id)
166       
167      rl(1,1) = 1.
168     
169      if (mpi_rank==0) then
170         
171        call histbeg('defstoke.nc', 1, rl, 1, rl,
172     .               1, 1, 1, 1,
173     .               tau0, zjulian, tstep, dhoriid, filedid)
174     
175      endif
176C
177C  Appel a histhori pour rajouter les autres grilles horizontales
178C
179      do jj = 1, jjp1
180        do ii = 1, iip1
181          rlong(ii,jj) = rlonv(ii) * 180. / pi
182          rlat(ii,jj) = rlatu(jj) * 180. / pi
183        enddo
184      enddo
185
186      jjb=jj_begin
187      jje=jj_end
188      jjn=jj_nb
189
190      call histhori(fileid, iip1, rlong(:,jjb:jje),jjn,rlat(:,jjb:jje),
191     .             'scalar','Grille points scalaires', thoriid)
192       
193C
194C  Appel a histvert pour la grille verticale
195C
196      call histvert(fileid, 'sig_s', 'Niveaux sigma',
197     . 'sigma_level',
198     .              llm, nivsigs, zvertiid)
199C Pour le fichier V
200      call histvert(filevid, 'sig_s', 'Niveaux sigma',
201     .  'sigma_level',
202     .              llm, nivsigs, zvertiid)
203c pour le fichier def
204      if (mpi_rank==0) then
205         nivd(1) = 1
206         call histvert(filedid, 'sig_s', 'Niveaux sigma',
207     .        'sigma_level',
208     .        1, nivd, dvertiid)
209      endif
210C
211C  Appels a histdef pour la definition des variables a sauvegarder
212       
213        CALL histdef(fileid, "phis", "Surface geop. height", "-",
214     .                iip1,jjn,thoriid, 1,1,1, -99, 32,
215     .                "once", t_ops, t_wrt)
216
217         CALL histdef(fileid, "aire", "Grid area", "-",
218     .                iip1,jjn,thoriid, 1,1,1, -99, 32,
219     .                "once", t_ops, t_wrt)
220       
221        if (mpi_rank==0) then
222       
223        CALL histdef(filedid, "dtvr", "tps dyn", "s",
224     .                1,1,dhoriid, 1,1,1, -99, 32,
225     .                "once", t_ops, t_wrt)
226       
227         CALL histdef(filedid, "istdyn", "tps stock", "s",
228     .                1,1,dhoriid, 1,1,1, -99, 32,
229     .                "once", t_ops, t_wrt)
230         
231         CALL histdef(filedid, "istphy", "tps stock phy", "s",
232     .                1,1,dhoriid, 1,1,1, -99, 32,
233     .                "once", t_ops, t_wrt)
234
235        endif
236C
237C Masse
238C
239      call histdef(fileid, 'masse', 'Masse', 'kg',
240     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
241     .             32, 'inst(X)', t_ops, t_wrt)
242C
243C  Pbaru
244C
245      call histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s',
246     .             iip1, jjn, uhoriid, llm, 1, llm, zvertiid,
247     .             32, 'inst(X)', t_ops, t_wrt)
248
249C
250C  Pbarv
251C
252      if (pole_sud) jjn=jj_nb-1
253     
254      call histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s',
255     .             iip1, jjn, vhoriid, llm, 1, llm, zvertiid,
256     .             32, 'inst(X)', t_ops, t_wrt)
257C
258C  w
259C
260      if (pole_sud) jjn=jj_nb
261      call histdef(fileid, 'w', 'flx de masse vert', 'kg m/s',
262     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
263     .             32, 'inst(X)', t_ops, t_wrt)
264
265C
266C  Temperature potentielle
267C
268      call histdef(fileid, 'teta', 'temperature potentielle', '-',
269     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
270     .             32, 'inst(X)', t_ops, t_wrt)
271C
272
273C
274C Geopotentiel
275C
276      call histdef(fileid, 'phi', 'geopotentiel instantane', '-',
277     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
278     .             32, 'inst(X)', t_ops, t_wrt)
279C
280C  Fin
281C
282      call histend(fileid)
283      call histend(filevid)
284      if (mpi_rank==0) call histend(filedid)
285      if (ok_sync) then
286        call histsync(fileid)
287        call histsync(filevid)
288        if (mpi_rank==0) call histsync(filedid)
289      endif
290       
291#else
292      write(lunout,*)'initfluxsto_p: Needs IOIPSL to function'
293#endif
294! #endif of #ifdef CPP_IOIPSL
295      return
296      end
Note: See TracBrowser for help on using the repository browser.