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 histbeg_totreg_m, ONLY : histbeg_totreg
  USE histdef_m, ONLY : histdef
  USE histend_m, ONLY : histend
  use histhori_regular_m, only: histhori_regular
  use histsync_m, only: histsync
  USE histvert_m, ONLY : histvert
  USE dimens_m
  USE paramet_m
  USE comconst
  USE comvert
  use conf_gcm_m
  USE comgeom
  USE serre
  USE temps, ONLY : annee_ref, day_ref, itau_dyn
  USE ener
  USE nr_util, ONLY : pi

  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                                                      
  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	guez	61	USE histbeg_totreg_m, ONLY : histbeg_totreg
28			USE histdef_m, ONLY : histdef
29			USE histend_m, ONLY : histend
30			use histhori_regular_m, only: histhori_regular
31			use histsync_m, only: histsync
32			USE histvert_m, ONLY : histvert
33	guez	31	USE dimens_m
34			USE paramet_m
35			USE comconst
36			USE comvert
37	guez	57	use conf_gcm_m
38	guez	31	USE comgeom
39			USE serre
40			USE temps, ONLY : annee_ref, day_ref, itau_dyn
41			USE ener
42	guez	39	USE nr_util, ONLY : pi
43	guez	3
44	guez	31	IMPLICIT NONE
45	guez	3
46	guez	31	! Arguments
47			INTEGER itau
48			REAL, INTENT (IN) :: tstep
49			REAL t_ops, t_wrt
50			INTEGER fileid, filevid, filedid
51			INTEGER nq, ndex(1)
52			REAL nivd(1)
53	guez	3
54	guez	31	! Variables locales
55			REAL zjulian
56			CHARACTER*3 str
57			CHARACTER*10 ctrac
58			INTEGER iq
59			REAL rlong(iip1, jjp1), rlat(iip1, jjp1)
60			INTEGER uhoriid, vhoriid, thoriid, zvertiid, dhoriid, dvertiid
61			INTEGER ii, jj
62			INTEGER zan, idayref
63			LOGICAL ok_sync
64	guez	3
65	guez	31	!---------------------------------------------------------
66	guez	3
67	guez	31	! Initialisations
68			str = 'q '
69			ctrac = 'traceur '
70			ok_sync = .TRUE.
71	guez	3
72	guez	31	! Appel a histbeg: creation du fichier netcdf et initialisations diverses
73	guez	3
74	guez	31	zan = annee_ref
75			idayref = day_ref
76			CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
77	guez	3
78	guez	31	DO jj = 1, jjp1
79			DO ii = 1, iip1
80			rlong(ii, jj) = rlonu(ii)*180./pi
81			rlat(ii, jj) = rlatu(jj)*180./pi
82			END DO
83			END DO
84	guez	3
85	guez	31	CALL histbeg_totreg('fluxstoke', rlong(:, 1), rlat(1, :), 1, iip1, 1, jjp1, &
86			itau_dyn, zjulian, tstep, uhoriid, fileid)
87
88			! Creation du fichier histoire pour la grille en V (oblige pour l'instant,
89			! IOIPSL ne permet pas de grilles avec des nombres de point differents dans
90			! un meme fichier)
91
92			DO jj = 1, jjm
93			DO ii = 1, iip1
94			rlong(ii, jj) = rlonv(ii)*180./pi
95			rlat(ii, jj) = rlatv(jj)*180./pi
96			END DO
97			END DO
98
99			CALL histbeg_totreg('fluxstokev.nc', rlong(:, 1), rlat(1, :jjm), 1, iip1, &
100			1, jjm, itau_dyn, zjulian, tstep, vhoriid, filevid)
101
102			CALL histbeg_totreg('defstoke.nc', (/1./), (/1./), 1, 1, 1, 1, itau_dyn, &
103			zjulian, tstep, dhoriid, filedid)
104
105			! Appel a histhori pour rajouter les autres grilles horizontales
106
107			DO jj = 1, jjp1
108			DO ii = 1, iip1
109			rlong(ii, jj) = rlonv(ii)*180./pi
110			rlat(ii, jj) = rlatu(jj)*180./pi
111			END DO
112			END DO
113
114			CALL histhori_regular(fileid, iip1, rlong, jjp1, rlat, 'scalar', &
115			'Grille points scalaires', thoriid)
116
117			! Appel a histvert pour la grille verticale
118
119			CALL histvert(fileid, 'sig_s', 'Niveaux sigma', 'sigma_level', llm, &
120			nivsigs, zvertiid)
121			! Pour le fichier V
122			CALL histvert(filevid, 'sig_s', 'Niveaux sigma', 'sigma_level', llm, &
123			nivsigs, zvertiid)
124			! pour le fichier def
125			nivd(1) = 1
126			CALL histvert(filedid, 'sig_s', 'Niveaux sigma', 'sigma_level', 1, nivd, &
127			dvertiid)
128
129			! Appels a histdef pour la definition des variables a sauvegarder
130			CALL histdef(fileid, 'phis', 'Surface geop. height', '-', iip1, jjp1, &
131			thoriid, 1, 1, 1, -99, 'once', t_ops, t_wrt)
132			CALL histdef(fileid, 'aire', 'Grid area', '-', iip1, jjp1, thoriid, 1, 1, &
133			1, -99, 'once', t_ops, t_wrt)
134			CALL histdef(filedid, 'dtvr', 'tps dyn', 's', 1, 1, dhoriid, 1, 1, 1, -99, &
135			'once', t_ops, t_wrt)
136			CALL histdef(filedid, 'istdyn', 'tps stock', 's', 1, 1, dhoriid, 1, 1, 1, &
137			-99, 'once', t_ops, t_wrt)
138			CALL histdef(filedid, 'istphy', 'tps stock phy', 's', 1, 1, dhoriid, 1, 1, &
139			1, -99, 'once', t_ops, t_wrt)
140			CALL histdef(fileid, 'masse', 'Masse', 'kg', iip1, jjp1, thoriid, llm, 1, &
141			llm, zvertiid, 'inst(X)', t_ops, t_wrt)
142			CALL histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s', iip1, jjp1, &
143			uhoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
144			CALL histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s', iip1, jjm, &
145			vhoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
146			CALL histdef(fileid, 'w', 'flx de masse vert', 'kg m/s', iip1, jjp1, &
147			thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
148			CALL histdef(fileid, 'teta', 'temperature potentielle', '-', iip1, jjp1, &
149			thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
150			CALL histdef(fileid, 'phi', 'geopotentiel instantane', '-', iip1, jjp1, &
151			thoriid, llm, 1, llm, zvertiid, 'inst(X)', t_ops, t_wrt)
152
153			CALL histend(fileid)
154			CALL histend(filevid)
155			CALL histend(filedid)
156			IF (ok_sync) THEN
157			CALL histsync(fileid)
158			CALL histsync(filevid)
159			CALL histsync(filedid)
160			END IF
161
162			END SUBROUTINE initfluxsto