Sources/phylmd/initphysto.f

module initphysto_m

  IMPLICIT NONE

contains

  SUBROUTINE initphysto(infile,rlon,rlat,tstep,t_ops,t_wrt,fileid)

    ! From phylmd/initphysto.F,v 1.2 2004/06/22 11:45:32
    !   Routine d'initialisation des ecritures des fichiers histoires LMDZ
    !   au format IOIPSL

    !   Appels succesifs des routines: histbeg
    !                                  histhori
    !                                  histver
    !                                  histdef
    !                                  histend

    !   Entree:

    !      infile: nom du fichier histoire a creer
    !      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

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

    !   L. Fairhead, 03/99

    use dynetat0_m, only: day_ref, annee_ref
    USE histbeg_totreg_m, ONLY : histbeg_totreg
    USE histdef_m, ONLY : histdef
    USE histend_m, ONLY : histend
    use histsync_m, only: histsync
    USE histvert_m, ONLY : histvert
    USE dimens_m
    USE paramet_m
    USE comconst
    USE indicesol
    USE dimphy
    use conf_gcm_m
    USE comgeom
    USE nr_util, ONLY : pi
    USE ymds2ju_m

    !   Arguments
    CHARACTER(len=*) infile
    INTEGER nhoriid, i
    REAL, INTENT (IN) :: tstep
    REAL t_ops, t_wrt
    INTEGER fileid
    INTEGER l
    REAL nivsigs(llm)

    !   Variables locales

    INTEGER tau0
    REAL zjulian
    CHARACTER(len=3) str
    CHARACTER(len=10) ctrac
    INTEGER zvertiid
    LOGICAL ok_sync
    REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)

    REAL, INTENT (IN) :: rlon(klon), rlat(klon)

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

    !  Initialisations
    str = 'q  '
    ctrac = 'traceur   '
    ok_sync = .TRUE.

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

    CALL ymds2ju(annee_ref,1,day_ref,0.0,zjulian)
    tau0 = 0

    CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon)
    DO i = 1, iim
       zx_lon(i,1) = rlon(i+1)
       zx_lon(i,jjm+1) = rlon(i+1)
    END DO
    CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlat,zx_lat)


    CALL histbeg_totreg(infile,zx_lon(:,1),zx_lat(1,:),1,iim,1,jjm+1,tau0, &
         zjulian,tstep,nhoriid,fileid)

    !  Appel a histvert pour la grille verticale

    DO l = 1, llm
       nivsigs(l) = float(l)
    END DO

    CALL histvert(fileid,'sig_s','Niveaux sigma','sigma_level',nivsigs, &
         zvertiid)

    !  Appels a histdef pour la definition des variables a sauvegarder

    CALL histdef(fileid,'phis','Surface geop. height','-',iim,jjm+1,nhoriid, &
         1,1,1,-99,'once',t_ops,t_wrt)

    CALL histdef(fileid,'aire','Grid area','-',iim,jjm+1,nhoriid,1,1,1,-99, &
         'once',t_ops,t_wrt)

    CALL histdef(fileid,'dtime','tps phys ','s',1,1,nhoriid,1,1,1,-99, &
         'once',t_ops,t_wrt)

    CALL histdef(fileid,'istphy','tps stock','s',1,1,nhoriid,1,1,1,-99, &
         'once',t_ops,t_wrt)

    ! T

    CALL histdef(fileid,'t','Temperature','K',iim,jjm+1,nhoriid,llm,1,llm, &
         zvertiid,'inst(X)',t_ops,t_wrt)

    CALL histdef(fileid,'mfu','flx m. pan. mt','kg m/s',iim,jjm+1,nhoriid, &
         llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)

    CALL histdef(fileid,'mfd','flx m. pan. des','kg m/s',iim,jjm+1,nhoriid, &
         llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)


    ! en_u

    CALL histdef(fileid,'en_u','flx ent pan mt','kg m/s',iim,jjm+1,nhoriid, &
         llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)

    CALL histdef(fileid,'de_u','flx det pan mt','kg m/s',iim,jjm+1,nhoriid, &
         llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)


    ! en_d

    CALL histdef(fileid,'en_d','flx ent pan dt','kg m/s',iim,jjm+1,nhoriid, &
         llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)


    ! de_d

    CALL histdef(fileid,'de_d','flx det pan dt','kg m/s',iim,jjm+1,nhoriid, &
         llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)

    ! coefh frac_impa,frac_nucl

    CALL histdef(fileid,'coefh',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
         zvertiid,'inst(X)',t_ops,t_wrt)

    ! abderrahmane le 16 09 02
    CALL histdef(fileid,'fm_th',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
         zvertiid,'inst(X)',t_ops,t_wrt)

    CALL histdef(fileid,'en_th',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
         zvertiid,'inst(X)',t_ops,t_wrt)
    ! fin aj

    CALL histdef(fileid,'frac_impa',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
         zvertiid,'inst(X)',t_ops,t_wrt)

    CALL histdef(fileid,'frac_nucl',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
         zvertiid,'inst(X)',t_ops,t_wrt)


    ! pyu1

    CALL histdef(fileid,'pyu1',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
         'inst(X)',t_ops,t_wrt)


    ! pyv1

    CALL histdef(fileid,'pyv1',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
         'inst(X)',t_ops,t_wrt)

    CALL histdef(fileid,'ftsol1',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
         'inst(X)',t_ops,t_wrt)


    ! ftsol2

    CALL histdef(fileid,'ftsol2',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
         'inst(X)',t_ops,t_wrt)


    ! ftsol3

    CALL histdef(fileid,'ftsol3',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
         'inst(X)',t_ops,t_wrt)


    ! ftsol4

    CALL histdef(fileid,'ftsol4',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
         'inst(X)',t_ops,t_wrt)


    ! rain

    CALL histdef(fileid,'rain',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
         'inst(X)',t_ops,t_wrt)


    ! psrf1

    CALL histdef(fileid,'psrf1',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
         'inst(X)',t_ops,t_wrt)


    ! psrf2

    CALL histdef(fileid,'psrf2',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
         'inst(X)',t_ops,t_wrt)


    ! psrf3

    CALL histdef(fileid,'psrf3',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
         'inst(X)',t_ops,t_wrt)


    ! psrf4

    CALL histdef(fileid,'psrf4',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
         'inst(X)',t_ops,t_wrt)

    CALL histend(fileid)
    IF (ok_sync) CALL histsync

  END SUBROUTINE initphysto

end module initphysto_m
1	guez	155	module initphysto_m
2	guez	3
3	guez	155	IMPLICIT NONE
4	guez	3
5	guez	155	contains
6	guez	3
7	guez	155	SUBROUTINE initphysto(infile,rlon,rlat,tstep,t_ops,t_wrt,fileid)
8	guez	3
9	guez	155	! From phylmd/initphysto.F,v 1.2 2004/06/22 11:45:32
10			! Routine d'initialisation des ecritures des fichiers histoires LMDZ
11			! au format IOIPSL
12	guez	3
13	guez	155	! Appels succesifs des routines: histbeg
14			! histhori
15			! histver
16			! histdef
17			! histend
18	guez	3
19	guez	155	! Entree:
20	guez	3
21	guez	155	! infile: nom du fichier histoire a creer
22			! day0,anne0: date de reference
23			! tstep: duree du pas de temps en seconde
24			! t_ops: frequence de l'operation pour IOIPSL
25			! t_wrt: frequence d'ecriture sur le fichier
26	guez	3
27	guez	155	! Sortie:
28			! fileid: ID du fichier netcdf cree
29			! filevid:ID du fichier netcdf pour la grille v
30	guez	3
31	guez	155	! L. Fairhead, 03/99
32	guez	3
33	guez	155	use dynetat0_m, only: day_ref, annee_ref
34			USE histbeg_totreg_m, ONLY : histbeg_totreg
35			USE histdef_m, ONLY : histdef
36			USE histend_m, ONLY : histend
37			use histsync_m, only: histsync
38			USE histvert_m, ONLY : histvert
39			USE dimens_m
40			USE paramet_m
41			USE comconst
42			USE indicesol
43			USE dimphy
44			use conf_gcm_m
45			USE comgeom
46			USE nr_util, ONLY : pi
47			USE ymds2ju_m
48	guez	3
49	guez	155	! Arguments
50			CHARACTER(len=*) infile
51			INTEGER nhoriid, i
52			REAL, INTENT (IN) :: tstep
53			REAL t_ops, t_wrt
54			INTEGER fileid
55			INTEGER l
56			REAL nivsigs(llm)
57	guez	3
58	guez	155	! Variables locales
59	guez	3
60	guez	155	INTEGER tau0
61			REAL zjulian
62			CHARACTER(len=3) str
63			CHARACTER(len=10) ctrac
64			INTEGER zvertiid
65			LOGICAL ok_sync
66			REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1)
67	guez	3
68	guez	155	REAL, INTENT (IN) :: rlon(klon), rlat(klon)
69	guez	3
70	guez	155	!-----------------------------------------------------
71	guez	3
72	guez	155	! Initialisations
73			str = 'q '
74			ctrac = 'traceur '
75			ok_sync = .TRUE.
76	guez	3
77	guez	155	! Appel a histbeg: creation du fichier netcdf et initialisations
78			! diverses
79	guez	3
80	guez	155	CALL ymds2ju(annee_ref,1,day_ref,0.0,zjulian)
81			tau0 = 0
82	guez	3
83	guez	155	CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlon,zx_lon)
84			DO i = 1, iim
85			zx_lon(i,1) = rlon(i+1)
86			zx_lon(i,jjm+1) = rlon(i+1)
87			END DO
88			CALL gr_fi_ecrit(1,klon,iim,jjm+1,rlat,zx_lat)
89	guez	3
90
91	guez	155	CALL histbeg_totreg(infile,zx_lon(:,1),zx_lat(1,:),1,iim,1,jjm+1,tau0, &
92			zjulian,tstep,nhoriid,fileid)
93	guez	3
94	guez	155	! Appel a histvert pour la grille verticale
95	guez	3
96	guez	155	DO l = 1, llm
97			nivsigs(l) = float(l)
98			END DO
99	guez	3
100	guez	155	CALL histvert(fileid,'sig_s','Niveaux sigma','sigma_level',nivsigs, &
101			zvertiid)
102	guez	3
103	guez	155	! Appels a histdef pour la definition des variables a sauvegarder
104	guez	3
105	guez	155	CALL histdef(fileid,'phis','Surface geop. height','-',iim,jjm+1,nhoriid, &
106			1,1,1,-99,'once',t_ops,t_wrt)
107	guez	3
108	guez	155	CALL histdef(fileid,'aire','Grid area','-',iim,jjm+1,nhoriid,1,1,1,-99, &
109			'once',t_ops,t_wrt)
110	guez	3
111	guez	155	CALL histdef(fileid,'dtime','tps phys ','s',1,1,nhoriid,1,1,1,-99, &
112			'once',t_ops,t_wrt)
113	guez	3
114	guez	155	CALL histdef(fileid,'istphy','tps stock','s',1,1,nhoriid,1,1,1,-99, &
115			'once',t_ops,t_wrt)
116	guez	3
117	guez	155	! T
118	guez	3
119	guez	155	CALL histdef(fileid,'t','Temperature','K',iim,jjm+1,nhoriid,llm,1,llm, &
120			zvertiid,'inst(X)',t_ops,t_wrt)
121	guez	31
122	guez	155	CALL histdef(fileid,'mfu','flx m. pan. mt','kg m/s',iim,jjm+1,nhoriid, &
123			llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
124	guez	31
125	guez	155	CALL histdef(fileid,'mfd','flx m. pan. des','kg m/s',iim,jjm+1,nhoriid, &
126			llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
127	guez	31
128
129	guez	155	! en_u
130	guez	31
131	guez	155	CALL histdef(fileid,'en_u','flx ent pan mt','kg m/s',iim,jjm+1,nhoriid, &
132			llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
133	guez	31
134	guez	155	CALL histdef(fileid,'de_u','flx det pan mt','kg m/s',iim,jjm+1,nhoriid, &
135			llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
136	guez	31
137
138	guez	155	! en_d
139	guez	31
140	guez	155	CALL histdef(fileid,'en_d','flx ent pan dt','kg m/s',iim,jjm+1,nhoriid, &
141			llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
142	guez	31
143
144
145	guez	155	! de_d
146	guez	31
147	guez	155	CALL histdef(fileid,'de_d','flx det pan dt','kg m/s',iim,jjm+1,nhoriid, &
148			llm,1,llm,zvertiid,'inst(X)',t_ops,t_wrt)
149	guez	31
150	guez	155	! coefh frac_impa,frac_nucl
151	guez	31
152	guez	155	CALL histdef(fileid,'coefh',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
153			zvertiid,'inst(X)',t_ops,t_wrt)
154	guez	31
155	guez	155	! abderrahmane le 16 09 02
156			CALL histdef(fileid,'fm_th',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
157			zvertiid,'inst(X)',t_ops,t_wrt)
158	guez	31
159	guez	155	CALL histdef(fileid,'en_th',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
160			zvertiid,'inst(X)',t_ops,t_wrt)
161			! fin aj
162	guez	31
163	guez	155	CALL histdef(fileid,'frac_impa',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
164			zvertiid,'inst(X)',t_ops,t_wrt)
165	guez	31
166	guez	155	CALL histdef(fileid,'frac_nucl',' ',' ',iim,jjm+1,nhoriid,llm,1,llm, &
167			zvertiid,'inst(X)',t_ops,t_wrt)
168	guez	31
169
170	guez	155	! pyu1
171	guez	31
172	guez	155	CALL histdef(fileid,'pyu1',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
173			'inst(X)',t_ops,t_wrt)
174	guez	31
175
176	guez	155	! pyv1
177	guez	31
178	guez	155	CALL histdef(fileid,'pyv1',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
179			'inst(X)',t_ops,t_wrt)
180	guez	31
181	guez	155	CALL histdef(fileid,'ftsol1',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
182			'inst(X)',t_ops,t_wrt)
183	guez	31
184
185	guez	155	! ftsol2
186	guez	31
187	guez	155	CALL histdef(fileid,'ftsol2',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
188			'inst(X)',t_ops,t_wrt)
189	guez	31
190
191	guez	155	! ftsol3
192	guez	31
193	guez	155	CALL histdef(fileid,'ftsol3',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
194			'inst(X)',t_ops,t_wrt)
195	guez	31
196
197	guez	155	! ftsol4
198	guez	31
199	guez	155	CALL histdef(fileid,'ftsol4',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
200			'inst(X)',t_ops,t_wrt)
201	guez	31
202
203	guez	155	! rain
204	guez	31
205	guez	155	CALL histdef(fileid,'rain',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
206			'inst(X)',t_ops,t_wrt)
207	guez	31
208
209	guez	155	! psrf1
210	guez	31
211	guez	155	CALL histdef(fileid,'psrf1',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
212			'inst(X)',t_ops,t_wrt)
213	guez	31
214
215	guez	155	! psrf2
216	guez	31
217	guez	155	CALL histdef(fileid,'psrf2',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
218			'inst(X)',t_ops,t_wrt)
219	guez	31
220
221	guez	155	! psrf3
222	guez	31
223	guez	155	CALL histdef(fileid,'psrf3',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
224			'inst(X)',t_ops,t_wrt)
225	guez	31
226
227	guez	155	! psrf4
228	guez	31
229	guez	155	CALL histdef(fileid,'psrf4',' ',' ',iim,jjm+1,nhoriid,1,1,1,-99, &
230			'inst(X)',t_ops,t_wrt)
231
232			CALL histend(fileid)
233			IF (ok_sync) CALL histsync
234
235			END SUBROUTINE initphysto
236
237			end module initphysto_m