trunk/bibio/initfluxsto.f

!
! $Header: /home/cvsroot/LMDZ4/libf/bibio/initfluxsto.F,v 1.1.1.1 2004/05/19 12:53:05 lmdzadmin Exp $
!
      subroutine initfluxsto
     .  (tstep,t_ops,t_wrt,nq,
     .                    fileid,filevid,filedid)

       USE IOIPSL

C
C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
C   au format IOIPSL
C
C   Appels succesifs des routines: histbeg
C                                  histhori
C                                  histver
C                                  histdef
C                                  histend
C
C   Entree:
C
C      day0,anne0: date de reference
C      tstep: duree du pas de temps en seconde
C      t_ops: frequence de l'operation pour IOIPSL
C      t_wrt: frequence d'ecriture sur le fichier
C      nq: nombre de traceurs
C
C   Sortie:
C      fileid: ID du fichier netcdf cree
C      filevid:ID du fichier netcdf pour la grille v
C
C   L. Fairhead, LMD, 03/99
C
C =====================================================================
C
C   Declarations
       use dimens_m
      use paramet_m
      use comconst
      use comvert
      use logic
      use comgeom
      use serre
      use temps, only: annee_ref, day_ref, itau_dyn
      use ener
      implicit none

C   Arguments
C
      integer*4 itau
      real, intent(in):: tstep
      real t_ops, t_wrt
      integer fileid, filevid,filedid
      integer nq,ndex(1)
      real nivd(1)

C   Variables locales
      real zjulian
      character*3 str
      character*10 ctrac
      integer iq
      real rlong(iip1,jjp1), rlat(iip1,jjp1)
      integer uhoriid, vhoriid, thoriid, zvertiid,dhoriid,dvertiid
      integer ii,jj
      integer zan, idayref
      logical ok_sync
C
C  Initialisations
C
      pi = 4. * atan (1.)
      str='q  '
      ctrac = 'traceur   '
      ok_sync = .true.
C
C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
C         

      zan = annee_ref
      idayref = day_ref
      CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
        
        do jj = 1, jjp1
        do ii = 1, iip1
          rlong(ii,jj) = rlonu(ii) * 180. / pi
          rlat(ii,jj) = rlatu(jj) * 180. / pi
        enddo
      enddo
 
      call histbeg_totreg('fluxstoke', rlong(:,1), rlat(1,:),
     .             1, iip1, 1, jjp1,
     .             itau_dyn, zjulian, tstep, uhoriid, fileid)
C
C  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans 
C  un meme fichier)


      do jj = 1, jjm
        do ii = 1, iip1
          rlong(ii,jj) = rlonv(ii) * 180. / pi
          rlat(ii,jj) = rlatv(jj) * 180. / pi
        enddo
      enddo

      call histbeg_totreg('fluxstokev.nc', rlong(:,1),
     .             rlat(1,:jjm),1, iip1, 1, jjm,
     .             itau_dyn, zjulian, tstep, vhoriid, filevid)
        
      call histbeg_totreg('defstoke.nc', (/1./), (/1./),
     .             1, 1, 1, 1,
     .             itau_dyn, zjulian, tstep, dhoriid, filedid)

C
C  Appel a histhori pour rajouter les autres grilles horizontales
C
      do jj = 1, jjp1
        do ii = 1, iip1
          rlong(ii,jj) = rlonv(ii) * 180. / pi
          rlat(ii,jj) = rlatu(jj) * 180. / pi
        enddo
      enddo

      call histhori_regular(fileid, iip1, rlong, jjp1, rlat, 'scalar',
     .              'Grille points scalaires', thoriid)
        
C
C  Appel a histvert pour la grille verticale
C
      call histvert(fileid, 'sig_s', 'Niveaux sigma',
     . 'sigma_level',
     .              llm, nivsigs, zvertiid)
C Pour le fichier V
      call histvert(filevid, 'sig_s', 'Niveaux sigma',
     .  'sigma_level',
     .              llm, nivsigs, zvertiid)
c pour le fichier def
      nivd(1) = 1
      call histvert(filedid, 'sig_s', 'Niveaux sigma',
     .  'sigma_level',
     .              1, nivd, dvertiid)

C
C  Appels a histdef pour la definition des variables a sauvegarder
        
        CALL histdef(fileid, "phis", "Surface geop. height", "-",
     .                iip1,jjp1,thoriid, 1,1,1, -99,
     .                "once", t_ops, t_wrt)

         CALL histdef(fileid, "aire", "Grid area", "-",
     .                iip1,jjp1,thoriid, 1,1,1, -99,
     .                "once", t_ops, t_wrt)
        
        CALL histdef(filedid, "dtvr", "tps dyn", "s",
     .                1,1,dhoriid, 1,1,1, -99,
     .                "once", t_ops, t_wrt)
        
         CALL histdef(filedid, "istdyn", "tps stock", "s",
     .                1,1,dhoriid, 1,1,1, -99,
     .                "once", t_ops, t_wrt)
         
         CALL histdef(filedid, "istphy", "tps stock phy", "s",
     .                1,1,dhoriid, 1,1,1, -99,
     .                "once", t_ops, t_wrt)


C
C Masse 
C
      call histdef(fileid, 'masse', 'Masse', 'kg',
     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
     .             'inst(X)', t_ops, t_wrt)
C
C  Pbaru 
C
      call histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s',
     .             iip1, jjp1, uhoriid, llm, 1, llm, zvertiid,
     .             'inst(X)', t_ops, t_wrt)

C
C  Pbarv 
C
      call histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s',
     .             iip1, jjm, vhoriid, llm, 1, llm, zvertiid,
     .             'inst(X)', t_ops, t_wrt)
C
C  w 
C
      call histdef(fileid, 'w', 'flx de masse vert', 'kg m/s',
     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
     .             'inst(X)', t_ops, t_wrt)

C
C  Temperature potentielle
C
      call histdef(fileid, 'teta', 'temperature potentielle', '-',
     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
     .             'inst(X)', t_ops, t_wrt)
C

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