trunk/bibio/initfluxsto.f

SUBROUTINE initfluxsto(tstep, t_ops, t_wrt, nq, fileid, filevid, filedid)

  ! From bibio/initfluxsto.F, v 1.1.1.1 2004/05/19 12:53:05

  !   Routine d'initialisation des ecritures des fichiers histoires LMDZ  
  !   au format IOIPSL                                                    
  !   Appels succesifs des routines: histbeg                              
  !                                  histhori                             
  !                                  histver                              
  !                                  histdef                              
  !                                  histend                              

  !   Entree:                                                             
  !      day0, anne0: date de reference                                    
  !      tstep: duree du pas de temps en seconde                          
  !      t_ops: frequence de l'operation pour IOIPSL                      
  !      t_wrt: frequence d'ecriture sur le fichier                       
  !      nq: nombre de traceurs                                           

  !   Sortie:                                                             
  !      fileid: ID du fichier netcdf cree                                
  !      filevid:ID du fichier netcdf pour la grille v                    

  !   L. Fairhead, 03/99                                             

  USE calendar
  USE histcom
  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

  !   Arguments                                                           
  INTEGER itau
  REAL, INTENT (IN) :: tstep
  REAL t_ops, t_wrt
  INTEGER fileid, filevid, filedid
  INTEGER nq, ndex(1)
  REAL nivd(1)

  !   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

  !---------------------------------------------------------

  !  Initialisations                                                      

  pi = 4.*atan(1.)
  str = 'q  '
  ctrac = 'traceur   '
  ok_sync = .TRUE.

  !  Appel a histbeg: creation du fichier netcdf et initialisations diverses

  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
     END DO
  END DO

  CALL histbeg_totreg('fluxstoke', rlong(:, 1), rlat(1, :), 1, iip1, 1, jjp1, &
       itau_dyn, zjulian, tstep, uhoriid, fileid)

  !  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
  !  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
  !  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
     END DO
  END DO

  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)

  !  Appel a histhori pour rajouter les autres grilles horizontales       

  DO jj = 1, jjp1
     DO ii = 1, iip1
        rlong(ii, jj) = rlonv(ii)*180./pi
        rlat(ii, jj) = rlatu(jj)*180./pi
     END DO
  END DO

  CALL histhori_regular(fileid, iip1, rlong, jjp1, rlat, 'scalar', &
       'Grille points scalaires', thoriid)

  !  Appel a histvert pour la grille verticale                            

  CALL histvert(fileid, 'sig_s', 'Niveaux sigma', 'sigma_level', llm, &
       nivsigs, zvertiid)
  ! Pour le fichier V                                                     
  CALL histvert(filevid, 'sig_s', 'Niveaux sigma', 'sigma_level', llm, &
       nivsigs, zvertiid)
  ! pour le fichier def                                                   
  nivd(1) = 1
  CALL histvert(filedid, 'sig_s', 'Niveaux sigma', 'sigma_level', 1, nivd, &
       dvertiid)

  !  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)
  CALL histdef(fileid, 'masse', 'Masse', 'kg', iip1, jjp1, thoriid, llm, 1, &
       llm, zvertiid, 'inst(X)', t_ops, t_wrt)
  CALL histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s', iip1, jjp1, &
       uhoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
  CALL histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s', iip1, jjm, &
       vhoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
  CALL histdef(fileid, 'w', 'flx de masse vert', 'kg m/s', iip1, jjp1, &
       thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
  CALL histdef(fileid, 'teta', 'temperature potentielle', '-', iip1, jjp1, &
       thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
  CALL histdef(fileid, 'phi', 'geopotentiel instantane', '-', iip1, jjp1, &
       thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)

  CALL histend(fileid)
  CALL histend(filevid)
  CALL histend(filedid)
  IF (ok_sync) THEN
     CALL histsync(fileid)
     CALL histsync(filevid)
     CALL histsync(filedid)
  END IF

END SUBROUTINE initfluxsto
1	guez	31	SUBROUTINE initfluxsto(tstep, t_ops, t_wrt, nq, fileid, filevid, filedid)
2	guez	3
3	guez	31	! From bibio/initfluxsto.F, v 1.1.1.1 2004/05/19 12:53:05
4	guez	3
5	guez	31	! Routine d'initialisation des ecritures des fichiers histoires LMDZ
6			! au format IOIPSL
7			! Appels succesifs des routines: histbeg
8			! histhori
9			! histver
10			! histdef
11			! histend
12	guez	3
13	guez	31	! Entree:
14			! day0, anne0: date de reference
15			! tstep: duree du pas de temps en seconde
16			! t_ops: frequence de l'operation pour IOIPSL
17			! t_wrt: frequence d'ecriture sur le fichier
18			! nq: nombre de traceurs
19	guez	3
20	guez	31	! Sortie:
21			! fileid: ID du fichier netcdf cree
22			! filevid:ID du fichier netcdf pour la grille v
23	guez	3
24	guez	31	! L. Fairhead, 03/99
25	guez	3
26	guez	31	USE calendar
27			USE histcom
28			USE dimens_m
29			USE paramet_m
30			USE comconst
31			USE comvert
32			USE logic
33			USE comgeom
34			USE serre
35			USE temps, ONLY : annee_ref, day_ref, itau_dyn
36			USE ener
37	guez	3
38	guez	31	IMPLICIT NONE
39	guez	3
40	guez	31	! Arguments
41			INTEGER itau
42			REAL, INTENT (IN) :: tstep
43			REAL t_ops, t_wrt
44			INTEGER fileid, filevid, filedid
45			INTEGER nq, ndex(1)
46			REAL nivd(1)
47	guez	3
48	guez	31	! Variables locales
49			REAL zjulian
50			CHARACTER*3 str
51			CHARACTER*10 ctrac
52			INTEGER iq
53			REAL rlong(iip1, jjp1), rlat(iip1, jjp1)
54			INTEGER uhoriid, vhoriid, thoriid, zvertiid, dhoriid, dvertiid
55			INTEGER ii, jj
56			INTEGER zan, idayref
57			LOGICAL ok_sync
58	guez	3
59	guez	31	!---------------------------------------------------------
60	guez	3
61	guez	31	! Initialisations
62	guez	3
63	guez	31	pi = 4.*atan(1.)
64			str = 'q '
65			ctrac = 'traceur '
66			ok_sync = .TRUE.
67	guez	3
68	guez	31	! Appel a histbeg: creation du fichier netcdf et initialisations diverses
69	guez	3
70	guez	31	zan = annee_ref
71			idayref = day_ref
72			CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
73	guez	3
74	guez	31	DO jj = 1, jjp1
75			DO ii = 1, iip1
76			rlong(ii, jj) = rlonu(ii)*180./pi
77			rlat(ii, jj) = rlatu(jj)*180./pi
78			END DO
79			END DO
80	guez	3
81	guez	31	CALL histbeg_totreg('fluxstoke', rlong(:, 1), rlat(1, :), 1, iip1, 1, jjp1, &
82			itau_dyn, zjulian, tstep, uhoriid, fileid)
83
84			! Creation du fichier histoire pour la grille en V (oblige pour l'instant,
85			! IOIPSL ne permet pas de grilles avec des nombres de point differents dans
86			! un meme fichier)
87
88			DO jj = 1, jjm
89			DO ii = 1, iip1
90			rlong(ii, jj) = rlonv(ii)*180./pi
91			rlat(ii, jj) = rlatv(jj)*180./pi
92			END DO
93			END DO
94
95			CALL histbeg_totreg('fluxstokev.nc', rlong(:, 1), rlat(1, :jjm), 1, iip1, &
96			1, jjm, itau_dyn, zjulian, tstep, vhoriid, filevid)
97
98			CALL histbeg_totreg('defstoke.nc', (/1./), (/1./), 1, 1, 1, 1, itau_dyn, &
99			zjulian, tstep, dhoriid, filedid)
100
101			! Appel a histhori pour rajouter les autres grilles horizontales
102
103			DO jj = 1, jjp1
104			DO ii = 1, iip1
105			rlong(ii, jj) = rlonv(ii)*180./pi
106			rlat(ii, jj) = rlatu(jj)*180./pi
107			END DO
108			END DO
109
110			CALL histhori_regular(fileid, iip1, rlong, jjp1, rlat, 'scalar', &
111			'Grille points scalaires', thoriid)
112
113			! Appel a histvert pour la grille verticale
114
115			CALL histvert(fileid, 'sig_s', 'Niveaux sigma', 'sigma_level', llm, &
116			nivsigs, zvertiid)
117			! Pour le fichier V
118			CALL histvert(filevid, 'sig_s', 'Niveaux sigma', 'sigma_level', llm, &
119			nivsigs, zvertiid)
120			! pour le fichier def
121			nivd(1) = 1
122			CALL histvert(filedid, 'sig_s', 'Niveaux sigma', 'sigma_level', 1, nivd, &
123			dvertiid)
124
125			! Appels a histdef pour la definition des variables a sauvegarder
126			CALL histdef(fileid, 'phis', 'Surface geop. height', '-', iip1, jjp1, &
127			thoriid, 1, 1, 1, -99, 'once', t_ops, t_wrt)
128			CALL histdef(fileid, 'aire', 'Grid area', '-', iip1, jjp1, thoriid, 1, 1, &
129			1, -99, 'once', t_ops, t_wrt)
130			CALL histdef(filedid, 'dtvr', 'tps dyn', 's', 1, 1, dhoriid, 1, 1, 1, -99, &
131			'once', t_ops, t_wrt)
132			CALL histdef(filedid, 'istdyn', 'tps stock', 's', 1, 1, dhoriid, 1, 1, 1, &
133			-99, 'once', t_ops, t_wrt)
134			CALL histdef(filedid, 'istphy', 'tps stock phy', 's', 1, 1, dhoriid, 1, 1, &
135			1, -99, 'once', t_ops, t_wrt)
136			CALL histdef(fileid, 'masse', 'Masse', 'kg', iip1, jjp1, thoriid, llm, 1, &
137			llm, zvertiid, 'inst(X)', t_ops, t_wrt)
138			CALL histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s', iip1, jjp1, &
139			uhoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
140			CALL histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s', iip1, jjm, &
141			vhoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
142			CALL histdef(fileid, 'w', 'flx de masse vert', 'kg m/s', iip1, jjp1, &
143			thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
144			CALL histdef(fileid, 'teta', 'temperature potentielle', '-', iip1, jjp1, &
145			thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
146			CALL histdef(fileid, 'phi', 'geopotentiel instantane', '-', iip1, jjp1, &
147			thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
148
149			CALL histend(fileid)
150			CALL histend(filevid)
151			CALL histend(filedid)
152			IF (ok_sync) THEN
153			CALL histsync(fileid)
154			CALL histsync(filevid)
155			CALL histsync(filedid)
156			END IF
157
158			END SUBROUTINE initfluxsto