libf/bibio/inithist.f90

module inithist_m

  ! This module is clean: no C preprocessor directive, no include line

  implicit none

contains

  subroutine inithist(day0, anne0, tstep, nq, fileid, filevid, t_ops, &
       t_wrt)

    ! From inithist.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, LMD, 03/99

    USE IOIPSL
    use dimens_m
    use paramet_m
    use comconst
    use comvert
    use logic
    use comgeom
    use serre
    use temps
    use ener
    use iniadvtrac_m

    !   Arguments
    integer day0, anne0
    real, intent(in):: tstep, t_ops, t_wrt
    integer fileid, filevid
    integer nq

    !   Variables locales
    real zjulian
    integer iq
    real rlong(iip1,jjp1), rlat(iip1,jjp1)
    integer uhoriid, vhoriid, thoriid, zvertiid
    integer ii,jj
    integer zan, dayref

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

    !  Initialisations

    pi = 4. * atan (1.)

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

    zan = anne0
    dayref = day0
    CALL ymds2ju(zan, 1, dayref, 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
       enddo
    enddo

    call histbeg_totreg("dyn_hist.nc", 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
       enddo
    enddo

    call histbeg_totreg('dyn_histv.nc', rlong(:,1), rlat(1,:jjm), &
         1, iip1, 1, jjm, &
         itau_dyn, zjulian, tstep, vhoriid, filevid)
    !
    !  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
       enddo
    enddo

    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','-', &
         llm, nivsigs, zvertiid)
    ! Pour le fichier V
    call histvert(filevid, 'sig_s', 'Niveaux sigma','-', &
         llm, nivsigs, zvertiid)
    !
    !  Appels a histdef pour la definition des variables a sauvegarder
    !
    !  Vents U
    !
    call histdef(fileid, 'ucov', 'vents u covariants', 'm/s', &
         iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, &
         'inst(X)', t_ops, t_wrt)
    !
    !  Vents V
    !
    call histdef(filevid, 'vcov', 'vents v covariants', 'm/s', &
         iip1, jjm, vhoriid, llm, 1, llm, zvertiid, &
         'inst(X)', t_ops, t_wrt)

    !
    !  Temperature potentielle
    !
    call histdef(fileid, 'teta', 'temperature potentielle', '-', &
         iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
         'inst(X)', t_ops, t_wrt)
    !
    !  Geopotentiel
    !
    call histdef(fileid, 'phi', 'geopotentiel instantane', '-', &
         iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
         'inst(X)', t_ops, t_wrt)
    !
    !  Traceurs
    !
    DO iq=1,nq
       call histdef(fileid, ttext(iq),  ttext(iq), '-', &
            iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
            'inst(X)', t_ops, t_wrt)
    enddo
    !
    !  Masse
    !
    call histdef(fileid, 'masse', 'masse', 'kg', &
         iip1, jjp1, thoriid, 1, 1, 1, -99, &
         'inst(X)', t_ops, t_wrt)
    !
    !  Pression au sol
    !
    call histdef(fileid, 'ps', 'pression naturelle au sol', 'Pa', &
         iip1, jjp1, thoriid, 1, 1, 1, -99, &
         'inst(X)', t_ops, t_wrt)
    !
    !  Pression au sol
    !
    call histdef(fileid, 'phis', 'geopotentiel au sol', '-', &
         iip1, jjp1, thoriid, 1, 1, 1, -99, &
         'inst(X)', t_ops, t_wrt)
    !
    !  Fin
    !
    call histend(fileid)
    call histend(filevid)

  end subroutine inithist

end module inithist_m
1	guez	3	module inithist_m
2
3			! This module is clean: no C preprocessor directive, no include line
4
5			implicit none
6
7			contains
8
9	guez	27	subroutine inithist(day0, anne0, tstep, nq, fileid, filevid, t_ops, &
10	guez	3	t_wrt)
11
12			! From inithist.F,v 1.1.1.1 2004/05/19 12:53:05
13
14			! Routine d'initialisation des ecritures des fichiers histoires LMDZ
15			! au format IOIPSL
16
17			! Appels succesifs des routines: histbeg
18			! histhori
19			! histver
20			! histdef
21			! histend
22
23			! Entree:
24			! day0,anne0: date de reference
25			! tstep: duree du pas de temps en seconde
26			! t_ops: frequence de l'operation pour IOIPSL
27			! t_wrt: frequence d'ecriture sur le fichier
28			! nq: nombre de traceurs
29
30			! Sortie:
31			! fileid: ID du fichier netcdf cree
32			! filevid:ID du fichier netcdf pour la grille v
33
34			! L. Fairhead, LMD, 03/99
35
36			USE IOIPSL
37			use dimens_m
38			use paramet_m
39			use comconst
40			use comvert
41			use logic
42			use comgeom
43			use serre
44			use temps
45			use ener
46	guez	18	use iniadvtrac_m
47	guez	3
48			! Arguments
49			integer day0, anne0
50			real, intent(in):: tstep, t_ops, t_wrt
51			integer fileid, filevid
52			integer nq
53
54			! Variables locales
55			real zjulian
56			integer iq
57			real rlong(iip1,jjp1), rlat(iip1,jjp1)
58			integer uhoriid, vhoriid, thoriid, zvertiid
59			integer ii,jj
60			integer zan, dayref
61
62			!-----------------------------------------------------------------------
63
64			! Initialisations
65
66			pi = 4. * atan (1.)
67
68			! Appel a histbeg: creation du fichier netcdf et initialisations diverses
69
70			zan = anne0
71			dayref = day0
72			CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
73
74			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			enddo
79			enddo
80
81	guez	27	call histbeg_totreg("dyn_hist.nc", rlong(:,1), rlat(1,:), &
82	guez	3	1, iip1, 1, jjp1, &
83	guez	27	itau_dyn, zjulian, tstep, uhoriid, fileid)
84	guez	3	!
85			! Creation du fichier histoire pour la grille en V (oblige pour l'instant,
86	guez	27	! IOIPSL ne permet pas de grilles avec des nombres de point differents dans
87	guez	3	! un meme fichier)
88
89			do jj = 1, jjm
90			do ii = 1, iip1
91			rlong(ii,jj) = rlonv(ii) * 180. / pi
92			rlat(ii,jj) = rlatv(jj) * 180. / pi
93			enddo
94			enddo
95
96	guez	15	call histbeg_totreg('dyn_histv.nc', rlong(:,1), rlat(1,:jjm), &
97	guez	3	1, iip1, 1, jjm, &
98	guez	27	itau_dyn, zjulian, tstep, vhoriid, filevid)
99	guez	3	!
100			! Appel a histhori pour rajouter les autres grilles horizontales
101			!
102			do jj = 1, jjp1
103			do ii = 1, iip1
104			rlong(ii,jj) = rlonv(ii) * 180. / pi
105			rlat(ii,jj) = rlatu(jj) * 180. / pi
106			enddo
107			enddo
108
109	guez	15	call histhori_regular(fileid, iip1, rlong, jjp1, rlat, 'scalar', &
110	guez	3	'Grille points scalaires', thoriid)
111			!
112			! Appel a histvert pour la grille verticale
113			!
114			call histvert(fileid, 'sig_s', 'Niveaux sigma','-', &
115			llm, nivsigs, zvertiid)
116			! Pour le fichier V
117			call histvert(filevid, 'sig_s', 'Niveaux sigma','-', &
118			llm, nivsigs, zvertiid)
119			!
120			! Appels a histdef pour la definition des variables a sauvegarder
121			!
122			! Vents U
123			!
124			call histdef(fileid, 'ucov', 'vents u covariants', 'm/s', &
125			iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, &
126	guez	15	'inst(X)', t_ops, t_wrt)
127	guez	3	!
128			! Vents V
129			!
130			call histdef(filevid, 'vcov', 'vents v covariants', 'm/s', &
131			iip1, jjm, vhoriid, llm, 1, llm, zvertiid, &
132	guez	15	'inst(X)', t_ops, t_wrt)
133	guez	3
134			!
135			! Temperature potentielle
136			!
137			call histdef(fileid, 'teta', 'temperature potentielle', '-', &
138			iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
139	guez	15	'inst(X)', t_ops, t_wrt)
140	guez	3	!
141			! Geopotentiel
142			!
143			call histdef(fileid, 'phi', 'geopotentiel instantane', '-', &
144			iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
145	guez	15	'inst(X)', t_ops, t_wrt)
146	guez	3	!
147			! Traceurs
148			!
149			DO iq=1,nq
150			call histdef(fileid, ttext(iq), ttext(iq), '-', &
151			iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
152	guez	15	'inst(X)', t_ops, t_wrt)
153	guez	3	enddo
154			!
155			! Masse
156			!
157			call histdef(fileid, 'masse', 'masse', 'kg', &
158			iip1, jjp1, thoriid, 1, 1, 1, -99, &
159	guez	15	'inst(X)', t_ops, t_wrt)
160	guez	3	!
161			! Pression au sol
162			!
163			call histdef(fileid, 'ps', 'pression naturelle au sol', 'Pa', &
164			iip1, jjp1, thoriid, 1, 1, 1, -99, &
165	guez	15	'inst(X)', t_ops, t_wrt)
166	guez	3	!
167			! Pression au sol
168			!
169			call histdef(fileid, 'phis', 'geopotentiel au sol', '-', &
170			iip1, jjp1, thoriid, 1, 1, 1, -99, &
171	guez	15	'inst(X)', t_ops, t_wrt)
172	guez	3	!
173			! Fin
174			!
175			call histend(fileid)
176			call histend(filevid)
177
178			end subroutine inithist
179
180			end module inithist_m