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, version 1.1.1.1 2004/05/19 12:53:05

    ! Routine d'initialisation des écritures des fichiers histoires LMDZ
    ! au format IOIPSL
    ! Appels successifs des routines : histbeg, histhori, histver,
    ! histdef, histend

    ! Entrées :
    ! day0, anne0: date de référence
    ! tstep : durée du pas de temps en secondes
    ! t_ops : fréquence de l'opération pour IOIPSL
    ! t_wrt : fréquence d'écriture sur le fichier
    ! nq : nombre de traceurs

    ! Sorties :
    ! fileid : ID du fichier Netcdf créé
    ! filevid : ID du fichier Netcdf pour la grille v

    ! L. Fairhead, LMD, 03/99

    USE calendar
    use histcom
    use dimens_m
    use paramet_m
    use comconst
    use comvert
    use logic
    use comgeom
    use serre
    use temps
    use ener
    use iniadvtrac_m
    use nr_util, only: pi

    ! 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

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

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