Sources/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 comconst
  USE comgeom
  use conf_gcm_m
  USE dimens_m
  USE disvert_m
  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 nr_util, ONLY : pi
  USE paramet_m
  USE serre
  USE temps, ONLY : annee_ref, day_ref, itau_dyn
  use ymds2ju_m, only: ymds2ju

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