source: LMDZ5/trunk/libf/dyn3d_common/initfluxsto.F @ 2597

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

Cleanup in the dynamics: get rid of comconst.h, make it a module comconst_mod.
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: 6.2 KB
Line 
1!
2! $Id: initfluxsto.F 2597 2016-07-22 06:44:47Z emillour $
3!
4      subroutine initfluxsto
5     .  (infile,tstep,t_ops,t_wrt,
6     .                    fileid,filevid,filedid)
7
8#ifdef CPP_IOIPSL
9       USE IOIPSL
10#endif
11      USE comconst_mod, ONLY: pi
12      implicit none
13
14C
15C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
16C   au format IOIPSL
17C
18C   Appels succesifs des routines: histbeg
19C                                  histhori
20C                                  histver
21C                                  histdef
22C                                  histend
23C
24C   Entree:
25C
26C      infile: nom du fichier histoire a creer
27C      day0,anne0: date de reference
28C      tstep: duree du pas de temps en seconde
29C      t_ops: frequence de l'operation pour IOIPSL
30C      t_wrt: frequence d'ecriture sur le fichier
31C
32C   Sortie:
33C      fileid: ID du fichier netcdf cree
34C      filevid:ID du fichier netcdf pour la grille v
35C
36C   L. Fairhead, LMD, 03/99
37C
38C =====================================================================
39C
40C   Declarations
41      include "dimensions.h"
42      include "paramet.h"
43      include "comvert.h"
44      include "comgeom.h"
45      include "temps.h"
46      include "ener.h"
47      include "logic.h"
48      include "description.h"
49      include "serre.h"
50      include "iniprint.h"
51
52C   Arguments
53C
54      character*(*) infile
55      real tstep, t_ops, t_wrt
56      integer fileid, filevid,filedid
57
58#ifdef CPP_IOIPSL
59! This routine needs IOIPSL to work
60C   Variables locales
61C
62      real nivd(1)
63      integer tau0
64      real zjulian
65      character*3 str
66      character*10 ctrac
67      integer iq
68      real rlong(iip1,jjp1), rlat(iip1,jjp1),rl(1,1)
69      integer uhoriid, vhoriid, thoriid, zvertiid,dhoriid,dvertiid
70      integer ii,jj
71      integer zan, idayref
72      logical ok_sync
73C
74C  Initialisations
75C
76      pi = 4. * atan (1.)
77      str='q  '
78      ctrac = 'traceur   '
79      ok_sync = .true.
80C
81C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
82C         
83
84      zan = annee_ref
85      idayref = day_ref
86      CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
87      tau0 = itau_dyn
88       
89        do jj = 1, jjp1
90        do ii = 1, iip1
91          rlong(ii,jj) = rlonu(ii) * 180. / pi
92          rlat(ii,jj) = rlatu(jj) * 180. / pi
93        enddo
94      enddo
95 
96      call histbeg(infile, iip1, rlong(:,1), jjp1, rlat(1,:),
97     .             1, iip1, 1, jjp1,
98     .             tau0, zjulian, tstep, uhoriid, fileid)
99C
100C  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
101C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
102C  un meme fichier)
103
104
105      do jj = 1, jjm
106        do ii = 1, iip1
107          rlong(ii,jj) = rlonv(ii) * 180. / pi
108          rlat(ii,jj) = rlatv(jj) * 180. / pi
109        enddo
110      enddo
111
112      call histbeg('fluxstokev.nc', iip1, rlong(:,1), jjm, rlat(1,:),
113     .             1, iip1, 1, jjm,
114     .             tau0, zjulian, tstep, vhoriid, filevid)
115       
116        rl(1,1) = 1.
117      call histbeg('defstoke.nc', 1, rl, 1, rl,
118     .             1, 1, 1, 1,
119     .             tau0, zjulian, tstep, dhoriid, filedid)
120
121C
122C  Appel a histhori pour rajouter les autres grilles horizontales
123C
124      do jj = 1, jjp1
125        do ii = 1, iip1
126          rlong(ii,jj) = rlonv(ii) * 180. / pi
127          rlat(ii,jj) = rlatu(jj) * 180. / pi
128        enddo
129      enddo
130
131      call histhori(fileid, iip1, rlong, jjp1, rlat, 'scalar',
132     .              'Grille points scalaires', thoriid)
133       
134C
135C  Appel a histvert pour la grille verticale
136C
137      call histvert(fileid, 'sig_s', 'Niveaux sigma',
138     . 'sigma_level',
139     .              llm, nivsigs, zvertiid)
140C Pour le fichier V
141      call histvert(filevid, 'sig_s', 'Niveaux sigma',
142     .  'sigma_level',
143     .              llm, nivsigs, zvertiid)
144c pour le fichier def
145      nivd(1) = 1
146      call histvert(filedid, 'sig_s', 'Niveaux sigma',
147     .  'sigma_level',
148     .              1, nivd, dvertiid)
149
150C
151C  Appels a histdef pour la definition des variables a sauvegarder
152       
153        CALL histdef(fileid, "phis", "Surface geop. height", "-",
154     .                iip1,jjp1,thoriid, 1,1,1, -99, 32,
155     .                "once", t_ops, t_wrt)
156
157         CALL histdef(fileid, "aire", "Grid area", "-",
158     .                iip1,jjp1,thoriid, 1,1,1, -99, 32,
159     .                "once", t_ops, t_wrt)
160       
161        CALL histdef(filedid, "dtvr", "tps dyn", "s",
162     .                1,1,dhoriid, 1,1,1, -99, 32,
163     .                "once", t_ops, t_wrt)
164       
165         CALL histdef(filedid, "istdyn", "tps stock", "s",
166     .                1,1,dhoriid, 1,1,1, -99, 32,
167     .                "once", t_ops, t_wrt)
168         
169         CALL histdef(filedid, "istphy", "tps stock phy", "s",
170     .                1,1,dhoriid, 1,1,1, -99, 32,
171     .                "once", t_ops, t_wrt)
172
173
174C
175C Masse
176C
177      call histdef(fileid, 'masse', 'Masse', 'kg',
178     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
179     .             32, 'inst(X)', t_ops, t_wrt)
180C
181C  Pbaru
182C
183      call histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s',
184     .             iip1, jjp1, uhoriid, llm, 1, llm, zvertiid,
185     .             32, 'inst(X)', t_ops, t_wrt)
186
187C
188C  Pbarv
189C
190      call histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s',
191     .             iip1, jjm, vhoriid, llm, 1, llm, zvertiid,
192     .             32, 'inst(X)', t_ops, t_wrt)
193C
194C  w
195C
196      call histdef(fileid, 'w', 'flx de masse vert', 'kg m/s',
197     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
198     .             32, 'inst(X)', t_ops, t_wrt)
199
200C
201C  Temperature potentielle
202C
203      call histdef(fileid, 'teta', 'temperature potentielle', '-',
204     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
205     .             32, 'inst(X)', t_ops, t_wrt)
206C
207
208C
209C Geopotentiel
210C
211      call histdef(fileid, 'phi', 'geopotentiel instantane', '-',
212     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
213     .             32, 'inst(X)', t_ops, t_wrt)
214C
215C  Fin
216C
217      call histend(fileid)
218      call histend(filevid)
219      call histend(filedid)
220      if (ok_sync) then
221        call histsync(fileid)
222        call histsync(filevid)
223        call histsync(filedid)
224      endif
225       
226#else
227! tell the user this routine should be run with ioipsl
228      write(lunout,*)"initfluxsto: Warning this routine should not be",
229     &               " used without ioipsl"
230#endif
231! of #ifdef CPP_IOIPSL
232      return
233      end
Note: See TracBrowser for help on using the repository browser.