libf/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
     .  (infile,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      infile: nom du fichier histoire a creer
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
      character*(*) infile
      integer*4 itau
      real tstep, t_ops, t_wrt
      integer fileid, filevid,filedid
      integer nq,ndex(1)
      real nivd(1)

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