source: LMDZ5/branches/IPSLCM5A2.1_ISO/libf/dyn3dpar/initfluxsto_p.F @ 3693

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

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