source: LMDZ4/trunk/libf/dyn3dpar/initfluxsto_p.F @ 807

Last change on this file since 807 was 774, checked in by Laurent Fairhead, 17 years ago

Suite du merge entre la version et la HEAD: quelques modifications de
Yann sur le

LF

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 6.6 KB
Line 
1!
2! $Header$
3!
4      subroutine initfluxsto_p
5     .  (infile,tstep,t_ops,t_wrt,nq,
6     .                    fileid,filevid,filedid)
7
8       USE IOIPSL
9       use parallel
10       use Write_field
11       use misc_mod
12       
13      implicit none
14
15C
16C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
17C   au format IOIPSL
18C
19C   Appels succesifs des routines: histbeg
20C                                  histhori
21C                                  histver
22C                                  histdef
23C                                  histend
24C
25C   Entree:
26C
27C      infile: nom du fichier histoire a creer
28C      day0,anne0: date de reference
29C      tstep: duree du pas de temps en seconde
30C      t_ops: frequence de l'operation pour IOIPSL
31C      t_wrt: frequence d'ecriture sur le fichier
32C      nq: nombre de traceurs
33C
34C   Sortie:
35C      fileid: ID du fichier netcdf cree
36C      filevid:ID du fichier netcdf pour la grille v
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
54C   Arguments
55C
56      character*(*) infile
57      integer*4 itau
58      real tstep, t_ops, t_wrt
59      integer fileid, filevid,filedid
60      integer nq,ndex(1)
61      real nivd(1)
62
63C   Variables locales
64C
65      integer tau0
66      real zjulian
67      character*3 str
68      character*10 ctrac
69      integer iq
70      real rlong(iip1,jjp1), rlat(iip1,jjp1),rl(1,1)
71      integer uhoriid, vhoriid, thoriid, zvertiid,dhoriid,dvertiid
72      integer ii,jj
73      integer zan, idayref
74      logical ok_sync
75      integer :: jjb,jje,jjn
76C
77C  Initialisations
78C
79      pi = 4. * atan (1.)
80      str='q  '
81      ctrac = 'traceur   '
82      ok_sync = .true.
83C
84C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
85C         
86
87      zan = annee_ref
88      idayref = day_ref
89      CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
90      tau0 = itau_dyn
91       
92        do jj = 1, jjp1
93        do ii = 1, iip1
94          rlong(ii,jj) = rlonu(ii) * 180. / pi
95          rlat(ii,jj) = rlatu(jj) * 180. / pi
96        enddo
97      enddo
98
99      jjb=jj_begin
100      jje=jj_end
101      jjn=jj_nb
102       
103      call histbeg(trim(infile)//'_'//trim(int2str(mpi_rank))//'.nc',
104     .             iip1, rlong(:,1), jjp1, rlat(1,jjb:jje),
105     .             1, iip1, 1, jjn,
106     .             tau0, zjulian, tstep, uhoriid, fileid)
107C
108C  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
109C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
110C  un meme fichier)
111
112
113      do jj = 1, jjm
114        do ii = 1, iip1
115          rlong(ii,jj) = rlonv(ii) * 180. / pi
116          rlat(ii,jj) = rlatv(jj) * 180. / pi
117        enddo
118      enddo
119
120      jjb=jj_begin
121      jje=jj_end
122      jjn=jj_nb
123      if (pole_sud) jje=jj_end-1
124      if (pole_sud) jjn=jj_nb-1
125
126      call histbeg('fluxstokev_'//trim(int2str(mpi_rank))//'.nc',
127     .             iip1, rlong(:,1), jjm, rlat(1,jjb:jje),
128     .             1, iip1, 1, jjn,
129     .             tau0, zjulian, tstep, vhoriid, filevid)
130       
131      rl(1,1) = 1.     
132     
133      if (mpi_rank==0) then
134         
135        call histbeg('defstoke.nc', 1, rl, 1, rl,
136     .               1, 1, 1, 1,
137     .               tau0, zjulian, tstep, dhoriid, filedid)
138     
139      endif
140C
141C  Appel a histhori pour rajouter les autres grilles horizontales
142C
143      do jj = 1, jjp1
144        do ii = 1, iip1
145          rlong(ii,jj) = rlonv(ii) * 180. / pi
146          rlat(ii,jj) = rlatu(jj) * 180. / pi
147        enddo
148      enddo
149
150      jjb=jj_begin
151      jje=jj_end
152      jjn=jj_nb
153
154      call histhori(fileid, iip1, rlong(:,jjb:jje),jjn,rlat(:,jjb:jje),
155     .             'scalar','Grille points scalaires', thoriid)
156       
157C
158C  Appel a histvert pour la grille verticale
159C
160      call histvert(fileid, 'sig_s', 'Niveaux sigma',
161     . 'sigma_level',
162     .              llm, nivsigs, zvertiid)
163C Pour le fichier V
164      call histvert(filevid, 'sig_s', 'Niveaux sigma',
165     .  'sigma_level',
166     .              llm, nivsigs, zvertiid)
167c pour le fichier def
168      nivd(1) = 1
169      call histvert(filedid, 'sig_s', 'Niveaux sigma',
170     .  'sigma_level',
171     .              1, nivd, dvertiid)
172
173C
174C  Appels a histdef pour la definition des variables a sauvegarder
175       
176        CALL histdef(fileid, "phis", "Surface geop. height", "-",
177     .                iip1,jjn,thoriid, 1,1,1, -99, 32,
178     .                "once", t_ops, t_wrt)
179
180         CALL histdef(fileid, "aire", "Grid area", "-",
181     .                iip1,jjn,thoriid, 1,1,1, -99, 32,
182     .                "once", t_ops, t_wrt)
183       
184        if (mpi_rank==0) then
185       
186        CALL histdef(filedid, "dtvr", "tps dyn", "s",
187     .                1,1,dhoriid, 1,1,1, -99, 32,
188     .                "once", t_ops, t_wrt)
189       
190         CALL histdef(filedid, "istdyn", "tps stock", "s",
191     .                1,1,dhoriid, 1,1,1, -99, 32,
192     .                "once", t_ops, t_wrt)
193         
194         CALL histdef(filedid, "istphy", "tps stock phy", "s",
195     .                1,1,dhoriid, 1,1,1, -99, 32,
196     .                "once", t_ops, t_wrt)
197
198        endif
199C
200C Masse
201C
202      call histdef(fileid, 'masse', 'Masse', 'kg',
203     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
204     .             32, 'inst(X)', t_ops, t_wrt)
205C
206C  Pbaru
207C
208      call histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s',
209     .             iip1, jjn, uhoriid, llm, 1, llm, zvertiid,
210     .             32, 'inst(X)', t_ops, t_wrt)
211
212C
213C  Pbarv
214C
215      if (pole_sud) jjn=jj_nb-1
216     
217      call histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s',
218     .             iip1, jjn, vhoriid, llm, 1, llm, zvertiid,
219     .             32, 'inst(X)', t_ops, t_wrt)
220C
221C  w
222C
223      if (pole_sud) jjn=jj_nb
224      call histdef(fileid, 'w', 'flx de masse vert', 'kg m/s',
225     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
226     .             32, 'inst(X)', t_ops, t_wrt)
227
228C
229C  Temperature potentielle
230C
231      call histdef(fileid, 'teta', 'temperature potentielle', '-',
232     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
233     .             32, 'inst(X)', t_ops, t_wrt)
234C
235
236C
237C Geopotentiel
238C
239      call histdef(fileid, 'phi', 'geopotentiel instantane', '-',
240     .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
241     .             32, 'inst(X)', t_ops, t_wrt)
242C
243C  Fin
244C
245      call histend(fileid)
246      call histend(filevid)
247      call histend(filedid)
248      if (ok_sync) then
249        call histsync(fileid)
250        call histsync(filevid)
251        call histsync(filedid)
252      endif
253       
254      return
255      end
Note: See TracBrowser for help on using the repository browser.