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

Last change on this file since 1632 was 1632, checked in by Laurent Fairhead, 12 years ago

Import initial du répertoire dyn3dmem

Attention! ceci n'est qu'une version préliminaire du code "basse mémoire":
le code contenu dans ce répertoire est basé sur la r1320 et a donc besoin
d'être mis à jour par rapport à la dynamique parallèle d'aujourd'hui.
Ce code est toutefois mis à disposition pour circonvenir à des problèmes
de mémoire que certaines configurations du modèle pourraient rencontrer.
Dans l'état, il compile et tourne sur vargas et au CCRT


Initial import of dyn3dmem

Warning! this is just a preliminary version of the memory light code:
it is based on r1320 of the code and thus needs to be updated before
it can replace the present dyn3dpar code. It is nevertheless put at your
disposal to circumvent some memory problems some LMDZ configurations may
encounter. In its present state, it will compile and run on vargas and CCRT

File size: 7.6 KB
Line 
1!
2! $Id: initfluxsto_p.F 1279 2009-12-10 09:02:56Z fairhead $
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
13       use Write_field
14       use misc_mod
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      real tstep, t_ops, t_wrt
61      integer fileid, filevid,filedid
62
63#ifdef CPP_IOIPSL
64! This routine needs IOIPSL
65C   Variables locales
66C
67      real nivd(1)
68      integer tau0
69      real zjulian
70      character*3 str
71      character*10 ctrac
72      integer iq
73      real rlong(iip1,jjp1), rlat(iip1,jjp1),rl(1,1)
74      integer uhoriid, vhoriid, thoriid, zvertiid,dhoriid,dvertiid
75      integer ii,jj
76      integer zan, idayref
77      logical ok_sync
78      integer :: jjb,jje,jjn
79
80! definition du domaine d'ecriture pour le rebuild
81
82      INTEGER,DIMENSION(2) :: ddid
83      INTEGER,DIMENSION(2) :: dsg
84      INTEGER,DIMENSION(2) :: dsl
85      INTEGER,DIMENSION(2) :: dpf
86      INTEGER,DIMENSION(2) :: dpl
87      INTEGER,DIMENSION(2) :: dhs
88      INTEGER,DIMENSION(2) :: dhe
89     
90      INTEGER :: dynu_domain_id
91      INTEGER :: dynv_domain_id
92
93C
94C  Initialisations
95C
96      pi = 4. * atan (1.)
97      str='q  '
98      ctrac = 'traceur   '
99      ok_sync = .true.
100C
101C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
102C         
103
104      zan = annee_ref
105      idayref = day_ref
106      CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
107      tau0 = itau_dyn
108       
109        do jj = 1, jjp1
110        do ii = 1, iip1
111          rlong(ii,jj) = rlonu(ii) * 180. / pi
112          rlat(ii,jj) = rlatu(jj) * 180. / pi
113        enddo
114      enddo
115
116      jjb=jj_begin
117      jje=jj_end
118      jjn=jj_nb
119
120      ddid=(/ 1,2 /)
121      dsg=(/ iip1,jjp1 /)
122      dsl=(/ iip1,jjn /)
123      dpf=(/ 1,jjb /)
124      dpl=(/ iip1,jje /)
125      dhs=(/ 0,0 /)
126      dhe=(/ 0,0 /)
127
128      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
129     .                 'box',dynu_domain_id)
130       
131      call histbeg(trim(infile),iip1, rlong(:,1), jjn, rlat(1,jjb:jje),
132     .             1, iip1, 1, jjn, tau0, zjulian, tstep, uhoriid,
133     .             fileid,dynu_domain_id)
134C
135C  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
136C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
137C  un meme fichier)
138
139
140      do jj = 1, jjm
141        do ii = 1, iip1
142          rlong(ii,jj) = rlonv(ii) * 180. / pi
143          rlat(ii,jj) = rlatv(jj) * 180. / pi
144        enddo
145      enddo
146
147      jjb=jj_begin
148      jje=jj_end
149      jjn=jj_nb
150      if (pole_sud) jje=jj_end-1
151      if (pole_sud) jjn=jj_nb-1
152
153      ddid=(/ 1,2 /)
154      dsg=(/ iip1,jjm /)
155      dsl=(/ iip1,jjn /)
156      dpf=(/ 1,jjb /)
157      dpl=(/ iip1,jje /)
158      dhs=(/ 0,0 /)
159      dhe=(/ 0,0 /)
160
161      call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
162     .                 'box',dynv_domain_id)
163     
164      call histbeg('fluxstokev',iip1, rlong(:,1), jjn, rlat(1,jjb:jje),
165     .             1, iip1, 1, jjn,tau0, zjulian, tstep, vhoriid,
166     .             filevid,dynv_domain_id)
167       
168      rl(1,1) = 1.     
169     
170      if (mpi_rank==0) then
171         
172        call histbeg('defstoke.nc', 1, rl, 1, rl,
173     .               1, 1, 1, 1,
174     .               tau0, zjulian, tstep, dhoriid, filedid)
175     
176      endif
177C
178C  Appel a histhori pour rajouter les autres grilles horizontales
179C
180      do jj = 1, jjp1
181        do ii = 1, iip1
182          rlong(ii,jj) = rlonv(ii) * 180. / pi
183          rlat(ii,jj) = rlatu(jj) * 180. / pi
184        enddo
185      enddo
186
187      jjb=jj_begin
188      jje=jj_end
189      jjn=jj_nb
190
191      call histhori(fileid, iip1, rlong(:,jjb:jje),jjn,rlat(:,jjb:jje),
192     .             'scalar','Grille points scalaires', thoriid)
193       
194C
195C  Appel a histvert pour la grille verticale
196C
197      call histvert(fileid, 'sig_s', 'Niveaux sigma',
198     . 'sigma_level',
199     .              llm, nivsigs, zvertiid)
200C Pour le fichier V
201      call histvert(filevid, 'sig_s', 'Niveaux sigma',
202     .  'sigma_level',
203     .              llm, nivsigs, zvertiid)
204c pour le fichier def
205      nivd(1) = 1
206      call histvert(filedid, 'sig_s', 'Niveaux sigma',
207     .  'sigma_level',
208     .              1, nivd, dvertiid)
209
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      call histend(filedid)
285      if (ok_sync) then
286        call histsync(fileid)
287        call histsync(filevid)
288        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.