source: LMDZ5/branches/IPSLCM5A2.1/libf/dyn3d_common/initfluxsto.F @ 5017

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