Context Navigation

physiq.F @ 391

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

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

Download in other formats:

Original Format