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

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

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