libf/phylmd/initphysto.f90

!
! $Header: /home/cvsroot/LMDZ4/libf/phylmd/initphysto.F,v 1.2 2004/06/22 11:45:32 lmdzadmin Exp $
!
C
C
      subroutine initphysto
     .  (infile,
     .  rlon, rlat, tstep,t_ops,t_wrt,nq,fileid)

      USE calendar
      use histcom
      use dimens_m
      use paramet_m
      use comconst
      use indicesol
      use dimphy
      use logic
      use comgeom
      use serre
      use temps
      use ener
      implicit none

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

C   Arguments
      character*(*) infile
      integer*4 nhoriid, i
      real, intent(in):: tstep
      real t_ops, t_wrt
      integer fileid, filevid
      integer nq,l
      real nivsigs(llm)

C   Variables locales
C
      integer tau0
      real zjulian
      character*3 str
      character*10 ctrac
      integer iq
      integer uhoriid, vhoriid, thoriid, zvertiid
      integer ii,jj
      integer zan, idayref
      logical ok_sync
      REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
C
      REAL, intent(in):: rlon(klon), rlat(klon)

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 = 0
        
        CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon)
         DO i = 1, iim
            zx_lon(i,1) = rlon(i+1)
            zx_lon(i,jjm+1) = rlon(i+1)
         ENDDO
         CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlat,zx_lat)


      call histbeg_totreg(infile, zx_lon(:,1), zx_lat(1,:),
     .             1, iim, 1, jjm+1,
     .             tau0, zjulian, tstep, nhoriid, fileid)

C  Appel a histvert pour la grille verticale
C
        DO l=1,llm
            nivsigs(l)=float(l)
         ENDDO
        
        write(*,*) 'avant histvert ds initphysto'

      call histvert(fileid, 'sig_s', 'Niveaux sigma',
     . 'sigma_level',
     .              llm, nivsigs, zvertiid)
C
C  Appels a histdef pour la definition des variables a sauvegarder
C
        write(*,*) 'apres histvert ds initphysto'

       CALL histdef(fileid, "phis", "Surface geop. height", "-",
     .                iim,jjm+1,nhoriid, 1,1,1, -99, 
     .                "once", t_ops, t_wrt)
c
        write(*,*) 'apres phis ds initphysto'

         CALL histdef(fileid, "aire", "Grid area", "-",
     .                iim,jjm+1,nhoriid, 1,1,1, -99, 
     .                "once", t_ops, t_wrt)
         write(*,*) 'apres aire ds initphysto'

         CALL histdef(fileid, "dtime", "tps phys ", "s",
     .                1,1,nhoriid, 1,1,1, -99, 
     .                "once", t_ops, t_wrt)
        
         CALL histdef(fileid, "istphy", "tps stock", "s",
     .                1,1,nhoriid, 1,1,1, -99, 
     .                "once", t_ops, t_wrt)

C T 
C
      call histdef(fileid, 't', 'Temperature', 'K',
     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
     .              'inst(X)', t_ops, t_wrt)
        write(*,*) 'apres t ds initphysto'
C mfu 
C
      call histdef(fileid, 'mfu', 'flx m. pan. mt', 'kg m/s',
     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
     .              'inst(X)', t_ops, t_wrt)
        write(*,*) 'apres mfu ds initphysto'
C
C mfd 
C
      call histdef(fileid, 'mfd', 'flx m. pan. des', 'kg m/s',
     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
     .              'inst(X)', t_ops, t_wrt)

C
C en_u 
C
      call histdef(fileid, 'en_u', 'flx ent pan mt', 'kg m/s',
     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
     .              'inst(X)', t_ops, t_wrt)
               write(*,*) 'apres en_u ds initphysto'
C
C de_u 
C
      call histdef(fileid, 'de_u', 'flx det pan mt', 'kg m/s',
     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
     .              'inst(X)', t_ops, t_wrt)

C
C en_d 
C
      call histdef(fileid, 'en_d', 'flx ent pan dt', 'kg m/s',
     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
     .              'inst(X)', t_ops, t_wrt)
C

C
C de_d 
C
      call histdef(fileid, 'de_d', 'flx det pan dt', 'kg m/s',
     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
     .              'inst(X)', t_ops, t_wrt)

c coefh frac_impa,frac_nucl
        
        call histdef(fileid, "coefh", " ", " ",
     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
     .              "inst(X)", t_ops, t_wrt)

c abderrahmane le 16 09 02
        call histdef(fileid, "fm_th", " ", " ",
     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
     .              "inst(X)", t_ops, t_wrt)

        call histdef(fileid, "en_th", " ", " ",
     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
     .              "inst(X)", t_ops, t_wrt)
c fin aj
        
        write(*,*) 'apres coefh ds initphysto'  

        call histdef(fileid, 'frac_impa', ' ', ' ',
     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
     .              'inst(X)', t_ops, t_wrt)
        
        call histdef(fileid, 'frac_nucl', ' ', ' ',
     .             iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
     .              'inst(X)', t_ops, t_wrt)

c
c pyu1
c
      CALL histdef(fileid, "pyu1", " ", " ",
     .                iim,jjm+1,nhoriid, 1,1,1, -99, 
     .                "inst(X)", t_ops, t_wrt)

c
c pyv1
c
        CALL histdef(fileid, "pyv1", " ", " ",
     .                iim,jjm+1,nhoriid, 1,1,1, -99, 
     .                "inst(X)", t_ops, t_wrt)
        
        write(*,*) 'apres pyv1 ds initphysto'
c
c ftsol1
c
        call histdef(fileid, "ftsol1", " ", " ",
     .             iim, jjm+1, nhoriid, 1, 1,1, -99,
     .             "inst(X)", t_ops, t_wrt)

c
c ftsol2
c
        call histdef(fileid, "ftsol2", " ", " ",
     .             iim, jjm+1, nhoriid, 1, 1,1, -99,
     .             "inst(X)", t_ops, t_wrt)

c
c ftsol3
c
        call histdef(fileid, "ftsol3", " ", " ",
     .             iim, jjm+1, nhoriid, 1, 1,1, -99,
     .              "inst(X)", t_ops, t_wrt)

c
c ftsol4
c
        call histdef(fileid, "ftsol4", " ", " ",
     .             iim, jjm+1, nhoriid, 1, 1,1, -99,
     .              "inst(X)", t_ops, t_wrt)
        
c
c rain
c
        call histdef(fileid, "rain", " ", " ",
     .             iim, jjm+1, nhoriid, 1, 1,1, -99,
     .              "inst(X)", t_ops, t_wrt)

c
c psrf1
c
        call histdef(fileid, "psrf1", " ", " ",
     .             iim, jjm+1, nhoriid, 1, 1, 1, -99,
     .              "inst(X)", t_ops, t_wrt)
        
c
c psrf2
c
        call histdef(fileid, "psrf2", " ", " ",
     .             iim, jjm+1, nhoriid, 1, 1, 1, -99,
     .              "inst(X)", t_ops, t_wrt)

c
c psrf3
c
        call histdef(fileid, "psrf3", " ", " ",
     .             iim, jjm+1, nhoriid, 1, 1, 1, -99,
     .              "inst(X)", t_ops, t_wrt)

c
c psrf4
c
        call histdef(fileid, "psrf4", " ", " ",
     .             iim, jjm+1, nhoriid, 1, 1, 1, -99,
     .              "inst(X)", t_ops, t_wrt)
        
        write(*,*) 'avant histend ds initphysto'        

      call histend(fileid)
c     if (ok_sync) call histsync(fileid)
      if (ok_sync) call histsync

        
      return
      end
1	guez	3	!
2			! $Header: /home/cvsroot/LMDZ4/libf/phylmd/initphysto.F,v 1.2 2004/06/22 11:45:32 lmdzadmin Exp $
3			!
4			C
5			C
6			subroutine initphysto
7			. (infile,
8			. rlon, rlat, tstep,t_ops,t_wrt,nq,fileid)
9
10	guez	30	USE calendar
11			use histcom
12	guez	3	use dimens_m
13			use paramet_m
14			use comconst
15			use indicesol
16			use dimphy
17			use logic
18			use comgeom
19			use serre
20			use temps
21			use ener
22			implicit none
23
24			C
25			C Routine d'initialisation des ecritures des fichiers histoires LMDZ
26			C au format IOIPSL
27			C
28			C Appels succesifs des routines: histbeg
29			C histhori
30			C histver
31			C histdef
32			C histend
33			C
34			C Entree:
35			C
36			C infile: nom du fichier histoire a creer
37			C day0,anne0: date de reference
38			C tstep: duree du pas de temps en seconde
39			C t_ops: frequence de l'operation pour IOIPSL
40			C t_wrt: frequence d'ecriture sur le fichier
41			C nq: nombre de traceurs
42			C
43			C Sortie:
44			C fileid: ID du fichier netcdf cree
45			C filevid:ID du fichier netcdf pour la grille v
46			C
47			C L. Fairhead, LMD, 03/99
48			C
49			C =====================================================================
50			C
51			C Declarations
52
53			C Arguments
54			character() infile
55			integer*4 nhoriid, i
56	guez	12	real, intent(in):: tstep
57			real t_ops, t_wrt
58	guez	3	integer fileid, filevid
59			integer nq,l
60			real nivsigs(llm)
61
62			C Variables locales
63			C
64			integer tau0
65			real zjulian
66			character*3 str
67			character*10 ctrac
68			integer iq
69			integer uhoriid, vhoriid, thoriid, zvertiid
70			integer ii,jj
71			integer zan, idayref
72			logical ok_sync
73			REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
74			C
75			REAL, intent(in):: rlon(klon), rlat(klon)
76
77			C Initialisations
78			C
79			pi = 4. * atan (1.)
80			str='q '
81			ctrac = 'traceur '
82			ok_sync= .true.
83			C
84			C Appel a histbeg: creation du fichier netcdf et initialisations diverses
85			C
86
87			zan = annee_ref
88			idayref = day_ref
89			CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
90			tau0 = 0
91
92			CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon)
93			DO i = 1, iim
94			zx_lon(i,1) = rlon(i+1)
95			zx_lon(i,jjm+1) = rlon(i+1)
96			ENDDO
97			CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlat,zx_lat)
98
99
100	guez	15	call histbeg_totreg(infile, zx_lon(:,1), zx_lat(1,:),
101	guez	3	. 1, iim, 1, jjm+1,
102			. tau0, zjulian, tstep, nhoriid, fileid)
103
104			C Appel a histvert pour la grille verticale
105			C
106			DO l=1,llm
107			nivsigs(l)=float(l)
108			ENDDO
109
110			write(,) 'avant histvert ds initphysto'
111
112			call histvert(fileid, 'sig_s', 'Niveaux sigma',
113			. 'sigma_level',
114			. llm, nivsigs, zvertiid)
115			C
116			C Appels a histdef pour la definition des variables a sauvegarder
117			C
118			write(,) 'apres histvert ds initphysto'
119
120			CALL histdef(fileid, "phis", "Surface geop. height", "-",
121	guez	15	. iim,jjm+1,nhoriid, 1,1,1, -99,
122	guez	3	. "once", t_ops, t_wrt)
123			c
124			write(,) 'apres phis ds initphysto'
125
126			CALL histdef(fileid, "aire", "Grid area", "-",
127	guez	15	. iim,jjm+1,nhoriid, 1,1,1, -99,
128	guez	3	. "once", t_ops, t_wrt)
129			write(,) 'apres aire ds initphysto'
130
131			CALL histdef(fileid, "dtime", "tps phys ", "s",
132	guez	15	. 1,1,nhoriid, 1,1,1, -99,
133	guez	3	. "once", t_ops, t_wrt)
134
135			CALL histdef(fileid, "istphy", "tps stock", "s",
136	guez	15	. 1,1,nhoriid, 1,1,1, -99,
137	guez	3	. "once", t_ops, t_wrt)
138
139			C T
140			C
141			call histdef(fileid, 't', 'Temperature', 'K',
142			. iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
143	guez	15	. 'inst(X)', t_ops, t_wrt)
144	guez	3	write(,) 'apres t ds initphysto'
145			C mfu
146			C
147			call histdef(fileid, 'mfu', 'flx m. pan. mt', 'kg m/s',
148			. iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
149	guez	15	. 'inst(X)', t_ops, t_wrt)
150	guez	3	write(,) 'apres mfu ds initphysto'
151			C
152			C mfd
153			C
154			call histdef(fileid, 'mfd', 'flx m. pan. des', 'kg m/s',
155			. iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
156	guez	15	. 'inst(X)', t_ops, t_wrt)
157	guez	3
158			C
159			C en_u
160			C
161			call histdef(fileid, 'en_u', 'flx ent pan mt', 'kg m/s',
162			. iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
163	guez	15	. 'inst(X)', t_ops, t_wrt)
164	guez	3	write(,) 'apres en_u ds initphysto'
165			C
166			C de_u
167			C
168			call histdef(fileid, 'de_u', 'flx det pan mt', 'kg m/s',
169			. iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
170	guez	15	. 'inst(X)', t_ops, t_wrt)
171	guez	3
172			C
173			C en_d
174			C
175			call histdef(fileid, 'en_d', 'flx ent pan dt', 'kg m/s',
176			. iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
177	guez	15	. 'inst(X)', t_ops, t_wrt)
178	guez	3	C
179
180			C
181			C de_d
182			C
183			call histdef(fileid, 'de_d', 'flx det pan dt', 'kg m/s',
184			. iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
185	guez	15	. 'inst(X)', t_ops, t_wrt)
186	guez	3
187			c coefh frac_impa,frac_nucl
188
189			call histdef(fileid, "coefh", " ", " ",
190			. iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
191	guez	15	. "inst(X)", t_ops, t_wrt)
192	guez	3
193			c abderrahmane le 16 09 02
194			call histdef(fileid, "fm_th", " ", " ",
195			. iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
196	guez	15	. "inst(X)", t_ops, t_wrt)
197	guez	3
198			call histdef(fileid, "en_th", " ", " ",
199			. iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
200	guez	15	. "inst(X)", t_ops, t_wrt)
201	guez	3	c fin aj
202
203			write(,) 'apres coefh ds initphysto'
204
205			call histdef(fileid, 'frac_impa', ' ', ' ',
206			. iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
207	guez	15	. 'inst(X)', t_ops, t_wrt)
208	guez	3
209			call histdef(fileid, 'frac_nucl', ' ', ' ',
210			. iim, jjm+1, nhoriid, llm, 1, llm, zvertiid,
211	guez	15	. 'inst(X)', t_ops, t_wrt)
212	guez	3
213			c
214			c pyu1
215			c
216			CALL histdef(fileid, "pyu1", " ", " ",
217	guez	15	. iim,jjm+1,nhoriid, 1,1,1, -99,
218	guez	3	. "inst(X)", t_ops, t_wrt)
219
220			c
221			c pyv1
222			c
223			CALL histdef(fileid, "pyv1", " ", " ",
224	guez	15	. iim,jjm+1,nhoriid, 1,1,1, -99,
225	guez	3	. "inst(X)", t_ops, t_wrt)
226
227			write(,) 'apres pyv1 ds initphysto'
228			c
229			c ftsol1
230			c
231			call histdef(fileid, "ftsol1", " ", " ",
232	guez	15	. iim, jjm+1, nhoriid, 1, 1,1, -99,
233	guez	3	. "inst(X)", t_ops, t_wrt)
234
235			c
236			c ftsol2
237			c
238			call histdef(fileid, "ftsol2", " ", " ",
239	guez	15	. iim, jjm+1, nhoriid, 1, 1,1, -99,
240	guez	3	. "inst(X)", t_ops, t_wrt)
241
242			c
243			c ftsol3
244			c
245			call histdef(fileid, "ftsol3", " ", " ",
246			. iim, jjm+1, nhoriid, 1, 1,1, -99,
247	guez	15	. "inst(X)", t_ops, t_wrt)
248	guez	3
249			c
250			c ftsol4
251			c
252			call histdef(fileid, "ftsol4", " ", " ",
253			. iim, jjm+1, nhoriid, 1, 1,1, -99,
254	guez	15	. "inst(X)", t_ops, t_wrt)
255	guez	3
256			c
257			c rain
258			c
259			call histdef(fileid, "rain", " ", " ",
260			. iim, jjm+1, nhoriid, 1, 1,1, -99,
261	guez	15	. "inst(X)", t_ops, t_wrt)
262	guez	3
263			c
264			c psrf1
265			c
266			call histdef(fileid, "psrf1", " ", " ",
267			. iim, jjm+1, nhoriid, 1, 1, 1, -99,
268	guez	15	. "inst(X)", t_ops, t_wrt)
269	guez	3
270			c
271			c psrf2
272			c
273			call histdef(fileid, "psrf2", " ", " ",
274			. iim, jjm+1, nhoriid, 1, 1, 1, -99,
275	guez	15	. "inst(X)", t_ops, t_wrt)
276	guez	3
277			c
278			c psrf3
279			c
280			call histdef(fileid, "psrf3", " ", " ",
281			. iim, jjm+1, nhoriid, 1, 1, 1, -99,
282	guez	15	. "inst(X)", t_ops, t_wrt)
283	guez	3
284			c
285			c psrf4
286			c
287			call histdef(fileid, "psrf4", " ", " ",
288			. iim, jjm+1, nhoriid, 1, 1, 1, -99,
289	guez	15	. "inst(X)", t_ops, t_wrt)
290	guez	3
291			write(,) 'avant histend ds initphysto'
292
293			call histend(fileid)
294			c if (ok_sync) call histsync(fileid)
295			if (ok_sync) call histsync
296
297
298
299			return
300			end