Context Navigation

physiq.F @ 373

Last change on this file since 373 was 373, checked in by lmdzadmin, 22 years ago
Inclusion du nouveau schema de nuages de SB. FH IM/LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 124.3 KB

Line
1	c
2	c $Header$
3	c
4	SUBROUTINE physiq (nlon,nlev,nqmax ,
5	. debut,lafin,rjourvrai,rjour_ecri,gmtime,pdtphys,
6	. paprs,pplay,pphi,pphis,paire,presnivs,clesphy0,
7	. u,v,t,qx,
8	. omega, cufi, cvfi,
9	. d_u, d_v, d_t, d_qx, d_ps)
10	USE ioipsl
11	USE histcom
12	USE writephys
13
14	IMPLICIT none
15	c======================================================================
16	c
17	c Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
18	c
19	c Objet: Moniteur general de la physique du modele
20	cAA Modifications quant aux traceurs :
21	cAA - uniformisation des parametrisations ds phytrac
22	cAA - stockage des moyennes des champs necessaires
23	cAA en mode traceur off-line
24	c======================================================================
25	c modif ( P. Le Van , 12/10/98 )
26	c
27	c Arguments:
28	c
29	c nlon----input-I-nombre de points horizontaux
30	c nlev----input-I-nombre de couches verticales
31	c nqmax---input-I-nombre de traceurs (y compris vapeur d'eau) = 1
32	c debut---input-L-variable logique indiquant le premier passage
33	c lafin---input-L-variable logique indiquant le dernier passage
34	c rjour---input-R-numero du jour de l'experience
35	c gmtime--input-R-temps universel dans la journee (0 a 86400 s)
36	c pdtphys-input-R-pas d'integration pour la physique (seconde)
37	c paprs---input-R-pression pour chaque inter-couche (en Pa)
38	c pplay---input-R-pression pour le mileu de chaque couche (en Pa)
39	c pphi----input-R-geopotentiel de chaque couche (g z) (reference sol)
40	c pphis---input-R-geopotentiel du sol
41	c paire---input-R-aire de chaque maille
42	c presnivs-input_R_pressions approximat. des milieux couches ( en PA)
43	c u-------input-R-vitesse dans la direction X (de O a E) en m/s
44	c v-------input-R-vitesse Y (de S a N) en m/s
45	c t-------input-R-temperature (K)
46	c qx------input-R-humidite specifique (kg/kg) et d'autres traceurs
47	c d_t_dyn-input-R-tendance dynamique pour "t" (K/s)
48	c d_q_dyn-input-R-tendance dynamique pour "q" (kg/kg/s)
49	c omega---input-R-vitesse verticale en Pa/s
50	c cufi----input-R-resolution des mailles en x (m)
51	c cvfi----input-R-resolution des mailles en y (m)
52	c
53	c d_u-----output-R-tendance physique de "u" (m/s/s)
54	c d_v-----output-R-tendance physique de "v" (m/s/s)
55	c d_t-----output-R-tendance physique de "t" (K/s)
56	c d_qx----output-R-tendance physique de "qx" (kg/kg/s)
57	c d_ps----output-R-tendance physique de la pression au sol
58	c======================================================================
59	#include "dimensions.h"
60	integer jjmp1
61	parameter (jjmp1=jjm+1-1/jjm)
62	#include "dimphy.h"
63	#include "regdim.h"
64	#include "indicesol.h"
65	#include "dimsoil.h"
66	#include "clesphys.h"
67	#include "control.h"
68	#include "temps.h"
69	c======================================================================
70	LOGICAL check ! Verifier la conservation du modele en eau
71	PARAMETER (check=.FALSE.)
72	LOGICAL ok_stratus ! Ajouter artificiellement les stratus
73	PARAMETER (ok_stratus=.FALSE.)
74	c======================================================================
75	c Parametres lies au coupleur OASIS:
76	#include "oasis.h"
77	INTEGER,SAVE :: npas, nexca
78	logical rnpb
79	parameter(rnpb=.true.)
80	c PARAMETER (npas=1440)
81	c PARAMETER (nexca=48)
82	EXTERNAL fromcpl, intocpl, inicma
83	c ocean = type de modele ocean a utiliser: force, slab, couple
84	character*6 ocean
85	SAVE ocean
86
87	c parameter (ocean = 'force ')
88	c parameter (ocean = 'couple')
89	logical ok_ocean
90	c======================================================================
91	c Clef controlant l'activation du cycle diurne:
92	ccc LOGICAL cycle_diurne
93	ccc PARAMETER (cycle_diurne=.FALSE.)
94	c======================================================================
95	c Modele thermique du sol, a activer pour le cycle diurne:
96	ccc LOGICAL soil_model
97	ccc PARAMETER (soil_model=.FALSE.)
98	logical ok_veget
99	save ok_veget
100	c parameter (ok_veget = .true.)
101	c parameter (ok_veget = .false.)
102	c======================================================================
103	c Dans les versions precedentes, l'eau liquide nuageuse utilisee dans
104	c le calcul du rayonnement est celle apres la precipitation des nuages.
105	c Si cette cle new_oliq est activee, ce sera une valeur moyenne entre
106	c la condensation et la precipitation. Cette cle augmente les impacts
107	c radiatifs des nuages.
108	ccc LOGICAL new_oliq
109	ccc PARAMETER (new_oliq=.FALSE.)
110	c======================================================================
111	c Clefs controlant deux parametrisations de l'orographie:
112	cc LOGICAL ok_orodr
113	ccc PARAMETER (ok_orodr=.FALSE.)
114	ccc LOGICAL ok_orolf
115	ccc PARAMETER (ok_orolf=.FALSE.)
116	c======================================================================
117	LOGICAL ok_journe ! sortir le fichier journalier
118	save ok_journe
119	c PARAMETER (ok_journe=.true.)
120	c
121	LOGICAL ok_mensuel ! sortir le fichier mensuel
122	save ok_mensuel
123	c PARAMETER (ok_mensuel=.true.)
124	c
125	LOGICAL ok_instan ! sortir le fichier instantane
126	save ok_instan
127	c PARAMETER (ok_instan=.true.)
128	c
129	LOGICAL ok_region ! sortir le fichier regional
130	PARAMETER (ok_region=.FALSE.)
131	c======================================================================
132	c
133	INTEGER ivap ! indice de traceurs pour vapeur d'eau
134	PARAMETER (ivap=1)
135	INTEGER iliq ! indice de traceurs pour eau liquide
136	PARAMETER (iliq=2)
137
138	INTEGER nvm ! nombre de vegetations
139	PARAMETER (nvm=8)
140	REAL veget(klon,nvm) ! couverture vegetale
141	SAVE veget
142
143	c
144	c
145	c Variables argument:
146	c
147	INTEGER nlon
148	INTEGER nlev
149	INTEGER nqmax
150	REAL rjourvrai, rjour_ecri
151	REAL gmtime
152	REAL pdtphys
153	LOGICAL debut, lafin
154	REAL paprs(klon,klev+1)
155	REAL pplay(klon,klev)
156	REAL pphi(klon,klev)
157	REAL pphis(klon)
158	REAL paire(klon)
159	REAL presnivs(klev)
160	REAL znivsig(klev)
161	REAL zsurf(nbsrf)
162	real cufi(klon), cvfi(klon)
163
164	REAL u(klon,klev)
165	REAL v(klon,klev)
166	REAL t(klon,klev)
167	REAL qx(klon,klev,nqmax)
168
169	REAL t_ancien(klon,klev), q_ancien(klon,klev)
170	SAVE t_ancien, q_ancien
171	LOGICAL ancien_ok
172	SAVE ancien_ok
173
174	REAL d_t_dyn(klon,klev)
175	REAL d_q_dyn(klon,klev)
176
177	REAL omega(klon,klev)
178
179	REAL d_u(klon,klev)
180	REAL d_v(klon,klev)
181	REAL d_t(klon,klev)
182	REAL d_qx(klon,klev,nqmax)
183	REAL d_ps(klon)
184
185	INTEGER longcles
186	PARAMETER ( longcles = 20 )
187	REAL clesphy0( longcles )
188	c
189	c Variables quasi-arguments
190	c
191	REAL xjour
192	SAVE xjour
193	c
194	c
195	c Variables propres a la physique
196	c
197	REAL dtime
198	SAVE dtime ! pas temporel de la physique
199	c
200	INTEGER radpas
201	SAVE radpas ! frequence d'appel rayonnement
202	c
203	REAL radsol(klon)
204	SAVE radsol ! bilan radiatif au sol
205	c
206	REAL rlat(klon)
207	SAVE rlat ! latitude pour chaque point
208	c
209	REAL rlon(klon)
210	SAVE rlon ! longitude pour chaque point
211	c
212	cc INTEGER iflag_con
213	cc SAVE iflag_con ! indicateur de la convection
214	c
215	INTEGER itap
216	SAVE itap ! compteur pour la physique
217	c
218	REAL co2_ppm
219	SAVE co2_ppm ! concentration du CO2
220	c
221	REAL solaire
222	SAVE solaire ! constante solaire
223	c
224	REAL ftsol(klon,nbsrf)
225	SAVE ftsol ! temperature du sol
226	c
227	REAL ftsoil(klon,nsoilmx,nbsrf)
228	SAVE ftsoil ! temperature dans le sol
229	c
230	REAL fevap(klon,nbsrf)
231	SAVE fevap ! evaporation
232	REAL fluxlat(klon,nbsrf)
233	SAVE fluxlat
234	c
235	REAL deltat(klon)
236	SAVE deltat ! ecart avec la SST de reference
237	c
238	REAL fqsol(klon,nbsrf)
239	SAVE fqsol ! humidite du sol
240	c
241	REAL fsnow(klon,nbsrf)
242	SAVE fsnow ! epaisseur neigeuse
243	c
244	REAL falbe(klon,nbsrf)
245	SAVE falbe ! albedo par type de surface
246	REAL falblw(klon,nbsrf)
247	SAVE falblw ! albedo par type de surface
248
249	c
250	c
251	c Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):
252	c
253	REAL zmea(klon)
254	SAVE zmea ! orographie moyenne
255	c
256	REAL zstd(klon)
257	SAVE zstd ! deviation standard de l'OESM
258	c
259	REAL zsig(klon)
260	SAVE zsig ! pente de l'OESM
261	c
262	REAL zgam(klon)
263	save zgam ! anisotropie de l'OESM
264	c
265	REAL zthe(klon)
266	SAVE zthe ! orientation de l'OESM
267	c
268	REAL zpic(klon)
269	SAVE zpic ! Maximum de l'OESM
270	c
271	REAL zval(klon)
272	SAVE zval ! Minimum de l'OESM
273	c
274	REAL rugoro(klon)
275	SAVE rugoro ! longueur de rugosite de l'OESM
276	c
277	REAL zulow(klon),zvlow(klon),zustr(klon), zvstr(klon)
278	c
279	REAL zuthe(klon),zvthe(klon)
280	SAVE zuthe
281	SAVE zvthe
282	INTEGER igwd,idx(klon),itest(klon)
283	c
284	REAL agesno(klon,nbsrf)
285	SAVE agesno ! age de la neige
286	c
287	REAL alb_neig(klon)
288	SAVE alb_neig ! albedo de la neige
289	cKE43
290	c Variables liees a la convection de K. Emanuel (sb):
291	c
292	REAL ema_workcbmf(klon) ! cloud base mass flux
293	SAVE ema_workcbmf
294
295	REAL ema_cbmf(klon) ! cloud base mass flux
296	SAVE ema_cbmf
297
298	REAL ema_pcb(klon) ! cloud base pressure
299	SAVE ema_pcb
300
301	REAL ema_pct(klon) ! cloud top pressure
302	SAVE ema_pct
303
304	REAL bas, top ! cloud base and top levels
305	SAVE bas
306	SAVE top
307
308	REAL Ma(klon,klev) ! undilute upward mass flux
309	SAVE Ma
310	REAL ema_work1(klon, klev), ema_work2(klon, klev)
311	SAVE ema_work1, ema_work2
312	REAL wdn(klon), tdn(klon), qdn(klon)
313	c Variables locales pour la couche limite (al1):
314	c
315	cAl1 REAL pblh(klon) ! Hauteur de couche limite
316	cAl1 SAVE pblh
317	c34EK
318	c
319	c Variables locales:
320	c
321	REAL cdragh(klon) ! drag coefficient pour T and Q
322	REAL cdragm(klon) ! drag coefficient pour vent
323	cAA
324	cAA Pour phytrac
325	cAA
326	REAL ycoefh(klon,klev) ! coef d'echange pour phytrac
327	REAL yu1(klon) ! vents dans la premiere couche U
328	REAL yv1(klon) ! vents dans la premiere couche V
329	LOGICAL offline ! Controle du stockage ds "physique"
330	PARAMETER (offline=.false.)
331	INTEGER physid
332	REAL pfrac_impa(klon,klev)! Produits des coefs lessivage impaction
333	save pfrac_impa
334	REAL pfrac_nucl(klon,klev)! Produits des coefs lessivage nucleation
335	save pfrac_nucl
336	REAL pfrac_1nucl(klon,klev)! Produits des coefs lessi nucl (alpha = 1)
337	save pfrac_1nucl
338	REAL frac_impa(klon,klev) ! fractions d'aerosols lessivees (impaction)
339	REAL frac_nucl(klon,klev) ! idem (nucleation)
340	cAA
341	REAL rain_fall(klon) ! pluie
342	REAL snow_fall(klon) ! neige
343	save snow_fall, rain_fall
344	REAL evap(klon), devap(klon) ! evaporation et sa derivee
345	REAL sens(klon), dsens(klon) ! chaleur sensible et sa derivee
346	REAL dlw(klon) ! derivee infra rouge
347	REAL bils(klon) ! bilan de chaleur au sol
348	REAL fder(klon) ! Derive de flux (sensible et latente)
349	save fder
350	REAL ve(klon) ! integr. verticale du transport meri. de l'energie
351	REAL vq(klon) ! integr. verticale du transport meri. de l'eau
352	REAL ue(klon) ! integr. verticale du transport zonal de l'energie
353	REAL uq(klon) ! integr. verticale du transport zonal de l'eau
354	c
355	REAL frugs(klon,nbsrf) ! longueur de rugosite
356	save frugs
357	REAL zxrugs(klon) ! longueur de rugosite
358	c
359	c Conditions aux limites
360	c
361	INTEGER julien
362	c
363	INTEGER lmt_pas
364	SAVE lmt_pas ! frequence de mise a jour
365	REAL pctsrf(klon,nbsrf)
366	SAVE pctsrf ! sous-fraction du sol
367	REAL albsol(klon)
368	SAVE albsol ! albedo du sol total
369	REAL albsollw(klon)
370	SAVE albsollw ! albedo du sol total
371	REAL albsol1(klon)
372	SAVE albsol1 ! albedo du sol total
373	REAL albsollw1(klon)
374	SAVE albsollw1 ! albedo du sol total
375
376	REAL wo(klon,klev)
377	SAVE wo ! ozone
378	c======================================================================
379	c
380	c Declaration des procedures appelees
381	c
382	EXTERNAL angle ! calculer angle zenithal du soleil
383	EXTERNAL alboc ! calculer l'albedo sur ocean
384	EXTERNAL albsno ! calculer albedo sur neige
385	EXTERNAL ajsec ! ajustement sec
386	EXTERNAL clmain ! couche limite
387	EXTERNAL condsurf ! lire les conditions aux limites
388	EXTERNAL conlmd ! convection (schema LMD)
389	cKE43
390	EXTERNAL conema3 ! convect4.3
391	EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)
392	cAA
393	EXTERNAL fisrtilp_tr ! schema de condensation a grande echelle (pluie)
394	c ! stockage des coefficients necessaires au
395	c ! lessivage OFF-LINE et ON-LINE
396	cAA
397	EXTERNAL hgardfou ! verifier les temperatures
398	EXTERNAL nuage ! calculer les proprietes radiatives
399	EXTERNAL o3cm ! initialiser l'ozone
400	EXTERNAL orbite ! calculer l'orbite terrestre
401	EXTERNAL ozonecm ! prescrire l'ozone
402	EXTERNAL phyetat0 ! lire l'etat initial de la physique
403	EXTERNAL phyredem ! ecrire l'etat de redemarrage de la physique
404	EXTERNAL radlwsw ! rayonnements solaire et infrarouge
405	EXTERNAL suphec ! initialiser certaines constantes
406	EXTERNAL transp ! transport total de l'eau et de l'energie
407	EXTERNAL ecribina ! ecrire le fichier binaire global
408	EXTERNAL ecribins ! ecrire le fichier binaire global
409	EXTERNAL ecrirega ! ecrire le fichier binaire regional
410	EXTERNAL ecriregs ! ecrire le fichier binaire regional
411	c
412	c Variables locales
413	c
414	real clwcon(klon,klev),rnebcon(klon,klev)
415	real clwcon0(klon,klev),rnebcon0(klon,klev)
416	save rnebcon, clwcon
417
418	REAL rhcl(klon,klev) ! humiditi relative ciel clair
419	REAL dialiq(klon,klev) ! eau liquide nuageuse
420	REAL diafra(klon,klev) ! fraction nuageuse
421	REAL cldliq(klon,klev) ! eau liquide nuageuse
422	REAL cldfra(klon,klev) ! fraction nuageuse
423	REAL cldtau(klon,klev) ! epaisseur optique
424	REAL cldemi(klon,klev) ! emissivite infrarouge
425	c
426	C§§§ PB
427	REAL fluxq(klon,klev, nbsrf) ! flux turbulent d'humidite
428	REAL fluxt(klon,klev, nbsrf) ! flux turbulent de chaleur
429	REAL fluxu(klon,klev, nbsrf) ! flux turbulent de vitesse u
430	REAL fluxv(klon,klev, nbsrf) ! flux turbulent de vitesse v
431	c
432	REAL zxfluxt(klon, klev)
433	REAL zxfluxq(klon, klev)
434	REAL zxfluxu(klon, klev)
435	REAL zxfluxv(klon, klev)
436	C§§§
437	REAL heat(klon,klev) ! chauffage solaire
438	REAL heat0(klon,klev) ! chauffage solaire ciel clair
439	REAL cool(klon,klev) ! refroidissement infrarouge
440	REAL cool0(klon,klev) ! refroidissement infrarouge ciel clair
441	REAL topsw(klon), toplw(klon), solsw(klon), sollw(klon)
442	real sollwdown(klon) ! downward LW flux at surface
443	REAL topsw0(klon), toplw0(klon), solsw0(klon), sollw0(klon)
444	REAL albpla(klon)
445	c Le rayonnement n'est pas calcule tous les pas, il faut donc
446	c sauvegarder les sorties du rayonnement
447	SAVE heat,cool,albpla,topsw,toplw,solsw,sollw,sollwdown
448	SAVE topsw0,toplw0,solsw0,sollw0, heat0, cool0
449	INTEGER itaprad
450	SAVE itaprad
451	c
452	REAL conv_q(klon,klev) ! convergence de l'humidite (kg/kg/s)
453	REAL conv_t(klon,klev) ! convergence de la temperature(K/s)
454	c
455	REAL cldl(klon),cldm(klon),cldh(klon) !nuages bas, moyen et haut
456	REAL cldt(klon),cldq(klon) !nuage total, eau liquide integree
457	c
458	REAL zxtsol(klon), zxqsol(klon), zxsnow(klon)
459	c
460	REAL dist, rmu0(klon), fract(klon)
461	REAL zdtime, zlongi
462	c
463	CHARACTER*2 str2
464	CHARACTER*2 iqn
465	c
466	REAL qcheck
467	REAL z_avant(klon), z_apres(klon), z_factor(klon)
468	LOGICAL zx_ajustq
469	c
470	REAL za, zb
471	REAL zx_t, zx_qs, zdelta, zcor, zfra, zlvdcp, zlsdcp
472	real zqsat(klon,klev)
473	INTEGER i, k, iq, ig, j, nsrf, ll
474	REAL t_coup
475	PARAMETER (t_coup=234.0)
476	c
477	REAL zphi(klon,klev)
478	REAL zx_tmp_x(iim), zx_tmp_yjjmp1
479	REAL zx_relief(iim,jjmp1)
480	REAL zx_aire(iim,jjmp1)
481	cKE43
482	c Variables locales pour la convection de K. Emanuel (sb):
483	c
484	REAL upwd(klon,klev) ! saturated updraft mass flux
485	REAL dnwd(klon,klev) ! saturated downdraft mass flux
486	REAL dnwd0(klon,klev) ! unsaturated downdraft mass flux
487	REAL tvp(klon,klev) ! virtual temp of lifted parcel
488	REAL cape(klon) ! CAPE
489	SAVE cape
490	REAL pbase(klon) ! cloud base pressure
491	SAVE pbase
492	REAL bbase(klon) ! cloud base buoyancy
493	SAVE bbase
494	REAL rflag(klon) ! flag fonctionnement de convect
495	INTEGER iflagctrl(klon) ! flag fonctionnement de convect
496	c -- convect43:
497	INTEGER ntra ! nb traceurs pour convect4.3
498	REAL pori_con(klon) ! pressure at the origin level of lifted parcel
499	REAL plcl_con(klon),dtma_con(klon),dtlcl_con(klon)
500	REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev)
501	REAL dplcldt(klon), dplcldr(klon)
502	c? . condm_con(klon,klev),conda_con(klon,klev),
503	c? . mr_con(klon,klev),ep_con(klon,klev)
504	c? . ,sadiab(klon,klev),wadiab(klon,klev)
505	c --
506	c34EK
507	c
508	c Variables du changement
509	c
510	c con: convection
511	c lsc: condensation a grande echelle (Large-Scale-Condensation)
512	c ajs: ajustement sec
513	c eva: evaporation de l'eau liquide nuageuse
514	c vdf: couche limite (Vertical DiFfusion)
515	REAL d_t_con(klon,klev),d_q_con(klon,klev)
516	REAL d_u_con(klon,klev),d_v_con(klon,klev)
517	REAL d_t_lsc(klon,klev),d_q_lsc(klon,klev),d_ql_lsc(klon,klev)
518	REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev)
519	REAL d_t_eva(klon,klev),d_q_eva(klon,klev)
520	REAL rneb(klon,klev)
521	c
522	REAL pmfu(klon,klev), pmfd(klon,klev)
523	REAL pen_u(klon,klev), pen_d(klon,klev)
524	REAL pde_u(klon,klev), pde_d(klon,klev)
525	INTEGER kcbot(klon), kctop(klon), kdtop(klon)
526	REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1)
527	REAL prfl(klon,klev+1), psfl(klon,klev+1)
528	c
529	INTEGER ibas_con(klon), itop_con(klon)
530	REAL rain_con(klon), rain_lsc(klon)
531	REAL snow_con(klon), snow_lsc(klon)
532	REAL d_ts(klon,nbsrf)
533	c
534	REAL d_u_vdf(klon,klev), d_v_vdf(klon,klev)
535	REAL d_t_vdf(klon,klev), d_q_vdf(klon,klev)
536	c
537	REAL d_u_oro(klon,klev), d_v_oro(klon,klev)
538	REAL d_t_oro(klon,klev)
539	REAL d_u_lif(klon,klev), d_v_lif(klon,klev)
540	REAL d_t_lif(klon,klev)
541
542	REAL ratqs(klon,klev),ratqss(klon,klev),ratqsc(klon,klev)
543	real ratqsbas,ratqshaut
544	save ratqsbas,ratqshaut, ratqs
545	real zpt_conv(klon,klev)
546
547	c Parametres lies au nouveau schema de nuages (SB, PDF)
548	real fact_cldcon
549	real facttemps
550	logical ok_newmicro
551	save ok_newmicro
552	save fact_cldcon,facttemps
553
554	integer iflag_cldcon
555	save iflag_cldcon
556
557	logical ptconv(klon,klev)
558
559	c
560	c Variables liees a l'ecriture de la bande histoire physique
561	c
562	INTEGER ecrit_mth
563	SAVE ecrit_mth ! frequence d'ecriture (fichier mensuel)
564	c
565	INTEGER ecrit_day
566	SAVE ecrit_day ! frequence d'ecriture (fichier journalier)
567	c
568	INTEGER ecrit_ins
569	SAVE ecrit_ins ! frequence d'ecriture (fichier instantane)
570	c
571	INTEGER ecrit_reg
572	SAVE ecrit_reg ! frequence d'ecriture
573	c
574	integer itau_w ! pas de temps ecriture = itap + itau_phy
575	c
576	c
577	c Variables locales pour effectuer les appels en serie
578	c
579	REAL t_seri(klon,klev), q_seri(klon,klev)
580	REAL ql_seri(klon,klev)
581	REAL u_seri(klon,klev), v_seri(klon,klev)
582	c
583	REAL tr_seri(klon,klev,nbtr)
584	REAL d_tr(klon,klev,nbtr)
585
586	REAL zx_rh(klon,klev)
587
588	INTEGER length
589	PARAMETER ( length = 100 )
590	REAL tabcntr0( length )
591	c
592	INTEGER ndex2d(iimjjmp1),ndex3d(iimjjmp1*klev)
593	REAL zx_tmp_fi2d(klon)
594	REAL zx_tmp_2d(iim,jjmp1), zx_tmp_3d(iim,jjmp1,klev)
595	REAL zx_lon(iim,jjmp1), zx_lat(iim,jjmp1)
596	c
597	INTEGER nid_day, nid_mth, nid_ins
598	SAVE nid_day, nid_mth, nid_ins
599	c
600	INTEGER nhori, nvert
601	REAL zsto, zout
602	real zjulian
603	save zjulian
604
605	character*20 modname
606	character*80 abort_message
607	logical ok_sync
608	real date0
609	integer idayref
610
611	C essai writephys
612	integer fid_day, fid_mth, fid_ins
613	parameter (fid_ins = 1, fid_day = 2, fid_mth = 3)
614	integer prof2d_on, prof3d_on, prof2d_av, prof3d_av
615	parameter (prof2d_on = 1, prof3d_on = 2,
616	. prof2d_av = 3, prof3d_av = 4)
617	character*30 nom_fichier
618	character*10 varname
619	character*40 vartitle
620	character*20 varunits
621	c
622	c Declaration des constantes et des fonctions thermodynamiques
623	c
624	#include "YOMCST.h"
625	#include "YOETHF.h"
626	#include "FCTTRE.h"
627	c======================================================================
628	modname = 'physiq'
629	ok_sync=.TRUE.
630	IF (nqmax .LT. 2) THEN
631	PRINT*, 'eaux vapeur et liquide sont indispensables'
632	CALL ABORT
633	ENDIF
634	IF (debut) THEN
635	CALL suphec ! initialiser constantes et parametres phys.
636	ENDIF
637
638
639	c======================================================================
640	xjour = rjourvrai
641	c
642	c Si c'est le debut, il faut initialiser plusieurs choses
643	c ********
644	c
645	IF (debut) THEN
646
647	c
648	c appel a la lecture du run.def physique
649	c
650	call conf_phys(ocean, ok_veget, ok_journe, ok_mensuel,
651	. ok_instan, fact_cldcon, facttemps,ok_newmicro,
652	. iflag_cldcon,ratqsbas,ratqshaut)
653
654	DO k = 2, nvm ! pas de vegetation
655	DO i = 1, klon
656	veget(i,k) = 0.0
657	ENDDO
658	ENDDO
659	DO i = 1, klon
660	veget(i,1) = 1.0 ! il n'y a que du desert
661	ENDDO
662	PRINT*, 'Pas de vegetation; desert partout'
663	c
664	c
665	c Initialiser les compteurs:
666	c
667
668	frugs = 0.
669	itap = 0
670	itaprad = 0
671	c
672	CALL phyetat0 ("startphy.nc",dtime,co2_ppm,solaire,
673	. rlat,rlon,pctsrf, ftsol,ftsoil,deltat,fqsol,fsnow,
674	. falbe, fevap, rain_fall,snow_fall,solsw, sollwdown,
675	. dlw,radsol,frugs,agesno,clesphy0,
676	. zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,tabcntr0,
677	. t_ancien, q_ancien, ancien_ok, rnebcon, ratqs,clwcon )
678
679	c
680	radpas = NINT( 86400./dtime/nbapp_rad)
681
682	c
683	CALL printflag( tabcntr0,radpas,ok_ocean,ok_oasis ,ok_journe,
684	, ok_instan, ok_region )
685	c
686	IF (ABS(dtime-pdtphys).GT.0.001) THEN
687	PRINT*, 'Pas physique n est pas correcte',dtime,pdtphys
688	abort_message=' See above '
689	call abort_gcm(modname,abort_message,1)
690	ENDIF
691	IF (nlon .NE. klon) THEN
692	PRINT*, 'nlon et klon ne sont pas coherents', nlon, klon
693	abort_message=' See above '
694	call abort_gcm(modname,abort_message,1)
695	ENDIF
696	IF (nlev .NE. klev) THEN
697	PRINT*, 'nlev et klev ne sont pas coherents', nlev, klev
698	abort_message=' See above '
699	call abort_gcm(modname,abort_message,1)
700	ENDIF
701	c
702	IF (dtime*FLOAT(radpas).GT.21600..AND.cycle_diurne) THEN
703	PRINT*, 'Nbre d appels au rayonnement insuffisant'
704	PRINT*, "Au minimum 4 appels par jour si cycle diurne"
705	abort_message=' See above '
706	call abort_gcm(modname,abort_message,1)
707	ENDIF
708	PRINT*, "Clef pour la convection, iflag_con=", iflag_con
709	c
710	cKE43
711	c Initialisation pour la convection de K.E. (sb):
712	IF (iflag_con.GE.3) THEN
713
714	PRINT, "** Convection de Kerry Emanuel 4.3 "
715	PRINT*, "On va utiliser le melange convectif des traceurs qui"
716	PRINT*, "est calcule dans convect4.3"
717	PRINT*, " !!! penser aux logical flags de phytrac"
718
719	DO i = 1, klon
720	ema_cbmf(i) = 0.
721	ema_pcb(i) = 0.
722	ema_pct(i) = 0.
723	ema_workcbmf(i) = 0.
724	ENDDO
725	ENDIF
726	c34EK
727	IF (ok_orodr) THEN
728	DO i=1,klon
729	rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
730	ENDDO
731	CALL SUGWD(klon,klev,paprs,pplay)
732	DO i=1,klon
733	zuthe(i)=0.
734	zvthe(i)=0.
735	if(zstd(i).gt.10.)then
736	zuthe(i)=(1.-zgam(i))*cos(zthe(i))
737	zvthe(i)=(1.-zgam(i))*sin(zthe(i))
738	endif
739	ENDDO
740	ENDIF
741	c
742	c
743	lmt_pas = NINT(86400./dtime * 1.0) ! tous les jours
744	PRINT*,'La frequence de lecture surface est de ', lmt_pas
745	c
746	ecrit_mth = NINT(86400./dtime *ecritphy) ! tous les ecritphy jours
747	IF (ok_mensuel) THEN
748	PRINT*, 'La frequence de sortie mensuelle est de ', ecrit_mth
749	ENDIF
750	ecrit_day = NINT(86400./dtime *1.0) ! tous les jours
751	IF (ok_journe) THEN
752	PRINT*, 'La frequence de sortie journaliere est de ',ecrit_day
753	ENDIF
754	ccc ecrit_ins = NINT(86400./dtime *0.5) ! 2 fois par jour
755	ccc ecrit_ins = NINT(86400./dtime *0.25) ! 4 fois par jour
756	ecrit_ins = NINT(86400./dtime/12.) ! toutes les deux heures
757	ecrit_ins = NINT(86400./dtime/48.) ! a chaque pas de temps
758	IF (ok_instan) THEN
759	PRINT*, 'La frequence de sortie instant. est de ', ecrit_ins
760	ENDIF
761	ecrit_reg = NINT(86400./dtime *0.25) ! 4 fois par jour
762	IF (ok_region) THEN
763	PRINT*, 'La frequence de sortie region est de ', ecrit_reg
764	ENDIF
765
766	c
767	c Initialiser le couplage si necessaire
768	c
769	npas = 0
770	nexca = 0
771	if (ocean == 'couple') then
772	npas = itaufin/ iphysiq
773	nexca = 86400 / dtime
774	write(,)' ##### Ocean couple #####'
775	write(,)' Valeurs des pas de temps'
776	write(,)' npas = ', npas
777	write(,)' nexca = ', nexca
778	endif
779	c
780	c
781	c Gestion calendrier
782
783	c
784	IF (ok_journe) THEN
785	c
786	idayref = day_ref
787	CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
788	c
789	CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
790	DO i = 1, iim
791	zx_lon(i,1) = rlon(i+1)
792	zx_lon(i,jjmp1) = rlon(i+1)
793	ENDDO
794	DO ll=1,klev
795	znivsig(ll)=float(ll)
796	ENDDO
797	CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
798	write(,)'zx_lon = ',zx_lon(:,1)
799	write(,)'zx_lat = ',zx_lat(1,:)
800	CALL histbeg("histday", iim,zx_lon(:,1), jjmp1,zx_lat(1,:),
801	. 1,iim,1,jjmp1, itau_phy, zjulian, dtime,
802	. nhori, nid_day)
803	write(,)'Journee ', itau_phy, zjulian
804	CALL histvert(nid_day, "presnivs", "Vertical levels", "mb",
805	. klev, presnivs, nvert)
806	c call histvert(nid_day, 'sig_s', 'Niveaux sigma','-',
807	c . klev, znivsig, nvert)
808	c
809	zsto = dtime
810	zout = dtime * FLOAT(ecrit_day)
811	C Essai writephys
812	c nom_fichier = 'histday1'
813	c call writephy_ini(fid_day,nom_fichier,klon,iim,jjmp1,klev,
814	c . rlon,rlat, presnivs,
815	c . zjulian, dtime)
816	c call writephy_def(prof2d_on, fid_day, "once", zsto, zout, 0)
817	c call writephy_def(prof3d_on, fid_day, "once", zsto, zout,
818	c . klev)
819	c call writephy_def(prof2d_av, fid_day, "ave(X)", zsto, zout, 0)
820	c call writephy_def(prof3d_av, fid_day, "ave(X)", zsto, zout,
821	c . klev)
822
823	c
824	CALL histdef(nid_day, "phis", "Surface geop. height", "-",
825	. iim,jjmp1,nhori, 1,1,1, -99, 32,
826	. "once", zsto,zout)
827	c
828	CALL histdef(nid_day, "aire", "Grid area", "-",
829	. iim,jjmp1,nhori, 1,1,1, -99, 32,
830	. "once", zsto,zout)
831	c
832	c Champs 2D:
833	c
834	CALL histdef(nid_day, "tsol", "Surface Temperature", "K",
835	. iim,jjmp1,nhori, 1,1,1, -99, 32,
836	. "ave(X)", zsto,zout)
837	c
838	CALL histdef(nid_day, "tter", "Surface Temperature", "K",
839	. iim,jjmp1,nhori, 1,1,1, -99, 32,
840	. "ave(X)", zsto,zout)
841	c
842	CALL histdef(nid_day, "tlic", "Surface Temperature", "K",
843	. iim,jjmp1,nhori, 1,1,1, -99, 32,
844	. "ave(X)", zsto,zout)
845	c
846	CALL histdef(nid_day, "toce", "Surface Temperature", "K",
847	. iim,jjmp1,nhori, 1,1,1, -99, 32,
848	. "ave(X)", zsto,zout)
849	c
850	CALL histdef(nid_day, "tsic", "Surface Temperature", "K",
851	. iim,jjmp1,nhori, 1,1,1, -99, 32,
852	. "ave(X)", zsto,zout)
853	c
854	CALL histdef(nid_day, "psol", "Surface Pressure", "Pa",
855	. iim,jjmp1,nhori, 1,1,1, -99, 32,
856	. "ave(X)", zsto,zout)
857	c
858	CALL histdef(nid_day, "rain", "Precipitation", "mm/day",
859	. iim,jjmp1,nhori, 1,1,1, -99, 32,
860	. "ave(X)", zsto,zout)
861	c
862	CALL histdef(nid_day, "snow", "Snow fall", "mm/day",
863	. iim,jjmp1,nhori, 1,1,1, -99, 32,
864	. "ave(X)", zsto,zout)
865	c
866	CALL histdef(nid_day, "snow_cov", "Snow cover", "mm",
867	. iim,jjmp1,nhori, 1,1,1, -99, 32,
868	. "ave(X)", zsto,zout)
869	c
870	CALL histdef(nid_day, "evap", "Evaporation", "mm/day",
871	. iim,jjmp1,nhori, 1,1,1, -99, 32,
872	. "ave(X)", zsto,zout)
873	c
874	CALL histdef(nid_day, "tops", "Solar rad. at TOA", "W/m2",
875	. iim,jjmp1,nhori, 1,1,1, -99, 32,
876	. "ave(X)", zsto,zout)
877	c
878	CALL histdef(nid_day, "topl", "IR rad. at TOA", "W/m2",
879	. iim,jjmp1,nhori, 1,1,1, -99, 32,
880	. "ave(X)", zsto,zout)
881	c
882	CALL histdef(nid_day, "sols", "Solar rad. at surf.", "W/m2",
883	. iim,jjmp1,nhori, 1,1,1, -99, 32,
884	. "ave(X)", zsto,zout)
885	c
886	CALL histdef(nid_day, "soll", "IR rad. at surface", "W/m2",
887	. iim,jjmp1,nhori, 1,1,1, -99, 32,
888	. "ave(X)", zsto,zout)
889	c
890	CALL histdef(nid_day, "solldown", "Down. IR rad. at surface",
891	. "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32,
892	. "ave(X)", zsto,zout)
893	c
894	CALL histdef(nid_day, "bils", "Surf. total heat flux", "W/m2",
895	. iim,jjmp1,nhori, 1,1,1, -99, 32,
896	. "ave(X)", zsto,zout)
897	c
898	CALL histdef(nid_day, "sens", "Sensible heat flux", "W/m2",
899	. iim,jjmp1,nhori, 1,1,1, -99, 32,
900	. "ave(X)", zsto,zout)
901	c
902	CALL histdef(nid_day, "fder", "Heat flux derivation", "W/m2",
903	. iim,jjmp1,nhori, 1,1,1, -99, 32,
904	. "ave(X)", zsto,zout)
905	c
906	CALL histdef(nid_day, "frtu", "Zonal wind stress", "Pa",
907	. iim,jjmp1,nhori, 1,1,1, -99, 32,
908	. "ave(X)", zsto,zout)
909	c
910	CALL histdef(nid_day, "frtv", "Meridional wind stress", "Pa",
911	. iim,jjmp1,nhori, 1,1,1, -99, 32,
912	. "ave(X)", zsto,zout)
913	c
914	C §§§ PB flux pour chauqe sous surface
915	C
916	DO nsrf = 1, nbsrf
917	C
918	call histdef(nid_day, "pourc_"//clnsurf(nsrf),
919	$ "Fraction"//clnsurf(nsrf), "W/m2",
920	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
921	$ "ave(X)", zsto,zout)
922	C
923	call histdef(nid_day, "tsol_"//clnsurf(nsrf),
924	$ "Fraction"//clnsurf(nsrf), "W/m2",
925	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
926	$ "ave(X)", zsto,zout)
927	C
928	call histdef(nid_day, "sens_"//clnsurf(nsrf),
929	$ "Sensible heat flux "//clnsurf(nsrf), "W/m2",
930	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
931	$ "ave(X)", zsto,zout)
932	c
933	call histdef(nid_day, "lat_"//clnsurf(nsrf),
934	$ "Latent heat flux "//clnsurf(nsrf), "W/m2",
935	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
936	$ "ave(X)", zsto,zout)
937	C
938	call histdef(nid_day, "taux_"//clnsurf(nsrf),
939	$ "Zonal wind stress"//clnsurf(nsrf),"Pa",
940	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
941	$ "ave(X)", zsto,zout)
942
943	call histdef(nid_day, "tauy_"//clnsurf(nsrf),
944	$ "Meridional xind stress "//clnsurf(nsrf), "Pa",
945	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
946	$ "ave(X)", zsto,zout)
947	C
948	call histdef(nid_day, "albe_"//clnsurf(nsrf),
949	$ "Albedo surf. "//clnsurf(nsrf), "W/m2",
950	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
951	$ "ave(X)", zsto,zout)
952	C
953	call histdef(nid_day, "rugs_"//clnsurf(nsrf),
954	$ "Latent heat flux "//clnsurf(nsrf), "W/m2",
955	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
956	$ "ave(X)", zsto,zout)
957
958	C§§§
959	END DO
960
961	CALL histdef(nid_day, "sicf", "Sea-ice fraction", "-",
962	. iim,jjmp1,nhori, 1,1,1, -99, 32,
963	. "ave(X)", zsto,zout)
964	c
965	CALL histdef(nid_day, "cldl", "Low-level cloudiness", "-",
966	. iim,jjmp1,nhori, 1,1,1, -99, 32,
967	. "ave(X)", zsto,zout)
968	c
969	CALL histdef(nid_day, "cldm", "Mid-level cloudiness", "-",
970	. iim,jjmp1,nhori, 1,1,1, -99, 32,
971	. "ave(X)", zsto,zout)
972	c
973	CALL histdef(nid_day, "cldh", "High-level cloudiness", "-",
974	. iim,jjmp1,nhori, 1,1,1, -99, 32,
975	. "ave(X)", zsto,zout)
976	c
977	CALL histdef(nid_day, "cldt", "Total cloudiness", "-",
978	. iim,jjmp1,nhori, 1,1,1, -99, 32,
979	. "ave(X)", zsto,zout)
980	c
981	CALL histdef(nid_day, "cldq", "Cloud liquid water path", "-",
982	. iim,jjmp1,nhori, 1,1,1, -99, 32,
983	. "ave(X)", zsto,zout)
984	c
985	c Champs 3D:
986	c
987	CALL histdef(nid_day, "temp", "Air temperature", "K",
988	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
989	. "ave(X)", zsto,zout)
990	c
991	CALL histdef(nid_day, "ovap", "Specific humidity", "Kg/Kg",
992	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
993	. "ave(X)", zsto,zout)
994	c
995	CALL histdef(nid_day, "geop", "Geopotential height", "m",
996	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
997	. "ave(X)", zsto,zout)
998	c
999	CALL histdef(nid_day, "vitu", "Zonal wind", "m/s",
1000	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1001	. "ave(X)", zsto,zout)
1002	c
1003	CALL histdef(nid_day, "vitv", "Meridional wind", "m/s",
1004	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1005	. "ave(X)", zsto,zout)
1006	c
1007	CALL histdef(nid_day, "vitw", "Vertical wind", "m/s",
1008	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1009	. "ave(X)", zsto,zout)
1010	c
1011	CALL histdef(nid_day, "pres", "Air pressure", "Pa",
1012	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1013	. "ave(X)", zsto,zout)
1014	c
1015	CALL histend(nid_day)
1016	c
1017	ndex2d = 0
1018	ndex3d = 0
1019	c
1020	ENDIF ! fin de test sur ok_journe
1021	c
1022	IF (ok_mensuel) THEN
1023	c
1024	idayref = day_ref
1025	CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
1026	c
1027	CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
1028	DO i = 1, iim
1029	zx_lon(i,1) = rlon(i+1)
1030	zx_lon(i,jjmp1) = rlon(i+1)
1031	ENDDO
1032	DO ll=1,klev
1033	znivsig(ll)=float(ll)
1034	ENDDO
1035	CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
1036	CALL histbeg("histmth.nc", iim,zx_lon(:,1), jjmp1,zx_lat(1,:),
1037	. 1,iim,1,jjmp1, itau_phy, zjulian, dtime,
1038	. nhori, nid_mth)
1039	write(,)'Mensuel ', itau_phy, zjulian
1040	CALL histvert(nid_mth, "presnivs", "Vertical levels", "mb",
1041	. klev, presnivs, nvert)
1042	c call histvert(nid_mth, 'sig_s', 'Niveaux sigma','-',
1043	c . klev, znivsig, nvert)
1044	c
1045	zsto = dtime
1046	zout = dtime * ecrit_mth
1047	c
1048	CALL histdef(nid_mth, "phis", "Surface geop. height", "-",
1049	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1050	. "once", zsto,zout)
1051	c
1052	CALL histdef(nid_mth, "aire", "Grid area", "-",
1053	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1054	. "once", zsto,zout)
1055	c
1056	c Champs 2D:
1057	c
1058	CALL histdef(nid_mth, "tsol", "Surface Temperature", "K",
1059	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1060	. "ave(X)", zsto,zout)
1061	c
1062	CALL histdef(nid_mth, "psol", "Surface Pressure", "Pa",
1063	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1064	. "ave(X)", zsto,zout)
1065	c
1066	CALL histdef(nid_mth, "qsol", "Surface humidity", "mm",
1067	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1068	. "ave(X)", zsto,zout)
1069	c
1070	CALL histdef(nid_mth, "rain", "Precipitation", "mm/day",
1071	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1072	. "ave(X)", zsto,zout)
1073	c
1074	CALL histdef(nid_mth, "plul", "Large-scale Precip.", "mm/day",
1075	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1076	. "ave(X)", zsto,zout)
1077	c
1078	CALL histdef(nid_mth, "pluc", "Convective Precip.", "mm/day",
1079	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1080	. "ave(X)", zsto,zout)
1081	c
1082	CALL histdef(nid_mth, "snow", "Snow fall", "mm/day",
1083	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1084	. "ave(X)", zsto,zout)
1085	c
1086	CALL histdef(nid_mth, "snow_cov", "Snow cover", "mm",
1087	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1088	. "ave(X)", zsto,zout)
1089	c
1090	CALL histdef(nid_mth, "evap", "Evaporation", "mm/day",
1091	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1092	. "ave(X)", zsto,zout)
1093	c
1094	CALL histdef(nid_mth, "tops", "Solar rad. at TOA", "W/m2",
1095	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1096	. "ave(X)", zsto,zout)
1097	c
1098	CALL histdef(nid_mth, "topl", "IR rad. at TOA", "W/m2",
1099	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1100	. "ave(X)", zsto,zout)
1101	c
1102	CALL histdef(nid_mth, "sols", "Solar rad. at surf.", "W/m2",
1103	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1104	. "ave(X)", zsto,zout)
1105	c
1106	CALL histdef(nid_mth, "soll", "IR rad. at surface", "W/m2",
1107	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1108	. "ave(X)", zsto,zout)
1109	c
1110	CALL histdef(nid_mth, "solldown", "Down. IR rad. at surface",
1111	. "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32,
1112	. "ave(X)", zsto,zout)
1113	c
1114	CALL histdef(nid_mth, "tops0", "Solar rad. at TOA", "W/m2",
1115	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1116	. "ave(X)", zsto,zout)
1117	c
1118	CALL histdef(nid_mth, "topl0", "IR rad. at TOA", "W/m2",
1119	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1120	. "ave(X)", zsto,zout)
1121	c
1122	CALL histdef(nid_mth, "sols0", "Solar rad. at surf.", "W/m2",
1123	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1124	. "ave(X)", zsto,zout)
1125	c
1126	CALL histdef(nid_mth, "soll0", "IR rad. at surface", "W/m2",
1127	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1128	. "ave(X)", zsto,zout)
1129	c
1130	CALL histdef(nid_mth, "bils", "Surf. total heat flux", "W/m2",
1131	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1132	. "ave(X)", zsto,zout)
1133	c
1134	CALL histdef(nid_mth, "sens", "Sensible heat flux", "W/m2",
1135	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1136	. "ave(X)", zsto,zout)
1137	c
1138	CALL histdef(nid_mth, "fder", "Heat flux derivation", "W/m2",
1139	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1140	. "ave(X)", zsto,zout)
1141	c
1142	CALL histdef(nid_mth, "frtu", "Zonal wind stress", "Pa",
1143	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1144	. "ave(X)", zsto,zout)
1145	c
1146	CALL histdef(nid_mth, "frtv", "Meridional wind stress", "Pa",
1147	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1148	. "ave(X)", zsto,zout)
1149	c
1150	DO nsrf = 1, nbsrf
1151	C
1152	call histdef(nid_mth, "pourc_"//clnsurf(nsrf),
1153	$ "Fraction "//clnsurf(nsrf), "W/m2",
1154	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1155	$ "ave(X)", zsto,zout)
1156	C
1157	call histdef(nid_mth, "tsol_"//clnsurf(nsrf),
1158	$ "Fraction "//clnsurf(nsrf), "W/m2",
1159	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1160	$ "ave(X)", zsto,zout)
1161	C
1162	call histdef(nid_mth, "sens_"//clnsurf(nsrf),
1163	$ "Sensible heat flux "//clnsurf(nsrf), "W/m2",
1164	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1165	$ "ave(X)", zsto,zout)
1166	c
1167	call histdef(nid_mth, "lat_"//clnsurf(nsrf),
1168	$ "Latent heat flux "//clnsurf(nsrf), "W/m2",
1169	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1170	$ "ave(X)", zsto,zout)
1171	C
1172	call histdef(nid_mth, "taux_"//clnsurf(nsrf),
1173	$ "Zonal wind stress"//clnsurf(nsrf), "Pa",
1174	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1175	$ "ave(X)", zsto,zout)
1176
1177	call histdef(nid_mth, "tauy_"//clnsurf(nsrf),
1178	$ "Meridional xind stress "//clnsurf(nsrf), "Pa",
1179	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1180	$ "ave(X)", zsto,zout)
1181	c
1182	call histdef(nid_mth, "albe_"//clnsurf(nsrf),
1183	$ "Albedo surf. "//clnsurf(nsrf), "W/m2",
1184	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1185	$ "ave(X)", zsto,zout)
1186	c
1187	call histdef(nid_mth, "rugs_"//clnsurf(nsrf),
1188	$ "Latent heat flux "//clnsurf(nsrf), "W/m2",
1189	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1190	$ "ave(X)", zsto,zout)
1191	c
1192	CALL histdef(nid_mth, "ages_"//clnsurf(nsrf), "Snow age","day",
1193	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1194	. "ave(X)", zsto,zout)
1195
1196	END DO
1197	C
1198	CALL histdef(nid_mth, "sicf", "Sea-ice fraction", "-",
1199	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1200	. "ave(X)", zsto,zout)
1201	c
1202	CALL histdef(nid_mth, "albs", "Surface albedo", "-",
1203	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1204	. "ave(X)", zsto,zout)
1205	CALL histdef(nid_mth, "albslw", "Surface albedo LW", "-",
1206	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1207	. "ave(X)", zsto,zout)
1208	c
1209	CALL histdef(nid_mth, "cdrm", "Momentum drag coef.", "-",
1210	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1211	. "ave(X)", zsto,zout)
1212	c
1213	CALL histdef(nid_mth, "cdrh", "Heat drag coef.", "-",
1214	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1215	. "ave(X)", zsto,zout)
1216	c
1217	CALL histdef(nid_mth, "cldl", "Low-level cloudiness", "-",
1218	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1219	. "ave(X)", zsto,zout)
1220	c
1221	CALL histdef(nid_mth, "cldm", "Mid-level cloudiness", "-",
1222	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1223	. "ave(X)", zsto,zout)
1224	c
1225	CALL histdef(nid_mth, "cldh", "High-level cloudiness", "-",
1226	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1227	. "ave(X)", zsto,zout)
1228	c
1229	CALL histdef(nid_mth, "cldt", "Total cloudiness", "-",
1230	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1231	. "ave(X)", zsto,zout)
1232	c
1233	CALL histdef(nid_mth, "cldq", "Cloud liquid water path", "-",
1234	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1235	. "ave(X)", zsto,zout)
1236	c
1237	CALL histdef(nid_mth, "ue", "Zonal energy transport", "-",
1238	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1239	. "ave(X)", zsto,zout)
1240	c
1241	CALL histdef(nid_mth, "ve", "Merid energy transport", "-",
1242	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1243	. "ave(X)", zsto,zout)
1244	c
1245	CALL histdef(nid_mth, "uq", "Zonal humidity transport", "-",
1246	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1247	. "ave(X)", zsto,zout)
1248	c
1249	CALL histdef(nid_mth, "vq", "Merid humidity transport", "-",
1250	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1251	. "ave(X)", zsto,zout)
1252	cKE43
1253	IF (iflag_con .GE. 3) THEN ! sb
1254	c
1255	CALL histdef(nid_mth, "cape", "Conv avlbl pot ener", "J/Kg",
1256	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1257	. "ave(X)", zsto,zout)
1258	c
1259	CALL histdef(nid_mth, "pbase", "Cld base pressure", "hPa",
1260	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1261	. "ave(X)", zsto,zout)
1262	c
1263	CALL histdef(nid_mth, "ptop", "Cld top pressure", "hPa",
1264	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1265	. "ave(X)", zsto,zout)
1266	c
1267	CALL histdef(nid_mth, "fbase", "Cld base mass flux", "Kg/m2/s",
1268	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1269	. "ave(X)", zsto,zout)
1270	c
1271	c
1272	ENDIF
1273	c34EK
1274	c
1275	c Champs 3D:
1276	c
1277	CALL histdef(nid_mth, "temp", "Air temperature", "K",
1278	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1279	. "ave(X)", zsto,zout)
1280	c
1281	CALL histdef(nid_mth, "ovap", "Specific humidity", "Kg/Kg",
1282	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1283	. "ave(X)", zsto,zout)
1284	c
1285	CALL histdef(nid_mth, "geop", "Geopotential height", "m",
1286	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1287	. "ave(X)", zsto,zout)
1288	c
1289	CALL histdef(nid_mth, "vitu", "Zonal wind", "m/s",
1290	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1291	. "ave(X)", zsto,zout)
1292	c
1293	CALL histdef(nid_mth, "vitv", "Meridional wind", "m/s",
1294	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1295	. "ave(X)", zsto,zout)
1296	c
1297	CALL histdef(nid_mth, "vitw", "Vertical wind", "m/s",
1298	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1299	. "ave(X)", zsto,zout)
1300	c
1301	CALL histdef(nid_mth, "pres", "Air pressure", "Pa",
1302	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1303	. "ave(X)", zsto,zout)
1304	c
1305	CALL histdef(nid_mth, "rneb", "Cloud fraction", "-",
1306	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1307	. "ave(X)", zsto,zout)
1308	c
1309	CALL histdef(nid_mth, "rhum", "Relative humidity", "-",
1310	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1311	. "ave(X)", zsto,zout)
1312	c
1313	CALL histdef(nid_mth, "oliq", "Liquid water content", "kg/kg",
1314	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1315	. "ave(X)", zsto,zout)
1316	c
1317	CALL histdef(nid_mth, "dtdyn", "Dynamics dT", "K/s",
1318	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1319	. "ave(X)", zsto,zout)
1320	c
1321	CALL histdef(nid_mth, "dqdyn", "Dynamics dQ", "Kg/Kg/s",
1322	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1323	. "ave(X)", zsto,zout)
1324	c
1325	CALL histdef(nid_mth, "dtcon", "Convection dT", "K/s",
1326	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1327	. "ave(X)", zsto,zout)
1328	c
1329	CALL histdef(nid_mth, "ducon", "Convection du", "m/s2",
1330	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1331	. "ave(X)", zsto,zout)
1332	c
1333	CALL histdef(nid_mth, "dqcon", "Convection dQ", "Kg/Kg/s",
1334	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1335	. "ave(X)", zsto,zout)
1336	c
1337	CALL histdef(nid_mth, "dtlsc", "Condensation dT", "K/s",
1338	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1339	. "ave(X)", zsto,zout)
1340	c
1341	CALL histdef(nid_mth, "dqlsc", "Condensation dQ", "Kg/Kg/s",
1342	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1343	. "ave(X)", zsto,zout)
1344	c
1345	CALL histdef(nid_mth, "dtvdf", "Boundary-layer dT", "K/s",
1346	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1347	. "ave(X)", zsto,zout)
1348	c
1349	CALL histdef(nid_mth, "dqvdf", "Boundary-layer dQ", "Kg/Kg/s",
1350	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1351	. "ave(X)", zsto,zout)
1352	c
1353	CALL histdef(nid_mth, "dteva", "Reevaporation dT", "K/s",
1354	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1355	. "ave(X)", zsto,zout)
1356	c
1357	CALL histdef(nid_mth, "dqeva", "Reevaporation dQ", "Kg/Kg/s",
1358	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1359	. "ave(X)", zsto,zout)
1360
1361	CALL histdef(nid_mth, "ptconv", "POINTS CONVECTIFS"," ",
1362	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1363	. "ave(X)", zsto,zout)
1364
1365	CALL histdef(nid_mth, "ratqs", "RATQS"," ",
1366	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1367	. "ave(X)", zsto,zout)
1368
1369	c
1370	CALL histdef(nid_mth, "dtajs", "Dry adjust. dT", "K/s",
1371	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1372	. "ave(X)", zsto,zout)
1373
1374	CALL histdef(nid_mth, "dqajs", "Dry adjust. dQ", "Kg/Kg/s",
1375	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1376	. "ave(X)", zsto,zout)
1377	c
1378	CALL histdef(nid_mth, "dtswr", "SW radiation dT", "K/s",
1379	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1380	. "ave(X)", zsto,zout)
1381	c
1382	CALL histdef(nid_mth, "dtsw0", "SW radiation dT", "K/s",
1383	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1384	. "ave(X)", zsto,zout)
1385	c
1386	CALL histdef(nid_mth, "dtlwr", "LW radiation dT", "K/s",
1387	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1388	. "ave(X)", zsto,zout)
1389	c
1390	CALL histdef(nid_mth, "dtlw0", "LW radiation dT", "K/s",
1391	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1392	. "ave(X)", zsto,zout)
1393	c
1394	CALL histdef(nid_mth, "duvdf", "Boundary-layer dU", "m/s2",
1395	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1396	. "ave(X)", zsto,zout)
1397	c
1398	CALL histdef(nid_mth, "dvvdf", "Boundary-layer dV", "m/s2",
1399	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1400	. "ave(X)", zsto,zout)
1401	c
1402	IF (ok_orodr) THEN
1403	CALL histdef(nid_mth, "duoro", "Orography dU", "m/s2",
1404	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1405	. "ave(X)", zsto,zout)
1406	c
1407	CALL histdef(nid_mth, "dvoro", "Orography dV", "m/s2",
1408	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1409	. "ave(X)", zsto,zout)
1410	c
1411	ENDIF
1412	C
1413	IF (ok_orolf) THEN
1414	CALL histdef(nid_mth, "dulif", "Orography dU", "m/s2",
1415	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1416	. "ave(X)", zsto,zout)
1417	c
1418	CALL histdef(nid_mth, "dvlif", "Orography dV", "m/s2",
1419	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1420	. "ave(X)", zsto,zout)
1421	ENDIF
1422	C
1423	CALL histdef(nid_mth, "ozone", "Ozone concentration", "-",
1424	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1425	. "ave(X)", zsto,zout)
1426	c
1427	if (nqmax.GE.3) THEN
1428	DO iq=1,nqmax-2
1429	IF (iq.LE.99) THEN
1430	WRITE(str2,'(i2.2)') iq
1431	CALL histdef(nid_mth, "trac"//str2, "Tracer No."//str2, "-",
1432	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1433	. "ave(X)", zsto,zout)
1434	ELSE
1435	PRINT*, "Trop de traceurs"
1436	CALL abort
1437	ENDIF
1438	ENDDO
1439	ENDIF
1440	c
1441	cKE43
1442	IF (iflag_con.GE.3) THEN ! (sb)
1443	c
1444	CALL histdef(nid_mth, "upwd", "saturated updraft", "Kg/m2/s",
1445	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1446	. "ave(X)", zsto,zout)
1447	c
1448	CALL histdef(nid_mth, "dnwd", "saturated downdraft","Kg/m2/s",
1449	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1450	. "ave(X)", zsto,zout)
1451	c
1452	CALL histdef(nid_mth, "dnwd0", "unsat. downdraft", "Kg/m2/s",
1453	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1454	. "ave(X)", zsto,zout)
1455	c
1456	CALL histdef(nid_mth,"Ma","undilute adiab updraft","Kg/m2/s",
1457	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1458	. "ave(X)", zsto,zout)
1459	c
1460	c
1461	ENDIF
1462	c34EK
1463	CALL histend(nid_mth)
1464	c
1465	ndex2d = 0
1466	ndex3d = 0
1467	c
1468	ENDIF ! fin de test sur ok_mensuel
1469	c
1470	c
1471	IF (ok_instan) THEN
1472	c
1473	idayref = day_ref
1474	CALL ymds2ju(annee_ref, 1, idayref, 0.0, zjulian)
1475	c
1476	CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlon,zx_lon)
1477	DO i = 1, iim
1478	zx_lon(i,1) = rlon(i+1)
1479	zx_lon(i,jjmp1) = rlon(i+1)
1480	ENDDO
1481	DO ll=1,klev
1482	znivsig(ll)=float(ll)
1483	ENDDO
1484	CALL gr_fi_ecrit(1,klon,iim,jjmp1,rlat,zx_lat)
1485	CALL histbeg("histins", iim,zx_lon(:,1), jjmp1,zx_lat(1,:),
1486	. 1,iim,1,jjmp1, itau_phy, zjulian, dtime,
1487	. nhori, nid_ins)
1488	write(,)'Inst ', itau_phy, zjulian
1489	CALL histvert(nid_ins, "presnivs", "Vertical levels", "mb",
1490	. klev, presnivs, nvert)
1491	c call histvert(nid_ins, 'sig_s', 'Niveaux sigma','-',
1492	c . klev, znivsig, nvert)
1493	c
1494	c
1495	zsto = dtime * ecrit_ins
1496	zout = dtime * ecrit_ins
1497	C
1498	CALL histdef(nid_ins, "phis", "Surface geop. height", "-",
1499	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1500	. "once", zsto,zout)
1501	c
1502	CALL histdef(nid_ins, "aire", "Grid area", "-",
1503	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1504	. "once", zsto,zout)
1505	c
1506	c Champs 2D:
1507	c
1508	CALL histdef(nid_ins, "tsol", "Surface Temperature", "K",
1509	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1510	. "inst(X)", zsto,zout)
1511	c
1512	CALL histdef(nid_ins, "psol", "Surface Pressure", "Pa",
1513	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1514	. "inst(X)", zsto,zout)
1515	c
1516	CALL histdef(nid_ins, "plul", "Large-scale Precip.", "mm/day",
1517	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1518	. "inst(X)", zsto,zout)
1519	c
1520	CALL histdef(nid_ins, "pluc", "Convective Precip.", "mm/day",
1521	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1522	. "inst(X)", zsto,zout)
1523
1524	CALL histdef(nid_ins, "qsol", "Surface humidity", "mm",
1525	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1526	. "inst(X)", zsto,zout)
1527	c
1528	CALL histdef(nid_ins, "rain", "Precipitation", "mm/day",
1529	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1530	. "inst(X)", zsto,zout)
1531	c
1532	CALL histdef(nid_ins, "snow", "Snow fall", "mm/day",
1533	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1534	. "inst(X)", zsto,zout)
1535	c
1536	CALL histdef(nid_ins, "snow_cov", "Snow cover", "mm",
1537	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1538	. "inst(X)", zsto,zout)
1539	c
1540	CALL histdef(nid_ins, "topl", "OLR", "W/m2",
1541	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1542	. "inst(X)", zsto,zout)
1543	c
1544	CALL histdef(nid_ins, "evap", "Evaporation", "mm/day",
1545	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1546	. "inst(X)", zsto,zout)
1547	c
1548	CALL histdef(nid_ins, "sols", "Solar rad. at surf.", "W/m2",
1549	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1550	. "inst(X)", zsto,zout)
1551	c
1552	CALL histdef(nid_ins, "soll", "IR rad. at surface", "W/m2",
1553	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1554	. "inst(X)", zsto,zout)
1555	c
1556	CALL histdef(nid_ins, "solldown", "Down. IR rad. at surface",
1557	. "W/m2", iim,jjmp1,nhori, 1,1,1, -99, 32,
1558	. "inst(X)", zsto,zout)
1559	c
1560	CALL histdef(nid_ins, "bils", "Surf. total heat flux", "W/m2",
1561	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1562	. "inst(X)", zsto,zout)
1563	c
1564	CALL histdef(nid_ins, "sens", "Sensible heat flux", "W/m2",
1565	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1566	. "inst(X)", zsto,zout)
1567	c
1568	CALL histdef(nid_ins, "fder", "Heat flux derivation", "W/m2",
1569	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1570	. "inst(X)", zsto,zout)
1571	c
1572	CALL histdef(nid_ins, "dtsvdfo", "Boundary-layer dTs(o)", "K/s",
1573	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1574	. "inst(X)", zsto,zout)
1575	c
1576	CALL histdef(nid_ins, "dtsvdft", "Boundary-layer dTs(t)", "K/s",
1577	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1578	. "inst(X)", zsto,zout)
1579	c
1580	CALL histdef(nid_ins, "dtsvdfg", "Boundary-layer dTs(g)", "K/s",
1581	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1582	. "inst(X)", zsto,zout)
1583	c
1584	CALL histdef(nid_ins, "dtsvdfi", "Boundary-layer dTs(g)", "K/s",
1585	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1586	. "inst(X)", zsto,zout)
1587
1588	DO nsrf = 1, nbsrf
1589	C
1590	call histdef(nid_ins, "pourc_"//clnsurf(nsrf),
1591	$ "Fraction"//clnsurf(nsrf), "W/m2",
1592	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1593	$ "inst(X)", zsto,zout)
1594
1595	call histdef(nid_ins, "sens_"//clnsurf(nsrf),
1596	$ "Sensible heat flux "//clnsurf(nsrf), "W/m2",
1597	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1598	$ "inst(X)", zsto,zout)
1599	c
1600	call histdef(nid_ins, "tsol_"//clnsurf(nsrf),
1601	$ "Surface Temperature"//clnsurf(nsrf), "W/m2",
1602	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1603	$ "inst(X)", zsto,zout)
1604	c
1605	call histdef(nid_ins, "lat_"//clnsurf(nsrf),
1606	$ "Latent heat flux "//clnsurf(nsrf), "W/m2",
1607	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1608	$ "inst(X)", zsto,zout)
1609	C
1610	call histdef(nid_ins, "taux_"//clnsurf(nsrf),
1611	$ "Zonal wind stress"//clnsurf(nsrf),"Pa",
1612	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1613	$ "inst(X)", zsto,zout)
1614
1615	call histdef(nid_ins, "tauy_"//clnsurf(nsrf),
1616	$ "Meridional xind stress "//clnsurf(nsrf), "Pa",
1617	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1618	$ "inst(X)", zsto,zout)
1619	c
1620	call histdef(nid_ins, "albe_"//clnsurf(nsrf),
1621	$ "Albedo "//clnsurf(nsrf), "-",
1622	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1623	$ "inst(X)", zsto,zout)
1624	c
1625	call histdef(nid_ins, "rugs_"//clnsurf(nsrf),
1626	$ "rugosite "//clnsurf(nsrf), "-",
1627	$ iim,jjmp1,nhori, 1,1,1, -99, 32,
1628	$ "inst(X)", zsto,zout)
1629	C§§§
1630	END DO
1631	CALL histdef(nid_ins, "rugs", "rugosity", "-",
1632	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1633	. "inst(X)", zsto,zout)
1634
1635	c
1636	CALL histdef(nid_ins, "albs", "Surface albedo", "-",
1637	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1638	. "inst(X)", zsto,zout)
1639	CALL histdef(nid_ins, "albslw", "Surface albedo LW", "-",
1640	. iim,jjmp1,nhori, 1,1,1, -99, 32,
1641	. "inst(X)", zsto,zout)
1642	c
1643	c
1644	c Champs 3D:
1645	c
1646	CALL histdef(nid_ins, "temp", "Temperature", "K",
1647	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1648	. "inst(X)", zsto,zout)
1649	c
1650	CALL histdef(nid_ins, "vitu", "Zonal wind", "m/s",
1651	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1652	. "inst(X)", zsto,zout)
1653	c
1654	CALL histdef(nid_ins, "vitv", "Merid wind", "m/s",
1655	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1656	. "inst(X)", zsto,zout)
1657	c
1658	CALL histdef(nid_ins, "geop", "Geopotential height", "m",
1659	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1660	. "inst(X)", zsto,zout)
1661	c
1662	CALL histdef(nid_ins, "pres", "Air pressure", "Pa",
1663	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1664	. "inst(X)", zsto,zout)
1665	c
1666	CALL histdef(nid_ins, "dtvdf", "Boundary-layer dT", "K/s",
1667	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1668	. "inst(X)", zsto,zout)
1669	c
1670	CALL histdef(nid_ins, "dqvdf", "Boundary-layer dQ", "Kg/Kg/s",
1671	. iim,jjmp1,nhori, klev,1,klev,nvert, 32,
1672	. "inst(X)", zsto,zout)
1673	c
1674
1675	CALL histend(nid_ins)
1676	c
1677	ndex2d = 0
1678	ndex3d = 0
1679	c
1680	ENDIF
1681
1682	c$$$PB Positionner date0 pour initialisation de ORCHIDEE
1683	date0 = zjulian
1684	C date0 = day_ini
1685	WRITE(,) 'physiq date0 : ',date0
1686	c
1687	c
1688	c
1689	c Prescrire l'ozone dans l'atmosphere
1690	c
1691	c
1692	cc DO i = 1, klon
1693	cc DO k = 1, klev
1694	cc CALL o3cm (paprs(i,k)/100.,paprs(i,k+1)/100., wo(i,k),20)
1695	cc ENDDO
1696	cc ENDDO
1697	c
1698	c
1699	ENDIF
1700	c
1701	c ************** Fin de IF ( debut ) *************
1702	c
1703	c
1704	c Mettre a zero des variables de sortie (pour securite)
1705	c
1706	DO i = 1, klon
1707	d_ps(i) = 0.0
1708	ENDDO
1709	DO k = 1, klev
1710	DO i = 1, klon
1711	d_t(i,k) = 0.0
1712	d_u(i,k) = 0.0
1713	d_v(i,k) = 0.0
1714	ENDDO
1715	ENDDO
1716	DO iq = 1, nqmax
1717	DO k = 1, klev
1718	DO i = 1, klon
1719	d_qx(i,k,iq) = 0.0
1720	ENDDO
1721	ENDDO
1722	ENDDO
1723	c
1724	c Ne pas affecter les valeurs entrees de u, v, h, et q
1725	c
1726	DO k = 1, klev
1727	DO i = 1, klon
1728	t_seri(i,k) = t(i,k)
1729	u_seri(i,k) = u(i,k)
1730	v_seri(i,k) = v(i,k)
1731	q_seri(i,k) = qx(i,k,ivap)
1732	ql_seri(i,k) = qx(i,k,iliq)
1733	ENDDO
1734	ENDDO
1735	IF (nqmax.GE.3) THEN
1736	DO iq = 3, nqmax
1737	DO k = 1, klev
1738	DO i = 1, klon
1739	tr_seri(i,k,iq-2) = qx(i,k,iq)
1740	ENDDO
1741	ENDDO
1742	ENDDO
1743	ELSE
1744	DO k = 1, klev
1745	DO i = 1, klon
1746	tr_seri(i,k,1) = 0.0
1747	ENDDO
1748	ENDDO
1749	ENDIF
1750	c
1751	c Diagnostiquer la tendance dynamique
1752	c
1753	IF (ancien_ok) THEN
1754	DO k = 1, klev
1755	DO i = 1, klon
1756	d_t_dyn(i,k) = (t_seri(i,k)-t_ancien(i,k))/dtime
1757	d_q_dyn(i,k) = (q_seri(i,k)-q_ancien(i,k))/dtime
1758	ENDDO
1759	ENDDO
1760	ELSE
1761	DO k = 1, klev
1762	DO i = 1, klon
1763	d_t_dyn(i,k) = 0.0
1764	d_q_dyn(i,k) = 0.0
1765	ENDDO
1766	ENDDO
1767	ancien_ok = .TRUE.
1768	ENDIF
1769	c
1770	c Ajouter le geopotentiel du sol:
1771	c
1772	DO k = 1, klev
1773	DO i = 1, klon
1774	zphi(i,k) = pphi(i,k) + pphis(i)
1775	ENDDO
1776	ENDDO
1777	c
1778	c Verifier les temperatures
1779	c
1780	CALL hgardfou(t_seri,ftsol,'debutphy')
1781	c
1782	c Incrementer le compteur de la physique
1783	c
1784	itap = itap + 1
1785	julien = MOD(NINT(xjour),360)
1786	c
1787	c Mettre en action les conditions aux limites (albedo, sst, etc.).
1788	c Prescrire l'ozone et calculer l'albedo sur l'ocean.
1789	c
1790	IF (MOD(itap-1,lmt_pas) .EQ. 0) THEN
1791	PRINT *,' PHYS cond julien ',julien
1792	CALL ozonecm( FLOAT(julien), rlat, paprs, wo)
1793	ENDIF
1794	c
1795	c Re-evaporer l'eau liquide nuageuse
1796	c
1797	DO k = 1, klev ! re-evaporation de l'eau liquide nuageuse
1798	DO i = 1, klon
1799	zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
1800	c zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
1801	zlsdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
1802	zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
1803	zb = MAX(0.0,ql_seri(i,k))
1804	za = - MAX(0.0,ql_seri(i,k))
1805	. * (zlvdcp(1.-zdelta)+zlsdcpzdelta)
1806	t_seri(i,k) = t_seri(i,k) + za
1807	q_seri(i,k) = q_seri(i,k) + zb
1808	ql_seri(i,k) = 0.0
1809	d_t_eva(i,k) = za
1810	d_q_eva(i,k) = zb
1811	ENDDO
1812	ENDDO
1813	c
1814	c Appeler la diffusion verticale (programme de couche limite)
1815	c
1816	DO i = 1, klon
1817	c if (.not. ok_veget) then
1818	c frugs(i,is_ter) = SQRT(frugs(i,is_ter)2+rugoro(i)2)
1819	c endif
1820	c frugs(i,is_lic) = rugoro(i)
1821	c frugs(i,is_oce) = rugmer(i)
1822	c frugs(i,is_sic) = 0.001
1823	zxrugs(i) = 0.0
1824	ENDDO
1825	DO nsrf = 1, nbsrf
1826	DO i = 1, klon
1827	frugs(i,nsrf) = MAX(frugs(i,nsrf),0.001)
1828	ENDDO
1829	ENDDO
1830	DO nsrf = 1, nbsrf
1831	DO i = 1, klon
1832	zxrugs(i) = zxrugs(i) + frugs(i,nsrf)*pctsrf(i,nsrf)
1833	ENDDO
1834	ENDDO
1835	c
1836	C calculs necessaires au calcul de l'albedo dans l'interface
1837	c
1838	CALL orbite(FLOAT(julien),zlongi,dist)
1839	IF (cycle_diurne) THEN
1840	zdtime=dtime*FLOAT(radpas) ! pas de temps du rayonnement (s)
1841	CALL zenang(zlongi,gmtime,zdtime,rlat,rlon,rmu0,fract)
1842	ELSE
1843	rmu0 = -999.999
1844	ENDIF
1845
1846	fder = dlw
1847
1848	CALL clmain(dtime,itap,date0,pctsrf,
1849	e t_seri,q_seri,u_seri,v_seri,
1850	e julien, rmu0,
1851	e ok_veget, ocean, npas, nexca, ftsol,
1852	$ soil_model,ftsoil,
1853	$ paprs,pplay,radsol, fsnow,fqsol,fevap,falbe,falblw,
1854	$ fluxlat,
1855	e rain_fall, snow_fall, solsw, sollw, sollwdown, fder,
1856	e rlon, rlat, cufi, cvfi, frugs,
1857	e debut, lafin, agesno,rugoro ,
1858	s d_t_vdf,d_q_vdf,d_u_vdf,d_v_vdf,d_ts,
1859	s fluxt,fluxq,fluxu,fluxv,cdragh,cdragm,
1860	s dsens, devap,
1861	s ycoefh,yu1,yv1)
1862
1863	c
1864	C§§§ PB
1865	C§§§ Incrementation des flux
1866	C§§
1867	zxfluxt=0.
1868	zxfluxq=0.
1869	zxfluxu=0.
1870	zxfluxv=0.
1871	DO nsrf = 1, nbsrf
1872	DO k = 1, klev
1873	DO i = 1, klon
1874	zxfluxt(i,k) = zxfluxt(i,k) +
1875	$ fluxt(i,k,nsrf) * pctsrf( i, nsrf)
1876	zxfluxq(i,k) = zxfluxq(i,k) +
1877	$ fluxq(i,k,nsrf) * pctsrf( i, nsrf)
1878	zxfluxu(i,k) = zxfluxu(i,k) +
1879	$ fluxu(i,k,nsrf) * pctsrf( i, nsrf)
1880	zxfluxv(i,k) = zxfluxv(i,k) +
1881	$ fluxv(i,k,nsrf) * pctsrf( i, nsrf)
1882	END DO
1883	END DO
1884	END DO
1885	DO i = 1, klon
1886	sens(i) = - zxfluxt(i,1) ! flux de chaleur sensible au sol
1887	c evap(i) = - fluxq(i,1) ! flux d'evaporation au sol
1888	evap(i) = - zxfluxq(i,1) ! flux d'evaporation au sol
1889	fder(i) = dlw(i) + dsens(i) + devap(i)
1890	ENDDO
1891
1892
1893	DO k = 1, klev
1894	DO i = 1, klon
1895	t_seri(i,k) = t_seri(i,k) + d_t_vdf(i,k)
1896	q_seri(i,k) = q_seri(i,k) + d_q_vdf(i,k)
1897	u_seri(i,k) = u_seri(i,k) + d_u_vdf(i,k)
1898	v_seri(i,k) = v_seri(i,k) + d_v_vdf(i,k)
1899	ENDDO
1900	ENDDO
1901	c
1902	c Incrementer la temperature du sol
1903	c
1904	DO i = 1, klon
1905	zxtsol(i) = 0.0
1906	IF ( abs( pctsrf(i, is_ter) + pctsrf(i, is_lic) +
1907	$ pctsrf(i, is_oce) + pctsrf(i, is_sic) - 1.) .GT. EPSFRA)
1908	$ THEN
1909	WRITE(,) 'physiq : pb sous surface au point ', i,
1910	$ pctsrf(i, 1 : nbsrf)
1911	ENDIF
1912	ENDDO
1913	DO nsrf = 1, nbsrf
1914	DO i = 1, klon
1915	c$$$ IF (pctsrf(i,nsrf) .GE. EPSFRA) THEN
1916	ftsol(i,nsrf) = ftsol(i,nsrf) + d_ts(i,nsrf)
1917	zxtsol(i) = zxtsol(i) + ftsol(i,nsrf)*pctsrf(i,nsrf)
1918	c$$$ ENDIF
1919	ENDDO
1920	ENDDO
1921
1922	c
1923	c Si une sous-fraction n'existe pas, elle prend la temp. moyenne
1924	c
1925	DO nsrf = 1, nbsrf
1926	DO i = 1, klon
1927	IF (pctsrf(i,nsrf) .LT. epsfra) ftsol(i,nsrf) = zxtsol(i)
1928	ENDDO
1929	ENDDO
1930
1931	c
1932	c Calculer la derive du flux infrarouge
1933	c
1934	c$$$ DO nsrf = 1, nbsrf
1935	DO i = 1, klon
1936	c$$$ IF (pctsrf(i,nsrf) .GE. EPSFRA) THEN
1937	dlw(i) = - 4.0RSIGMAzxtsol(i)**3
1938	c$$$ . *(ftsol(i,nsrf)-zxtsol(i))
1939	c$$$ . *pctsrf(i,nsrf)
1940	c$$$ ENDIF
1941	c$$$ ENDDO
1942	ENDDO
1943	c
1944	c Appeler la convection (au choix)
1945	c
1946	DO k = 1, klev
1947	DO i = 1, klon
1948	conv_q(i,k) = d_q_dyn(i,k)
1949	. + d_q_vdf(i,k)/dtime
1950	conv_t(i,k) = d_t_dyn(i,k)
1951	. + d_t_vdf(i,k)/dtime
1952	ENDDO
1953	ENDDO
1954	IF (check) THEN
1955	za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
1956	PRINT*, "avantcon=", za
1957	ENDIF
1958	zx_ajustq = .FALSE.
1959	IF (iflag_con.EQ.2) zx_ajustq=.TRUE.
1960	IF (zx_ajustq) THEN
1961	DO i = 1, klon
1962	z_avant(i) = 0.0
1963	ENDDO
1964	DO k = 1, klev
1965	DO i = 1, klon
1966	z_avant(i) = z_avant(i) + (q_seri(i,k)+ql_seri(i,k))
1967	. *(paprs(i,k)-paprs(i,k+1))/RG
1968	ENDDO
1969	ENDDO
1970	ENDIF
1971	IF (iflag_con.EQ.1) THEN
1972	stop'reactiver le call conlmd dans physiq.F'
1973	c CALL conlmd (dtime, paprs, pplay, t_seri, q_seri, conv_q,
1974	c . d_t_con, d_q_con,
1975	c . rain_con, snow_con, ibas_con, itop_con)
1976	ELSE IF (iflag_con.EQ.2) THEN
1977	CALL conflx(dtime, paprs, pplay, t_seri, q_seri,
1978	e conv_t, conv_q, zxfluxq(1,1), omega,
1979	s d_t_con, d_q_con, rain_con, snow_con,
1980	s pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
1981	s kcbot, kctop, kdtop, pmflxr, pmflxs)
1982	WHERE (rain_con < 0.) rain_con = 0.
1983	WHERE (snow_con < 0.) snow_con = 0.
1984	DO i = 1, klon
1985	ibas_con(i) = klev+1 - kcbot(i)
1986	itop_con(i) = klev+1 - kctop(i)
1987	ENDDO
1988	ELSE IF (iflag_con.GE.3) THEN
1989	c nb of tracers for the KE convection:
1990	if (nqmax .GE. 4) then
1991	ntra = nbtr
1992	else
1993	ntra = 1
1994	endif
1995	if (iflag_con.eq.4) then ! vectorise
1996	CALL conemav (dtime,paprs,pplay,t_seri,q_seri,
1997	. u_seri,v_seri,tr_seri,nbtr,
1998	. ema_work1,ema_work2,
1999	. d_t_con,d_q_con,d_u_con,d_v_con,d_tr,
2000	. rain_con, snow_con, ibas_con, itop_con,
2001	. upwd,dnwd,dnwd0,
2002	c . Ma,cape,tvp,(/(nint(rflag(i)),i=1,size(rflag))/),
2003	. Ma,cape,tvp,iflagctrl,
2004	. pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr)
2005
2006	else
2007
2008	c print*,'Avant conema OUI'
2009	CALL conema3 (dtime,
2010	. paprs,pplay,t_seri,q_seri,
2011	. u_seri,v_seri,tr_seri,nbtr,
2012	. ema_work1,ema_work2,
2013	. d_t_con,d_q_con,d_u_con,d_v_con,d_tr,
2014	. rain_con, snow_con, ibas_con, itop_con,
2015	. upwd,dnwd,dnwd0,bas,top,
2016	. Ma,cape,tvp,rflag,
2017	. pbase
2018	. ,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr
2019	. ,clwcon0)
2020	c print*,'Apres conema3 '
2021
2022	c Calculer l'humidite relative pour diagnostique
2023	c
2024	DO k = 1, klev
2025	DO i = 1, klon
2026	zx_t = t_seri(i,k)
2027	IF (thermcep) THEN
2028	zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
2029	zx_qs = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
2030	zx_qs = MIN(0.5,zx_qs)
2031	zcor = 1./(1.-retv*zx_qs)
2032	zx_qs = zx_qs*zcor
2033	ELSE
2034	IF (zx_t.LT.t_coup) THEN
2035	zx_qs = qsats(zx_t)/pplay(i,k)
2036	ELSE
2037	zx_qs = qsatl(zx_t)/pplay(i,k)
2038	ENDIF
2039	ENDIF
2040	zqsat(i,k)=zx_qs
2041	ENDDO
2042	ENDDO
2043
2044	c calcul des propriétés des nuages convectifs
2045	clwcon0(:,:)=fact_cldcon*clwcon0(:,:)
2046	call clouds_gno
2047	s (klon,klev,q_seri,zqsat,clwcon0,ptconv,ratqsc,rnebcon0)
2048
2049	endif
2050	DO i = 1, klon
2051	ema_pcb(i) = pbase(i)
2052	ENDDO
2053	DO i = 1, klon
2054	ema_pct(i) = paprs(i,itop_con(i))
2055	ENDDO
2056	DO i = 1, klon
2057	ema_cbmf(i) = ema_workcbmf(i)
2058	ENDDO
2059	ELSE
2060	PRINT*, "iflag_con non-prevu", iflag_con
2061	CALL abort
2062	ENDIF
2063
2064	c CALL homogene(paprs, q_seri, d_q_con, u_seri,v_seri,
2065	c . d_u_con, d_v_con)
2066	DO k = 1, klev
2067	DO i = 1, klon
2068	t_seri(i,k) = t_seri(i,k) + d_t_con(i,k)
2069	q_seri(i,k) = q_seri(i,k) + d_q_con(i,k)
2070	u_seri(i,k) = u_seri(i,k) + d_u_con(i,k)
2071	v_seri(i,k) = v_seri(i,k) + d_v_con(i,k)
2072	ENDDO
2073	ENDDO
2074	IF (check) THEN
2075	za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
2076	PRINT*, "aprescon=", za
2077	zx_t = 0.0
2078	za = 0.0
2079	DO i = 1, klon
2080	za = za + paire(i)/FLOAT(klon)
2081	zx_t = zx_t + (rain_con(i)+snow_con(i))*paire(i)/FLOAT(klon)
2082	ENDDO
2083	zx_t = zx_t/za*dtime
2084	PRINT*, "Precip=", zx_t
2085	ENDIF
2086	IF (zx_ajustq) THEN
2087	DO i = 1, klon
2088	z_apres(i) = 0.0
2089	ENDDO
2090	DO k = 1, klev
2091	DO i = 1, klon
2092	z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k))
2093	. *(paprs(i,k)-paprs(i,k+1))/RG
2094	ENDDO
2095	ENDDO
2096	DO i = 1, klon
2097	z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime)
2098	. /z_apres(i)
2099	ENDDO
2100	DO k = 1, klev
2101	DO i = 1, klon
2102	IF (z_factor(i).GT.(1.0+1.0E-08) .OR.
2103	. z_factor(i).LT.(1.0-1.0E-08)) THEN
2104	q_seri(i,k) = q_seri(i,k) * z_factor(i)
2105	ENDIF
2106	ENDDO
2107	ENDDO
2108	ENDIF
2109	zx_ajustq=.FALSE.
2110	c
2111	IF (nqmax.GT.2) THEN !--melange convectif de traceurs
2112	c
2113	IF (iflag_con .NE. 2 .AND. debut) THEN
2114	PRINT*, 'Pour l instant, seul conflx fonctionne ',
2115	$ 'avec traceurs', iflag_con
2116	PRINT*,' Mettre iflag_con',
2117	$ ' = 2 dans run.def et repasser'
2118	c CALL abort
2119	ENDIF
2120	c
2121	ENDIF !--nqmax.GT.2
2122	c
2123	c Appeler l'ajustement sec
2124	c
2125	CALL ajsec(paprs, pplay, t_seri, q_seri, d_t_ajs, d_q_ajs)
2126	DO k = 1, klev
2127	DO i = 1, klon
2128	t_seri(i,k) = t_seri(i,k) + d_t_ajs(i,k)
2129	q_seri(i,k) = q_seri(i,k) + d_q_ajs(i,k)
2130	ENDDO
2131	ENDDO
2132
2133
2134	c-------------------------------------------------------------------------
2135	c Caclul des ratqs
2136	c-------------------------------------------------------------------------
2137
2138	c print*,'calcul des ratqs'
2139	c ratqs convectifs a l'ancienne en fonction de q(z=0)-q / q
2140	c ----------------
2141	c on ecrase le tableau ratqsc calcule par clouds_gno
2142	if (iflag_cldcon.eq.1) then
2143	do k=1,klev
2144	do i=1,klon
2145	if(ptconv(i,k)) then
2146	ratqsc(i,k)=ratqsbas
2147	s +fact_cldcon*(q_seri(i,1)-q_seri(i,k))/q_seri(i,k)
2148	else
2149	ratqsc(i,k)=0.
2150	endif
2151	enddo
2152	enddo
2153	endif
2154
2155	c ratqs stables
2156	c -------------
2157	do k=1,klev
2158	ratqss(:,k)=ratqsbas+(ratqshaut-ratqsbas)*
2159	s min((paprs(:,1)-pplay(:,k))/(paprs(:,1)-30000.),1.)
2160	enddo
2161
2162
2163	c ratqs final
2164	c -----------
2165	if (iflag_cldcon.eq.1 .or.iflag_cldcon.eq.2) then
2166	c les ratqs sont une conbinaison de ratqss et ratqsc
2167	c ratqs final
2168	c 1e4 (en gros 3 heures), en dur pour le moment, est le temps de
2169	c relaxation des ratqs
2170	facttemps=exp(-pdtphys/1.e4)
2171	ratqs(:,:)=max(ratqs(:,:)*facttemps,ratqss(:,:))
2172	ratqs(:,:)=max(ratqs(:,:),ratqsc(:,:))
2173	c print*,'calcul des ratqs fini'
2174	else
2175	c on ne prend que le ratqs stable pour fisrtilp
2176	ratqs(:,:)=ratqss(:,:)
2177	endif
2178
2179
2180	c
2181	c Appeler le processus de condensation a grande echelle
2182	c et le processus de precipitation
2183	c-------------------------------------------------------------------------
2184	CALL fisrtilp(dtime,paprs,pplay,
2185	. t_seri, q_seri,ptconv,ratqs,
2186	. d_t_lsc, d_q_lsc, d_ql_lsc, rneb, cldliq,
2187	. rain_lsc, snow_lsc,
2188	. pfrac_impa, pfrac_nucl, pfrac_1nucl,
2189	. frac_impa, frac_nucl,
2190	. prfl, psfl, rhcl)
2191
2192	WHERE (rain_lsc < 0) rain_lsc = 0.
2193	WHERE (snow_lsc < 0) snow_lsc = 0.
2194	DO k = 1, klev
2195	DO i = 1, klon
2196	t_seri(i,k) = t_seri(i,k) + d_t_lsc(i,k)
2197	q_seri(i,k) = q_seri(i,k) + d_q_lsc(i,k)
2198	ql_seri(i,k) = ql_seri(i,k) + d_ql_lsc(i,k)
2199	cldfra(i,k) = rneb(i,k)
2200	IF (.NOT.new_oliq) cldliq(i,k) = ql_seri(i,k)
2201	ENDDO
2202	ENDDO
2203	IF (check) THEN
2204	za = qcheck(klon,klev,paprs,q_seri,ql_seri,paire)
2205	PRINT*, "apresilp=", za
2206	zx_t = 0.0
2207	za = 0.0
2208	DO i = 1, klon
2209	za = za + paire(i)/FLOAT(klon)
2210	zx_t = zx_t + (rain_lsc(i)+snow_lsc(i))*paire(i)/FLOAT(klon)
2211	ENDDO
2212	zx_t = zx_t/za*dtime
2213	PRINT*, "Precip=", zx_t
2214	ENDIF
2215	c
2216	c-------------------------------------------------------------------
2217	c PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
2218	c-------------------------------------------------------------------
2219
2220	c 1. NUAGES CONVECTIFS
2221	c
2222	IF (iflag_cldcon.eq.-1) THEN ! seulement pour Tiedtke
2223
2224	c Nuages diagnostiques pour Tiedtke
2225	CALL diagcld1(paprs,pplay,
2226	. rain_con,snow_con,ibas_con,itop_con,
2227	. diafra,dialiq)
2228	DO k = 1, klev
2229	DO i = 1, klon
2230	IF (diafra(i,k).GT.cldfra(i,k)) THEN
2231	cldliq(i,k) = dialiq(i,k)
2232	cldfra(i,k) = diafra(i,k)
2233	ENDIF
2234	ENDDO
2235	ENDDO
2236
2237	ELSE IF (iflag_cldcon.eq.3) THEN
2238	c On prend pour les nuages convectifs le max du calcul de la
2239	c convection et du calcul du pas de temps précédent diminué d'un facteur
2240	c facttemps
2241	facttemps=pdtphys/1.e4
2242	do k=1,klev
2243	do i=1,klon
2244	rnebcon(i,k)=rnebcon(i,k)*facttemps
2245	if (rnebcon0(i,k)clwcon0(i,k).gt.rnebcon(i,k)clwcon(i,k))
2246	s then
2247	rnebcon(i,k)=rnebcon0(i,k)
2248	clwcon(i,k)=clwcon0(i,k)
2249	endif
2250	enddo
2251	enddo
2252
2253	c On prend la somme des fractions nuageuses et des contenus en eau
2254	cldfra(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.)
2255	cldliq(:,:)=cldliq(:,:)+rnebcon(:,:)*clwcon(:,:)
2256
2257
2258	ENDIF
2259	c
2260	c 2. NUAGES STARTIFORMES
2261	c
2262	IF (ok_stratus) THEN
2263	CALL diagcld2(paprs,pplay,t_seri,q_seri, diafra,dialiq)
2264	DO k = 1, klev
2265	DO i = 1, klon
2266	IF (diafra(i,k).GT.cldfra(i,k)) THEN
2267	cldliq(i,k) = dialiq(i,k)
2268	cldfra(i,k) = diafra(i,k)
2269	ENDIF
2270	ENDDO
2271	ENDDO
2272	ENDIF
2273	c
2274	c Precipitation totale
2275	c
2276	DO i = 1, klon
2277	rain_fall(i) = rain_con(i) + rain_lsc(i)
2278	snow_fall(i) = snow_con(i) + snow_lsc(i)
2279	ENDDO
2280	c
2281	c Calculer l'humidite relative pour diagnostique
2282	c
2283	DO k = 1, klev
2284	DO i = 1, klon
2285	zx_t = t_seri(i,k)
2286	IF (thermcep) THEN
2287	zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
2288	zx_qs = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
2289	zx_qs = MIN(0.5,zx_qs)
2290	zcor = 1./(1.-retv*zx_qs)
2291	zx_qs = zx_qs*zcor
2292	ELSE
2293	IF (zx_t.LT.t_coup) THEN
2294	zx_qs = qsats(zx_t)/pplay(i,k)
2295	ELSE
2296	zx_qs = qsatl(zx_t)/pplay(i,k)
2297	ENDIF
2298	ENDIF
2299	zx_rh(i,k) = q_seri(i,k)/zx_qs
2300	zqsat(i,k)=zx_qs
2301	ENDDO
2302	ENDDO
2303	c
2304	c Calculer les parametres optiques des nuages et quelques
2305	c parametres pour diagnostiques:
2306	c
2307	if (ok_newmicro) then
2308	CALL newmicro (paprs, pplay,ok_newmicro,
2309	. t_seri, cldliq, cldfra, cldtau, cldemi,
2310	. cldh, cldl, cldm, cldt, cldq)
2311	else
2312	CALL nuage (paprs, pplay,
2313	. t_seri, cldliq, cldfra, cldtau, cldemi,
2314	. cldh, cldl, cldm, cldt, cldq)
2315	endif
2316	c
2317	c Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
2318	c
2319	IF (MOD(itaprad,radpas).EQ.0) THEN
2320	DO i = 1, klon
2321	albsol(i) = falbe(i,is_oce) * pctsrf(i,is_oce)
2322	. + falbe(i,is_lic) * pctsrf(i,is_lic)
2323	. + falbe(i,is_ter) * pctsrf(i,is_ter)
2324	. + falbe(i,is_sic) * pctsrf(i,is_sic)
2325	albsollw(i) = falblw(i,is_oce) * pctsrf(i,is_oce)
2326	. + falblw(i,is_lic) * pctsrf(i,is_lic)
2327	. + falblw(i,is_ter) * pctsrf(i,is_ter)
2328	. + falblw(i,is_sic) * pctsrf(i,is_sic)
2329	ENDDO
2330	! if (debut) then
2331	! albsol1 = albsol
2332	! albsollw1 = albsollw
2333	! endif
2334	! albsol = albsol1
2335	! albsollw = albsollw1
2336	CALL radlwsw ! nouveau rayonnement (compatible Arpege-IFS)
2337	e (dist, rmu0, fract, co2_ppm, solaire,
2338	e paprs, pplay,zxtsol,albsol, albsollw, t_seri,q_seri,
2339	e wo,
2340	e cldfra, cldemi, cldtau,
2341	s heat,heat0,cool,cool0,radsol,albpla,
2342	s topsw,toplw,solsw,sollw,
2343	s sollwdown,
2344	s topsw0,toplw0,solsw0,sollw0)
2345	itaprad = 0
2346	ENDIF
2347	itaprad = itaprad + 1
2348	c
2349	c Ajouter la tendance des rayonnements (tous les pas)
2350	c
2351	DO k = 1, klev
2352	DO i = 1, klon
2353	t_seri(i,k) = t_seri(i,k)
2354	. + (heat(i,k)-cool(i,k)) * dtime/86400.
2355	ENDDO
2356	ENDDO
2357	c
2358	c Calculer l'hydrologie de la surface
2359	c
2360	c CALL hydrol(dtime,pctsrf,rain_fall, snow_fall, zxevap,
2361	c . agesno, ftsol,fqsol,fsnow, ruis)
2362	c
2363	DO i = 1, klon
2364	zxqsol(i) = 0.0
2365	zxsnow(i) = 0.0
2366	ENDDO
2367	DO nsrf = 1, nbsrf
2368	DO i = 1, klon
2369	zxqsol(i) = zxqsol(i) + fqsol(i,nsrf)*pctsrf(i,nsrf)
2370	zxsnow(i) = zxsnow(i) + fsnow(i,nsrf)*pctsrf(i,nsrf)
2371	ENDDO
2372	ENDDO
2373	c
2374	c Si une sous-fraction n'existe pas, elle prend la valeur moyenne
2375	c
2376	c$$$ DO nsrf = 1, nbsrf
2377	c$$$ DO i = 1, klon
2378	c$$$ IF (pctsrf(i,nsrf).LT.epsfra) THEN
2379	c$$$ fqsol(i,nsrf) = zxqsol(i)
2380	c$$$ fsnow(i,nsrf) = zxsnow(i)
2381	c$$$ ENDIF
2382	c$$$ ENDDO
2383	c$$$ ENDDO
2384	c
2385	c Calculer le bilan du sol et la derive de temperature (couplage)
2386	c
2387	DO i = 1, klon
2388	bils(i) = radsol(i) - sens(i) - evap(i)*RLVTT
2389	ENDDO
2390	c
2391	cmoddeblott(jan95)
2392	c Appeler le programme de parametrisation de l'orographie
2393	c a l'echelle sous-maille:
2394	c
2395	IF (ok_orodr) THEN
2396	c
2397	c selection des points pour lesquels le shema est actif:
2398	igwd=0
2399	DO i=1,klon
2400	itest(i)=0
2401	c IF ((zstd(i).gt.10.0)) THEN
2402	IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
2403	itest(i)=1
2404	igwd=igwd+1
2405	idx(igwd)=i
2406	ENDIF
2407	ENDDO
2408	c igwdim=MAX(1,igwd)
2409	c
2410	CALL drag_noro(klon,klev,dtime,paprs,pplay,
2411	e zmea,zstd, zsig, zgam, zthe,zpic,zval,
2412	e igwd,idx,itest,
2413	e t_seri, u_seri, v_seri,
2414	s zulow, zvlow, zustr, zvstr,
2415	s d_t_oro, d_u_oro, d_v_oro)
2416	c
2417	c ajout des tendances
2418	DO k = 1, klev
2419	DO i = 1, klon
2420	t_seri(i,k) = t_seri(i,k) + d_t_oro(i,k)
2421	u_seri(i,k) = u_seri(i,k) + d_u_oro(i,k)
2422	v_seri(i,k) = v_seri(i,k) + d_v_oro(i,k)
2423	ENDDO
2424	ENDDO
2425	c
2426	ENDIF ! fin de test sur ok_orodr
2427	c
2428	IF (ok_orolf) THEN
2429	c
2430	c selection des points pour lesquels le shema est actif:
2431	igwd=0
2432	DO i=1,klon
2433	itest(i)=0
2434	IF ((zpic(i)-zmea(i)).GT.100.) THEN
2435	itest(i)=1
2436	igwd=igwd+1
2437	idx(igwd)=i
2438	ENDIF
2439	ENDDO
2440	c igwdim=MAX(1,igwd)
2441	c
2442	CALL lift_noro(klon,klev,dtime,paprs,pplay,
2443	e rlat,zmea,zstd,zpic,
2444	e itest,
2445	e t_seri, u_seri, v_seri,
2446	s zulow, zvlow, zustr, zvstr,
2447	s d_t_lif, d_u_lif, d_v_lif)
2448	c
2449	c ajout des tendances
2450	DO k = 1, klev
2451	DO i = 1, klon
2452	t_seri(i,k) = t_seri(i,k) + d_t_lif(i,k)
2453	u_seri(i,k) = u_seri(i,k) + d_u_lif(i,k)
2454	v_seri(i,k) = v_seri(i,k) + d_v_lif(i,k)
2455	ENDDO
2456	ENDDO
2457	c
2458	ENDIF ! fin de test sur ok_orolf
2459	c
2460	cAA
2461	cAA Installation de l'interface online-offline pour traceurs
2462	cAA
2463	c====================================================================
2464	c Calcul des tendances traceurs
2465	c====================================================================
2466	C Pascale : il faut quand meme apeller phytrac car il gere les sorties
2467	cKE43 des traceurs => il faut donc mettre des flags a .false.
2468	IF (iflag_con.GE.3) THEN
2469	c on ajoute les tendances calculees par KE43
2470	c$$$ OM on onhibe la convection sur les traceurs
2471	DO iq=1, nqmax-2 ! Sandrine a -3 ???
2472	c$$$ OM on inhibe la convection sur les traceur
2473	c$$$ DO k = 1, nlev
2474	c$$$ DO i = 1, klon
2475	c$$$ tr_seri(i,k,iq) = tr_seri(i,k,iq) + d_tr(i,k,iq)
2476	c$$$ ENDDO
2477	c$$$ ENDDO
2478	WRITE(iqn,'(i2.2)') iq
2479	CALL minmaxqfi(tr_seri(1,1,iq),0.,1.e33,'couche lim iq='//iqn)
2480	ENDDO
2481	CMAF modif pour garder info du nombre de traceurs auxquels
2482	C la physique s'applique
2483	ELSE
2484	CMAF modif pour garder info du nombre de traceurs auxquels
2485	C la physique s'applique
2486	C
2487	call phytrac (rnpb,
2488	I debut,lafin,
2489	I nqmax-2,
2490	I nlon,nlev,dtime,
2491	I t,paprs,pplay,
2492	I pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
2493	I ycoefh,yu1,yv1,ftsol,pctsrf,rlat,
2494	I frac_impa, frac_nucl,
2495	I rlon,presnivs,paire,pphis,
2496	O tr_seri)
2497	ENDIF
2498
2499	IF (offline) THEN
2500
2501	call phystokenc (
2502	I nlon,nlev,pdtphys,rlon,rlat,
2503	I t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,
2504	I ycoefh,yu1,yv1,ftsol,pctsrf,
2505	I frac_impa, frac_nucl,
2506	I pphis,paire,dtime,itap)
2507
2508
2509	ENDIF
2510
2511	c
2512	c Calculer le transport de l'eau et de l'energie (diagnostique)
2513	c
2514	CALL transp (paprs,zxtsol,
2515	e t_seri, q_seri, u_seri, v_seri, zphi,
2516	s ve, vq, ue, uq)
2517	c
2518	c Accumuler les variables a stocker dans les fichiers histoire:
2519	c
2520	c
2521	c
2522
2523	IF (ok_journe) THEN
2524	c
2525	ndex2d = 0
2526	ndex3d = 0
2527	c
2528	c Champs 2D:
2529	c
2530	zsto = dtime
2531	zout = dtime * FLOAT(ecrit_day)
2532	itau_w = itau_phy + itap
2533
2534	i = NINT(zout/zsto)
2535	CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
2536	CALL histwrite(nid_day,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2537	varname = 'phis'
2538	vartitle= 'Surface geop. height'
2539	varunits= '-'
2540	c call writephy(fid_day,prof2d_on,varname,pphis,vartitle,
2541	c . varunits)
2542	c
2543	i = NINT(zout/zsto)
2544	CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
2545	CALL histwrite(nid_day,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2546	varname = 'aire'
2547	vartitle= 'Grid area'
2548	varunits= '-'
2549	c call writephy(fid_day,prof2d_on,varname,paire,vartitle,
2550	c . varunits)
2551	C
2552	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2553	CALL histwrite(nid_day,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2554	c call writephy(fid_day,prof2d_av,'tsol',zxtsol,
2555	c . 'Surface Temperature','K')
2556	c
2557	C
2558	zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_ter)
2559	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d ,zx_tmp_2d)
2560	CALL histwrite(nid_day,"tter",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2561	c call writephy(fid_day,prof2d_av,'tter',ftsol(1 : klon, is_ter),
2562	c . 'Surface Temperature','K')
2563	C
2564	zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_lic)
2565	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2566	CALL histwrite(nid_day,"tlic",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2567	c call writephy(fid_day,prof2d_av,'tlic',ftsol(1 : klon, is_lic),
2568	c . 'Surface Temperature','K')
2569	C
2570	zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_oce)
2571	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2572	CALL histwrite(nid_day,"toce",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2573	c call writephy(fid_day,prof2d_av,'toce',ftsol(1 : klon, is_oce),
2574	c . 'Surface Temperature','K')
2575	C
2576	zx_tmp_fi2d(1 : klon) = ftsol(1 : klon, is_sic)
2577	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2578	CALL histwrite(nid_day,"tsic",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2579	c call writephy(fid_day,prof2d_av,'tsic',ftsol(1 : klon, is_sic),
2580	c . 'Surface Temperature','K')
2581	C
2582	DO i = 1, klon
2583	zx_tmp_fi2d(i) = paprs(i,1)
2584	ENDDO
2585	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2586	CALL histwrite(nid_day,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2587	c Essai writephys
2588	varname = 'psol'
2589	vartitle= 'pression au sol'
2590	varunits= 'hPa'
2591	c call writephy(fid_day,prof2d_av,varname,zx_tmp_fi2d,vartitle,
2592	c . varunits)
2593	c
2594	DO i = 1, klon
2595	zx_tmp_fi2d(i) = (rain_fall(i) + snow_fall(i))* 86400.
2596	ENDDO
2597	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2598	CALL histwrite(nid_day,"rain",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2599	c call writephy(fid_day,prof2d_av,'rain',zx_tmp_fi2d,
2600	c . 'Precipitation','mm/day')
2601
2602
2603	c
2604	CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
2605	CALL histwrite(nid_day,"snow",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2606	c call writephy(fid_day,prof2d_av,'snow',snow_fall,
2607	c . 'Snow','mm/day')
2608	c
2609	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
2610	CALL histwrite(nid_day,"snow_cov",itau_w,zx_tmp_2d,iim*jjmp1,
2611	. ndex2d)
2612	c call writephy(fid_day,prof2d_av,'snow_cov',zxsnow,
2613	c . 'Snow cover','mm')
2614	c
2615	CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
2616	CALL histwrite(nid_day,"evap",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2617	c call writephy(fid_day,prof2d_av,'evap',evap,
2618	c . 'Evaporation','mm/day')
2619	c
2620	CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
2621	CALL histwrite(nid_day,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2622	c call writephy(fid_day,prof2d_av,'tops',topsw,
2623	c . 'Solar rad. at TOA','W/m2')
2624	c
2625	CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
2626	CALL histwrite(nid_day,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2627	c call writephy(fid_day,prof2d_av,'topl',toplw,
2628	c . 'IR rad. at TOA','W/m2')
2629	c
2630	CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
2631	CALL histwrite(nid_day,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2632	c call writephy(fid_day,prof2d_av,'sols',solsw,
2633	c . 'Solar rad. at surf.','W/m2')
2634	c
2635	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
2636	CALL histwrite(nid_day,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2637	c call writephy(fid_day,prof2d_av,'soll',sollw,
2638	c . 'IR rad. at surface','W/m2')
2639	c
2640	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
2641	CALL histwrite(nid_day,"solldown",itau_w,zx_tmp_2d,iim*jjmp1,
2642	. ndex2d)
2643	c call writephy(fid_day,prof2d_av,'solldown',sollwdown,
2644	c . 'Down. IR rad. at surface','W/m2')
2645	c
2646	CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
2647	CALL histwrite(nid_day,"bils",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2648	c call writephy(fid_day,prof2d_av,'bils',bils,
2649	c . 'Surf. total heat flux','W/m2')
2650	c
2651	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
2652	CALL histwrite(nid_day,"sens",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2653	c call writephy(fid_day,prof2d_av,'sens',sens,
2654	c . 'Sensible heat flux','W/m2')
2655	c
2656	CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
2657	CALL histwrite(nid_day,"fder",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2658	c call writephy(fid_day,prof2d_av,'fder',fder,
2659	c . 'Heat flux derivation','W/m2')
2660	c
2661	c
2662	DO nsrf = 1, nbsrf
2663	C§§§
2664	zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
2665	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2666	CALL histwrite(nid_day,"pourc_"//clnsurf(nsrf),itau_w,
2667	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2668	c call writephy(fid_day,prof2d_av,'pourc_'//clnsurf(nsrf),
2669	c . pctsrf( 1 : klon, nsrf),
2670	c . 'Fraction'//clnsurf(nsrf),'-')
2671	C
2672	zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
2673	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2674	CALL histwrite(nid_day,"tsol_"//clnsurf(nsrf),itau_w,
2675	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2676	c call writephy(fid_day,prof2d_av,'tsol_'//clnsurf(nsrf),
2677	c . ftsol( 1 : klon, nsrf),
2678	c . 'Surf. Temp'//clnsurf(nsrf),'K')
2679	C
2680	zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
2681	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2682	CALL histwrite(nid_day,"sens_"//clnsurf(nsrf),itau_w,
2683	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2684	c call writephy(fid_day,prof2d_av,'sens_'//clnsurf(nsrf),
2685	c . fluxt( 1 : klon, 1, nsrf),
2686	c . 'Sensible heat flux '//clnsurf(nsrf),'W/m2')
2687	C
2688	zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
2689	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2690	CALL histwrite(nid_day,"lat_"//clnsurf(nsrf),itau_w,
2691	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2692	c call writephy(fid_day,prof2d_av,'lat_'//clnsurf(nsrf),
2693	c . fluxlat( 1 : klon, nsrf),
2694	c . 'Latent heat flux '//clnsurf(nsrf),'W/m2')
2695	C
2696	zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
2697	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2698	CALL histwrite(nid_day,"taux_"//clnsurf(nsrf),itau_w,
2699	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2700	c call writephy(fid_day,prof2d_av,'taux_'//clnsurf(nsrf),
2701	c . fluxu( 1 : klon, 1, nsrf),
2702	c . 'Zonal wind stress '//clnsurf(nsrf),'Pa')
2703	C
2704	zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
2705	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2706	CALL histwrite(nid_day,"tauy_"//clnsurf(nsrf),itau_w,
2707	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2708	c call writephy(fid_day,prof2d_av,'tauy_'//clnsurf(nsrf),
2709	c . fluxv( 1 : klon, 1, nsrf),
2710	c . 'Meridional wind stress '//clnsurf(nsrf),'Pa')
2711	C
2712	zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
2713	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2714	CALL histwrite(nid_day,"albe_"//clnsurf(nsrf),itau_w,
2715	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2716	c call writephy(fid_day,prof2d_av,'albe_'//clnsurf(nsrf),
2717	c . falbe( 1 : klon, nsrf),
2718	c . 'Albedo surf. SW'//clnsurf(nsrf),'-')
2719	c call writephy(fid_day,prof2d_av,'alblw_'//clnsurf(nsrf),
2720	c . falblw( 1 : klon, nsrf),
2721	c . 'Albedo surf. LW'//clnsurf(nsrf),'-')
2722	C
2723	zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
2724	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2725	CALL histwrite(nid_day,"rugs_"//clnsurf(nsrf),itau_w,
2726	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2727	c call writephy(fid_day,prof2d_av,'rugs_'//clnsurf(nsrf),
2728	c . frugs( 1 : klon, nsrf),
2729	c . 'Rugosity '//clnsurf(nsrf),' - ')
2730	C
2731	END DO
2732	C
2733	c$$$ DO i = 1, klon
2734	c$$$ zx_tmp_fi2d(i) = pctsrf(i,is_sic)
2735	c$$$ ENDDO
2736	c$$$ CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2737	c$$$ CALL histwrite(nid_day,"sicf",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2738	c
2739	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldl,zx_tmp_2d)
2740	CALL histwrite(nid_day,"cldl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2741	c call writephy(fid_day,prof2d_av,'cldl',cldl,
2742	c . 'Low-level cloudiness','-')
2743	c
2744	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldm,zx_tmp_2d)
2745	CALL histwrite(nid_day,"cldm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2746	c call writephy(fid_day,prof2d_av,'cldm',cldm,
2747	c . 'Mid-level cloudiness','-')
2748	c
2749	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldh,zx_tmp_2d)
2750	CALL histwrite(nid_day,"cldh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2751	c call writephy(fid_day,prof2d_av,'cldh',cldh,
2752	c . 'High-level cloudiness','-')
2753	c
2754	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
2755	CALL histwrite(nid_day,"cldt",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2756	c call writephy(fid_day,prof2d_av,'cldt',cldt,
2757	c . 'Total cloudiness','-')
2758	c
2759	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldq,zx_tmp_2d)
2760	CALL histwrite(nid_day,"cldq",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2761	c call writephy(fid_day,prof2d_av,'cldq',cldq,
2762	c . 'Cloud liquid water path','-')
2763	c
2764	c Champs 3D:
2765	c
2766	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
2767	CALL histwrite(nid_day,"temp",itau_w,zx_tmp_3d,
2768	. iimjjmp1klev,ndex3d)
2769	c Essai writephys
2770	varname = 'temp'
2771	vartitle= 'temperature 3D'
2772	varunits= 'K'
2773	c call writephy(fid_day,prof3d_av,varname,t_seri,vartitle,varunits)
2774	c
2775	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
2776	CALL histwrite(nid_day,"ovap",itau_w,zx_tmp_3d,
2777	. iimjjmp1klev,ndex3d)
2778	c call writephy(fid_day,prof3d_av,'ovap',qx(1,1,ivap),
2779	c . 'Specific humidity','Kg/Kg')
2780	c
2781	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
2782	CALL histwrite(nid_day,"geop",itau_w,zx_tmp_3d,
2783	. iimjjmp1klev,ndex3d)
2784	c call writephy(fid_day,prof3d_av,'geop',zphi,
2785	c . 'Geopotential height','m')
2786	c
2787	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
2788	CALL histwrite(nid_day,"vitu",itau_w,zx_tmp_3d,
2789	. iimjjmp1klev,ndex3d)
2790	c call writephy(fid_day,prof3d_av,'vitu',u_seri,
2791	c . 'Zonal wind','m/s')
2792	c
2793	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
2794	CALL histwrite(nid_day,"vitv",itau_w,zx_tmp_3d,
2795	. iimjjmp1klev,ndex3d)
2796	c call writephy(fid_day,prof3d_av,'vitv',v_seri,
2797	c . 'Meridional wind','m/s')
2798	c
2799	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
2800	CALL histwrite(nid_day,"vitw",itau_w,zx_tmp_3d,
2801	. iimjjmp1klev,ndex3d)
2802	c call writephy(fid_day,prof3d_av,'vitw',omega,
2803	c . 'Vertical wind','m/s')
2804	c
2805	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
2806	CALL histwrite(nid_day,"pres",itau_w,zx_tmp_3d,
2807	. iimjjmp1klev,ndex3d)
2808	c call writephy(fid_day,prof3d_av,'pres',pplay,
2809	c . 'Air pressure','Pa')
2810
2811	c
2812	if (ok_sync) then
2813	c call writephy_sync(fid_day)
2814	call histsync(nid_day)
2815	endif
2816	ENDIF
2817	C
2818	IF (ok_mensuel) THEN
2819	c
2820	ndex2d = 0
2821	ndex3d = 0
2822	c
2823	c Champs 2D:
2824	c
2825	zsto = dtime
2826	zout = dtime * ecrit_mth
2827	itau_w = itau_phy + itap
2828
2829	i = NINT(zout/zsto)
2830	CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
2831	CALL histwrite(nid_mth,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2832	C
2833	i = NINT(zout/zsto)
2834	CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
2835	CALL histwrite(nid_mth,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2836
2837	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
2838	CALL histwrite(nid_mth,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2839	c
2840	DO i = 1, klon
2841	zx_tmp_fi2d(i) = paprs(i,1)
2842	ENDDO
2843	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2844	CALL histwrite(nid_mth,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2845	c
2846	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxqsol,zx_tmp_2d)
2847	CALL histwrite(nid_mth,"qsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2848	c
2849	DO i = 1, klon
2850	zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
2851	ENDDO
2852	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2853	CALL histwrite(nid_mth,"rain",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2854	c
2855	DO i = 1, klon
2856	zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
2857	ENDDO
2858	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2859	CALL histwrite(nid_mth,"plul",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2860	c
2861	DO i = 1, klon
2862	zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
2863	ENDDO
2864	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2865	CALL histwrite(nid_mth,"pluc",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2866	c
2867	CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
2868	CALL histwrite(nid_mth,"snow",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2869	c
2870	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
2871	CALL histwrite(nid_mth,"snow_cov",itau_w,zx_tmp_2d,iim*jjmp1,
2872	. ndex2d)
2873	c
2874	CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
2875	CALL histwrite(nid_mth,"evap",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2876	c
2877	CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw,zx_tmp_2d)
2878	CALL histwrite(nid_mth,"tops",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2879	c
2880	CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
2881	CALL histwrite(nid_mth,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2882	c
2883	CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
2884	CALL histwrite(nid_mth,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2885	c
2886	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
2887	CALL histwrite(nid_mth,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2888	c
2889	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
2890	CALL histwrite(nid_mth,"solldown",itau_w,zx_tmp_2d,iim*jjmp1,
2891	. ndex2d)
2892	c
2893	CALL gr_fi_ecrit(1, klon,iim,jjmp1, topsw0,zx_tmp_2d)
2894	CALL histwrite(nid_mth,"tops0",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2895	c
2896	CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw0,zx_tmp_2d)
2897	CALL histwrite(nid_mth,"topl0",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2898	c
2899	CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw0,zx_tmp_2d)
2900	CALL histwrite(nid_mth,"sols0",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2901	c
2902	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw0,zx_tmp_2d)
2903	CALL histwrite(nid_mth,"soll0",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2904	c
2905	CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
2906	CALL histwrite(nid_mth,"bils",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2907	c
2908	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
2909	CALL histwrite(nid_mth,"sens",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2910	c
2911	CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
2912	CALL histwrite(nid_mth,"fder",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2913	c
2914	c
2915	c DO i = 1, klon
2916	c zx_tmp_fi2d(i) = fluxu(i,1)
2917	c ENDDO
2918	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2919	c CALL histwrite(nid_mth,"frtu",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2920	c
2921	c DO i = 1, klon
2922	c zx_tmp_fi2d(i) = fluxv(i,1)
2923	c ENDDO
2924	c CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2925	c CALL histwrite(nid_mth,"frtv",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2926	c
2927	DO nsrf = 1, nbsrf
2928	C§§§
2929	zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
2930	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2931	CALL histwrite(nid_mth,"pourc_"//clnsurf(nsrf),itau_w,
2932	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2933	C
2934	zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
2935	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2936	CALL histwrite(nid_mth,"tsol_"//clnsurf(nsrf),itau_w,
2937	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2938	C
2939	zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
2940	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2941	CALL histwrite(nid_mth,"sens_"//clnsurf(nsrf),itau_w,
2942	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2943	C
2944	zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
2945	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2946	CALL histwrite(nid_mth,"lat_"//clnsurf(nsrf),itau_w,
2947	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2948	C
2949	zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
2950	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2951	CALL histwrite(nid_mth,"taux_"//clnsurf(nsrf),itau_w,
2952	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2953	C
2954	zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
2955	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2956	CALL histwrite(nid_mth,"tauy_"//clnsurf(nsrf),itau_w,
2957	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2958	C
2959	zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
2960	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2961	CALL histwrite(nid_mth,"albe_"//clnsurf(nsrf),itau_w,
2962	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2963	C
2964	zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
2965	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
2966	CALL histwrite(nid_mth,"rugs_"//clnsurf(nsrf),itau_w,
2967	$ zx_tmp_2d,iim*jjmp1,ndex2d)
2968	c
2969	zx_tmp_fi2d(1 : klon) = agesno( 1 : klon, nsrf)
2970	CALL gr_fi_ecrit(1, klon,iim,jjmp1, agesno,zx_tmp_2d)
2971	CALL histwrite(nid_mth,"ages_"//clnsurf(nsrf),itau_w
2972	$ ,zx_tmp_2d,iim*jjmp1,ndex2d)
2973
2974	END DO
2975	c$$$ DO i = 1, klon
2976	c$$$ zx_tmp_fi2d(i) = pctsrf(i,is_sic)
2977	c$$$ ENDDO
2978	c$$$ CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
2979	c$$$ CALL histwrite(nid_mth,"sicf",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2980	c
2981	CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol,zx_tmp_2d)
2982	CALL histwrite(nid_mth,"albs",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2983	CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsollw,zx_tmp_2d)
2984	CALL histwrite(nid_mth,"albslw",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2985	c
2986	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragm,zx_tmp_2d)
2987	CALL histwrite(nid_mth,"cdrm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2988	c
2989	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cdragh,zx_tmp_2d)
2990	CALL histwrite(nid_mth,"cdrh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2991	c
2992	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldl,zx_tmp_2d)
2993	CALL histwrite(nid_mth,"cldl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2994	c
2995	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldm,zx_tmp_2d)
2996	CALL histwrite(nid_mth,"cldm",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
2997	c
2998	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldh,zx_tmp_2d)
2999	CALL histwrite(nid_mth,"cldh",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3000	c
3001	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldt,zx_tmp_2d)
3002	CALL histwrite(nid_mth,"cldt",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3003	c
3004	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cldq,zx_tmp_2d)
3005	CALL histwrite(nid_mth,"cldq",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3006	c
3007	CALL gr_fi_ecrit(1, klon,iim,jjmp1, ue,zx_tmp_2d)
3008	CALL histwrite(nid_mth,"ue",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3009	c
3010	CALL gr_fi_ecrit(1, klon,iim,jjmp1, ve,zx_tmp_2d)
3011	CALL histwrite(nid_mth,"ve",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3012	c
3013	CALL gr_fi_ecrit(1, klon,iim,jjmp1, uq,zx_tmp_2d)
3014	CALL histwrite(nid_mth,"uq",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3015	c
3016	CALL gr_fi_ecrit(1, klon,iim,jjmp1, vq,zx_tmp_2d)
3017	CALL histwrite(nid_mth,"vq",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3018	cKE43
3019	IF (iflag_con .GE. 3) THEN ! sb
3020	c
3021	CALL gr_fi_ecrit(1, klon,iim,jjmp1, cape,zx_tmp_2d)
3022	CALL histwrite(nid_mth,"cape",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3023	c
3024	CALL gr_fi_ecrit(1, klon,iim,jjmp1,pbase,zx_tmp_2d)
3025	CALL histwrite(nid_mth,"pbase",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3026	c
3027	CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_pct,zx_tmp_2d)
3028	CALL histwrite(nid_mth,"ptop",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3029	c
3030	CALL gr_fi_ecrit(1, klon,iim,jjmp1,ema_cbmf,zx_tmp_2d)
3031	CALL histwrite(nid_mth,"fbase",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3032	c
3033	c
3034	ENDIF
3035	c34EK
3036	c
3037	c Champs 3D:
3038	C
3039	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
3040	CALL histwrite(nid_mth,"temp",itau_w,zx_tmp_3d,
3041	. iimjjmp1klev,ndex3d)
3042	c
3043	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,ivap), zx_tmp_3d)
3044	CALL histwrite(nid_mth,"ovap",itau_w,zx_tmp_3d,
3045	. iimjjmp1klev,ndex3d)
3046	c
3047	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
3048	CALL histwrite(nid_mth,"geop",itau_w,zx_tmp_3d,
3049	. iimjjmp1klev,ndex3d)
3050	c
3051	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
3052	CALL histwrite(nid_mth,"vitu",itau_w,zx_tmp_3d,
3053	. iimjjmp1klev,ndex3d)
3054	c
3055	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
3056	CALL histwrite(nid_mth,"vitv",itau_w,zx_tmp_3d,
3057	. iimjjmp1klev,ndex3d)
3058	c
3059	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, omega, zx_tmp_3d)
3060	CALL histwrite(nid_mth,"vitw",itau_w,zx_tmp_3d,
3061	. iimjjmp1klev,ndex3d)
3062	c
3063	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
3064	CALL histwrite(nid_mth,"pres",itau_w,zx_tmp_3d,
3065	. iimjjmp1klev,ndex3d)
3066	c
3067	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldfra, zx_tmp_3d)
3068	CALL histwrite(nid_mth,"rneb",itau_w,zx_tmp_3d,
3069	. iimjjmp1klev,ndex3d)
3070	c
3071	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zx_rh, zx_tmp_3d)
3072	CALL histwrite(nid_mth,"rhum",itau_w,zx_tmp_3d,
3073	. iimjjmp1klev,ndex3d)
3074	c
3075	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cldliq, zx_tmp_3d)
3076	CALL histwrite(nid_mth,"oliq",itau_w,zx_tmp_3d,
3077	. iimjjmp1klev,ndex3d)
3078	c
3079	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_dyn, zx_tmp_3d)
3080	CALL histwrite(nid_mth,"dtdyn",itau_w,zx_tmp_3d,
3081	. iimjjmp1klev,ndex3d)
3082	c
3083	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_dyn, zx_tmp_3d)
3084	CALL histwrite(nid_mth,"dqdyn",itau_w,zx_tmp_3d,
3085	. iimjjmp1klev,ndex3d)
3086	c
3087	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_con, zx_tmp_3d)
3088	CALL histwrite(nid_mth,"dtcon",itau_w,zx_tmp_3d,
3089	. iimjjmp1klev,ndex3d)
3090	c
3091	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_con, zx_tmp_3d)
3092	CALL histwrite(nid_mth,"dqcon",itau_w,zx_tmp_3d,
3093	. iimjjmp1klev,ndex3d)
3094	c
3095	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_lsc, zx_tmp_3d)
3096	CALL histwrite(nid_mth,"dtlsc",itau_w,zx_tmp_3d,
3097	. iimjjmp1klev,ndex3d)
3098	c
3099	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_lsc, zx_tmp_3d)
3100	CALL histwrite(nid_mth,"dqlsc",itau_w,zx_tmp_3d,
3101	. iimjjmp1klev,ndex3d)
3102	c
3103	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_vdf, zx_tmp_3d)
3104	CALL histwrite(nid_mth,"dtvdf",itau_w,zx_tmp_3d,
3105	. iimjjmp1klev,ndex3d)
3106	c
3107	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_vdf, zx_tmp_3d)
3108	CALL histwrite(nid_mth,"dqvdf",itau_w,zx_tmp_3d,
3109	. iimjjmp1klev,ndex3d)
3110	c
3111	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_eva, zx_tmp_3d)
3112	CALL histwrite(nid_mth,"dteva",itau_w,zx_tmp_3d,
3113	. iimjjmp1klev,ndex3d)
3114	c
3115	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_eva, zx_tmp_3d)
3116	CALL histwrite(nid_mth,"dqeva",itau_w,zx_tmp_3d,
3117	. iimjjmp1klev,ndex3d)
3118	c
3119	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zpt_conv, zx_tmp_3d)
3120	CALL histwrite(nid_mth,"ptconv",itau_w,zx_tmp_3d,
3121	. iim(jjmp1)klev,ndex3d)
3122	c
3123	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, ratqs, zx_tmp_3d)
3124	CALL histwrite(nid_mth,"ratqs",itau_w,zx_tmp_3d,
3125	. iim(jjmp1)klev,ndex3d)
3126	c
3127	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_ajs, zx_tmp_3d)
3128	CALL histwrite(nid_mth,"dtajs",itau_w,zx_tmp_3d,
3129	. iimjjmp1klev,ndex3d)
3130	c
3131	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_ajs, zx_tmp_3d)
3132	CALL histwrite(nid_mth,"dqajs",itau_w,zx_tmp_3d,
3133	. iimjjmp1klev,ndex3d)
3134	c
3135	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat, zx_tmp_3d)
3136	CALL histwrite(nid_mth,"dtswr",itau_w,zx_tmp_3d,
3137	. iimjjmp1klev,ndex3d)
3138	c
3139	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, heat0, zx_tmp_3d)
3140	CALL histwrite(nid_mth,"dtsw0",itau_w,zx_tmp_3d,
3141	. iimjjmp1klev,ndex3d)
3142	c
3143	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool, zx_tmp_3d)
3144	CALL histwrite(nid_mth,"dtlwr",itau_w,zx_tmp_3d,
3145	. iimjjmp1klev,ndex3d)
3146	c
3147	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, cool0, zx_tmp_3d)
3148	CALL histwrite(nid_mth,"dtlw0",itau_w,zx_tmp_3d,
3149	. iimjjmp1klev,ndex3d)
3150	c
3151	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_vdf, zx_tmp_3d)
3152	CALL histwrite(nid_mth,"duvdf",itau_w,zx_tmp_3d,
3153	. iimjjmp1klev,ndex3d)
3154	c
3155	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_vdf, zx_tmp_3d)
3156	CALL histwrite(nid_mth,"dvvdf",itau_w,zx_tmp_3d,
3157	. iimjjmp1klev,ndex3d)
3158	c
3159	IF (ok_orodr) THEN
3160	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_oro, zx_tmp_3d)
3161	CALL histwrite(nid_mth,"duoro",itau_w,zx_tmp_3d,
3162	. iimjjmp1klev,ndex3d)
3163	c
3164	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_oro, zx_tmp_3d)
3165	CALL histwrite(nid_mth,"dvoro",itau_w,zx_tmp_3d,
3166	. iimjjmp1klev,ndex3d)
3167	c
3168	ENDIF
3169	C
3170	IF (ok_orolf) THEN
3171	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_u_lif, zx_tmp_3d)
3172	CALL histwrite(nid_mth,"dulif",itau_w,zx_tmp_3d,
3173	. iimjjmp1klev,ndex3d)
3174	c
3175	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_v_lif, zx_tmp_3d)
3176	CALL histwrite(nid_mth,"dvlif",itau_w,zx_tmp_3d,
3177	. iimjjmp1klev,ndex3d)
3178	ENDIF
3179	C
3180	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, wo, zx_tmp_3d)
3181	CALL histwrite(nid_mth,"ozone",itau_w,zx_tmp_3d,
3182	. iimjjmp1klev,ndex3d)
3183	c
3184	IF (nqmax.GE.3) THEN
3185	DO iq=1,nqmax-2
3186	IF (iq.LE.99) THEN
3187	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, qx(1,1,iq+2), zx_tmp_3d)
3188	WRITE(str2,'(i2.2)') iq
3189	CALL histwrite(nid_mth,"trac"//str2,itau_w,zx_tmp_3d,
3190	. iimjjmp1klev,ndex3d)
3191	ELSE
3192	PRINT*, "Trop de traceurs"
3193	CALL abort
3194	ENDIF
3195	ENDDO
3196	ENDIF
3197	cKE43
3198	IF (iflag_con.GE.3) THEN ! (sb)
3199	c
3200	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, upwd, zx_tmp_3d)
3201	CALL histwrite(nid_mth,"upwd",itau_w,zx_tmp_3d,
3202	. iimjjmp1klev,ndex3d)
3203	c
3204	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd, zx_tmp_3d)
3205	CALL histwrite(nid_mth,"dnwd",itau_w,zx_tmp_3d,
3206	. iimjjmp1klev,ndex3d)
3207	c
3208	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, dnwd0, zx_tmp_3d)
3209	CALL histwrite(nid_mth,"dnwd0",itau_w,zx_tmp_3d,
3210	. iimjjmp1klev,ndex3d)
3211	c
3212	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, Ma, zx_tmp_3d)
3213	CALL histwrite(nid_mth,"Ma",itau_w,zx_tmp_3d,
3214	. iimjjmp1klev,ndex3d)
3215	c
3216	c
3217	ENDIF
3218	c34EK
3219	c
3220	if (ok_sync) then
3221	call histsync(nid_mth)
3222	endif
3223	ENDIF
3224	c
3225	IF (ok_instan) THEN
3226	c
3227	ndex2d = 0
3228	ndex3d = 0
3229	c
3230	c Champs 2D:
3231	c
3232	zsto = dtime * ecrit_ins
3233	zout = dtime * ecrit_ins
3234	itau_w = itau_phy + itap
3235
3236	i = NINT(zout/zsto)
3237	CALL gr_fi_ecrit(1,klon,iim,jjmp1,pphis,zx_tmp_2d)
3238	CALL histwrite(nid_ins,"phis",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3239	c
3240	i = NINT(zout/zsto)
3241	CALL gr_fi_ecrit(1,klon,iim,jjmp1,paire,zx_tmp_2d)
3242	CALL histwrite(nid_ins,"aire",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3243
3244	DO i = 1, klon
3245	zx_tmp_fi2d(i) = paprs(i,1)
3246	ENDDO
3247	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3248	CALL histwrite(nid_ins,"psol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3249	c
3250	DO i = 1, klon
3251	zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i)
3252	ENDDO
3253	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3254	CALL histwrite(nid_ins,"rain",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3255	c
3256	DO i = 1, klon
3257	zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i)
3258	ENDDO
3259	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3260	CALL histwrite(nid_ins,"plul",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3261	c
3262	DO i = 1, klon
3263	zx_tmp_fi2d(i) = rain_con(i) + snow_con(i)
3264	ENDDO
3265	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d,zx_tmp_2d)
3266	CALL histwrite(nid_ins,"pluc",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3267
3268	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxtsol,zx_tmp_2d)
3269	CALL histwrite(nid_ins,"tsol",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3270	c
3271	CALL gr_fi_ecrit(1, klon,iim,jjmp1, snow_fall,zx_tmp_2d)
3272	CALL histwrite(nid_ins,"snow",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3273
3274	c
3275	CALL gr_fi_ecrit(1, klon,iim,jjmp1, toplw,zx_tmp_2d)
3276	CALL histwrite(nid_ins,"topl",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3277	c
3278	CALL gr_fi_ecrit(1, klon,iim,jjmp1, evap,zx_tmp_2d)
3279	CALL histwrite(nid_ins,"evap",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3280	c
3281	CALL gr_fi_ecrit(1, klon,iim,jjmp1, solsw,zx_tmp_2d)
3282	CALL histwrite(nid_ins,"sols",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3283	c
3284	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollw,zx_tmp_2d)
3285	CALL histwrite(nid_ins,"soll",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3286	c
3287	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sollwdown,zx_tmp_2d)
3288	CALL histwrite(nid_ins,"solldown",itau_w,zx_tmp_2d,iim*jjmp1,
3289	. ndex2d)
3290	c
3291	CALL gr_fi_ecrit(1, klon,iim,jjmp1, bils,zx_tmp_2d)
3292	CALL histwrite(nid_ins,"bils",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3293	c
3294	CALL gr_fi_ecrit(1, klon,iim,jjmp1, sens,zx_tmp_2d)
3295	CALL histwrite(nid_ins,"sens",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3296	c
3297	CALL gr_fi_ecrit(1, klon,iim,jjmp1, fder,zx_tmp_2d)
3298	CALL histwrite(nid_ins,"fder",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3299	c
3300	CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_oce),zx_tmp_2d)
3301	CALL histwrite(nid_ins,"dtsvdfo",itau_w,zx_tmp_2d,iim*jjmp1,
3302	. ndex2d)
3303	c
3304	CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_ter),zx_tmp_2d)
3305	CALL histwrite(nid_ins,"dtsvdft",itau_w,zx_tmp_2d,iim*jjmp1,
3306	. ndex2d)
3307	c
3308	CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_lic),zx_tmp_2d)
3309	CALL histwrite(nid_ins,"dtsvdfg",itau_w,zx_tmp_2d,iim*jjmp1,
3310	. ndex2d)
3311	c
3312	CALL gr_fi_ecrit(1, klon,iim,jjmp1, d_ts(1,is_sic),zx_tmp_2d)
3313	CALL histwrite(nid_ins,"dtsvdfi",itau_w,zx_tmp_2d,iim*jjmp1,
3314	. ndex2d)
3315
3316	DO nsrf = 1, nbsrf
3317	C§§§
3318	zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)
3319	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3320	CALL histwrite(nid_ins,"pourc_"//clnsurf(nsrf),itau_w,
3321	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3322	C
3323	zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf)
3324	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3325	CALL histwrite(nid_ins,"sens_"//clnsurf(nsrf),itau_w,
3326	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3327	C
3328	zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf)
3329	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3330	CALL histwrite(nid_ins,"lat_"//clnsurf(nsrf),itau_w,
3331	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3332	C
3333	zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf)
3334	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3335	CALL histwrite(nid_ins,"tsol_"//clnsurf(nsrf),itau_w,
3336	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3337	C
3338	zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf)
3339	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3340	CALL histwrite(nid_ins,"taux_"//clnsurf(nsrf),itau_w,
3341	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3342	C
3343	zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf)
3344	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3345	CALL histwrite(nid_ins,"tauy_"//clnsurf(nsrf),itau_w,
3346	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3347	C
3348	zx_tmp_fi2d(1 : klon) = frugs( 1 : klon, nsrf)
3349	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3350	CALL histwrite(nid_ins,"rugs_"//clnsurf(nsrf),itau_w,
3351	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3352	C
3353	zx_tmp_fi2d(1 : klon) = falbe( 1 : klon, nsrf)
3354	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zx_tmp_fi2d , zx_tmp_2d)
3355	CALL histwrite(nid_ins,"albe_"//clnsurf(nsrf),itau_w,
3356	$ zx_tmp_2d,iim*jjmp1,ndex2d)
3357	C
3358	END DO
3359	CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsol,zx_tmp_2d)
3360	CALL histwrite(nid_ins,"albs",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3361	CALL gr_fi_ecrit(1, klon,iim,jjmp1, albsollw,zx_tmp_2d)
3362	CALL histwrite(nid_ins,"albslw",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3363	c
3364	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxsnow,zx_tmp_2d)
3365	CALL histwrite(nid_ins,"snow_cov",itau_w,zx_tmp_2d,iim*jjmp1,
3366	. ndex2d)
3367	c
3368	CALL gr_fi_ecrit(1, klon,iim,jjmp1, zxrugs,zx_tmp_2d)
3369	CALL histwrite(nid_ins,"rugs",itau_w,zx_tmp_2d,iim*jjmp1,ndex2d)
3370	c
3371	c Champs 3D:
3372	c
3373	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, t_seri, zx_tmp_3d)
3374	CALL histwrite(nid_ins,"temp",itau_w,zx_tmp_3d,
3375	. iimjjmp1klev,ndex3d)
3376	c
3377	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, u_seri, zx_tmp_3d)
3378	CALL histwrite(nid_ins,"vitu",itau_w,zx_tmp_3d,
3379	. iimjjmp1klev,ndex3d)
3380	c
3381	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, v_seri, zx_tmp_3d)
3382	CALL histwrite(nid_ins,"vitv",itau_w,zx_tmp_3d,
3383	. iimjjmp1klev,ndex3d)
3384	c
3385	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, zphi, zx_tmp_3d)
3386	CALL histwrite(nid_ins,"geop",itau_w,zx_tmp_3d,
3387	. iimjjmp1klev,ndex3d)
3388	c
3389	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, pplay, zx_tmp_3d)
3390	CALL histwrite(nid_ins,"pres",itau_w,zx_tmp_3d,
3391	. iimjjmp1klev,ndex3d)
3392	c
3393	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_t_vdf, zx_tmp_3d)
3394	CALL histwrite(nid_ins,"dtvdf",itau_w,zx_tmp_3d,
3395	. iimjjmp1klev,ndex3d)
3396	c
3397	CALL gr_fi_ecrit(klev,klon,iim,jjmp1, d_q_vdf, zx_tmp_3d)
3398	CALL histwrite(nid_ins,"dqvdf",itau_w,zx_tmp_3d,
3399	. iimjjmp1klev,ndex3d)
3400
3401	c
3402	if (ok_sync) then
3403	call histsync(nid_ins)
3404	endif
3405	ENDIF
3406	c
3407	c
3408	c Ecrire la bande regionale (binaire grads)
3409	IF (ok_region .AND. mod(itap,ecrit_reg).eq.0) THEN
3410	CALL ecriregs(84,zxtsol)
3411	CALL ecriregs(84,paprs(1,1))
3412	CALL ecriregs(84,topsw)
3413	CALL ecriregs(84,toplw)
3414	CALL ecriregs(84,solsw)
3415	CALL ecriregs(84,sollw)
3416	CALL ecriregs(84,rain_fall)
3417	CALL ecriregs(84,snow_fall)
3418	CALL ecriregs(84,evap)
3419	CALL ecriregs(84,sens)
3420	CALL ecriregs(84,bils)
3421	CALL ecriregs(84,pctsrf(1,is_sic))
3422	CALL ecriregs(84,zxfluxu(1,1))
3423	CALL ecriregs(84,zxfluxv(1,1))
3424	CALL ecriregs(84,ue)
3425	CALL ecriregs(84,ve)
3426	CALL ecriregs(84,uq)
3427	CALL ecriregs(84,vq)
3428	c
3429	CALL ecrirega(84,u_seri)
3430	CALL ecrirega(84,v_seri)
3431	CALL ecrirega(84,omega)
3432	CALL ecrirega(84,t_seri)
3433	CALL ecrirega(84,zphi)
3434	CALL ecrirega(84,q_seri)
3435	CALL ecrirega(84,cldfra)
3436	CALL ecrirega(84,cldliq)
3437	CALL ecrirega(84,pplay)
3438
3439
3440	cc CALL ecrirega(84,d_t_dyn)
3441	cc CALL ecrirega(84,d_q_dyn)
3442	cc CALL ecrirega(84,heat)
3443	cc CALL ecrirega(84,cool)
3444	cc CALL ecrirega(84,d_t_con)
3445	cc CALL ecrirega(84,d_q_con)
3446	cc CALL ecrirega(84,d_t_lsc)
3447	cc CALL ecrirega(84,d_q_lsc)
3448	ENDIF
3449	c
3450	c Convertir les incrementations en tendances
3451	c
3452	DO k = 1, klev
3453	DO i = 1, klon
3454	d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime
3455	d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime
3456	d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / dtime
3457	d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / dtime
3458	d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / dtime
3459	ENDDO
3460	ENDDO
3461	c
3462	IF (nqmax.GE.3) THEN
3463	DO iq = 3, nqmax
3464	DO k = 1, klev
3465	DO i = 1, klon
3466	d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / dtime
3467	ENDDO
3468	ENDDO
3469	ENDDO
3470	ENDIF
3471	c
3472	c Sauvegarder les valeurs de t et q a la fin de la physique:
3473	c
3474	DO k = 1, klev
3475	DO i = 1, klon
3476	t_ancien(i,k) = t_seri(i,k)
3477	q_ancien(i,k) = q_seri(i,k)
3478	ENDDO
3479	ENDDO
3480	c
3481	c====================================================================
3482	c Si c'est la fin, il faut conserver l'etat de redemarrage
3483	c====================================================================
3484	c
3485	IF (lafin) THEN
3486	itau_phy = itau_phy + itap
3487	ccc IF (ok_oasis) CALL quitcpl
3488	CALL phyredem ("restartphy.nc",dtime,radpas,co2_ppm,solaire,
3489	. rlat, rlon, pctsrf, ftsol, ftsoil, deltat, fqsol, fsnow,
3490	. falbe, fevap, rain_fall, snow_fall,
3491	. solsw, sollwdown,dlw,
3492	. radsol,frugs,agesno,
3493	. zmea,zstd,zsig,zgam,zthe,zpic,zval,rugoro,
3494	. t_ancien, q_ancien, rnebcon, ratqs, clwcon)
3495	ENDIF
3496
3497	RETURN
3498	END
3499	FUNCTION qcheck(klon,klev,paprs,q,ql,aire)
3500	IMPLICIT none
3501	c
3502	c Calculer et imprimer l'eau totale. A utiliser pour verifier
3503	c la conservation de l'eau
3504	c
3505	#include "YOMCST.h"
3506	INTEGER klon,klev
3507	REAL paprs(klon,klev+1), q(klon,klev), ql(klon,klev)
3508	REAL aire(klon)
3509	REAL qtotal, zx, qcheck
3510	INTEGER i, k
3511	c
3512	zx = 0.0
3513	DO i = 1, klon
3514	zx = zx + aire(i)
3515	ENDDO
3516	qtotal = 0.0
3517	DO k = 1, klev
3518	DO i = 1, klon
3519	qtotal = qtotal + (q(i,k)+ql(i,k)) * aire(i)
3520	. *(paprs(i,k)-paprs(i,k+1))/RG
3521	ENDDO
3522	ENDDO
3523	c
3524	qcheck = qtotal/zx
3525	c
3526	RETURN
3527	END
3528	SUBROUTINE gr_fi_ecrit(nfield,nlon,iim,jjmp1,fi,ecrit)
3529	IMPLICIT none
3530	c
3531	c Tranformer une variable de la grille physique a
3532	c la grille d'ecriture
3533	c
3534	INTEGER nfield,nlon,iim,jjmp1, jjm
3535	REAL fi(nlon,nfield), ecrit(iim*jjmp1,nfield)
3536	c
3537	INTEGER i, n, ig
3538	c
3539	jjm = jjmp1 - 1
3540	DO n = 1, nfield
3541	DO i=1,iim
3542	ecrit(i,n) = fi(1,n)
3543	ecrit(i+jjm*iim,n) = fi(nlon,n)
3544	ENDDO
3545	DO ig = 1, nlon - 2
3546	ecrit(iim+ig,n) = fi(1+ig,n)
3547	ENDDO
3548	ENDDO
3549	RETURN
3550	END
3551

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format