Context Navigation

physiq.F @ 290

Last change on this file since 290 was 290, checked in by lmdzadmin, 23 years ago
Initialisations de variables Pasb LF
Property svn:eol-style set to `native` Property svn:executable set to ``* Property svn:keywords set to `Author Date Id Revision`
File size: 119.4 KB

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

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

Download in other formats:

Original Format