Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

physiq_mod.F90 @ 5456

Last change on this file since 5456 was 3331, checked in by acozic, 7 years ago
Add modification for isotopes
Property svn:executable set to ``*
File size: 225.4 KB

Rev	Line
[3331]	1	!
	2	! $Id: physiq_mod.F90 2618 2016-09-01 08:47:39Z oboucher $
	3	!
	4	!#define IO_DEBUG
	5	MODULE physiq_mod
	6
	7	IMPLICIT NONE
	8
	9	CONTAINS
	10
	11	SUBROUTINE physiq (nlon,nlev, &
	12	debut,lafin,pdtphys_, &
	13	paprs,pplay,pphi,pphis,presnivs, &
	14	u,v,rot,t,qx, &
	15	flxmass_w, &
	16	d_u, d_v, d_t, d_qx, d_ps)
	17
	18	USE ioipsl, only: histbeg, histvert, histdef, histend, histsync, &
	19	histwrite, ju2ymds, ymds2ju, getin
	20	USE geometry_mod, ONLY: cell_area, latitude_deg, longitude_deg
	21	USE phys_cal_mod, only: year_len, mth_len, days_elapsed, jh_1jan, &
	22	year_cur, mth_cur,jD_cur, jH_cur, jD_ref
	23	USE write_field_phy
	24	USE dimphy
	25	USE infotrac_phy, ONLY: nqtot, nbtr, nqo, type_trac,ok_isotopes
	26	#ifdef ISO
	27	USE infotrac_phy, ONLY: &
	28	iqiso,iso_num,iso_indnum,zone_num,ok_isotrac, &
	29	niso,ntraciso,nqtottr,itr_indice ! ajout C Risi pour isos
	30	#endif
	31	#ifdef ISO
	32	USE isotopes_mod, ONLY: iso_eau,iso_HDO,iso_O18,iso_O17,iso_HTO, &
	33	& bidouille_anti_divergence,ok_bidouille_wake, &
	34	& modif_ratqs,essai_convergence,iso_init,ridicule_rain,tnat, &
	35	& ridicule,ridicule_snow
	36	USE isotopes_routines_mod, ONLY: iso_tritium
	37	#ifdef ISOVERIF
	38	USE isotopes_verif_mod, ONLY: errmax,errmaxrel, &
	39	& deltalim,deltalim_snow, deltaD,deltaO,nlevmaxO17, &
	40	& iso_verif_positif_nostop,iso_verif_egalite_vect2D, &
	41	& iso_verif_aberrant_enc_vect2D,iso_verif_noNaN_vect2D, &
	42	& iso_verif_noNaN,iso_verif_aberrant_vect2D, &
	43	& iso_verif_o18_aberrant,iso_verif_aberrant_o17, &
	44	& iso_verif_aberrant,iso_verif_egalite_choix, &
	45	& iso_verif_aberrant_encadre,iso_verif_egalite, &
	46	& iso_verif_aberrant_choix,iso_verif_positif, &
	47	& iso_verif_positif_choix_vect,iso_verif_o18_aberrant_nostop, &
	48	& iso_verif_init, &
	49	& iso_verif_positif_strict_nostop,iso_verif_O18_aberrant_enc_vect2D
	50	#endif
	51	#ifdef ISOTRAC
	52	USE isotrac_mod, ONLY: option_traceurs,iso_traceurs_init, &
	53	& option_tmin,nzone_temp
	54	USE isotrac_routines_mod, only: initialise_bassins_boites, &
	55	& isotrac_recolorise_general,isotrac_recolorise_conv, &
	56	& iso_verif_traceur_jbid_vect
	57	#ifdef ISOVERIF
	58	USE isotrac_routines_mod, only: iso_verif_traceur_pbidouille
	59	USE isotopes_verif_mod, ONLY: iso_verif_traceur, &
	60	& iso_verif_traceur_justmass,iso_verif_traceur_vect, &
	61	& iso_verif_trac17_q_deltad,iso_verif_trac_masse_vect, &
	62	& iso_verif_tracpos_choix_nostop
	63	#endif
	64	#endif
	65	#endif
	66	USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev, klon_glo
	67	USE mod_phys_lmdz_para
	68	USE iophy
	69	USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
	70	USE phystokenc_mod, ONLY: offline, phystokenc
	71	USE time_phylmdz_mod, only: raz_date, day_step_phy, update_time
	72	USE vampir
	73	USE pbl_surface_mod, ONLY : pbl_surface
	74	USE change_srf_frac_mod
	75	USE surface_data, ONLY : type_ocean, ok_veget, ok_snow
	76	USE phys_local_var_mod, ONLY: phys_local_var_init, phys_local_var_end, &
	77	! [Variables internes non sauvegardees de la physique]
	78	! Variables locales pour effectuer les appels en serie
	79	t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,tr_seri, &
	80	! Dynamic tendencies (diagnostics)
	81	d_t_dyn,d_q_dyn,d_ql_dyn,d_qs_dyn,d_u_dyn,d_v_dyn,d_tr_dyn, &
	82	d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d, &
	83	! Physic tendencies
	84	d_t_con,d_q_con,d_u_con,d_v_con, &
	85	d_tr, & !! to be removed?? (jyg)
	86	d_t_wake,d_q_wake, &
	87	d_t_lwr,d_t_lw0,d_t_swr,d_t_sw0, &
	88	d_t_ajsb,d_q_ajsb, &
	89	d_t_ajs,d_q_ajs,d_u_ajs,d_v_ajs, &
	90	d_t_ajs_w,d_q_ajs_w, &
	91	d_t_ajs_x,d_q_ajs_x, &
	92	!
	93	d_t_eva,d_q_eva, &
	94	d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc, &
	95	d_t_lscst,d_q_lscst, &
	96	d_t_lscth,d_q_lscth, &
	97	plul_st,plul_th, &
	98	!
	99	d_t_vdf,d_q_vdf,d_u_vdf,d_v_vdf,d_t_diss, &
	100	d_t_vdf_w,d_q_vdf_w, &
	101	d_t_vdf_x,d_q_vdf_x, &
	102	d_ts, &
	103	!
	104	d_t_oli,d_u_oli,d_v_oli, &
	105	d_t_oro,d_u_oro,d_v_oro, &
	106	d_t_lif,d_u_lif,d_v_lif, &
	107	d_t_ec, &
	108	!
	109	du_gwd_hines,dv_gwd_hines,d_t_hin, &
	110	dv_gwd_rando,dv_gwd_front, &
	111	east_gwstress,west_gwstress, &
	112	d_q_ch4, &
	113	! Special RRTM
	114	ZLWFT0_i,ZSWFT0_i,ZFLDN0, &
	115	ZFLUP0,ZFSDN0,ZFSUP0, &
	116	!
	117	topswad_aero,solswad_aero, &
	118	topswai_aero,solswai_aero, &
	119	topswad0_aero,solswad0_aero, &
	120	!LW additional
	121	toplwad_aero,sollwad_aero, &
	122	toplwai_aero,sollwai_aero, &
	123	toplwad0_aero,sollwad0_aero, &
	124	!
	125	topsw_aero,solsw_aero, &
	126	topsw0_aero,solsw0_aero, &
	127	topswcf_aero,solswcf_aero, &
	128	tausum_aero,tau3d_aero, &
	129	!
	130	!variables CFMIP2/CMIP5
	131	topswad_aerop, solswad_aerop, &
	132	topswai_aerop, solswai_aerop, &
	133	topswad0_aerop, solswad0_aerop, &
	134	topsw_aerop, topsw0_aerop, &
	135	solsw_aerop, solsw0_aerop, &
	136	topswcf_aerop, solswcf_aerop, &
	137	!LW diagnostics
	138	toplwad_aerop, sollwad_aerop, &
	139	toplwai_aerop, sollwai_aerop, &
	140	toplwad0_aerop, sollwad0_aerop, &
	141	!
	142	ptstar, pt0, slp, &
	143	!
	144	bils, &
	145	!
	146	cldh, cldl,cldm, cldq, cldt, &
	147	JrNt, &
	148	dthmin, evap, fder, plcl, plfc, &
	149	prw, prlw, prsw, &
	150	s_lcl, s_pblh, s_pblt, s_therm, &
	151	cdragm, cdragh, &
	152	zustar, zu10m, zv10m, rh2m, qsat2m, &
	153	zq2m, zt2m, weak_inversion, &
	154	zt2m_min_mon, zt2m_max_mon, & ! pour calcul_divers.h
	155	t2m_min_mon, t2m_max_mon, & ! pour calcul_divers.h
	156	!
	157	s_pblh_x, s_pblh_w, &
	158	s_lcl_x, s_lcl_w, &
	159	!
	160	slab_wfbils, tpot, tpote, &
	161	ue, uq, ve, vq, zxffonte, &
	162	zxfqcalving, zxfluxlat, &
	163	zxrunofflic, &
	164	zxtsol, snow_lsc, zxfqfonte, zxqsurf, &
	165	rain_lsc, rain_num, &
	166	!
	167	sens_x, sens_w, &
	168	zxfluxlat_x, zxfluxlat_w, &
	169	!
	170	dtvdf_x, dtvdf_w, &
	171	dqvdf_x, dqvdf_w, &
	172	undi_tke, wake_tke, &
	173	pbl_tke_input, &
	174	t_therm, q_therm, u_therm, v_therm, &
	175	cdragh_x, cdragh_w, &
	176	cdragm_x, cdragm_w, &
	177	kh, kh_x, kh_w, &
	178	!
	179	ale_wake, alp_wake, &
	180	wake_h, wbeff, zmax_th, &
	181	sens, flwp, fiwp, &
	182	ale_bl_stat,alp_bl_conv,alp_bl_det, &
	183	alp_bl_fluct_m,alp_bl_fluct_tke, &
	184	alp_bl_stat, n2, s2, &
	185	proba_notrig, random_notrig, &
	186	!
	187	dnwd, dnwd0, &
	188	upwd, omega, &
	189	epmax_diag, &
	190	ep, &
	191	cldemi, &
	192	cldfra, cldtau, fiwc, &
	193	fl, re, flwc, &
	194	ref_liq, ref_ice, theta, &
	195	ref_liq_pi, ref_ice_pi, &
	196	zphi, wake_omg, zx_rh, &
	197	pmfd, pmfu, &
	198	!
	199	t2m, fluxlat, &
	200	fsollw, evap_pot, &
	201	fsolsw, wfbils, wfbilo, &
	202
	203	pmflxr, pmflxs, prfl, &
	204	psfl, fraca, Vprecip, &
	205	zw2, &
	206
	207	fluxu, fluxv, &
	208	fluxt, &
	209
	210	uwriteSTD, vwriteSTD, & !pour calcul_STDlev.h
	211	wwriteSTD, phiwriteSTD, & !pour calcul_STDlev.h
	212	qwriteSTD, twriteSTD, rhwriteSTD, & !pour calcul_STDlev.h
	213
	214	wdtrainA, wdtrainM, &
	215	beta_prec, &
	216	rneb, &
	217	#ifdef ISO
	218	xt_seri,xtl_seri,xts_seri, &
	219	d_xt_dyn,d_xtl_dyn,d_xts_dyn, &
	220	d_xt_con, d_xt_wake, &
	221	d_xt_ajsb, d_xt_ajs, &
	222	d_xt_ajs_w, d_xt_ajs_x, &
	223	d_xt_vdf, d_xt_vdf_w, d_xt_vdf_x, &
	224	d_xt_eva, d_xt_lsc, d_xtl_lsc, d_xti_lsc, &
	225	d_xt_ch4,d_xt_prod_nucl,d_xt_cosmo,d_xt_decroiss, &
	226	zxfxtcalving, xtevap,xtprw, &
	227	xt_therm, dxtvdf_w, dxtvdf_x, &
	228	zxfxtcalving, zxfxtfonte, &
	229	zxxtrunofflic, & ! pas besoin du runoff, c'est seulement quand on couple à sisvat
	230	h1_diag,runoff_diag,xtrunoff_diag,zxxtsnow,xtVprecip,xtVprecipi, &
	231	xtrain_lsc,xtsnow_lsc,pxtrfl,pxtsfl, &
	232	#endif
	233	zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic
	234	!
	235	USE phys_state_var_mod ! Variables sauvegardees de la physique
	236	USE phys_output_var_mod ! Variables pour les ecritures des sorties
	237	USE phys_output_write_mod
	238	USE fonte_neige_mod, ONLY : fonte_neige_get_vars
	239	USE phys_output_mod
	240	USE phys_output_ctrlout_mod
	241	USE iophy
	242	use open_climoz_m, only: open_climoz ! ozone climatology from a file
	243	use regr_pr_av_m, only: regr_pr_av
	244	use netcdf95, only: nf95_close
	245	!IM for NMC files
	246	! use netcdf, only: nf90_fill_real
	247	use netcdf
	248	use mod_phys_lmdz_mpi_data, only: is_mpi_root
	249	USE aero_mod
	250	use ozonecm_m, only: ozonecm ! ozone of J.-F. Royer
	251	use conf_phys_m, only: conf_phys
	252	use radlwsw_m, only: radlwsw
	253	use phyaqua_mod, only: zenang_an
	254	USE time_phylmdz_mod, only: day_step_phy, annee_ref, day_ref, itau_phy, &
	255	start_time, pdtphys, day_ini
	256	USE tracinca_mod, ONLY: config_inca
	257	#ifdef CPP_XIOS
	258	USE wxios, ONLY: missing_val, missing_val_omp
	259	USE xios, ONLY: xios_get_field_attr
	260	#endif
	261	#ifdef REPROBUS
	262	USE CHEM_REP, ONLY : Init_chem_rep_xjour
	263	#endif
	264	USE indice_sol_mod
	265	USE phytrac_mod, ONLY : phytrac
	266
	267	#ifdef CPP_RRTM
	268	USE YOERAD, ONLY : NRADLP
	269	USE YOESW, ONLY : RSUN
	270	#endif
	271	USE ioipsl_getin_p_mod, ONLY : getin_p
	272
	273	USE paramLMDZ_phy_mod
	274
	275	USE cmp_seri_mod
	276
	277	!IM stations CFMIP
	278	USE CFMIP_point_locations
	279	use FLOTT_GWD_rando_m, only: FLOTT_GWD_rando
	280	use ACAMA_GWD_rando_m, only: ACAMA_GWD_rando
	281
	282	IMPLICIT none
	283	!>======================================================================
	284	!!
	285	!! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
	286	!!
	287	!! Objet: Moniteur general de la physique du modele
	288	!!AA Modifications quant aux traceurs :
	289	!!AA - uniformisation des parametrisations ds phytrac
	290	!!AA - stockage des moyennes des champs necessaires
	291	!!AA en mode traceur off-line
	292	!!======================================================================
	293	!! CLEFS CPP POUR LES IO
	294	!! =====================
	295	#define histNMC
	296	!!======================================================================
	297	!! modif ( P. Le Van , 12/10/98 )
	298	!!
	299	!! Arguments:
	300	!!
	301	!! nlon----input-I-nombre de points horizontaux
	302	!! nlev----input-I-nombre de couches verticales, doit etre egale a klev
	303	!! debut---input-L-variable logique indiquant le premier passage
	304	!! lafin---input-L-variable logique indiquant le dernier passage
	305	!! jD_cur -R-jour courant a l'appel de la physique (jour julien)
	306	!! jH_cur -R-heure courante a l'appel de la physique (jour julien)
	307	!! pdtphys-input-R-pas d'integration pour la physique (seconde)
	308	!! paprs---input-R-pression pour chaque inter-couche (en Pa)
	309	!! pplay---input-R-pression pour le mileu de chaque couche (en Pa)
	310	!! pphi----input-R-geopotentiel de chaque couche (g z) (reference sol)
	311	!! pphis---input-R-geopotentiel du sol
	312	!! presnivs-input_R_pressions approximat. des milieux couches ( en PA)
	313	!! u-------input-R-vitesse dans la direction X (de O a E) en m/s
	314	!! v-------input-R-vitesse Y (de S a N) en m/s
	315	!! t-------input-R-temperature (K)
	316	!! qx------input-R-humidite specifique (kg/kg) et d'autres traceurs
	317	!! d_t_dyn-input-R-tendance dynamique pour "t" (K/s)
	318	!! d_q_dyn-input-R-tendance dynamique pour "q" (kg/kg/s)
	319	!! d_ql_dyn-input-R-tendance dynamique pour "ql" (kg/kg/s)
	320	!! d_qs_dyn-input-R-tendance dynamique pour "qs" (kg/kg/s)
	321	!! flxmass_w -input-R- flux de masse verticale
	322	!! d_u-----output-R-tendance physique de "u" (m/s/s)
	323	!! d_v-----output-R-tendance physique de "v" (m/s/s)
	324	!! d_t-----output-R-tendance physique de "t" (K/s)
	325	!! d_qx----output-R-tendance physique de "qx" (kg/kg/s)
	326	!! d_ps----output-R-tendance physique de la pression au sol
	327	!!======================================================================
	328	integer jjmp1
	329	! parameter (jjmp1=jjm+1-1/jjm) ! => (jjmp1=nbp_lat-1/(nbp_lat-1))
	330	! integer iip1
	331	! parameter (iip1=iim+1)
	332
	333	include "regdim.h"
	334	include "dimsoil.h"
	335	include "clesphys.h"
	336	include "thermcell.h"
	337	!======================================================================
	338	LOGICAL ok_cvl ! pour activer le nouveau driver pour convection KE
	339	PARAMETER (ok_cvl=.TRUE.)
	340	LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
	341	PARAMETER (ok_gust=.FALSE.)
	342	integer iflag_radia ! active ou non le rayonnement (MPL)
	343	save iflag_radia
	344	!$OMP THREADPRIVATE(iflag_radia)
	345	!======================================================================
	346	LOGICAL check ! Verifier la conservation du modele en eau
	347	PARAMETER (check=.FALSE.)
	348	LOGICAL ok_stratus ! Ajouter artificiellement les stratus
	349	PARAMETER (ok_stratus=.FALSE.)
	350	!======================================================================
	351	REAL amn, amx
	352	INTEGER igout
	353	!======================================================================
	354	! Clef controlant l'activation du cycle diurne:
	355	! en attente du codage des cles par Fred
	356	INTEGER iflag_cycle_diurne
	357	PARAMETER (iflag_cycle_diurne=1)
	358	!======================================================================
	359	! Modele thermique du sol, a activer pour le cycle diurne:
	360	!cc LOGICAL soil_model
	361	!cc PARAMETER (soil_model=.FALSE.)
	362	!======================================================================
	363	! Dans les versions precedentes, l'eau liquide nuageuse utilisee dans
	364	! le calcul du rayonnement est celle apres la precipitation des nuages.
	365	! Si cette cle new_oliq est activee, ce sera une valeur moyenne entre
	366	! la condensation et la precipitation. Cette cle augmente les impacts
	367	! radiatifs des nuages.
	368	!cc LOGICAL new_oliq
	369	!cc PARAMETER (new_oliq=.FALSE.)
	370	!======================================================================
	371	! Clefs controlant deux parametrisations de l'orographie:
	372	!c LOGICAL ok_orodr
	373	!cc PARAMETER (ok_orodr=.FALSE.)
	374	!cc LOGICAL ok_orolf
	375	!cc PARAMETER (ok_orolf=.FALSE.)
	376	!======================================================================
	377	LOGICAL ok_journe ! sortir le fichier journalier
	378	save ok_journe
	379	!$OMP THREADPRIVATE(ok_journe)
	380	!
	381	LOGICAL ok_mensuel ! sortir le fichier mensuel
	382	save ok_mensuel
	383	!$OMP THREADPRIVATE(ok_mensuel)
	384	!
	385	LOGICAL ok_instan ! sortir le fichier instantane
	386	save ok_instan
	387	!$OMP THREADPRIVATE(ok_instan)
	388	!
	389	LOGICAL ok_LES ! sortir le fichier LES
	390	save ok_LES
	391	!$OMP THREADPRIVATE(ok_LES)
	392	!
	393	LOGICAL callstats ! sortir le fichier stats
	394	save callstats
	395	!$OMP THREADPRIVATE(callstats)
	396	!
	397	LOGICAL ok_region ! sortir le fichier regional
	398	PARAMETER (ok_region=.FALSE.)
	399	!======================================================================
	400	real seuil_inversion
	401	save seuil_inversion
	402	!$OMP THREADPRIVATE(seuil_inversion)
	403	integer iflag_ratqs
	404	save iflag_ratqs
	405	!$OMP THREADPRIVATE(iflag_ratqs)
	406	real facteur
	407
	408	REAL wmax_th(klon)
	409	REAL tau_overturning_th(klon)
	410
	411	integer lmax_th(klon)
	412	integer limbas(klon)
	413	real ratqscth(klon,klev)
	414	real ratqsdiff(klon,klev)
	415	real zqsatth(klon,klev)
	416
	417	!======================================================================
	418	!
	419	INTEGER ivap ! indice de traceurs pour vapeur d'eau
	420	PARAMETER (ivap=1)
	421	INTEGER iliq ! indice de traceurs pour eau liquide
	422	PARAMETER (iliq=2)
	423	!CR: on ajoute la phase glace
	424	INTEGER isol ! indice de traceurs pour eau glace
	425	PARAMETER (isol=3)
	426	!
	427	!
	428	! Variables argument:
	429	!
	430	INTEGER nlon
	431	INTEGER nlev
	432	REAL,INTENT(IN) :: pdtphys_
	433	! NB: pdtphys to be used in physics is in time_phylmdz_mod
	434	LOGICAL debut, lafin
	435	REAL paprs(klon,klev+1)
	436	REAL pplay(klon,klev)
	437	REAL pphi(klon,klev)
	438	REAL pphis(klon)
	439	REAL presnivs(klev)
	440	REAL znivsig(klev)
	441	real pir
	442
	443	REAL u(klon,klev)
	444	REAL v(klon,klev)
	445
	446	REAL, intent(in):: rot(klon, klev)
	447	! relative vorticity, in s-1, needed for frontal waves
	448
	449	REAL t(klon,klev),thetal(klon,klev)
	450	! thetal: ligne suivante a decommenter si vous avez les fichiers
	451	! MPL 20130625
	452	! fth_fonctions.F90 et parkind1.F90
	453	! sinon thetal=theta
	454	! REAL fth_thetae,fth_thetav,fth_thetal
	455	REAL qx(klon,klev,nqtot)
	456	REAL flxmass_w(klon,klev)
	457	REAL d_u(klon,klev)
	458	REAL d_v(klon,klev)
	459	REAL d_t(klon,klev)
	460	REAL d_qx(klon,klev,nqtot)
	461	REAL d_ps(klon)
	462	! Variables pour le transport convectif
	463	real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
	464	real wght_cvfd(klon,klev)
	465	#ifndef CPP_XIOS
	466	REAL, SAVE :: missing_val
	467	#endif
	468	! Variables pour le lessivage convectif
	469	! RomP >>>
	470	real phi2(klon,klev,klev)
	471	real d1a(klon,klev),dam(klon,klev)
	472	real ev(klon,klev)
	473	real clw(klon,klev),elij(klon,klev,klev)
	474	real epmlmMm(klon,klev,klev),eplaMm(klon,klev)
	475	! RomP <<<
	476	!IM definition dynamique o_trac dans phys_output_open
	477	! type(ctrl_out) :: o_trac(nqtot)
	478
	479	! variables a une pression donnee
	480	!
	481	include "declare_STDlev.h"
	482	!
	483	!
	484	include "radopt.h"
	485	!
	486	!
	487	INTEGER debug
	488	INTEGER n
	489	!ym INTEGER npoints
	490	!ym PARAMETER(npoints=klon)
	491	!
	492	INTEGER nregISCtot
	493	PARAMETER(nregISCtot=1)
	494	!
	495	! imin_debut, nbpti, jmin_debut, nbptj : parametres pour sorties
	496	! sur 1 region rectangulaire y compris pour 1 point
	497	! imin_debut : indice minimum de i; nbpti : nombre de points en
	498	! direction i (longitude)
	499	! jmin_debut : indice minimum de j; nbptj : nombre de points en
	500	! direction j (latitude)
	501	INTEGER imin_debut, nbpti
	502	INTEGER jmin_debut, nbptj
	503	!IM: region='3d' <==> sorties en global
	504	CHARACTER*3 region
	505	PARAMETER(region='3d')
	506	logical ok_hf
	507	!
	508	save ok_hf
	509	!$OMP THREADPRIVATE(ok_hf)
	510
	511	INTEGER,PARAMETER :: longcles=20
	512	REAL,SAVE :: clesphy0(longcles)
	513	!$OMP THREADPRIVATE(clesphy0)
	514	!
	515	! Variables propres a la physique
	516	INTEGER itap
	517	SAVE itap ! compteur pour la physique
	518	!$OMP THREADPRIVATE(itap)
	519
	520	INTEGER, SAVE :: abortphy=0 ! Reprere si on doit arreter en fin de phys
	521	!$OMP THREADPRIVATE(abortphy)
	522	!
	523	REAL,save :: solarlong0
	524	!$OMP THREADPRIVATE(solarlong0)
	525
	526	!
	527	! Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):
	528	!
	529	!IM 141004 REAL zulow(klon),zvlow(klon),zustr(klon), zvstr(klon)
	530	REAL zulow(klon),zvlow(klon)
	531	!
	532	INTEGER igwd,idx(klon),itest(klon)
	533	!
	534	! REAL,allocatable,save :: run_off_lic_0(:)
	535	! !$OMP THREADPRIVATE(run_off_lic_0)
	536	!ym SAVE run_off_lic_0
	537	!KE43
	538	! Variables liees a la convection de K. Emanuel (sb):
	539	!
	540	REAL bas, top ! cloud base and top levels
	541	SAVE bas
	542	SAVE top
	543	!$OMP THREADPRIVATE(bas, top)
	544	!------------------------------------------------------------------
	545	! Upmost level reached by deep convection and related variable (jyg)
	546	!
	547	INTEGER izero
	548	INTEGER k_upper_cv
	549	!------------------------------------------------------------------
	550	!
	551	!==========================================================================
	552	!CR04.12.07: on ajoute les nouvelles variables du nouveau schema
	553	!de convection avec poches froides
	554	! Variables li\'ees \`a la poche froide (jyg)
	555
	556	REAL mip(klon,klev) ! mass flux shed by the adiab ascent at each level
	557	!
	558	REAL wape_prescr, fip_prescr
	559	INTEGER it_wape_prescr
	560	SAVE wape_prescr, fip_prescr, it_wape_prescr
	561	!$OMP THREADPRIVATE(wape_prescr, fip_prescr, it_wape_prescr)
	562	!
	563	! variables supplementaires de concvl
	564	REAL Tconv(klon,klev)
	565	REAL sij(klon,klev,klev)
	566
	567	real, save :: alp_bl_prescr=0.
	568	real, save :: ale_bl_prescr=0.
	569
	570	real, save :: wake_s_min_lsp=0.1
	571
	572	!$OMP THREADPRIVATE(alp_bl_prescr,ale_bl_prescr)
	573	!$OMP THREADPRIVATE(wake_s_min_lsp)
	574
	575
	576	real ok_wk_lsp(klon)
	577
	578	!RC
	579	! Variables li\'ees \`a la poche froide (jyg et rr)
	580	! Version diagnostique pour l'instant : pas de r\'etroaction sur
	581	! la convection
	582
	583	REAL t_wake(klon,klev),q_wake(klon,klev) ! wake pour la convection
	584
	585	REAL wake_dth(klon,klev) ! wake : temp pot difference
	586
	587	REAL wake_d_deltat_gw(klon,klev)! wake : delta T tendency due to
	588	! Gravity Wave (/s)
	589	REAL wake_omgbdth(klon,klev) ! Wake : flux of Delta_Theta
	590	! transported by LS omega
	591	REAL wake_dp_omgb(klon,klev) ! Wake : vertical gradient of
	592	! large scale omega
	593	REAL wake_dtKE(klon,klev) ! Wake : differential heating
	594	! (wake - unpertubed) CONV
	595	REAL wake_dqKE(klon,klev) ! Wake : differential moistening
	596	! (wake - unpertubed) CONV
	597	REAL wake_dtPBL(klon,klev) ! Wake : differential heating
	598	! (wake - unpertubed) PBL
	599	REAL wake_dqPBL(klon,klev) ! Wake : differential moistening
	600	! (wake - unpertubed) PBL
	601	REAL wake_ddeltat(klon,klev),wake_ddeltaq(klon,klev)
	602	REAL wake_dp_deltomg(klon,klev) ! Wake : gradient vertical de wake_omg
	603	REAL wake_spread(klon,klev) ! spreading term in wake_delt
	604	!
	605	!pourquoi y'a pas de save??
	606	!
	607	INTEGER wake_k(klon) ! Wake sommet
	608	!
	609	REAL t_undi(klon,klev) ! temperature moyenne dans la zone
	610	! non perturbee
	611	REAL q_undi(klon,klev) ! humidite moyenne dans la zone
	612	! non perturbee
	613	#ifdef ISO
	614	REAL xt_wake(ntraciso,klon,klev)
	615	REAL wake_dxtKE(ntraciso,klon,klev)
	616	REAL wake_dxtPBL(ntraciso,klon,klev)
	617	REAL xt_undi(ntraciso,klon,klev)
	618	REAL dxt_dwn(ntraciso,klon,klev)
	619	REAL wdxt_PBL(ntraciso,klon,klev)
	620	REAL udxt_PBL(ntraciso,klon,klev)
	621	REAL dxt_a(ntraciso,klon,klev)
	622	REAL d_xt_adjwk(ntraciso,klon,klev)
	623	#endif
	624	!
	625	!jyg<
	626	!cc REAL wake_pe(klon) ! Wake potential energy - WAPE
	627	!>jyg
	628
	629	REAL wake_gfl(klon) ! Gust Front Length
	630	REAL wake_dens(klon)
	631	!
	632	!
	633	REAL dt_dwn(klon,klev)
	634	REAL dq_dwn(klon,klev)
	635	REAL wdt_PBL(klon,klev)
	636	REAL udt_PBL(klon,klev)
	637	REAL wdq_PBL(klon,klev)
	638	REAL udq_PBL(klon,klev)
	639	REAL M_dwn(klon,klev)
	640	REAL M_up(klon,klev)
	641	REAL dt_a(klon,klev)
	642	REAL dq_a(klon,klev)
	643	REAL d_t_adjwk(klon,klev) !jyg
	644	REAL d_q_adjwk(klon,klev) !jyg
	645	LOGICAL,SAVE :: ok_adjwk=.FALSE.
	646	!$OMP THREADPRIVATE(ok_adjwk)
	647	REAL,SAVE :: oliqmax=999.
	648	!$OMP THREADPRIVATE(oliqmax)
	649	REAL, SAVE :: alp_offset
	650	!$OMP THREADPRIVATE(alp_offset)
	651
	652	! !!
	653	!=================================================================
	654	! PROVISOIRE : DECOUPLAGE PBL/WAKE
	655	! --------------------------------
	656	REAL wake_deltat_sav(klon,klev)
	657	REAL wake_deltaq_sav(klon,klev)
	658	!=================================================================
	659
	660	!
	661	!RR:fin declarations poches froides
	662	!==========================================================================
	663
	664	REAL ztv(klon,klev),ztva(klon,klev)
	665	REAL zpspsk(klon,klev)
	666	REAL ztla(klon,klev),zqla(klon,klev)
	667	REAL zthl(klon,klev)
	668
	669	!cc nrlmd le 10/04/2012
	670
	671	!--------Stochastic Boundary Layer Triggering: ALE_BL--------
	672	!---Propri\'et\'es du thermiques au LCL
	673	real zlcl_th(klon) ! Altitude du LCL calcul\'e
	674	! continument (pcon dans
	675	! thermcell_main.F90)
	676	real fraca0(klon) ! Fraction des thermiques au LCL
	677	real w0(klon) ! Vitesse des thermiques au LCL
	678	real w_conv(klon) ! Vitesse verticale de grande \'echelle au LCL
	679	real tke0(klon,klev+1) ! TKE au d\'ebut du pas de temps
	680	real therm_tke_max0(klon) ! TKE dans les thermiques au LCL
	681	real env_tke_max0(klon) ! TKE dans l'environnement au LCL
	682
	683	!---D\'eclenchement stochastique
	684	integer :: tau_trig(klon)
	685
	686	REAL,SAVE :: random_notrig_max=1.
	687	!$OMP THREADPRIVATE(random_notrig_max)
	688
	689	!--------Statistical Boundary Layer Closure: ALP_BL--------
	690	!---Profils de TKE dans et hors du thermique
	691	real therm_tke_max(klon,klev) ! Profil de TKE dans les thermiques
	692	real env_tke_max(klon,klev) ! Profil de TKE dans l'environnement
	693
	694
	695	!cc fin nrlmd le 10/04/2012
	696
	697	! Variables locales pour la couche limite (al1):
	698	!
	699	!Al1 REAL pblh(klon) ! Hauteur de couche limite
	700	!Al1 SAVE pblh
	701	!34EK
	702	!
	703	! Variables locales:
	704	!
	705	!AA
	706	!AA Pour phytrac
	707	REAL u1(klon) ! vents dans la premiere couche U
	708	REAL v1(klon) ! vents dans la premiere couche V
	709
	710	!@$$ LOGICAL offline ! Controle du stockage ds "physique"
	711	!@$$ PARAMETER (offline=.false.)
	712	!@$$ INTEGER physid
	713	REAL frac_impa(klon,klev) ! fractions d'aerosols lessivees (impaction)
	714	REAL frac_nucl(klon,klev) ! idem (nucleation)
	715	! RomP >>>
	716	REAL beta_prec_fisrt(klon,klev) ! taux de conv de l'eau cond (fisrt)
	717	! RomP <<<
	718
	719	REAL :: calday
	720
	721	!IM cf FH pour Tiedtke 080604
	722	REAL rain_tiedtke(klon),snow_tiedtke(klon)
	723	!
	724	!IM 050204 END
	725	REAL devap(klon) ! evaporation et sa derivee
	726	REAL dsens(klon) ! chaleur sensible et sa derivee
	727	#ifdef ISO
	728	REAL dxtevap(ntraciso,klon)
	729	#endif
	730	!
	731	! Conditions aux limites
	732	!
	733	!
	734	REAL :: day_since_equinox
	735	! Date de l'equinoxe de printemps
	736	INTEGER, parameter :: mth_eq=3, day_eq=21
	737	REAL :: jD_eq
	738
	739	LOGICAL, parameter :: new_orbit = .true.
	740
	741	!
	742	INTEGER lmt_pas
	743	SAVE lmt_pas ! frequence de mise a jour
	744	!$OMP THREADPRIVATE(lmt_pas)
	745	real zmasse(klon, nbp_lev),exner(klon, nbp_lev)
	746	! (column-density of mass of air in a cell, in kg m-2)
	747	real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2
	748
	749	!IM sorties
	750	REAL un_jour
	751	PARAMETER(un_jour=86400.)
	752	INTEGER itapm1 !pas de temps de la physique du(es) mois precedents
	753	SAVE itapm1 !mis a jour le dernier pas de temps du mois en cours
	754	!$OMP THREADPRIVATE(itapm1)
	755	!======================================================================
	756	!
	757	! Declaration des procedures appelees
	758	!
	759	EXTERNAL angle ! calculer angle zenithal du soleil
	760	EXTERNAL alboc ! calculer l'albedo sur ocean
	761	EXTERNAL ajsec ! ajustement sec
	762	EXTERNAL conlmd ! convection (schema LMD)
	763	!KE43
	764	EXTERNAL conema3 ! convect4.3
	765	EXTERNAL fisrtilp ! schema de condensation a grande echelle (pluie)
	766	!AA
	767	! JBM (3/14) fisrtilp_tr not loaded
	768	! EXTERNAL fisrtilp_tr ! schema de condensation a grande echelle (pluie)
	769	! ! stockage des coefficients necessaires au
	770	! ! lessivage OFF-LINE et ON-LINE
	771	EXTERNAL hgardfou ! verifier les temperatures
	772	EXTERNAL nuage ! calculer les proprietes radiatives
	773	!C EXTERNAL o3cm ! initialiser l'ozone
	774	EXTERNAL orbite ! calculer l'orbite terrestre
	775	EXTERNAL phyetat0 ! lire l'etat initial de la physique
	776	EXTERNAL phyredem ! ecrire l'etat de redemarrage de la physique
	777	EXTERNAL suphel ! initialiser certaines constantes
	778	EXTERNAL transp ! transport total de l'eau et de l'energie
	779	!IM
	780	EXTERNAL haut2bas !variables de haut en bas
	781	EXTERNAL ini_undefSTD !initialise a 0 une variable a 1 niveau de pression
	782	EXTERNAL undefSTD !somme les valeurs definies d'1 var a 1 niveau de pression
	783	! EXTERNAL moy_undefSTD !moyenne d'1 var a 1 niveau de pression
	784	! EXTERNAL moyglo_aire
	785	! moyenne globale d'1 var ponderee par l'aire de la maille (moyglo_pondaire)
	786	! par la masse/airetot (moyglo_pondaima) et la vraie masse (moyglo_pondmass)
	787	!
	788	!
	789	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	790	! Local variables
	791	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	792	!
	793	REAL rhcl(klon,klev) ! humiditi relative ciel clair
	794	REAL dialiq(klon,klev) ! eau liquide nuageuse
	795	REAL diafra(klon,klev) ! fraction nuageuse
	796	REAL cldliq(klon,klev) ! eau liquide nuageuse
	797	!
	798	!XXX PB
	799	REAL fluxq(klon,klev, nbsrf) ! flux turbulent d'humidite
	800	!
	801	REAL zxfluxt(klon, klev)
	802	REAL zxfluxq(klon, klev)
	803	REAL zxfluxu(klon, klev)
	804	REAL zxfluxv(klon, klev)
	805	#ifdef ISO
	806	real fluxxt(ntraciso,klon,klev, nbsrf)
	807	REAL zxfluxxt(ntraciso,klon, klev)
	808	#endif
	809
	810	! Le rayonnement n'est pas calcule tous les pas, il faut donc
	811	! sauvegarder les sorties du rayonnement
	812	!ym SAVE heat,cool,albpla,topsw,toplw,solsw,sollw,sollwdown
	813	!ym SAVE sollwdownclr, toplwdown, toplwdownclr
	814	!ym SAVE topsw0,toplw0,solsw0,sollw0, heat0, cool0
	815	!
	816	INTEGER itaprad
	817	SAVE itaprad
	818	!$OMP THREADPRIVATE(itaprad)
	819	!
	820	REAL conv_q(klon,klev) ! convergence de l'humidite (kg/kg/s)
	821	REAL conv_t(klon,klev) ! convergence de la temperature(K/s)
	822
	823	!
	824	! REAL zxsnow(klon)
	825	REAL zxsnow_dummy(klon)
	826	REAL zsav_tsol(klon)
	827	!
	828	REAL dist, rmu0(klon), fract(klon)
	829	REAL zrmu0(klon), zfract(klon)
	830	REAL zdtime, zdtime1, zdtime2, zlongi
	831	!
	832	REAL qcheck
	833	REAL z_avant(klon), z_apres(klon), z_factor(klon)
	834	LOGICAL zx_ajustq
	835	!
	836	REAL za, zb
	837	REAL zx_t, zx_qs, zdelta, zcor, zlvdcp, zlsdcp
	838	real zqsat(klon,klev)
	839	!
	840	INTEGER i, k, iq, ig, j, nsrf, ll, l, iiq,itr
	841	#ifdef ISO
	842	REAL zxta(ntraciso),zbxt,zxt_apres(ntraciso,klon)
	843	REAL xt_iso(klon,klev),xtl_iso(klon,klev)
	844	REAL zxt_factor(ntraciso,klon),zxt_avant(ntraciso,klon)
	845	INTEGER ixt
	846	real seuil_q_undi
	847	parameter (seuil_q_undi=0.0)
	848	real wake_deltaq_prec(klon,klev)
	849	#endif
	850	!
	851	REAL t_coup
	852	PARAMETER (t_coup=234.0)
	853
	854	!ym A voir plus tard !!
	855	!ym REAL zx_relief(iim,jjmp1)
	856	!ym REAL zx_aire(iim,jjmp1)
	857	!
	858	! Grandeurs de sorties
	859	REAL s_capCL(klon)
	860	REAL s_oliqCL(klon), s_cteiCL(klon)
	861	REAL s_trmb1(klon), s_trmb2(klon)
	862	REAL s_trmb3(klon)
	863	!KE43
	864	! Variables locales pour la convection de K. Emanuel (sb):
	865
	866	REAL tvp(klon,klev) ! virtual temp of lifted parcel
	867	CHARACTER*40 capemaxcels !max(CAPE)
	868
	869	REAL rflag(klon) ! flag fonctionnement de convect
	870	INTEGER iflagctrl(klon) ! flag fonctionnement de convect
	871
	872	! -- convect43:
	873	INTEGER ntra ! nb traceurs pour convect4.3
	874	REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev)
	875	REAL dplcldt(klon), dplcldr(klon)
	876	!? . condm_con(klon,klev),conda_con(klon,klev),
	877	!? . mr_con(klon,klev),ep_con(klon,klev)
	878	!? . ,sadiab(klon,klev),wadiab(klon,klev)
	879	! --
	880	!34EK
	881	!
	882	! Variables du changement
	883	!
	884	! con: convection
	885	! lsc: condensation a grande echelle (Large-Scale-Condensation)
	886	! ajs: ajustement sec
	887	! eva: evaporation de l'eau liquide nuageuse
	888	! vdf: couche limite (Vertical DiFfusion)
	889	!
	890	! tendance nulles
	891	REAL, dimension(klon,klev):: du0, dv0, dt0, dq0, dql0, dqi0
	892	#ifdef ISO
	893	REAL, dimension(ntraciso,klon,klev):: dxt0, dxtl0, dxti0
	894	#endif
	895	!
	896	! Flag pour pouvoir ne pas ajouter les tendances.
	897	! Par defaut, les tendances doivente etre ajoutees et
	898	! flag_inhib_tend = 0
	899	! flag_inhib_tend > 0 : tendances non ajoutees, avec un nombre
	900	! croissant de print quand la valeur du flag augmente
	901	!!! attention, ce flag doit etre change avec prudence !!!
	902	INTEGER :: flag_inhib_tend = 0 ! 0 is the default value
	903	!! INTEGER :: flag_inhib_tend = 2
	904
	905	!
	906	!********************************************************
	907	! declarations
	908
	909	!********************************************************
	910	!IM 081204 END
	911	!
	912	REAL pen_u(klon,klev), pen_d(klon,klev)
	913	REAL pde_u(klon,klev), pde_d(klon,klev)
	914	INTEGER kcbot(klon), kctop(klon), kdtop(klon)
	915	!
	916	REAL ratqsc(klon,klev)
	917	real ratqsbas,ratqshaut,tau_ratqs
	918	save ratqsbas,ratqshaut,tau_ratqs
	919	!$OMP THREADPRIVATE(ratqsbas,ratqshaut,tau_ratqs)
	920	REAL, SAVE :: ratqsp0=50000., ratqsdp=20000.
	921	!$OMP THREADPRIVATE(ratqsp0, ratqsdp)
	922
	923	! Parametres lies au nouveau schema de nuages (SB, PDF)
	924	real fact_cldcon
	925	real facttemps
	926	logical ok_newmicro
	927	save ok_newmicro
	928	!$OMP THREADPRIVATE(ok_newmicro)
	929	!real ref_liq_pi(klon,klev), ref_ice_pi(klon,klev)
	930	save fact_cldcon,facttemps
	931	!$OMP THREADPRIVATE(fact_cldcon,facttemps)
	932
	933	integer iflag_cld_th
	934	save iflag_cld_th
	935	!$OMP THREADPRIVATE(iflag_cld_th)
	936	logical ptconv(klon,klev)
	937	!IM cf. AM 081204 BEG
	938	logical ptconvth(klon,klev)
	939	!IM cf. AM 081204 END
	940	!
	941	! Variables liees a l'ecriture de la bande histoire physique
	942	!
	943	!======================================================================
	944	!
	945
	946	!
	947	integer itau_w ! pas de temps ecriture = itap + itau_phy
	948	!
	949	!
	950	! Variables locales pour effectuer les appels en serie
	951	!
	952	!IM RH a 2m (la surface)
	953	REAL Lheat
	954
	955	INTEGER length
	956	PARAMETER ( length = 100 )
	957	REAL tabcntr0( length )
	958	!
	959	INTEGER ndex2d(nbp_lon*nbp_lat)
	960	!IM
	961	!
	962	!IM AMIP2 BEG
	963	REAL moyglo, mountor
	964	!IM 141004 BEG
	965	REAL zustrdr(klon), zvstrdr(klon)
	966	REAL zustrli(klon), zvstrli(klon)
	967	REAL zustrph(klon), zvstrph(klon)
	968	REAL aam, torsfc
	969	!IM 141004 END
	970	!IM 190504 BEG
	971	INTEGER ij
	972	! INTEGER imp1jmp1
	973	! PARAMETER(imp1jmp1=(iim+1)*jjmp1)
	974	!ym A voir plus tard
	975	! REAL zx_tmp((nbp_lon+1)*nbp_lat)
	976	! REAL airedyn(nbp_lon+1,nbp_lat)
	977	!IM 190504 END
	978	LOGICAL ok_msk
	979	REAL msk(klon)
	980	!IM
	981	REAL airetot, pi
	982	!ym A voir plus tard
	983	!ym REAL zm_wo(jjmp1, klev)
	984	!IM AMIP2 END
	985	!
	986	REAL zx_tmp_fi2d(klon) ! variable temporaire grille physique
	987	REAL zx_tmp_fi3d(klon,klev) ! variable temporaire pour champs 3D
	988	REAL zx_tmp_2d(nbp_lon,nbp_lat)
	989	REAL zx_lon(nbp_lon,nbp_lat)
	990	REAL zx_lat(nbp_lon,nbp_lat)
	991	!
	992	INTEGER nid_day_seri, nid_ctesGCM
	993	SAVE nid_day_seri, nid_ctesGCM
	994	!$OMP THREADPRIVATE(nid_day_seri,nid_ctesGCM)
	995	!
	996	!IM 280405 BEG
	997	! INTEGER nid_bilKPins, nid_bilKPave
	998	! SAVE nid_bilKPins, nid_bilKPave
	999	! !$OMP THREADPRIVATE(nid_bilKPins, nid_bilKPave)
	1000	!
	1001	REAL ve_lay(klon,klev) ! transport meri. de l'energie a chaque niveau vert.
	1002	REAL vq_lay(klon,klev) ! transport meri. de l'eau a chaque niveau vert.
	1003	REAL ue_lay(klon,klev) ! transport zonal de l'energie a chaque niveau vert.
	1004	REAL uq_lay(klon,klev) ! transport zonal de l'eau a chaque niveau vert.
	1005	!
	1006	REAL zjulian
	1007	SAVE zjulian
	1008	!$OMP THREADPRIVATE(zjulian)
	1009
	1010	INTEGER nhori, nvert
	1011	REAL zsto
	1012	REAL zstophy, zout
	1013
	1014	character*20 modname
	1015	character*80 abort_message
	1016	logical, save :: ok_sync, ok_sync_omp
	1017	!$OMP THREADPRIVATE(ok_sync)
	1018	real date0
	1019	integer idayref
	1020
	1021	! essai writephys
	1022	integer fid_day, fid_mth, fid_ins
	1023	parameter (fid_ins = 1, fid_day = 2, fid_mth = 3)
	1024	integer prof2d_on, prof3d_on, prof2d_av, prof3d_av
	1025	parameter (prof2d_on = 1, prof3d_on = 2, &
	1026	prof2d_av = 3, prof3d_av = 4)
	1027	! Variables liees au bilan d'energie et d'enthalpi
	1028	REAL ztsol(klon)
	1029	REAL d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec
	1030	REAL d_h_vcol_phy
	1031	REAL fs_bound, fq_bound
	1032	SAVE d_h_vcol_phy
	1033	!$OMP THREADPRIVATE(d_h_vcol_phy)
	1034	REAL zero_v(klon)
	1035	CHARACTER*40 ztit
	1036	INTEGER ip_ebil ! PRINT level for energy conserv. diag.
	1037	SAVE ip_ebil
	1038	DATA ip_ebil/0/
	1039	!$OMP THREADPRIVATE(ip_ebil)
	1040	INTEGER if_ebil ! level for energy conserv. dignostics
	1041	SAVE if_ebil
	1042	!$OMP THREADPRIVATE(if_ebil)
	1043	REAL q2m(klon,nbsrf) ! humidite a 2m
	1044	#ifdef ISO
	1045	REAL d_xtw(ntraciso),d_xtl(ntraciso), d_xts(ntraciso)
	1046	#endif
	1047
	1048	!IM: t2m, q2m, ustar, u10m, v10m et t2mincels, t2maxcels
	1049	CHARACTER*40 t2mincels, t2maxcels !t2m min., t2m max
	1050	CHARACTER*40 tinst, tave, typeval
	1051	REAL cldtaupi(klon,klev) ! Cloud optical thickness for
	1052	! pre-industrial (pi) aerosols
	1053
	1054
	1055	! Aerosol optical properties
	1056	CHARACTER*4, DIMENSION(naero_grp) :: rfname
	1057	REAL, DIMENSION(klon,klev) :: mass_solu_aero ! total mass
	1058	! concentration
	1059	! for all soluble
	1060	! aerosols[ug/m3]
	1061	REAL, DIMENSION(klon,klev) :: mass_solu_aero_pi
	1062	! - " - (pre-industrial value)
	1063
	1064	! Parameters
	1065	LOGICAL ok_ade, ok_aie ! Apply aerosol (in)direct effects or not
	1066	LOGICAL ok_cdnc ! ok cloud droplet number concentration (O. Boucher 01-2013)
	1067	REAL bl95_b0, bl95_b1 ! Parameter in Boucher and Lohmann (1995)
	1068	SAVE ok_ade, ok_aie, ok_cdnc, bl95_b0, bl95_b1
	1069	!$OMP THREADPRIVATE(ok_ade, ok_aie, ok_cdnc, bl95_b0, bl95_b1)
	1070	LOGICAL, SAVE :: aerosol_couple ! true : calcul des aerosols dans INCA
	1071	! false : lecture des aerosol dans un fichier
	1072	!$OMP THREADPRIVATE(aerosol_couple)
	1073	INTEGER, SAVE :: flag_aerosol
	1074	!$OMP THREADPRIVATE(flag_aerosol)
	1075	LOGICAL, SAVE :: new_aod
	1076	!$OMP THREADPRIVATE(new_aod)
	1077	!
	1078	!--STRAT AEROSOL
	1079	INTEGER, SAVE :: flag_aerosol_strat
	1080	!$OMP THREADPRIVATE(flag_aerosol_strat)
	1081	!c-fin STRAT AEROSOL
	1082	!
	1083	! Declaration des constantes et des fonctions thermodynamiques
	1084	!
	1085	LOGICAL,SAVE :: first=.true.
	1086	!$OMP THREADPRIVATE(first)
	1087
	1088	integer, save:: read_climoz ! read ozone climatology
	1089	! (let it keep the default OpenMP shared attribute)
	1090	! Allowed values are 0, 1 and 2
	1091	! 0: do not read an ozone climatology
	1092	! 1: read a single ozone climatology that will be used day and night
	1093	! 2: read two ozone climatologies, the average day and night
	1094	! climatology and the daylight climatology
	1095
	1096	integer, save:: ncid_climoz ! NetCDF file containing ozone climatologies
	1097	! (let it keep the default OpenMP shared attribute)
	1098
	1099	real, pointer, save:: press_climoz(:)
	1100	! (let it keep the default OpenMP shared attribute)
	1101	! edges of pressure intervals for ozone climatologies, in Pa, in strictly
	1102	! ascending order
	1103
	1104	integer, save:: co3i = 0
	1105	! time index in NetCDF file of current ozone fields
	1106	!$OMP THREADPRIVATE(co3i)
	1107
	1108	integer ro3i
	1109	! required time index in NetCDF file for the ozone fields, between 1
	1110	! and 360
	1111
	1112	INTEGER ierr
	1113	include "YOMCST.h"
	1114	include "YOETHF.h"
	1115	include "FCTTRE.h"
	1116	!IM 100106 BEG : pouvoir sortir les ctes de la physique
	1117	include "conema3.h"
	1118	include "fisrtilp.h"
	1119	include "nuage.h"
	1120	include "compbl.h"
	1121	!IM 100106 END : pouvoir sortir les ctes de la physique
	1122	!
	1123	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	1124	! Declarations pour Simulateur COSP
	1125	!============================================================
	1126	real :: mr_ozone(klon,klev)
	1127
	1128	!IM stations CFMIP
	1129	INTEGER, SAVE :: nCFMIP
	1130	!$OMP THREADPRIVATE(nCFMIP)
	1131	INTEGER, PARAMETER :: npCFMIP=120
	1132	INTEGER, ALLOCATABLE, SAVE :: tabCFMIP(:)
	1133	REAL, ALLOCATABLE, SAVE :: lonCFMIP(:), latCFMIP(:)
	1134	!$OMP THREADPRIVATE(tabCFMIP, lonCFMIP, latCFMIP)
	1135	INTEGER, ALLOCATABLE, SAVE :: tabijGCM(:)
	1136	REAL, ALLOCATABLE, SAVE :: lonGCM(:), latGCM(:)
	1137	!$OMP THREADPRIVATE(tabijGCM, lonGCM, latGCM)
	1138	INTEGER, ALLOCATABLE, SAVE :: iGCM(:), jGCM(:)
	1139	!$OMP THREADPRIVATE(iGCM, jGCM)
	1140	logical, dimension(nfiles) :: phys_out_filestations
	1141	logical, parameter :: lNMC=.FALSE.
	1142
	1143	!IM betaCRF
	1144	REAL, SAVE :: pfree, beta_pbl, beta_free
	1145	!$OMP THREADPRIVATE(pfree, beta_pbl, beta_free)
	1146	REAL, SAVE :: lon1_beta, lon2_beta, lat1_beta, lat2_beta
	1147	!$OMP THREADPRIVATE(lon1_beta, lon2_beta, lat1_beta, lat2_beta)
	1148	LOGICAL, SAVE :: mskocean_beta
	1149	!$OMP THREADPRIVATE(mskocean_beta)
	1150	REAL, dimension(klon, klev) :: beta ! facteur sur cldtaurad et
	1151	! cldemirad pour evaluer les
	1152	! retros liees aux CRF
	1153	REAL, dimension(klon, klev) :: cldtaurad ! epaisseur optique
	1154	! pour radlwsw pour
	1155	! tester "CRF off"
	1156	REAL, dimension(klon, klev) :: cldtaupirad ! epaisseur optique
	1157	! pour radlwsw pour
	1158	! tester "CRF off"
	1159	REAL, dimension(klon, klev) :: cldemirad ! emissivite pour
	1160	! radlwsw pour tester
	1161	! "CRF off"
	1162	REAL, dimension(klon, klev) :: cldfrarad ! fraction nuageuse
	1163
	1164	INTEGER :: nbtr_tmp ! Number of tracer inside concvl
	1165	REAL, dimension(klon,klev) :: sh_in ! Specific humidity entering in phytrac
	1166	integer iostat
	1167
	1168	REAL zzz
	1169	!albedo SB >>>
	1170	real,dimension(6),save :: SFRWL
	1171	!albedo SB <<<
	1172
	1173	!--OB variables for mass fixer (hard coded for now)
	1174	logical, parameter :: mass_fixer=.false.
	1175	real qql1(klon),qql2(klon),zdz,corrqql
	1176	#ifdef ISO
	1177	real xtql1(ntraciso,klon),xtql2(ntraciso,klon),corrxtql(ntraciso)
	1178	#endif
	1179
	1180	! Ehouarn: set value of jjmp1 since it is no longer a "fixed parameter"
	1181	jjmp1=nbp_lat
	1182
	1183	!======================================================================
	1184	! Gestion calendrier : mise a jour du module phys_cal_mod
	1185	!
	1186	pdtphys=pdtphys_
	1187	CALL update_time(pdtphys)
	1188
	1189	!======================================================================
	1190	! Ecriture eventuelle d'un profil verticale en entree de la physique.
	1191	! Utilise notamment en 1D mais peut etre active egalement en 3D
	1192	! en imposant la valeur de igout.
	1193	!======================================================================d
	1194	if (prt_level.ge.1) then
	1195	igout=klon/2+1/klon
	1196	write(lunout,*) 'DEBUT DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
	1197	write(lunout,*) 'igout, lat, lon ',igout, latitude_deg(igout), &
	1198	longitude_deg(igout)
	1199	write(lunout,*) &
	1200	'nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys'
	1201	write(lunout,*) &
	1202	nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys
	1203
	1204	write(lunout,*) 'paprs, play, phi, u, v, t'
	1205	do k=1,klev
	1206	write(lunout,*) paprs(igout,k),pplay(igout,k),pphi(igout,k), &
	1207	u(igout,k),v(igout,k),t(igout,k)
	1208	enddo
	1209	write(lunout,*) 'ovap (g/kg), oliq (g/kg)'
	1210	do k=1,klev
	1211	write(lunout,) qx(igout,k,1)1000,qx(igout,k,2)*1000.
	1212	enddo
	1213	endif
	1214
	1215	!======================================================================
	1216
	1217	if (first) then
	1218
	1219	!CR:nvelles variables convection/poches froides
	1220
	1221	print*, '================================================='
	1222	print*, 'Allocation des variables locales et sauvegardees'
	1223	call phys_local_var_init
	1224	!
	1225	pasphys=pdtphys
	1226	! appel a la lecture du run.def physique
	1227	call conf_phys(ok_journe, ok_mensuel, &
	1228	ok_instan, ok_hf, &
	1229	ok_LES, &
	1230	callstats, &
	1231	solarlong0,seuil_inversion, &
	1232	fact_cldcon, facttemps,ok_newmicro,iflag_radia, &
	1233	iflag_cld_th,iflag_ratqs,ratqsbas,ratqshaut,tau_ratqs, &
	1234	ok_ade, ok_aie, ok_cdnc, aerosol_couple, &
	1235	flag_aerosol, flag_aerosol_strat, new_aod, &
	1236	bl95_b0, bl95_b1, &
	1237	! nv flags pour la convection et les
	1238	! poches froides
	1239	read_climoz, &
	1240	alp_offset)
	1241	call phys_state_var_init(read_climoz)
	1242	call phys_output_var_init
	1243	print*, '================================================='
	1244	!
	1245	!CR: check sur le nb de traceurs de l eau
	1246	if ((iflag_ice_thermo.gt.0).and.(nqo==2)) then
	1247	WRITE (lunout, *) ' iflag_ice_thermo==1 requires 3 H2O tracers ', &
	1248	'(H2Ov, H2Ol, H2Oi) but nqo=', nqo, '. Might as well stop here.'
	1249	STOP
	1250	endif
	1251
	1252	dnwd0=0.0
	1253	ftd=0.0
	1254	fqd=0.0
	1255	cin=0.
	1256	!ym Attention pbase pas initialise dans concvl !!!!
	1257	pbase=0
	1258	!IM 180608
	1259
	1260	itau_con=0
	1261	first=.false.
	1262
	1263	endif ! first
	1264
	1265	!ym => necessaire pour iflag_con != 2
	1266	pmfd(:,:) = 0.
	1267	pen_u(:,:) = 0.
	1268	pen_d(:,:) = 0.
	1269	pde_d(:,:) = 0.
	1270	pde_u(:,:) = 0.
	1271	aam=0.
	1272	d_t_adjwk(:,:)=0
	1273	d_q_adjwk(:,:)=0
	1274	#ifdef ISO
	1275	d_xt_adjwk(:,:,:)=0
	1276	#endif
	1277	alp_bl_conv(:)=0.
	1278
	1279	torsfc=0.
	1280	forall (k=1: nbp_lev) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg
	1281
	1282	modname = 'physiq'
	1283	!IM
	1284	IF (ip_ebil_phy.ge.1) THEN
	1285	DO i=1,klon
	1286	zero_v(i)=0.
	1287	END DO
	1288	END IF
	1289
	1290	IF (debut) THEN
	1291	CALL suphel ! initialiser constantes et parametres phys.
	1292	CALL getin_p('random_notrig_max',random_notrig_max)
	1293	CALL getin_p('ok_adjwk',ok_adjwk)
	1294	CALL getin_p('oliqmax',oliqmax)
	1295	CALL getin_p('ratqsp0',ratqsp0)
	1296	CALL getin_p('ratqsdp',ratqsdp)
	1297	ENDIF
	1298
	1299	if(prt_level.ge.1) print*,'CONVERGENCE PHYSIQUE THERM 1 '
	1300
	1301
	1302	!======================================================================
	1303	! Gestion calendrier : mise a jour du module phys_cal_mod
	1304	!
	1305	! CALL phys_cal_update(jD_cur,jH_cur)
	1306
	1307	!
	1308	! Si c'est le debut, il faut initialiser plusieurs choses
	1309	! ********
	1310	!
	1311	IF (debut) THEN
	1312	!rv CRinitialisation de wght_th et lalim_conv pour la
	1313	!definition de la couche alimentation de la convection a partir
	1314	!des caracteristiques du thermique
	1315	wght_th(:,:)=1.
	1316	lalim_conv(:)=1
	1317	!RC
	1318	ustar(:,:)=0.
	1319	! u10m(:,:)=0.
	1320	! v10m(:,:)=0.
	1321	rain_con(:)=0.
	1322	snow_con(:)=0.
	1323	topswai(:)=0.
	1324	topswad(:)=0.
	1325	solswai(:)=0.
	1326	solswad(:)=0.
	1327
	1328	wmax_th(:)=0.
	1329	tau_overturning_th(:)=0.
	1330
	1331	IF (type_trac == 'inca') THEN
	1332	! jg : initialisation jusqu'au ces variables sont dans restart
	1333	ccm(:,:,:) = 0.
	1334	tau_aero(:,:,:,:) = 0.
	1335	piz_aero(:,:,:,:) = 0.
	1336	cg_aero(:,:,:,:) = 0.
	1337
	1338	config_inca='none' ! default
	1339	CALL getin_p('config_inca',config_inca)
	1340
	1341	ELSE
	1342	config_inca='none' ! default
	1343	END IF
	1344
	1345	IF (aerosol_couple .AND. (config_inca /= "aero" &
	1346	.AND. config_inca /= "aeNP ")) THEN
	1347	abort_message &
	1348	= 'if aerosol_couple is activated, config_inca need to be ' &
	1349	// 'aero or aeNP'
	1350	CALL abort_physic (modname,abort_message,1)
	1351	ENDIF
	1352
	1353
	1354
	1355	rnebcon0(:,:) = 0.0
	1356	clwcon0(:,:) = 0.0
	1357	rnebcon(:,:) = 0.0
	1358	clwcon(:,:) = 0.0
	1359
	1360	!IM
	1361	IF (ip_ebil_phy.ge.1) d_h_vcol_phy=0.
	1362	!
	1363	print*,'iflag_coupl,iflag_clos,iflag_wake', &
	1364	iflag_coupl,iflag_clos,iflag_wake
	1365	print*,'iflag_CYCLE_DIURNE', iflag_cycle_diurne
	1366	!
	1367	IF (iflag_con.EQ.2.AND.iflag_cld_th.GT.-1) THEN
	1368	abort_message = 'Tiedtke needs iflag_cld_th=-2 or -1'
	1369	CALL abort_physic (modname,abort_message,1)
	1370	ENDIF
	1371	!
	1372	!
	1373	! Initialiser les compteurs:
	1374	!
	1375	itap = 0
	1376	itaprad = 0
	1377
	1378	! C Risi: vérifier compatibilité des options isotopiques entre
	1379	! dyn3dmem et physiq
	1380	#ifdef ISO
	1381	write(,) 'physiq 1846: ok_isotopes,ntraciso,niso=',ok_isotopes,ntraciso,niso
	1382	if (.not.ok_isotopes) then
	1383	CALL abort_gcm('physiq 1756','options iso incompatibles',1)
	1384	endif
	1385	#ifdef ISOTRAC
	1386	if (.not.ok_isotrac) then
	1387	CALL abort_gcm('physiq 1758','options isotrac incompatibles',1)
	1388	endif
	1389	#else
	1390	! #ifdef ISOTRAC
	1391	if (ok_isotrac) then
	1392	CALL abort_gcm('physiq 1762','options isotrac incompatibles',1)
	1393	endif
	1394	#endif
	1395	!! #ifdef ISOTRAC
	1396	! -> on supprime opion ISOTRAC, tout passe par ok_isotrac
	1397	#else
	1398	! #ifdef ISO
	1399	if (ok_isotopes) then
	1400	CALL abort_gcm('physiq 1772','options iso incompatibles',1)
	1401	endif
	1402	#endif
	1403	! #ifdef ISO
	1404
	1405	#ifdef ISO
	1406	! initialisations isotopiques
	1407	#ifdef ISOVERIF
	1408	write(,) 'physiq 1366: call iso_init'
	1409	write(,) 'ok_isotopes=',ok_isotopes
	1410	#endif
	1411	if (ok_isotopes) then
	1412	call iso_init()
	1413	endif
	1414	#ifdef ISOTRAC
	1415	if (ok_isotrac) then
	1416	write(,) 'physiq 1416: call iso_traceurs_init'
	1417	call iso_traceurs_init()
	1418	endif
	1419	#endif
	1420	!write(,) 'gcm 265: ntraciso=',ntraciso
	1421	#ifdef ISOVERIF
	1422	write(,) 'physiq 1421: call iso_verif_init'
	1423	call iso_verif_init()
	1424	#endif
	1425	#endif
	1426
	1427	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	1428	!! Un petit travail \`a faire ici.
	1429	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	1430
	1431	if (iflag_pbl>1) then
	1432	PRINT*, "Using method MELLOR&YAMADA"
	1433	endif
	1434
	1435	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	1436	! FH 2008/05/02 changement lie a la lecture de nbapp_rad dans
	1437	! phylmd plutot que dyn3d
	1438	! Attention : la version precedente n'etait pas tres propre.
	1439	! Il se peut qu'il faille prendre une valeur differente de nbapp_rad
	1440	! pour obtenir le meme resultat.
	1441	dtime=pdtphys
	1442	IF (MOD(INT(86400./dtime),nbapp_rad).EQ.0) THEN
	1443	radpas = NINT( 86400./dtime/nbapp_rad)
	1444	ELSE
	1445	WRITE(lunout,*) 'le nombre de pas de temps physique doit etre un ', &
	1446	'multiple de nbapp_rad'
	1447	WRITE(lunout,*) 'changer nbapp_rad ou alors commenter ce test ', &
	1448	'mais 1+1<>2'
	1449	abort_message='nbre de pas de temps physique n est pas multiple ' &
	1450	// 'de nbapp_rad'
	1451	call abort_physic(modname,abort_message,1)
	1452	ENDIF
	1453	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	1454
	1455	CALL phyetat0 ("startphy.nc",clesphy0,tabcntr0)
	1456	!jyg<
	1457	IF (klon_glo==1) THEN
	1458	pbl_tke(:,:,is_ave) = 0.
	1459	DO nsrf=1,nbsrf
	1460	DO k = 1,klev+1
	1461	pbl_tke(:,k,is_ave) = pbl_tke(:,k,is_ave) &
	1462	+pctsrf(:,nsrf)*pbl_tke(:,k,nsrf)
	1463	ENDDO
	1464	ENDDO
	1465	!>jyg
	1466	ENDIF
	1467	!IM begin
	1468	print*,'physiq: clwcon rnebcon ratqs',clwcon(1,1),rnebcon(1,1) &
	1469	,ratqs(1,1)
	1470	!IM end
	1471
	1472	#ifdef ISO
	1473	#ifdef ISOTRAC
	1474	! on initialise les cartes des bassins pour les traceurs si besoin:
	1475	call initialise_bassins_boites(presnivs)
	1476	#endif
	1477	#endif
	1478
	1479	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	1480	!
	1481	! on remet le calendrier a zero
	1482	!
	1483	IF (raz_date .eq. 1) THEN
	1484	itau_phy = 0
	1485	ENDIF
	1486
	1487	CALL printflag( tabcntr0,radpas,ok_journe, &
	1488	ok_instan, ok_region )
	1489	!
	1490	IF (ABS(dtime-pdtphys).GT.0.001) THEN
	1491	WRITE(lunout,*) 'Pas physique n est pas correct',dtime, &
	1492	pdtphys
	1493	abort_message='Pas physique n est pas correct '
	1494	! call abort_physic(modname,abort_message,1)
	1495	dtime=pdtphys
	1496	ENDIF
	1497	IF (nlon .NE. klon) THEN
	1498	WRITE(lunout,*)'nlon et klon ne sont pas coherents', nlon, &
	1499	klon
	1500	abort_message='nlon et klon ne sont pas coherents'
	1501	call abort_physic(modname,abort_message,1)
	1502	ENDIF
	1503	IF (nlev .NE. klev) THEN
	1504	WRITE(lunout,*)'nlev et klev ne sont pas coherents', nlev, &
	1505	klev
	1506	abort_message='nlev et klev ne sont pas coherents'
	1507	call abort_physic(modname,abort_message,1)
	1508	ENDIF
	1509	!
	1510	IF (dtime*REAL(radpas).GT.21600..AND.iflag_cycle_diurne.GE.1) THEN
	1511	WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant'
	1512	WRITE(lunout,*)"Au minimum 4 appels par jour si cycle diurne"
	1513	abort_message='Nbre d appels au rayonnement insuffisant'
	1514	call abort_physic(modname,abort_message,1)
	1515	ENDIF
	1516	WRITE(lunout,*)"Clef pour la convection, iflag_con=", iflag_con
	1517	WRITE(lunout,*)"Clef pour le driver de la convection, ok_cvl=", &
	1518	ok_cvl
	1519	!
	1520	!KE43
	1521	! Initialisation pour la convection de K.E. (sb):
	1522	IF (iflag_con.GE.3) THEN
	1523
	1524	WRITE(lunout,)"** Convection de Kerry Emanuel 4.3 "
	1525	WRITE(lunout,*) &
	1526	"On va utiliser le melange convectif des traceurs qui"
	1527	WRITE(lunout,*)"est calcule dans convect4.3"
	1528	WRITE(lunout,*)" !!! penser aux logical flags de phytrac"
	1529
	1530	DO i = 1, klon
	1531	ema_cbmf(i) = 0.
	1532	ema_pcb(i) = 0.
	1533	ema_pct(i) = 0.
	1534	! ema_workcbmf(i) = 0.
	1535	ENDDO
	1536	!IM15/11/02 rajout initialisation ibas_con,itop_con cf. SB =>BEG
	1537	DO i = 1, klon
	1538	ibas_con(i) = 1
	1539	itop_con(i) = 1
	1540	ENDDO
	1541	!IM15/11/02 rajout initialisation ibas_con,itop_con cf. SB =>END
	1542	!================================================================
	1543	!CR:04.12.07: initialisations poches froides
	1544	! Controle de ALE et ALP pour la fermeture convective (jyg)
	1545	if (iflag_wake>=1) then
	1546	CALL ini_wake(0.,0.,it_wape_prescr,wape_prescr,fip_prescr &
	1547	,alp_bl_prescr, ale_bl_prescr)
	1548	! 11/09/06 rajout initialisation ALE et ALP du wake et PBL(YU)
	1549	! print*,'apres ini_wake iflag_cld_th=', iflag_cld_th
	1550	endif
	1551
	1552	! do i = 1,klon
	1553	! Ale_bl(i)=0.
	1554	! Alp_bl(i)=0.
	1555	! enddo
	1556
	1557	!===================================================================
	1558	!IM stations CFMIP
	1559	nCFMIP=npCFMIP
	1560	OPEN(98,file='npCFMIP_param.data',status='old', &
	1561	form='formatted',iostat=iostat)
	1562	if (iostat == 0) then
	1563	READ(98,*,end=998) nCFMIP
	1564	998 CONTINUE
	1565	CLOSE(98)
	1566	CONTINUE
	1567	IF(nCFMIP.GT.npCFMIP) THEN
	1568	print*,'nCFMIP > npCFMIP : augmenter npCFMIP et recompiler'
	1569	call abort_physic("physiq", "", 1)
	1570	else
	1571	print*,'physiq npCFMIP=',npCFMIP,'nCFMIP=',nCFMIP
	1572	ENDIF
	1573
	1574	!
	1575	ALLOCATE(tabCFMIP(nCFMIP))
	1576	ALLOCATE(lonCFMIP(nCFMIP), latCFMIP(nCFMIP))
	1577	ALLOCATE(tabijGCM(nCFMIP))
	1578	ALLOCATE(lonGCM(nCFMIP), latGCM(nCFMIP))
	1579	ALLOCATE(iGCM(nCFMIP), jGCM(nCFMIP))
	1580	!
	1581	! lecture des nCFMIP stations CFMIP, de leur numero
	1582	! et des coordonnees geographiques lonCFMIP, latCFMIP
	1583	!
	1584	CALL read_CFMIP_point_locations(nCFMIP, tabCFMIP, &
	1585	lonCFMIP, latCFMIP)
	1586	!
	1587	! identification des
	1588	! 1) coordonnees lonGCM, latGCM des points CFMIP dans la
	1589	! grille de LMDZ
	1590	! 2) indices points tabijGCM de la grille physique 1d sur
	1591	! klon points
	1592	! 3) indices iGCM, jGCM de la grille physique 2d
	1593	!
	1594	CALL LMDZ_CFMIP_point_locations(nCFMIP, lonCFMIP, latCFMIP, &
	1595	tabijGCM, lonGCM, latGCM, iGCM, jGCM)
	1596	!
	1597	else
	1598	ALLOCATE(tabijGCM(0))
	1599	ALLOCATE(lonGCM(0), latGCM(0))
	1600	ALLOCATE(iGCM(0), jGCM(0))
	1601	end if
	1602	else
	1603	ALLOCATE(tabijGCM(0))
	1604	ALLOCATE(lonGCM(0), latGCM(0))
	1605	ALLOCATE(iGCM(0), jGCM(0))
	1606	ENDIF
	1607
	1608	DO i=1,klon
	1609	rugoro(i) = f_rugoro * MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
	1610	ENDDO
	1611
	1612	!34EK
	1613	IF (ok_orodr) THEN
	1614
	1615	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	1616	! FH sans doute a enlever de finitivement ou, si on le
	1617	! garde, l'activer justement quand ok_orodr = false.
	1618	! ce rugoro est utilise par la couche limite et fait double emploi
	1619	! avec les param\'etrisations sp\'ecifiques de Francois Lott.
	1620	! DO i=1,klon
	1621	! rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
	1622	! ENDDO
	1623	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	1624	IF (ok_strato) THEN
	1625	CALL SUGWD_strato(klon,klev,paprs,pplay)
	1626	ELSE
	1627	CALL SUGWD(klon,klev,paprs,pplay)
	1628	ENDIF
	1629
	1630	DO i=1,klon
	1631	zuthe(i)=0.
	1632	zvthe(i)=0.
	1633	if(zstd(i).gt.10.)then
	1634	zuthe(i)=(1.-zgam(i))*cos(zthe(i))
	1635	zvthe(i)=(1.-zgam(i))*sin(zthe(i))
	1636	endif
	1637	ENDDO
	1638	ENDIF
	1639	!
	1640	!
	1641	lmt_pas = NINT(86400./dtime * 1.0) ! tous les jours
	1642	WRITE(lunout,*)'La frequence de lecture surface est de ', &
	1643	lmt_pas
	1644	!
	1645	capemaxcels = 't_max(X)'
	1646	t2mincels = 't_min(X)'
	1647	t2maxcels = 't_max(X)'
	1648	tinst = 'inst(X)'
	1649	tave = 'ave(X)'
	1650	!IM cf. AM 081204 BEG
	1651	write(lunout,*)'AVANT HIST IFLAG_CON=',iflag_con
	1652	!IM cf. AM 081204 END
	1653	!
	1654	!=============================================================
	1655	! Initialisation des sorties
	1656	!=============================================================
	1657
	1658	#ifdef CPP_IOIPSL
	1659
	1660	!$OMP MASTER
	1661	! FH : if ok_sync=.true. , the time axis is written at each time step
	1662	! in the output files. Only at the end in the opposite case
	1663	ok_sync_omp=.false.
	1664	CALL getin('ok_sync',ok_sync_omp)
	1665	call phys_output_open(longitude_deg,latitude_deg,nCFMIP,tabijGCM, &
	1666	iGCM,jGCM,lonGCM,latGCM, &
	1667	jjmp1,nlevSTD,clevSTD,rlevSTD, dtime,ok_veget, &
	1668	type_ocean,iflag_pbl,iflag_pbl_split,ok_mensuel,ok_journe, &
	1669	ok_hf,ok_instan,ok_LES,ok_ade,ok_aie, &
	1670	read_climoz, phys_out_filestations, &
	1671	new_aod, aerosol_couple, &
	1672	flag_aerosol_strat, pdtphys, paprs, pphis, &
	1673	pplay, lmax_th, ptconv, ptconvth, ivap, &
	1674	d_t, qx, d_qx, zmasse, ok_sync_omp)
	1675	!$OMP END MASTER
	1676	!$OMP BARRIER
	1677	ok_sync=ok_sync_omp
	1678
	1679	freq_outNMC(1) = ecrit_files(7)
	1680	freq_outNMC(2) = ecrit_files(8)
	1681	freq_outNMC(3) = ecrit_files(9)
	1682	WRITE(lunout,*)'OK freq_outNMC(1)=',freq_outNMC(1)
	1683	WRITE(lunout,*)'OK freq_outNMC(2)=',freq_outNMC(2)
	1684	WRITE(lunout,*)'OK freq_outNMC(3)=',freq_outNMC(3)
	1685
	1686	include "ini_histday_seri.h"
	1687
	1688	CALL ini_paramLMDZ_phy(dtime,nid_ctesGCM)
	1689
	1690	#endif
	1691	ecrit_reg = ecrit_reg * un_jour
	1692	ecrit_tra = ecrit_tra * un_jour
	1693
	1694	!XXXPB Positionner date0 pour initialisation de ORCHIDEE
	1695	date0 = jD_ref
	1696	WRITE(,) 'physiq date0 : ',date0
	1697	!
	1698	!
	1699	!
	1700	! Prescrire l'ozone dans l'atmosphere
	1701	!
	1702	!
	1703	!c DO i = 1, klon
	1704	!c DO k = 1, klev
	1705	!c CALL o3cm (paprs(i,k)/100.,paprs(i,k+1)/100., wo(i,k),20)
	1706	!c ENDDO
	1707	!c ENDDO
	1708	!
	1709	IF (type_trac == 'inca') THEN
	1710	#ifdef INCA
	1711	CALL VTe(VTphysiq)
	1712	CALL VTb(VTinca)
	1713	calday = REAL(days_elapsed) + jH_cur
	1714	WRITE(lunout,*) 'initial time chemini', days_elapsed, calday
	1715
	1716	CALL chemini( &
	1717	rg, &
	1718	ra, &
	1719	cell_area, &
	1720	latitude_deg, &
	1721	longitude_deg, &
	1722	presnivs, &
	1723	calday, &
	1724	klon, &
	1725	nqtot, &
	1726	nqo, &
	1727	pdtphys, &
	1728	annee_ref, &
	1729	day_ref, &
	1730	day_ini, &
	1731	start_time, &
	1732	itau_phy, &
	1733	io_lon, &
	1734	io_lat)
	1735
	1736	CALL VTe(VTinca)
	1737	CALL VTb(VTphysiq)
	1738	#endif
	1739	END IF
	1740
	1741	!
	1742	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	1743	! Nouvelle initialisation pour le rayonnement RRTM
	1744	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	1745
	1746	call iniradia(klon,klev,paprs(1,1:klev+1))
	1747
	1748	!$omp single
	1749	if (read_climoz >= 1) then
	1750	call open_climoz(ncid_climoz, press_climoz)
	1751	END IF
	1752	!$omp end single
	1753	!
	1754	!IM betaCRF
	1755	pfree=70000. !Pa
	1756	beta_pbl=1.
	1757	beta_free=1.
	1758	lon1_beta=-180.
	1759	lon2_beta=+180.
	1760	lat1_beta=90.
	1761	lat2_beta=-90.
	1762	mskocean_beta=.FALSE.
	1763
	1764	!albedo SB >>>
	1765	select case(nsw)
	1766	case(2)
	1767	SFRWL(1)=0.45538747
	1768	SFRWL(2)=0.54461211
	1769	case(4)
	1770	SFRWL(1)=0.45538747
	1771	SFRWL(2)=0.32870591
	1772	SFRWL(3)=0.18568763
	1773	SFRWL(4)=3.02191470E-02
	1774	case(6)
	1775	SFRWL(1)=1.28432794E-03
	1776	SFRWL(2)=0.12304168
	1777	SFRWL(3)=0.33106142
	1778	SFRWL(4)=0.32870591
	1779	SFRWL(5)=0.18568763
	1780	SFRWL(6)=3.02191470E-02
	1781	end select
	1782
	1783
	1784	!albedo SB <<<
	1785
	1786	OPEN(99,file='beta_crf.data',status='old', &
	1787	form='formatted',err=9999)
	1788	READ(99,*,end=9998) pfree
	1789	READ(99,*,end=9998) beta_pbl
	1790	READ(99,*,end=9998) beta_free
	1791	READ(99,*,end=9998) lon1_beta
	1792	READ(99,*,end=9998) lon2_beta
	1793	READ(99,*,end=9998) lat1_beta
	1794	READ(99,*,end=9998) lat2_beta
	1795	READ(99,*,end=9998) mskocean_beta
	1796	9998 Continue
	1797	CLOSE(99)
	1798	9999 Continue
	1799	WRITE(,)'pfree=',pfree
	1800	WRITE(,)'beta_pbl=',beta_pbl
	1801	WRITE(,)'beta_free=',beta_free
	1802	WRITE(,)'lon1_beta=',lon1_beta
	1803	WRITE(,)'lon2_beta=',lon2_beta
	1804	WRITE(,)'lat1_beta=',lat1_beta
	1805	WRITE(,)'lat2_beta=',lat2_beta
	1806	WRITE(,)'mskocean_beta=',mskocean_beta
	1807	ENDIF
	1808	!
	1809	! ************** Fin de IF ( debut ) *************
	1810	!
	1811	!
	1812	! Incrementer le compteur de la physique
	1813	!
	1814	itap = itap + 1
	1815	!
	1816	!
	1817	! Update fraction of the sub-surfaces (pctsrf) and
	1818	! initialize, where a new fraction has appeared, all variables depending
	1819	! on the surface fraction.
	1820	!
	1821	CALL change_srf_frac(itap, dtime, days_elapsed+1, &
	1822	pctsrf, fevap, z0m, z0h, agesno, &
	1823	falb_dir, falb_dif, ftsol, ustar, u10m, v10m, pbl_tke &
	1824	#ifdef ISO
	1825	,fxtevap &
	1826	#endif
	1827	& )
	1828
	1829	! Update time and other variables in Reprobus
	1830	IF (type_trac == 'repr') THEN
	1831	#ifdef REPROBUS
	1832	CALL Init_chem_rep_xjour(jD_cur-jD_ref+day_ref)
	1833	print*,'xjour equivalent rjourvrai',jD_cur-jD_ref+day_ref
	1834	CALL Rtime(debut)
	1835	#endif
	1836	END IF
	1837
	1838
	1839	! Tendances bidons pour les processus qui n'affectent pas certaines
	1840	! variables.
	1841	du0(:,:)=0.
	1842	dv0(:,:)=0.
	1843	dt0 = 0.
	1844	dq0(:,:)=0.
	1845	dql0(:,:)=0.
	1846	dqi0(:,:)=0.
	1847	#ifdef ISO
	1848	dxt0(:,:,:)=0.
	1849	dxtl0(:,:,:)=0.
	1850	dxti0(:,:,:)=0.
	1851	#endif
	1852	!
	1853	! Mettre a zero des variables de sortie (pour securite)
	1854	!
	1855	DO i = 1, klon
	1856	d_ps(i) = 0.0
	1857	ENDDO
	1858	DO k = 1, klev
	1859	DO i = 1, klon
	1860	d_t(i,k) = 0.0
	1861	d_u(i,k) = 0.0
	1862	d_v(i,k) = 0.0
	1863	ENDDO
	1864	ENDDO
	1865	DO iq = 1, nqtot
	1866	DO k = 1, klev
	1867	DO i = 1, klon
	1868	d_qx(i,k,iq) = 0.0
	1869	ENDDO
	1870	ENDDO
	1871	ENDDO
	1872	da(:,:)=0.
	1873	mp(:,:)=0.
	1874	phi(:,:,:)=0.
	1875	! RomP >>>
	1876	phi2(:,:,:)=0.
	1877	beta_prec_fisrt(:,:)=0.
	1878	beta_prec(:,:)=0.
	1879	epmlmMm(:,:,:)=0.
	1880	eplaMm(:,:)=0.
	1881	d1a(:,:)=0.
	1882	dam(:,:)=0.
	1883	pmflxr=0.
	1884	pmflxs=0.
	1885	! RomP <<<
	1886
	1887	!
	1888	! Ne pas affecter les valeurs entrees de u, v, h, et q
	1889	!
	1890	DO k = 1, klev
	1891	DO i = 1, klon
	1892	t_seri(i,k) = t(i,k)
	1893	u_seri(i,k) = u(i,k)
	1894	v_seri(i,k) = v(i,k)
	1895	q_seri(i,k) = qx(i,k,ivap)
	1896	ql_seri(i,k) = qx(i,k,iliq)
	1897	!CR: ATTENTION, on rajoute la variable glace
	1898	if (nqo.eq.2) then
	1899	qs_seri(i,k) = 0.
	1900	else if (nqo.eq.3) then
	1901	qs_seri(i,k) = qx(i,k,isol)
	1902	endif
	1903	ENDDO
	1904	ENDDO
	1905
	1906	! C Risi: dispatcher les isotopes dans les xt_seri
	1907	#ifdef ISO
	1908	#ifdef ISOVERIF
	1909	write(,) 'physiq 1847: qx(1,1,:)=',qx(1,1,:)
	1910	write(,) 'physiq 1846: ok_isotopes,ntraciso,niso=',ok_isotopes,ntraciso,niso
	1911	#endif
	1912	do ixt=1,ntraciso
	1913	#ifdef ISOVERIF
	1914	write(,) 'physiq tmp 1762a: ixt,iqiso_vap=',ixt,iqiso(ixt,ivap)
	1915	write(,) 'physiq tmp 1762b: ixt,iqiso_liq=',ixt,iqiso(ixt,iliq)
	1916	if (nqo.eq.3) then
	1917	write(,) 'physiq tmp 1762c: ixt,iqiso_liq=',ixt,iqiso(ixt,iliq)
	1918	endif !if (nqo.eq.3) then
	1919	#endif
	1920	if (ixt.gt.niso) then
	1921	write(,) 'izone,iiso=',zone_num(iqiso(ixt,ivap)),iso_indnum(iqiso(ixt,ivap))
	1922	endif
	1923	DO k = 1, klev
	1924	DO i = 1, klon
	1925	xt_seri(ixt,i,k) = qx(i,k,iqiso(ixt,ivap))
	1926	xtl_seri(ixt,i,k) = qx(i,k,iqiso(ixt,iliq))
	1927	if (nqo.eq.2) then
	1928	xts_seri(ixt,i,k) = 0.
	1929	else if (nqo.eq.3) then
	1930	xts_seri(ixt,i,k) = qx(i,k,iqiso(ixt,isol))
	1931	endif
	1932	enddo !DO i = 1, klon
	1933	enddo ! DO k = 1, klev
	1934	!write(,) 'physiq tmp 1897: dispatch termine pour ixt=',ixt
	1935	enddo !do ixt=1,niso
	1936	! write(,) 'physiq tmp 1898: dispatch termine pour tous'
	1937	#endif
	1938	! #ifdef ISO
	1939
	1940	!
	1941	!--OB mass fixer
	1942	IF (mass_fixer) THEN
	1943	!--store initial water burden
	1944	qql1(:)=0.0
	1945	DO k = 1, klev
	1946	qql1(:)=qql1(:)+(q_seri(:,k)+ql_seri(:,k)+qs_seri(:,k))*zmasse(:,k)
	1947	ENDDO
	1948	#ifdef ISO
	1949	#ifdef ISOVERIF
	1950	write(,) 'physiq tmp 1913'
	1951	#endif
	1952	do ixt=1,ntraciso
	1953	xtql1(ixt,:)=0.0
	1954	DO k = 1, klev
	1955	xtql1(ixt,:)=xtql1(ixt,:)+(xt_seri(ixt,:,k)+xtl_seri(ixt,:,k)+xts_seri(ixt,:,k))*zmasse(:,k)
	1956	ENDDO
	1957	enddo !do ixt=1,ntraciso
	1958	#endif
	1959	ENDIF
	1960	!--fin mass fixer
	1961
	1962	tke0(:,:)=pbl_tke(:,:,is_ave)
	1963
	1964	!CR:Nombre de traceurs de l'eau: nqo
	1965	! IF (nqtot.GE.3) THEN
	1966	IF (nqtot.GE.(nqo+1)) THEN
	1967	! DO iq = 3, nqtot
	1968	#ifdef ISO
	1969	! les isotopes ne sont pas dispatchés dans tr_seri, il faut les enlever.
	1970	! on a prévu pour ça un tableau d'indice dans infotrac
	1971	#ifdef ISOVERIF
	1972	write(,) 'physiq 1971: nqtottr=',nqtottr
	1973	#endif
	1974	do itr=1,nqtottr
	1975	iq=itr_indice(itr)
	1976	#ifdef ISOVERIF
	1977	write(,) 'physiq 1973: itr,iq=',itr,iq
	1978	write(,) 'qx(1,1,iq)=',qx(1,1,iq)
	1979	#endif
	1980	DO k = 1, klev
	1981	DO i = 1, klon
	1982	tr_seri(i,k,itr) = qx(i,k,iq) ! modif C Risi
	1983	ENDDO
	1984	ENDDO !DO k = 1, klev
	1985	!write(,) 'physiq 1980'
	1986	enddo !do itr=1,nqtottr
	1987	#else
	1988	DO iq = nqo+1, nqtot
	1989	itr=iq-nqo
	1990	DO k = 1, klev
	1991	DO i = 1, klon
	1992	tr_seri(i,k,itr) = qx(i,k,iq) ! modif C Risi
	1993	!! tr_seri(i,k,iq-2) = qx(i,k,iq)
	1994	! tr_seri(i,k,iq-nqo) = qx(i,k,iq)
	1995	ENDDO
	1996	ENDDO !DO k = 1, klev
	1997	! write(,) 'physiq tmp 1959'
	1998	ENDDO !DO iq = nqo+1, nqtot
	1999	#endif
	2000	ELSE !IF (nqtot.GE.(nqo+1)) THEN
	2001	DO k = 1, klev
	2002	DO i = 1, klon
	2003	tr_seri(i,k,1) = 0.0
	2004	ENDDO
	2005	ENDDO
	2006	ENDIF
	2007	write(,) 'physiq tmp 1968'
	2008	!
	2009	DO i = 1, klon
	2010	ztsol(i) = 0.
	2011	ENDDO
	2012	DO nsrf = 1, nbsrf
	2013	DO i = 1, klon
	2014	ztsol(i) = ztsol(i) + ftsol(i,nsrf)*pctsrf(i,nsrf)
	2015	ENDDO
	2016	ENDDO
	2017	! write(,) 'physiq tmp 1979'
	2018	! Initialize variables used for diagnostic purpose
	2019	if (flag_inhib_tend .ne. 0) call init_cmp_seri
	2020	! write(,) 'physiq tmp 1982: ip_ebil_phy=',ip_ebil_phy
	2021	!IM
	2022	IF (ip_ebil_phy.ge.1) THEN
	2023	ztit='after dynamic'
	2024	CALL diagetpq(cell_area,ztit,ip_ebil_phy,1,1,dtime &
	2025	, t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
	2026	, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec &
	2027	!#ifdef ISO
	2028	! & , xt_seri,xtl_seri,xts_seri,d_xtw, d_xtl, d_xts &
	2029	!#endif
	2030	& )
	2031
	2032	#ifdef ISOVERIF
	2033	call iso_verif_positif_choix_vect(t_seri(1,1),klev*klon,-100.0, &
	2034	& 'physiq 2024, avant revaptot')
	2035	#endif
	2036	! Comme les tendances de la physique sont ajoute dans la dynamique,
	2037	! on devrait avoir que la variation d'entalpie par la dynamique
	2038	! est egale a la variation de la physique au pas de temps precedent.
	2039	! Donc la somme de ces 2 variations devrait etre nulle.
	2040	call diagphy(cell_area,ztit,ip_ebil_phy &
	2041	, zero_v, zero_v, zero_v, zero_v, zero_v &
	2042	, zero_v, zero_v, zero_v, ztsol &
	2043	, d_h_vcol+d_h_vcol_phy, d_qt, 0. &
	2044	, fs_bound, fq_bound )
	2045	END IF
	2046
	2047	! Diagnostiquer la tendance dynamique
	2048	#ifdef ISOVERIF
	2049	write(,) 'physiq tmp 2010: ancien_ok=',ancien_ok
	2050	if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
	2051	do i=1,klon
	2052	do k=1,klev
	2053	if (q_seri(i,k).gt.ridicule) then
	2054	if (iso_verif_o18_aberrant_nostop( &
	2055	& xt_seri(iso_HDO,i,k)/q_seri(i,k), &
	2056	& xt_seri(iso_O18,i,k)/q_seri(i,k), &
	2057	& 'physiq 2099 qv').eq.1) then
	2058	write(,) 'i,k,q_seri(i,k)=',i,k,q_seri(i,k)
	2059	stop
	2060	endif ! if (iso_verif_o18_aberrant_nostop
	2061	endif !if (q_seri(i,k).gt.errmax) then
	2062	if (ql_seri(i,k).gt.ridicule) then
	2063	if (iso_verif_o18_aberrant_nostop( &
	2064	& xtl_seri(iso_HDO,i,k)/ql_seri(i,k), &
	2065	& xtl_seri(iso_O18,i,k)/ql_seri(i,k), &
	2066	& 'physiq 2099 ql').eq.1) then
	2067	write(,) 'i,k,ql_seri(i,k)=',i,k,ql_seri(i,k)
	2068	stop
	2069	endif ! if (iso_verif_o18_aberrant_nostop
	2070	endif !if (q_seri(i,k).gt.errmax) then
	2071	if (qs_seri(i,k).gt.ridicule) then
	2072	if (iso_verif_o18_aberrant_nostop( &
	2073	& xts_seri(iso_HDO,i,k)/qs_seri(i,k), &
	2074	& xts_seri(iso_O18,i,k)/qs_seri(i,k), &
	2075	& 'physiq 2099 qs').eq.1) then
	2076	write(,) 'i,k,qs_seri(i,k)=',i,k,qs_seri(i,k)
	2077	stop
	2078	endif ! if (iso_verif_o18_aberrant_nostop
	2079	endif !if (q_seri(i,k).gt.errmax) then
	2080	enddo !k=1,klev
	2081	enddo !i=1,klon
	2082	endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
	2083	#endif
	2084	!
	2085	IF (ancien_ok) THEN
	2086	!
	2087	d_u_dyn(:,:) = (u_seri(:,:)-u_ancien(:,:))/dtime
	2088	d_v_dyn(:,:) = (v_seri(:,:)-v_ancien(:,:))/dtime
	2089	d_t_dyn(:,:) = (t_seri(:,:)-t_ancien(:,:))/dtime
	2090	d_q_dyn(:,:) = (q_seri(:,:)-q_ancien(:,:))/dtime
	2091	d_ql_dyn(:,:) = (ql_seri(:,:)-ql_ancien(:,:))/dtime
	2092	d_qs_dyn(:,:) = (qs_seri(:,:)-qs_ancien(:,:))/dtime
	2093	CALL water_int(klon,klev,q_seri,zmasse,zx_tmp_fi2d)
	2094	d_q_dyn2d(:)=(zx_tmp_fi2d(:)-prw_ancien(:))/dtime
	2095	CALL water_int(klon,klev,ql_seri,zmasse,zx_tmp_fi2d)
	2096	d_ql_dyn2d(:)=(zx_tmp_fi2d(:)-prlw_ancien(:))/dtime
	2097	CALL water_int(klon,klev,qs_seri,zmasse,zx_tmp_fi2d)
	2098	d_qs_dyn2d(:)=(zx_tmp_fi2d(:)-prsw_ancien(:))/dtime
	2099	! !! RomP >>> td dyn traceur
	2100	!write(,) 'physiq tmp 2096'
	2101	IF (nqtot.GT.nqo) THEN ! jyg
	2102	#ifdef ISO
	2103	DO itr=1,nqtottr
	2104	!iq=itr_indice(itr)
	2105	d_tr_dyn(:,:,itr)=(tr_seri(:,:,itr)-tr_ancien(:,:,itr))/dtime
	2106	ENDDO !DO itr=1,nqtottr
	2107	#else
	2108	DO iq = nqo+1, nqtot ! jyg
	2109	d_tr_dyn(:,:,iq-nqo)=(tr_seri(:,:,iq-nqo)-tr_ancien(:,:,iq-nqo))/dtime ! jyg
	2110	ENDDO !DO iq = nqo+1, nqtot
	2111	#endif
	2112	ENDIF
	2113	! !! RomP <<<
	2114
	2115	#ifdef ISO
	2116	! write(,) 'physiq tmp 2112'
	2117	DO k = 1, klev
	2118	DO i = 1, klon
	2119	do ixt=1,ntraciso
	2120	d_xt_dyn(ixt,i,k) = &
	2121	& (xt_seri(ixt,i,k)-xt_ancien(ixt,i,k))/dtime
	2122	d_xtl_dyn(ixt,i,k) = &
	2123	& (xtl_seri(ixt,i,k)-xtl_ancien(ixt,i,k))/dtime
	2124	d_xts_dyn(ixt,i,k) = &
	2125	& (xts_seri(ixt,i,k)-xts_ancien(ixt,i,k))/dtime
	2126	enddo ! do ixt=1,niso
	2127	ENDDO
	2128	ENDDO
	2129	#ifdef ISOVERIF
	2130	DO k = 1, klev
	2131	DO i = 1, klon
	2132	do ixt=1,ntraciso
	2133	call iso_verif_noNaN(xt_seri(ixt,i,k),'physiq 2220')
	2134	call iso_verif_noNaN(xtl_seri(ixt,i,k),'physiq 2220b')
	2135	call iso_verif_noNaN(xts_seri(ixt,i,k),'physiq 2220b')
	2136	call iso_verif_noNaN(d_xt_dyn(ixt,i,k),'physiq 2220c')
	2137	call iso_verif_noNaN(d_xtl_dyn(ixt,i,k),'physiq 2220d')
	2138	call iso_verif_noNaN(d_xts_dyn(ixt,i,k),'physiq 2220e')
	2139	enddo ! do ixt=1,niso
	2140	enddo
	2141	enddo
	2142	#endif
	2143	#ifdef ISOVERIF
	2144	if (iso_eau.gt.0) then
	2145	DO k = 1, klev
	2146	DO i = 1, klon
	2147	call iso_verif_egalite_choix(xt_seri(iso_eau,i,k), &
	2148	& q_seri(i,k),'physiq 2033a',errmax,errmaxrel)
	2149	call iso_verif_egalite_choix(xtl_seri(iso_eau,i,k), &
	2150	& ql_seri(i,k),'physiq 2033al',errmax,errmaxrel)
	2151	call iso_verif_egalite_choix(xts_seri(iso_eau,i,k), &
	2152	& qs_seri(i,k),'physiq 2033as',errmax,errmaxrel)
	2153	call iso_verif_egalite_choix(xt_ancien(iso_eau,i,k), &
	2154	& q_ancien(i,k),'physiq 2033b',errmax,errmaxrel)
	2155	call iso_verif_egalite_choix(d_xt_dyn(iso_eau,i,k), &
	2156	& d_q_dyn(i,k),'physiq 2033c',errmax,errmaxrel)
	2157	enddo
	2158	enddo
	2159	endif
	2160	if (iso_HDO.gt.0) then
	2161	DO k = 1, klev
	2162	DO i = 1, klon
	2163	if (q_seri(i,k).gt.3e-3) then
	2164	call iso_verif_positif(deltaD(xt_seri(iso_eau,i,k) &
	2165	& /q_seri(i,k))+400.0,'physiq 2045a')
	2166	call iso_verif_positif(deltaD(xt_ancien(iso_eau,i,k) &
	2167	& /q_ancien(i,k))+400.0,'physiq 2045b')
	2168	call iso_verif_egalite_choix(d_xt_dyn(iso_hdo,i,k) &
	2169	& /tnat(iso_hdo),d_q_dyn(i,k),'physiq 2045c',1e-7,0.4)
	2170	endif
	2171	enddo
	2172	enddo
	2173	endif
	2174	#ifdef ISOTRAC
	2175	DO k = 1, klev
	2176	DO i = 1, klon
	2177	call iso_verif_traceur(xt_seri(1,i,k),'physiq 2065')
	2178	call iso_verif_traceur(xt_ancien(1,i,k),'physiq 2066')
	2179	enddo
	2180	enddo
	2181	#endif
	2182	#endif
	2183	#endif
	2184
	2185	ELSE ! ancien_OK
	2186	! write(,) 'physiq tmp 2103'
	2187	d_u_dyn(:,:) = 0.0
	2188	d_v_dyn(:,:) = 0.0
	2189	d_t_dyn(:,:) = 0.0
	2190	d_q_dyn(:,:) = 0.0
	2191	d_ql_dyn(:,:) = 0.0
	2192	d_qs_dyn(:,:) = 0.0
	2193	d_q_dyn2d(:) = 0.0
	2194	d_ql_dyn2d(:) = 0.0
	2195	d_qs_dyn2d(:) = 0.0
	2196
	2197	#ifdef ISO
	2198	! write(,) 'physiq tmp 2115'
	2199	! i=496
	2200	! k=18
	2201	! write(,) 'physiq 2105: q_seri(i,k),ql_seri(i,k),qs_seri(i,k),ridicule=', &
	2202	! q_seri(i,k),ql_seri(i,k),qs_seri(i,k),ridicule
	2203	DO k = 1, klev
	2204	DO i = 1, klon
	2205	do ixt=1,ntraciso
	2206	d_xt_dyn(ixt,i,k)= 0.0
	2207	d_xtl_dyn(ixt,i,k)= 0.0
	2208	d_xts_dyn(ixt,i,k)= 0.0
	2209	enddo
	2210	enddo
	2211	enddo
	2212	! write(,) 'physiq tmp 2125'
	2213	#endif
	2214	! !! RomP >>> td dyn traceur
	2215	IF (nqtot.GT.nqo) THEN ! jyg
	2216	#ifdef ISO
	2217	DO itr=1,nqtottr
	2218	!iq=itr_indice(itr)
	2219	d_tr_dyn(:,:,itr)= 0.0
	2220	ENDDO !DO itr=1,nqtottr
	2221	#else
	2222	DO iq = nqo+1, nqtot ! jyg
	2223	d_tr_dyn(:,:,iq-nqo)= 0.0 ! jyg
	2224	ENDDO
	2225	#endif
	2226	ENDIF
	2227	! !! RomP <<<
	2228	ancien_ok = .TRUE.
	2229	ENDIF
	2230	! write(,) 'physiq tmp 2136'
	2231	!
	2232	! Ajouter le geopotentiel du sol:
	2233	!
	2234	DO k = 1, klev
	2235	DO i = 1, klon
	2236	zphi(i,k) = pphi(i,k) + pphis(i)
	2237	ENDDO
	2238	ENDDO
	2239	!
	2240	! Verifier les temperatures
	2241	!
	2242	!IM BEG
	2243	IF (check) THEN
	2244	amn=MIN(ftsol(1,is_ter),1000.)
	2245	amx=MAX(ftsol(1,is_ter),-1000.)
	2246	DO i=2, klon
	2247	amn=MIN(ftsol(i,is_ter),amn)
	2248	amx=MAX(ftsol(i,is_ter),amx)
	2249	ENDDO
	2250	!
	2251	PRINT*,' debut avant hgardfou min max ftsol',itap,amn,amx
	2252	ENDIF !(check) THEN
	2253	!IM END
	2254	!
	2255	CALL hgardfou(t_seri,ftsol,'debutphy',abortphy)
	2256	IF (abortphy==1) Print*,'ERROR ABORT hgardfou debutphy'
	2257
	2258	!
	2259	!IM BEG
	2260	IF (check) THEN
	2261	amn=MIN(ftsol(1,is_ter),1000.)
	2262	amx=MAX(ftsol(1,is_ter),-1000.)
	2263	DO i=2, klon
	2264	amn=MIN(ftsol(i,is_ter),amn)
	2265	amx=MAX(ftsol(i,is_ter),amx)
	2266	ENDDO
	2267	!
	2268	PRINT*,' debut apres hgardfou min max ftsol',itap,amn,amx
	2269	ENDIF !(check) THEN
	2270	!IM END
	2271	!
	2272	! Mettre en action les conditions aux limites (albedo, sst, etc.).
	2273	! Prescrire l'ozone et calculer l'albedo sur l'ocean.
	2274	!
	2275	if (read_climoz >= 1) then
	2276	! Ozone from a file
	2277	! Update required ozone index:
	2278	ro3i = int((days_elapsed + jh_cur - jh_1jan) / year_len * 360.) + 1
	2279	if (ro3i == 361) ro3i = 360
	2280	! (This should never occur, except perhaps because of roundup
	2281	! error. See documentation.)
	2282	if (ro3i /= co3i) then
	2283	! Update ozone field:
	2284	if (read_climoz == 1) then
	2285	call regr_pr_av(ncid_climoz, (/"tro3"/), julien=ro3i, &
	2286	press_in_edg=press_climoz, paprs=paprs, v3=wo)
	2287	else
	2288	! read_climoz == 2
	2289	call regr_pr_av(ncid_climoz, (/"tro3 ", &
	2290	"tro3_daylight"/), julien=ro3i, press_in_edg=press_climoz, &
	2291	paprs=paprs, v3=wo)
	2292	end if
	2293	! Convert from mole fraction of ozone to column density of ozone in a
	2294	! cell, in kDU:
	2295	forall (l = 1: read_climoz) wo(:, :, l) = wo(:, :, l) * rmo3 / rmd &
	2296	* zmasse / dobson_u / 1e3
	2297	! (By regridding ozone values for LMDZ only once every 360th of
	2298	! year, we have already neglected the variation of pressure in one
	2299	! 360th of year. So do not recompute "wo" at each time step even if
	2300	! "zmasse" changes a little.)
	2301	co3i = ro3i
	2302	end if
	2303	ELSEIF (MOD(itap-1,lmt_pas) == 0) THEN
	2304	! Once per day, update ozone from Royer:
	2305
	2306	IF (solarlong0<-999.) then
	2307	! Generic case with evolvoing season
	2308	zzz=real(days_elapsed+1)
	2309	ELSE IF (abs(solarlong0-1000.)<1.e-4) then
	2310	! Particular case with annual mean insolation
	2311	zzz=real(90) ! could be revisited
	2312	IF (read_climoz/=-1) THEN
	2313	abort_message ='read_climoz=-1 is recommended when ' &
	2314	// 'solarlong0=1000.'
	2315	CALL abort_physic (modname,abort_message,1)
	2316	ENDIF
	2317	ELSE
	2318	! Case where the season is imposed with solarlong0
	2319	zzz=real(90) ! could be revisited
	2320	ENDIF
	2321	wo(:,:,1)=ozonecm(latitude_deg, paprs,read_climoz,rjour=zzz)
	2322	ENDIF
	2323	!
	2324	! Re-evaporer l'eau liquide nuageuse
	2325	!
	2326	DO k = 1, klev ! re-evaporation de l'eau liquide nuageuse
	2327	DO i = 1, klon
	2328	zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
	2329	!jyg<
	2330	! Attention : Arnaud a propose des formules completement differentes
	2331	! A verifier !!!
	2332	zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*q_seri(i,k))
	2333	IF (iflag_ice_thermo .EQ. 0) THEN
	2334	zlsdcp=zlvdcp
	2335	ENDIF
	2336	!>jyg
	2337
	2338	!write(,) 'physiq tmp 2245: iflag_ice_thermo=',iflag_ice_thermo
	2339	if (iflag_ice_thermo.eq.0) then
	2340	!pas necessaire a priori
	2341
	2342	zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
	2343	zb = MAX(0.0,ql_seri(i,k))
	2344	za = - MAX(0.0,ql_seri(i,k)) &
	2345	* (zlvdcp(1.-zdelta)+zlsdcpzdelta)
	2346	t_seri(i,k) = t_seri(i,k) + za
	2347	q_seri(i,k) = q_seri(i,k) + zb
	2348	ql_seri(i,k) = 0.0
	2349	d_t_eva(i,k) = za
	2350	d_q_eva(i,k) = zb
	2351
	2352	#ifdef ISO
	2353	!#ifdef ISOVERIF
	2354	! write(,) 'physiq tmp 2239'
	2355	!#endif
	2356	! DO k = 1, klev ! re-evaporation de l'eau liquide nuageuse
	2357	! DO i = 1, klon
	2358	do ixt=1,ntraciso
	2359	zbxt = MAX(0.0,xtl_seri(ixt,i,k))
	2360	xt_seri(ixt,i,k) = xt_seri(ixt,i,k) + zbxt
	2361	xtl_seri(ixt,i,k) = 0.0
	2362	d_xt_eva(ixt,i,k) = zbxt
	2363	enddo ! do ixt=1,niso
	2364	! ENDDO
	2365	! ENDDO
	2366	#ifdef ISOVERIF
	2367	do ixt=1,ntraciso
	2368	call iso_verif_noNaN(xt_seri(ixt,i,k), &
	2369	& 'physiq 2417: apres evap tot')
	2370	enddo
	2371	if (iso_eau.gt.0) then
	2372	! DO k = 1, klev
	2373	! DO i = 1, klon
	2374	call iso_verif_egalite_choix( &
	2375	& xt_seri(iso_eau,i,k),q_seri(i,k), &
	2376	& 'physiq 1891+, après réévap totale',errmax,errmaxrel)
	2377	call iso_verif_egalite_choix( &
	2378	& xtl_seri(iso_eau,i,k),ql_seri(i,k), &
	2379	& 'physiq 2209+, après réévap totale',errmax,errmaxrel)
	2380	! ENDDO ! DO i = 1, klon
	2381	! ENDDO !DO k = 1, klev
	2382	endif !if (iso_eau.gt.0) then
	2383	if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
	2384	if (q_seri(i,k).gt.ridicule) then
	2385	if (iso_verif_o18_aberrant_nostop( &
	2386	& xt_seri(iso_HDO,i,k)/q_seri(i,k), &
	2387	& xt_seri(iso_O18,i,k)/q_seri(i,k), &
	2388	& 'physiq 2315: apres reevap totale').eq.1) then
	2389	write(,) 'i,k,q_seri(i,k)=',i,k,q_seri(i,k)
	2390	write(,) 'd_q_eva(i,k)=',d_q_eva(i,k)
	2391	write(,) 'deltaD(d_q_eva(i,k))=',deltaD(d_xt_eva(iso_HDO,i,k)/d_q_eva(i,k))
	2392	write(,) 'deltaO18(d_q_eva(i,k))=',deltaO(d_xt_eva(iso_O18,i,k)/d_q_eva(i,k))
	2393	stop
	2394	endif ! if (iso_verif_o18_aberrant_nostop
	2395	endif !if (q_seri(i,k).gt.errmax) then
	2396	endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
	2397	#ifdef ISOTRAC
	2398	! DO k = 1, klev
	2399	! DO i = 1, klon
	2400	call iso_verif_traceur(xt_seri(1,i,k), &
	2401	& 'physiq 2165')
	2402	call iso_verif_traceur_pbidouille(xt_seri(1,i,k), &
	2403	& 'physiq 2165b')
	2404	! ENDDO ! DO i = 1, klon
	2405	! ENDDO !DO k = 1, klev
	2406	#endif
	2407
	2408	#endif
	2409	#endif
	2410
	2411	else
	2412
	2413	!CR: on r\'e-\'evapore eau liquide et glace
	2414
	2415	! zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k)))
	2416	! zb = MAX(0.0,ql_seri(i,k))
	2417	! za = - MAX(0.0,ql_seri(i,k)) &
	2418	! * (zlvdcp(1.-zdelta)+zlsdcpzdelta)
	2419	zb = MAX(0.0,ql_seri(i,k)+qs_seri(i,k))
	2420	za = - MAX(0.0,ql_seri(i,k))*zlvdcp &
	2421	- MAX(0.0,qs_seri(i,k))*zlsdcp
	2422	t_seri(i,k) = t_seri(i,k) + za
	2423	q_seri(i,k) = q_seri(i,k) + zb
	2424	ql_seri(i,k) = 0.0
	2425	!on \'evapore la glace
	2426	qs_seri(i,k) = 0.0
	2427	d_t_eva(i,k) = za
	2428	d_q_eva(i,k) = zb
	2429	endif
	2430
	2431	#ifdef ISO
	2432	!#ifdef ISOVERIF
	2433	! write(,) 'physiq tmp 2307'
	2434	!#endif
	2435	! DO k = 1, klev ! re-evaporation de l'eau liquide nuageuse
	2436	! DO i = 1, klon
	2437	do ixt=1,ntraciso
	2438	zbxt = MAX(0.0,xtl_seri(ixt,i,k)+xts_seri(ixt,i,k))
	2439	xt_seri(ixt,i,k) = xt_seri(ixt,i,k) + zbxt
	2440	xtl_seri(ixt,i,k) = 0.0
	2441	xts_seri(ixt,i,k) = 0.0
	2442	d_xt_eva(ixt,i,k) = zbxt
	2443	enddo ! do ixt=1,niso
	2444	! ENDDO
	2445	! ENDDO
	2446	#ifdef ISOVERIF
	2447	do ixt=1,ntraciso
	2448	call iso_verif_noNaN(xt_seri(ixt,i,k), &
	2449	& 'physiq 2417: apres evap tot')
	2450	enddo
	2451
	2452	#endif
	2453	#ifdef ISOVERIF
	2454	if (iso_eau.gt.0) then
	2455	! DO k = 1, klev
	2456	! DO i = 1, klon
	2457	call iso_verif_egalite_choix( &
	2458	& xt_seri(iso_eau,i,k),q_seri(i,k), &
	2459	& 'physiq 1891, après réévap totale',errmax,errmaxrel)
	2460	call iso_verif_egalite_choix( &
	2461	& xtl_seri(iso_eau,i,k),ql_seri(i,k), &
	2462	& 'physiq 2209, après réévap totale',errmax,errmaxrel)
	2463	call iso_verif_egalite_choix( &
	2464	& xts_seri(iso_eau,i,k),qs_seri(i,k), &
	2465	& 'physiq 2209b, après réévap totale',errmax,errmaxrel)
	2466	! ENDDO ! DO i = 1, klon
	2467	! ENDDO !DO k = 1, klev
	2468	! DO i = 1, klon
	2469	call iso_verif_egalite_choix( &
	2470	& xtsnow_fall(iso_eau,i),snow_fall(i), &
	2471	& 'physiq 2276',errmax,errmaxrel)
	2472	! enddo !DO i = 1, klon
	2473	endif !if (iso_eau.gt.0) then
	2474
	2475	if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
	2476	if (q_seri(i,k).gt.ridicule) then
	2477	if (iso_verif_o18_aberrant_nostop( &
	2478	& xt_seri(iso_HDO,i,k)/q_seri(i,k), &
	2479	& xt_seri(iso_O18,i,k)/q_seri(i,k), &
	2480	& 'physiq 2408: apres reevap totale').eq.1) then
	2481	write(,) 'i,k,q_seri(i,k)=',i,k,q_seri(i,k)
	2482	stop
	2483	endif ! if (iso_verif_o18_aberrant_nostop
	2484	endif !if (q_seri(i,k).gt.errmax) then
	2485	endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
	2486	#ifdef ISOTRAC
	2487	! DO k = 1, klev
	2488	! DO i = 1, klon
	2489	call iso_verif_traceur(xt_seri(1,i,k), &
	2490	& 'physiq 2165')
	2491	call iso_verif_traceur_pbidouille(xt_seri(1,i,k), &
	2492	& 'physiq 2165b')
	2493	! ENDDO ! DO i = 1, klon
	2494	! ENDDO !DO k = 1, klev
	2495	#endif
	2496	#endif
	2497	#endif
	2498
	2499	ENDDO
	2500	ENDDO
	2501
	2502	#ifdef ISO
	2503	#ifdef ISOTRAC
	2504	call isotrac_recolorise_general(xt_seri,t_seri,zx_rh,presnivs)
	2505	#endif
	2506	#endif
	2507
	2508	!IM
	2509	IF (ip_ebil_phy.ge.2) THEN
	2510	ztit='after reevap'
	2511	CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,1,dtime &
	2512	, t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
	2513	, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec &
	2514	!#ifdef ISO
	2515	! & , xt_seri,xtl_seri,xts_seri,d_xtw, d_xtl, d_xts &
	2516	!#endif
	2517	& )
	2518	call diagphy(cell_area,ztit,ip_ebil_phy &
	2519	, zero_v, zero_v, zero_v, zero_v, zero_v &
	2520	, zero_v, zero_v, zero_v, ztsol &
	2521	, d_h_vcol, d_qt, d_ec &
	2522	, fs_bound, fq_bound )
	2523	!
	2524	END IF
	2525
	2526	!
	2527	!=========================================================================
	2528	! Calculs de l'orbite.
	2529	! Necessaires pour le rayonnement et la surface (calcul de l'albedo).
	2530	! doit donc etre plac\'e avant radlwsw et pbl_surface
	2531
	2532	! !! jyg 17 Sep 2010 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	2533	call ymds2ju(year_cur, mth_eq, day_eq,0., jD_eq)
	2534	day_since_equinox = (jD_cur + jH_cur) - jD_eq
	2535	!
	2536	! choix entre calcul de la longitude solaire vraie ou valeur fixee a
	2537	! solarlong0
	2538	if (solarlong0<-999.) then
	2539	if (new_orbit) then
	2540	! calcul selon la routine utilisee pour les planetes
	2541	call solarlong(day_since_equinox, zlongi, dist)
	2542	else
	2543	! calcul selon la routine utilisee pour l'AR4
	2544	CALL orbite(REAL(days_elapsed+1),zlongi,dist)
	2545	endif
	2546	else
	2547	zlongi=solarlong0 ! longitude solaire vraie
	2548	dist=1. ! distance au soleil / moyenne
	2549	endif
	2550	if(prt_level.ge.1) &
	2551	write(lunout,*)'Longitude solaire ',zlongi,solarlong0,dist
	2552
	2553
	2554	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	2555	! Calcul de l'ensoleillement :
	2556	! ============================
	2557	! Pour une solarlong0=1000., on calcule un ensoleillement moyen sur
	2558	! l'annee a partir d'une formule analytique.
	2559	! Cet ensoleillement est sym\'etrique autour de l'\'equateur et
	2560	! non nul aux poles.
	2561	IF (abs(solarlong0-1000.)<1.e-4) then
	2562	call zenang_an(iflag_cycle_diurne.GE.1,jH_cur, &
	2563	latitude_deg,longitude_deg,rmu0,fract)
	2564	JrNt = 1.0
	2565	ELSE
	2566	! recode par Olivier Boucher en sept 2015
	2567	SELECT CASE (iflag_cycle_diurne)
	2568	CASE(0)
	2569	! Sans cycle diurne
	2570	CALL angle(zlongi, latitude_deg, fract, rmu0)
	2571	swradcorr = 1.0
	2572	JrNt = 1.0
	2573	zrmu0 = rmu0
	2574	CASE(1)
	2575	! Avec cycle diurne sans application des poids
	2576	! bit comparable a l ancienne formulation cycle_diurne=true
	2577	! on integre entre gmtime et gmtime+radpas
	2578	zdtime=dtime*REAL(radpas) ! pas de temps du rayonnement (s)
	2579	CALL zenang(zlongi,jH_cur,0.0,zdtime, &
	2580	latitude_deg,longitude_deg,rmu0,fract)
	2581	zrmu0 = rmu0
	2582	swradcorr = 1.0
	2583	! Calcul du flag jour-nuit
	2584	JrNt = 0.0
	2585	WHERE (fract.GT.0.0) JrNt = 1.0
	2586	CASE(2)
	2587	! Avec cycle diurne sans application des poids
	2588	! On integre entre gmtime-pdtphys et gmtime+pdtphys*(radpas-1)
	2589	! Comme cette routine est appele a tous les pas de temps de
	2590	! la physique meme si le rayonnement n'est pas appele je
	2591	! remonte en arriere les radpas-1 pas de temps
	2592	! suivant. Petite ruse avec MOD pour prendre en compte le
	2593	! premier pas de temps de la physique pendant lequel
	2594	! itaprad=0
	2595	zdtime1=dtime*REAL(-MOD(itaprad,radpas)-1)
	2596	zdtime2=dtime*REAL(radpas-MOD(itaprad,radpas)-1)
	2597	CALL zenang(zlongi,jH_cur,zdtime1,zdtime2, &
	2598	latitude_deg,longitude_deg,rmu0,fract)
	2599	!
	2600	! Calcul des poids
	2601	!
	2602	zdtime1=-dtime !--on corrige le rayonnement pour representer le
	2603	zdtime2=0.0 !--pas de temps de la physique qui se termine
	2604	CALL zenang(zlongi,jH_cur,zdtime1,zdtime2, &
	2605	latitude_deg,longitude_deg,zrmu0,zfract)
	2606	swradcorr = 0.0
	2607	WHERE (rmu0.GE.1.e-10 .OR. fract.GE.1.e-10) &
	2608	swradcorr=zfract/fract*zrmu0/rmu0
	2609	! Calcul du flag jour-nuit
	2610	JrNt = 0.0
	2611	WHERE (zfract.GT.0.0) JrNt = 1.0
	2612	END SELECT
	2613	ENDIF
	2614
	2615	if (mydebug) then
	2616	call writefield_phy('u_seri',u_seri,nbp_lev)
	2617	call writefield_phy('v_seri',v_seri,nbp_lev)
	2618	call writefield_phy('t_seri',t_seri,nbp_lev)
	2619	call writefield_phy('q_seri',q_seri,nbp_lev)
	2620	endif
	2621
	2622	!cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
	2623	! Appel au pbl_surface : Planetary Boudary Layer et Surface
	2624	! Cela implique tous les interactions des sous-surfaces et la
	2625	! partie diffusion turbulent du couche limit.
	2626	!
	2627	! Certains varibales de sorties de pbl_surface sont utiliser que pour
	2628	! ecriture des fihiers hist_XXXX.nc, ces sont :
	2629	! qsol, zq2m, s_pblh, s_lcl,
	2630	! s_capCL, s_oliqCL, s_cteiCL,s_pblT,
	2631	! s_therm, s_trmb1, s_trmb2, s_trmb3,
	2632	! zu10m, zv10m, fder,
	2633	! zxqsurf, rh2m, zxfluxu, zxfluxv,
	2634	! frugs, agesno, fsollw, fsolsw,
	2635	! d_ts, fevap, fluxlat, t2m,
	2636	! wfbils, wfbilo, fluxt, fluxu, fluxv,
	2637	!
	2638	! Certains ne sont pas utiliser du tout :
	2639	! dsens, devap, zxsnow, zxfluxt, zxfluxq, q2m, fluxq
	2640	!
	2641
	2642	! Calcul de l'humidite de saturation au niveau du sol
	2643
	2644
	2645
	2646	if (iflag_pbl/=0) then
	2647
	2648	!jyg+nrlmd<
	2649	IF (prt_level .ge. 2 .and. mod(iflag_pbl_split,2) .eq. 1) THEN
	2650	print *,'debut du splitting de la PBL'
	2651	ENDIF
	2652	! !!
	2653	!=================================================================
	2654	! PROVISOIRE : DECOUPLAGE PBL/WAKE
	2655	! --------------------------------
	2656	!
	2657	!! wake_deltat_sav(:,:)=wake_deltat(:,:)
	2658	!! wake_deltaq_sav(:,:)=wake_deltaq(:,:)
	2659	!! wake_deltat(:,:)=0.
	2660	!! wake_deltaq(:,:)=0.
	2661	!=================================================================
	2662	!>jyg+nrlmd
	2663	!
	2664	!-------gustiness calculation-------!
	2665	IF (iflag_gusts==0) THEN
	2666	gustiness(1:klon)=0
	2667	ELSE IF (iflag_gusts==1) THEN
	2668	do i = 1, klon
	2669	gustiness(i)=f_gust_blale_bl(i)+f_gust_wkale_wake(i)
	2670	enddo
	2671	! ELSE IF (iflag_gusts==2) THEN
	2672	! do i = 1, klon
	2673	! gustiness(i)=f_gust_blale_bl(i)+sigma_wk(i)f_gust_wk&
	2674	! *ale_wake(i) !! need to make sigma_wk accessible here
	2675	! enddo
	2676	! ELSE IF (iflag_gusts==3) THEN
	2677	! do i = 1, klon
	2678	! gustiness(i)=f_gust_blalp_bl(i)+f_gust_wkalp_wake(i)
	2679	! enddo
	2680	ENDIF
	2681
	2682	!write(,) 'physiq tmp 2674'
	2683
	2684	CALL pbl_surface( &
	2685	dtime, date0, itap, days_elapsed+1, &
	2686	debut, lafin, &
	2687	longitude_deg, latitude_deg, rugoro, zrmu0, &
	2688	zsig, sollwdown, pphi, cldt, &
	2689	rain_fall, snow_fall, solsw, sollw, &
	2690	gustiness, &
	2691	t_seri, q_seri, u_seri, v_seri, &
	2692	!nrlmd+jyg<
	2693	wake_deltat, wake_deltaq, wake_cstar, wake_s, &
	2694	!>nrlmd+jyg
	2695	pplay, paprs, pctsrf, &
	2696	ftsol,SFRWL,falb_dir,falb_dif,ustar,u10m,v10m,wstar, &
	2697	!albedo SB <<<
	2698	cdragh, cdragm, u1, v1, &
	2699	!albedo SB >>>
	2700	! albsol1, albsol2, sens, evap, &
	2701	albsol_dir, albsol_dif, sens, evap, &
	2702	!albedo SB <<<
	2703	albsol3_lic,runoff, snowhgt, qsnow, to_ice, sissnow, &
	2704	zxtsol, zxfluxlat, zt2m, qsat2m, &
	2705	d_t_vdf, d_q_vdf, d_u_vdf, d_v_vdf, d_t_diss, &
	2706	!nrlmd<
	2707	!jyg<
	2708	d_t_vdf_w, d_q_vdf_w, &
	2709	d_t_vdf_x, d_q_vdf_x, &
	2710	sens_x, zxfluxlat_x, sens_w, zxfluxlat_w, &
	2711	!>jyg
	2712	delta_tsurf,wake_dens, &
	2713	cdragh_x,cdragh_w,cdragm_x,cdragm_w, &
	2714	kh,kh_x,kh_w, &
	2715	!>nrlmd
	2716	coefh(1:klon,1:klev,1:nbsrf+1), coefm(1:klon,1:klev,1:nbsrf+1), &
	2717	slab_wfbils, &
	2718	qsol, zq2m, s_pblh, s_lcl, &
	2719	!jyg<
	2720	s_pblh_x, s_lcl_x, s_pblh_w, s_lcl_w, &
	2721	!>jyg
	2722	s_capCL, s_oliqCL, s_cteiCL,s_pblT, &
	2723	s_therm, s_trmb1, s_trmb2, s_trmb3, &
	2724	zustar, zu10m, zv10m, fder, &
	2725	zxqsurf, rh2m, zxfluxu, zxfluxv, &
	2726	z0m, z0h, agesno, fsollw, fsolsw, &
	2727	d_ts, fevap, fluxlat, t2m, &
	2728	wfbils, wfbilo, fluxt, fluxu, fluxv, &
	2729	dsens, devap, zxsnow, &
	2730	zxfluxt, zxfluxq, q2m, fluxq, pbl_tke, &
	2731	!nrlmd+jyg<
	2732	wake_delta_pbl_TKE &
	2733	!>nrlmd+jyg
	2734
	2735	#ifdef ISO
	2736	& ,xtrain_fall, xtsnow_fall,xt_seri, &
	2737	& wake_deltaxt,xtevap,fxtevap, &
	2738	& d_xt_vdf,d_xt_vdf_w,d_xt_vdf_x, &
	2739	& xtsol,dxtevap,zxxtsnow,zxfluxxt,fluxxt, &
	2740	& h1_diag,runoff_diag,xtrunoff_diag &
	2741	#endif
	2742	& )
	2743
	2744
	2745	#ifdef ISO
	2746	! write(,) 'physiq 2402: apres pbl_surface'
	2747	#ifdef ISOVERIF
	2748	do i=1,klon
	2749	do k=1,klev
	2750	do ixt=1,ntraciso
	2751	call iso_verif_noNaN(d_xt_vdf(ixt,i,k),'physiq 1993a')
	2752	call iso_verif_noNaN(xt_seri(ixt,i,k),'physiq 1993b')
	2753	enddo !do ixt=1,niso
	2754	enddo
	2755	enddo
	2756	#endif
	2757	#ifdef ISOVERIF
	2758	do i=1,klon
	2759	do k=1,klev
	2760	#ifdef ISOTRAC
	2761	call iso_verif_traceur_justmass(d_xt_vdf(1,i,k),'physiq 2443')
	2762	#endif
	2763	enddo
	2764	enddo
	2765
	2766	! verif iso_eau
	2767	!write(,) 'physiq tmp 2748: iso_eau=',iso_eau
	2768	!write(,) 'use_iso=',use_iso
	2769	!write(,) 'iso_eau.gt.0=',iso_eau.gt.0
	2770	!write(,) 'd_xt_vdf(iso_eau,1,1),d_q_vdf(1,1)=',d_xt_vdf(iso_eau,1,1),d_q_vdf(1,1)
	2771	!write(,) 'bidouille_anti_divergence=',bidouille_anti_divergence
	2772	if (iso_eau.gt.0) then
	2773	! write(,) 'physiq 2665: d_q_vdf,d_xt_vdf(iso_eau,554,19)=',d_q_vdf(554,19),d_xt_vdf(iso_eau,554,19)
	2774	! write(,) 'd_q_vdf,d_xt_vdf(iso_eau,2,1)=',d_q_vdf(2,1),d_xt_vdf(iso_eau,2,1)
	2775	do i=1,klon
	2776	! write(,) 'physiq 2667: i,k=',i,k
	2777	! write(,) 'd_q_vdf,d_xt_vdf(iso_eau,554,19)=',d_q_vdf(554,19),d_xt_vdf(iso_eau,554,19)
	2778	! write(,) 'd_q_vdf,d_xt_vdf(iso_eau,2,1)=',d_q_vdf(2,1),d_xt_vdf(iso_eau,2,1)
	2779	do k=1,klev
	2780	! write(,) 'physiq 2670: i,k=',i,k
	2781	! write(,) 'd_q_vdf,d_xt_vdf(iso_eau,554,19)=',d_q_vdf(554,19),d_xt_vdf(iso_eau,554,19)
	2782	! write(,) 'd_q_vdf,d_xt_vdf(iso_eau,2,1)=',d_q_vdf(2,1),d_xt_vdf(iso_eau,2,1)
	2783	! write(,) 'd_q_vdf,d_xt_vdf(iso_eau,i,k)=',d_q_vdf(i,k),d_xt_vdf(iso_eau,i,k)
	2784	call iso_verif_egalite_choix( &
	2785	& d_xt_vdf(iso_eau,i,k),d_q_vdf(i,k), &
	2786	& 'physiq 1984',errmax,errmaxrel)
	2787	call iso_verif_egalite_choix( &
	2788	& xt_seri(iso_eau,i,k),q_seri(i,k), &
	2789	& 'physiq 1985',errmax,errmaxrel)
	2790	do nsrf=1,nbsrf
	2791	call iso_verif_egalite_choix(fluxxt(iso_eau,i,k,nsrf), &
	2792	& fluxq(i,k,nsrf),'physiq 1991',errmax,errmaxrel)
	2793	enddo !do nsrf=1,nbsrf
	2794	enddo !k=1,klev
	2795	enddo !i=1,klon
	2796	endif !if (iso_eau.gt.0) then
	2797	if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
	2798	do i=1,klon
	2799	do k=1,klev
	2800	if (q_seri(i,k).gt.ridicule) then
	2801	if (iso_verif_o18_aberrant_nostop( &
	2802	& xt_seri(iso_HDO,i,k)/q_seri(i,k), &
	2803	& xt_seri(iso_O18,i,k)/q_seri(i,k), &
	2804	& 'physiq 4177, apres pbl_surface').eq.1) then
	2805	write(,) 'i,k,q_seri(i,k)=',i,k,q_seri(i,k)
	2806	stop
	2807	endif ! if (iso_verif_o18_aberrant_nostop
	2808	endif !if (q_seri(i,k).gt.errmax) then
	2809	enddo !k=1,klev
	2810	enddo !i=1,klon
	2811	endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
	2812	!write(,) 'physiq tmp 2689'
	2813	#endif
	2814	!#ifdef ISOVERIF
	2815	#endif
	2816	!#ifdef ISO
	2817	!
	2818	!=================================================================
	2819	! PROVISOIRE : DECOUPLAGE PBL/WAKE
	2820	! --------------------------------
	2821	!
	2822	!! wake_deltat(:,:)=wake_deltat_sav(:,:)
	2823	!! wake_deltaq(:,:)=wake_deltaq_sav(:,:)
	2824	!=================================================================
	2825	!
	2826	! Add turbulent diffusion tendency to the wake difference variables
	2827	IF (mod(iflag_pbl_split,2) .NE. 0) THEN
	2828	wake_deltat(:,:) = wake_deltat(:,:) + (d_t_vdf_w(:,:)-d_t_vdf_x(:,:))
	2829	wake_deltaq(:,:) = wake_deltaq(:,:) + (d_q_vdf_w(:,:)-d_q_vdf_x(:,:))
	2830	#ifdef ISO
	2831	do ixt=1,ntraciso
	2832	wake_deltaxt(:,:,:) = wake_deltaxt(:,:,:) + (d_xt_vdf_w(:,:,:)-d_xt_vdf_x(:,:,:))
	2833	enddo
	2834	#endif
	2835	ENDIF
	2836
	2837
	2838	!---------------------------------------------------------------------
	2839	! ajout des tendances de la diffusion turbulente
	2840	IF (klon_glo==1) THEN
	2841	CALL add_pbl_tend &
	2842	(d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,paprs,&
	2843	'vdf',abortphy,flag_inhib_tend &
	2844	#ifdef ISO
	2845	& ,d_xt_vdf,dxtl0,dxti0 &
	2846	#endif
	2847	& )
	2848	ELSE
	2849	CALL add_phys_tend &
	2850	(d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,paprs,&
	2851	'vdf',abortphy,flag_inhib_tend &
	2852	#ifdef ISO
	2853	& ,d_xt_vdf,dxtl0,dxti0 &
	2854	#endif
	2855	& )
	2856	ENDIF
	2857
	2858	#ifdef ISOVERIF
	2859	write(,) 'physiq tmp 2736'
	2860	#endif
	2861	!--------------------------------------------------------------------
	2862
	2863	if (mydebug) then
	2864	call writefield_phy('u_seri',u_seri,nbp_lev)
	2865	call writefield_phy('v_seri',v_seri,nbp_lev)
	2866	call writefield_phy('t_seri',t_seri,nbp_lev)
	2867	call writefield_phy('q_seri',q_seri,nbp_lev)
	2868	endif
	2869
	2870
	2871	!albedo SB >>>
	2872	albsol1=0.
	2873	albsol2=0.
	2874	falb1=0.
	2875	falb2=0.
	2876	select case(nsw)
	2877	case(2)
	2878	albsol1=albsol_dir(:,1)
	2879	albsol2=albsol_dir(:,2)
	2880	falb1=falb_dir(:,1,:)
	2881	falb2=falb_dir(:,2,:)
	2882	case(4)
	2883	albsol1=albsol_dir(:,1)
	2884	albsol2=albsol_dir(:,2)SFRWL(2)+albsol_dir(:,3)SFRWL(3) &
	2885	+albsol_dir(:,4)*SFRWL(4)
	2886	albsol2=albsol2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
	2887	falb1=falb_dir(:,1,:)
	2888	falb2=falb_dir(:,2,:)SFRWL(2)+falb_dir(:,3,:)SFRWL(3) &
	2889	+falb_dir(:,4,:)*SFRWL(4)
	2890	falb2=falb2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
	2891	case(6)
	2892	albsol1=albsol_dir(:,1)SFRWL(1)+albsol_dir(:,2)SFRWL(2) &
	2893	+albsol_dir(:,3)*SFRWL(3)
	2894	albsol1=albsol1/(SFRWL(1)+SFRWL(2)+SFRWL(3))
	2895	albsol2=albsol_dir(:,4)SFRWL(4)+albsol_dir(:,5)SFRWL(5) &
	2896	+albsol_dir(:,6)*SFRWL(6)
	2897	albsol2=albsol2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
	2898	falb1=falb_dir(:,1,:)SFRWL(1)+falb_dir(:,2,:)SFRWL(2) &
	2899	+falb_dir(:,3,:)*SFRWL(3)
	2900	falb1=falb1/(SFRWL(1)+SFRWL(2)+SFRWL(3))
	2901	falb2=falb_dir(:,4,:)SFRWL(4)+falb_dir(:,5,:)SFRWL(5) &
	2902	+falb_dir(:,6,:)*SFRWL(6)
	2903	falb2=falb2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
	2904	end select
	2905	!albedo SB <<<
	2906
	2907
	2908	CALL evappot(klon,nbsrf,ftsol,pplay(:,1),cdragh, &
	2909	t_seri(:,1),q_seri(:,1),u_seri(:,1),v_seri(:,1),evap_pot)
	2910
	2911
	2912	IF (ip_ebil_phy.ge.2) THEN
	2913	ztit='after surface_main'
	2914	CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
	2915	, t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
	2916	, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec &
	2917	!#ifdef ISO
	2918	! & , xt_seri,xtl_seri,xts_seri,d_xtw, d_xtl, d_xts &
	2919	!#endif
	2920	& )
	2921	call diagphy(cell_area,ztit,ip_ebil_phy &
	2922	, zero_v, zero_v, zero_v, zero_v, sens &
	2923	, evap , zero_v, zero_v, ztsol &
	2924	, d_h_vcol, d_qt, d_ec &
	2925	, fs_bound, fq_bound )
	2926	END IF
	2927
	2928	ENDIF
	2929	! =================================================================== c
	2930	! Calcul de Qsat
	2931
	2932	DO k = 1, klev
	2933	DO i = 1, klon
	2934	zx_t = t_seri(i,k)
	2935	IF (thermcep) THEN
	2936	zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
	2937	zx_qs = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
	2938	zx_qs = MIN(0.5,zx_qs)
	2939	zcor = 1./(1.-retv*zx_qs)
	2940	zx_qs = zx_qs*zcor
	2941	ELSE
	2942	!! IF (zx_t.LT.t_coup) THEN !jyg
	2943	IF (zx_t.LT.rtt) THEN !jyg
	2944	zx_qs = qsats(zx_t)/pplay(i,k)
	2945	ELSE
	2946	zx_qs = qsatl(zx_t)/pplay(i,k)
	2947	ENDIF
	2948	ENDIF
	2949	zqsat(i,k)=zx_qs
	2950	ENDDO
	2951	ENDDO
	2952
	2953	if (prt_level.ge.1) then
	2954	write(lunout,*) 'L qsat (g/kg) avant clouds_gno'
	2955	write(lunout,'(i4,f15.4)') (k,1000.*zqsat(igout,k),k=1,klev)
	2956	endif
	2957	!
	2958	! Appeler la convection (au choix)
	2959	!
	2960	DO k = 1, klev
	2961	DO i = 1, klon
	2962	conv_q(i,k) = d_q_dyn(i,k) &
	2963	+ d_q_vdf(i,k)/dtime
	2964	conv_t(i,k) = d_t_dyn(i,k) &
	2965	+ d_t_vdf(i,k)/dtime
	2966	ENDDO
	2967	ENDDO
	2968	IF (check) THEN
	2969	za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
	2970	WRITE(lunout,*) "avantcon=", za
	2971	ENDIF
	2972	zx_ajustq = .FALSE.
	2973	IF (iflag_con.EQ.2) zx_ajustq=.TRUE.
	2974	IF (zx_ajustq) THEN
	2975	DO i = 1, klon
	2976	z_avant(i) = 0.0
	2977	ENDDO
	2978	DO k = 1, klev
	2979	DO i = 1, klon
	2980	z_avant(i) = z_avant(i) + (q_seri(i,k)+ql_seri(i,k)) &
	2981	*(paprs(i,k)-paprs(i,k+1))/RG
	2982	ENDDO
	2983	ENDDO
	2984	ENDIF
	2985
	2986	! Calcule de vitesse verticale a partir de flux de masse verticale
	2987	DO k = 1, klev
	2988	DO i = 1, klon
	2989	omega(i,k) = RG*flxmass_w(i,k) / cell_area(i)
	2990	END DO
	2991	END DO
	2992	if (prt_level.ge.1) write(lunout,*) 'omega(igout, :) = ', &
	2993	omega(igout, :)
	2994
	2995	IF (iflag_con.EQ.1) THEN
	2996	abort_message ='reactiver le call conlmd dans physiq.F'
	2997	CALL abort_physic (modname,abort_message,1)
	2998	! CALL conlmd (dtime, paprs, pplay, t_seri, q_seri, conv_q,
	2999	! . d_t_con, d_q_con,
	3000	! . rain_con, snow_con, ibas_con, itop_con)
	3001	ELSE IF (iflag_con.EQ.2) THEN
	3002	#ifdef ISO
	3003	CALL abort_gcm('physiq 2770','isos pas prevus ici',1)
	3004	#endif
	3005	CALL conflx(dtime, paprs, pplay, t_seri, q_seri, &
	3006	conv_t, conv_q, -evap, omega, &
	3007	d_t_con, d_q_con, rain_con, snow_con, &
	3008	pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
	3009	kcbot, kctop, kdtop, pmflxr, pmflxs)
	3010	d_u_con = 0.
	3011	d_v_con = 0.
	3012
	3013
	3014	WHERE (rain_con < 0.) rain_con = 0.
	3015	WHERE (snow_con < 0.) snow_con = 0.
	3016	DO i = 1, klon
	3017	ibas_con(i) = klev+1 - kcbot(i)
	3018	itop_con(i) = klev+1 - kctop(i)
	3019	ENDDO
	3020	ELSE IF (iflag_con.GE.3) THEN
	3021	! nb of tracers for the KE convection:
	3022	! MAF la partie traceurs est faite dans phytrac
	3023	! on met ntra=1 pour limiter les appels mais on peut
	3024	! supprimer les calculs / ftra.
	3025
	3026	#ifdef ISOVERIF
	3027	do k = 1, klev
	3028	do i = 1, klon
	3029	call iso_verif_positif(q_seri(i,k),'physic 2929')
	3030	enddo
	3031	enddo
	3032	#endif
	3033	#ifdef ISO
	3034	#ifdef ISOVERIF
	3035	write(,) 'physiq 2877'
	3036	call iso_verif_noNaN_vect2D( &
	3037	& wake_deltaxt, &
	3038	& 'physiq 2704c, wake_deltaxt',ntraciso,klon,klev)
	3039	do k = 1, klev
	3040	do i = 1, klon
	3041	do ixt=1,ntraciso
	3042	call iso_verif_noNaN(xt_seri(ixt,i,k),'physiq 2757')
	3043	enddo ! do ixt=1,ntraciso
	3044	enddo !do i = 1, klon
	3045	enddo !do k = 1, klev
	3046	#endif
	3047	#ifdef ISOVERIF
	3048	if (iso_eau.gt.0) then
	3049	call iso_verif_egalite_vect2D( &
	3050	& xt_seri,q_seri, &
	3051	& 'physiq 2704a, avant calcul undi',ntraciso,klon,klev)
	3052	call iso_verif_egalite_vect2D( &
	3053	& wake_deltaxt,wake_deltaq, &
	3054	& 'physiq 2704b, wake_deltaq',ntraciso,klon,klev)
	3055	endif
	3056	if (iso_HDO.gt.0) then
	3057	call iso_verif_aberrant_enc_vect2D( &
	3058	& xt_seri,q_seri, &
	3059	& 'physiq 2709, avant calcul undi',ntraciso,klon,klev)
	3060	! call iso_verif_aberrant_vect2D_ns(
	3061	! : wake_deltaxt,wake_deltaq,
	3062	! : 'physiq 2709b, wake_deltaq',ntraciso,klon,klev)
	3063	endif
	3064	if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
	3065	do k = 1, klev
	3066	do i = 1, klon
	3067	if (q_seri(i,k).gt.ridicule) then
	3068	if (iso_verif_o18_aberrant_nostop( &
	3069	& xt_seri(iso_HDO,i,k)/q_seri(i,k), &
	3070	& xt_seri(iso_O18,i,k)/q_seri(i,k), &
	3071	& 'physiq 2947, avant calcul undi').eq.1) then
	3072	write(,) 'i,k,q_seri(i,k)=',i,k,q_seri(i,k)
	3073	stop
	3074	endif ! if (iso_verif_o18_aberrant_nostop
	3075	endif !if (q_seri(i,k).gt.errmax) then
	3076	enddo !do i = 1, klon
	3077	enddo !do k = 1, klev
	3078	endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
	3079	#endif
	3080	#endif
	3081
	3082	ntra = 1
	3083
	3084	!=======================================================================
	3085	!ajout pour la parametrisation des poches froides: calcul de
	3086	!t_wake et t_undi: si pas de poches froides, t_wake=t_undi=t_seri
	3087	do k=1,klev
	3088	do i=1,klon
	3089	if (iflag_wake>=1) then
	3090	t_wake(i,k) = t_seri(i,k) &
	3091	+(1-wake_s(i))*wake_deltat(i,k)
	3092	q_wake(i,k) = q_seri(i,k) &
	3093	+(1-wake_s(i))*wake_deltaq(i,k)
	3094	t_undi(i,k) = t_seri(i,k) &
	3095	-wake_s(i)*wake_deltat(i,k)
	3096	q_undi(i,k) = q_seri(i,k) &
	3097	-wake_s(i)*wake_deltaq(i,k)
	3098	#ifdef ISO
	3099	do ixt=1,ntraciso
	3100	xt_wake(ixt,i,k) = xt_seri(ixt,i,k) &
	3101	& +(1-wake_s(i))*wake_deltaxt(ixt,i,k)
	3102	xt_undi(ixt,i,k) = xt_seri(ixt,i,k) &
	3103	& -wake_s(i)*wake_deltaxt(ixt,i,k)
	3104	enddo !do ixt=1,ntraciso
	3105	#endif
	3106	else
	3107	t_wake(i,k) = t_seri(i,k)
	3108	q_wake(i,k) = q_seri(i,k)
	3109	t_undi(i,k) = t_seri(i,k)
	3110	q_undi(i,k) = q_seri(i,k)
	3111	#ifdef ISO
	3112	do ixt=1,ntraciso
	3113	xt_wake(ixt,i,k) =xt_seri(ixt,i,k)
	3114	xt_undi(ixt,i,k) =xt_seri(ixt,i,k)
	3115	enddo !do ixt=1,ntraciso
	3116	#endif
	3117	endif
	3118	enddo
	3119	enddo
	3120
	3121
	3122	#ifdef ISO
	3123	#ifdef ISOVERIF
	3124	write(,) 'physiq tmp 2952'
	3125	if (iso_eau.gt.0) then
	3126	call iso_verif_egalite_vect2D( &
	3127	& xt_wake,q_wake, &
	3128	& 'physiq 2744, calcul wake',ntraciso,klon,klev)
	3129	call iso_verif_egalite_vect2D( &
	3130	& xt_undi,q_undi, &
	3131	& 'physiq 2734, calcul undi',ntraciso,klon,klev)
	3132	endif
	3133	if (iso_HDO.gt.0) then
	3134	call iso_verif_aberrant_vect2D( &
	3135	& xt_wake,q_wake, &
	3136	& 'physiq 2749, calcul wake',ntraciso,klon,klev)
	3137	call iso_verif_aberrant_vect2D( &
	3138	& xt_undi,q_undi, &
	3139	& 'physiq 2739, calcul undi',ntraciso,klon,klev)
	3140	endif
	3141	#endif
	3142	#endif
	3143
	3144	#ifdef ISO
	3145	if (iflag_wake>=1) then
	3146	if (ok_bidouille_wake.eq.1) then
	3147	! if (essai_convergence) then
	3148	! else !if (essai_convergence) then
	3149	! on évite les q_undi négatifs
	3150
	3151	DO k=1,klev
	3152	DO i=1,klon
	3153	if (q_undi(i,k).lt.seuil_q_undi) then
	3154	wake_deltaq_prec(i,k)=wake_deltaq(i,k)
	3155	wake_deltaq(i,k)=(q_seri(i,k)-seuil_q_undi)/wake_s(i)
	3156	q_undi(i,k) = q_seri(i,k) &
	3157	& -wake_s(i)*wake_deltaq(i,k)
	3158	q_wake(i,k) = q_seri(i,k) &
	3159	& +(1-wake_s(i))*wake_deltaq(i,k)
	3160	do ixt=1,ntraciso
	3161	wake_deltaxt(ixt,i,k)=wake_deltaq(i,k) &
	3162	& *wake_deltaxt(ixt,i,k)/wake_deltaq_prec(i,k)
	3163	xt_wake(ixt,i,k) = xt_seri(ixt,i,k) &
	3164	& +(1-wake_s(i))*wake_deltaxt(ixt,i,k)
	3165	xt_undi(ixt,i,k) = xt_seri(ixt,i,k) &
	3166	& -wake_s(i)*wake_deltaxt(ixt,i,k)
	3167	enddo !do ixt=1,ntraciso
	3168	#ifdef ISOVERIF
	3169	! write(,) 'physiq 348: q_undi<0: i,k=',i,k
	3170	! write(,) 'wake_deltaq_prec=',wake_deltaq_prec(i,k)
	3171	! write(,) 'q_seri=',q_seri(i,k)
	3172	! write(,) 'wake_s=',wake_s(i)
	3173	do ixt=1,ntraciso
	3174	call iso_verif_noNaN(xt_undi(ixt,i,k), &
	3175	& 'physiq 288a')
	3176	enddo !do ixt=1,ntraciso
	3177	#endif
	3178	#ifdef ISOVERIF
	3179	if (iso_eau.gt.0) then
	3180	call iso_verif_egalite(wake_deltaq(i,k), &
	3181	& wake_deltaxt(iso_eau,i,k),'physiq 3070')
	3182	call iso_verif_egalite(q_undi(i,k), &
	3183	& xt_undi(iso_eau,i,k),'physiq 3073')
	3184	endif
	3185	#endif
	3186	endif !if (wake_deltaq(i,l).gt.q(i,l)/sigmaw(i)) then
	3187	enddo !DO i=1,klon
	3188	enddo !DO l=1,klev
	3189	endif !if (ok_bidouille_wake.eq.1) then
	3190	endif !if (iflag_wake>=1) then
	3191	#endif
	3192	! endif !if (essai_convergence) then
	3193
	3194
	3195	!
	3196	!jyg<
	3197	! Perform dry adiabatic adjustment on wake profile
	3198	! The corresponding tendencies are added to the convective tendencies
	3199	! after the call to the convective scheme.
	3200	IF (iflag_wake>=1) then
	3201	IF (ok_adjwk) THEN
	3202	limbas(:) = 1
	3203	CALL ajsec(paprs, pplay, t_wake, q_wake, limbas, &
	3204	d_t_adjwk, d_q_adjwk &
	3205	#ifdef ISO
	3206	& ,xt_wake,d_xt_adjwk &
	3207	#endif
	3208	& )
	3209	ENDIF
	3210	!
	3211	DO k=1,klev
	3212	DO i=1,klon
	3213	IF (wake_s(i) .GT. 1.e-3) THEN
	3214	t_wake(i,k) = t_wake(i,k) + d_t_adjwk(i,k)
	3215	q_wake(i,k) = q_wake(i,k) + d_q_adjwk(i,k)
	3216	wake_deltat(i,k) = wake_deltat(i,k) + d_t_adjwk(i,k)
	3217	wake_deltaq(i,k) = wake_deltaq(i,k) + d_q_adjwk(i,k)
	3218	#ifdef ISO
	3219	do ixt=1,ntraciso
	3220	xt_wake(ixt,i,k) = xt_wake(ixt,i,k) + d_xt_adjwk(ixt,i,k)
	3221	wake_deltaxt(ixt,i,k) = wake_deltaxt(ixt,i,k) + d_xt_adjwk(ixt,i,k)
	3222	enddo
	3223	#endif
	3224	ENDIF
	3225	ENDDO
	3226	ENDDO
	3227	ENDIF ! (iflag_wake>=1)
	3228	!>jyg
	3229	!
	3230	!jyg<
	3231	CALL alpale( debut, itap, dtime, paprs, omega, t_seri, &
	3232	alp_offset, it_wape_prescr, wape_prescr, fip_prescr, &
	3233	ale_bl_prescr, alp_bl_prescr, &
	3234	wake_pe, wake_fip, &
	3235	Ale_bl, Ale_bl_trig, Alp_bl, &
	3236	Ale, Alp , Ale_wake, Alp_wake)
	3237	!>jyg
	3238	!
	3239	! sb, oct02:
	3240	! Schema de convection modularise et vectorise:
	3241	! (driver commun aux versions 3 et 4)
	3242	!
	3243	IF (ok_cvl) THEN ! new driver for convectL
	3244	!
	3245
	3246	#ifdef ISO
	3247	#ifdef ISOVERIF
	3248	write(,) 'physiq tmp 3076'
	3249	do k=1,klev
	3250	do i=1,klon
	3251	! call iso_verif_positif(370.0-t_seri(i,k),
	3252	! : 'physiq 2872, avant concvl')
	3253	call iso_verif_positif(t_seri(i,k)-100.0, &
	3254	& 'physiq 2873, avant concvl')
	3255	enddo
	3256	enddo
	3257	#endif
	3258	#ifdef ISOVERIF
	3259	!write(,) 'physic 2553: avant appel concvl'
	3260	!write(,) 'klon=',klon
	3261	do k = 1, klev
	3262	do i = 1, klon
	3263	do ixt=1,ntraciso
	3264	call iso_verif_noNaN(xt_seri(ixt,i,k),'physiq 2925a')
	3265	call iso_verif_noNaN(xt_undi(ixt,i,k),'physiq 2925b')
	3266	enddo ! do ixt=1,ntraciso
	3267	enddo !do i = 1, klon
	3268	enddo !do k = 1, klev
	3269	#endif
	3270	#ifdef ISOVERIF
	3271	do k = 1, klev
	3272	do i = 1, klon
	3273	call iso_verif_positif(q_seri(i,k),'physic 3133a')
	3274	call iso_verif_positif(q_undi(i,k),'physic 3133b')
	3275	enddo
	3276	enddo
	3277	if (iso_eau.gt.0) then
	3278	do k = 1, klev
	3279	do i = 1, klon
	3280	call iso_verif_egalite_choix( &
	3281	& xt_seri(iso_eau,i,k),q_seri(i,k), &
	3282	& 'physic 2559',errmax,errmaxrel)
	3283	call iso_verif_egalite_choix( &
	3284	& xt_undi(iso_eau,i,k),q_undi(i,k), &
	3285	& 'physic 2559b',errmax,errmaxrel)
	3286	enddo !do i = 1, klon
	3287	enddo !do k = 1, klev
	3288	endif !if (iso_eau.gt.0) then
	3289	if (iso_HDO.gt.0) then
	3290	do k = 1, klev
	3291	do i = 1, klon
	3292	if (q_seri(i,k).gt.ridicule) then
	3293	call iso_verif_aberrant_encadre( &
	3294	& xt_seri(iso_hdo,i,k)/q_seri(i,k), &
	3295	& 'physic 2657')
	3296	endif !if (q_seri(i,k).gt.ridicule) then
	3297	enddo !do i = 1, klon
	3298	enddo !do k = 1, klev
	3299	endif !if (iso_HDO.gt.0) then
	3300	if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
	3301	do k = 1, klev
	3302	do i = 1, klon
	3303	if (q_seri(i,k).gt.ridicule) then
	3304	call iso_verif_O18_aberrant( &
	3305	& xt_seri(iso_HDO,i,k)/q_seri(i,k), &
	3306	& xt_seri(iso_O18,i,k)/q_seri(i,k), &
	3307	& 'physiq 3285')
	3308	endif ! if (q_seri(i,k).gt.ridicule) then
	3309	enddo
	3310	enddo
	3311	endif ! if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
	3312	if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
	3313	do i=1,klon
	3314	do k=1,nlev
	3315	if ((q_seri(i,k).gt.ridicule).and.(l.lt.nlevmaxO17)) then
	3316	call iso_verif_aberrant_o17(xt_seri(iso_o17,i,k) &
	3317	& /q_seri(i,k),xt_seri(iso_o18,i,k) &
	3318	& /q_seri(i,k),'physiq 2781: avat clmain')
	3319	endif !if (q_seri(i,k).gt.ridicule) then
	3320	enddo
	3321	enddo
	3322	endif ! if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
	3323	#ifdef ISOTRAC
	3324	do i=1,klon
	3325	do k=1,nlev
	3326	call iso_verif_traceur(xt_seri(1,i,k),'physiq 2975')
	3327	if (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k), &
	3328	& 'physiq 3060, avantconcvl',1e-5) &
	3329	& .eq.1) then
	3330	write(,) 'i,k=',i,k
	3331	!#ifdef ISOVERIF
	3332	stop
	3333	!#endif
	3334	endif !if (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k),
	3335	if (option_tmin.eq.1) then
	3336	call iso_verif_trac17_q_deltaD(xt_seri(1,i,k), &
	3337	& 'physiq 1456, avant concvl')
	3338	endif
	3339	! call iso_verif_tracpos_choix(xt_seri(1,i,k),
	3340	! : 'physiq 3060, avantconcvl',1e-5)
	3341	enddo !do k=1,nlev
	3342	enddo !do i=1,klon
	3343	#endif
	3344	! write(,) 'physiq 2585: appel de concvl'
	3345	#endif
	3346	!ISOVERIF
	3347	if ((bidouille_anti_divergence).and. &
	3348	& (iso_eau.gt.0)) then
	3349	do k=1,klev
	3350	do i=1,klon
	3351	xt_seri(iso_eau,i,k)= q_seri(i,k)
	3352	xt_undi(iso_eau,i,k)= q_undi(i,k)
	3353	enddo !do i=1,klon
	3354	enddo !do k=1,klev
	3355	endif !if ((bidouille_anti_divergence).and. &
	3356	#endif
	3357	!ISO
	3358	!jyg<
	3359	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	3360	! Calculate the upmost level of deep convection loops: k_upper_cv
	3361	! (near 22 km)
	3362	izero = klon/2+1/klon
	3363	k_upper_cv = klev
	3364	DO k = klev,1,-1
	3365	IF (pphi(izero,k) > 22.e4) k_upper_cv = k
	3366	ENDDO
	3367	IF (prt_level .ge. 5) THEN
	3368	Print *, 'upmost level of deep convection loops: k_upper_cv = ', &
	3369	k_upper_cv
	3370	ENDIF
	3371	!
	3372	!>jyg
	3373	IF (type_trac == 'repr') THEN
	3374	nbtr_tmp=ntra
	3375	ELSE
	3376	nbtr_tmp=nbtr
	3377	END IF
	3378	!jyg iflag_con est dans clesphys
	3379	!c CALL concvl (iflag_con,iflag_clos,
	3380	CALL concvl (iflag_clos, &
	3381	dtime, paprs, pplay, k_upper_cv, t_undi,q_undi, &
	3382	t_wake,q_wake,wake_s, &
	3383	u_seri,v_seri,tr_seri,nbtr_tmp, &
	3384	ALE,ALP, &
	3385	sig1,w01, &
	3386	d_t_con,d_q_con,d_u_con,d_v_con,d_tr, &
	3387	rain_con, snow_con, ibas_con, itop_con, sigd, &
	3388	ema_cbmf,plcl,plfc,wbeff,upwd,dnwd,dnwd0, &
	3389	Ma,mip,Vprecip,cape,cin,tvp,Tconv,iflagctrl, &
	3390	pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,qcondc,wd, &
	3391	! RomP >>>
	3392	!! . pmflxr,pmflxs,da,phi,mp,
	3393	!! . ftd,fqd,lalim_conv,wght_th)
	3394	pmflxr,pmflxs,da,phi,mp,phi2,d1a,dam,sij,clw,elij, &
	3395	ftd,fqd,lalim_conv,wght_th, &
	3396	ev, ep,epmlmMm,eplaMm, &
	3397	wdtrainA,wdtrainM,wght_cvfd,qtc_cv,sigt_cv, &
	3398	tau_cld_cv,coefw_cld_cv,epmax_diag &
	3399	#ifdef ISO
	3400	& ,xt_undi,xt_wake,d_xt_con,xtrain_con,xtsnow_con,fxtd &
	3401	& ,xtVprecip,xtVprecipi &
	3402	#ifdef DIAGISO
	3403	& , qlp,xtlp,qvp,xtvp,xtev,xtclw & ! juste diagnostique
	3404	& , wdtrain,xtwdtrain,tadiab &
	3405	& , taux_cond_conv &
	3406	& , fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
	3407	& , fxt_detrainement,fxt_ddft,fxt_fluxmasse &
	3408	& , fxt_evapprecip,Mi,Amp_diag,tcond,&
	3409	& , f_detrainement,q_detrainement,xt_detrainement &
	3410	#endif
	3411	#endif
	3412	& )
	3413	! RomP <<<
	3414
	3415	#ifdef ISO
	3416	#ifdef ISOVERIF
	3417	! write(,) 'q_detrainement(1,:)=',q_detrainement(1,:)
	3418	call iso_verif_noNaN_vect2D(d_xt_con, &
	3419	& 'physiq 3203a apres conv',ntraciso,klon,klev)
	3420	call iso_verif_noNaN_vect2D(xt_seri, &
	3421	& 'physiq 3203b apres conv',ntraciso,klon,klev)
	3422	#endif
	3423	#ifdef ISOVERIF
	3424	#ifdef ISOTRAC
	3425	call iso_verif_trac_masse_vect(d_xt_con,klon,klev, &
	3426	& 'physiq 3003 apres tend concvl', &
	3427	& errmax,errmaxrel)
	3428	call iso_verif_traceur_vect(xt_seri,klon,klev, &
	3429	& 'physiq 3005 apres tend concvl')
	3430	#endif
	3431	#endif
	3432	#endif
	3433
	3434	!IM begin
	3435	! print*,'physiq: cin pbase dnwd0 ftd fqd ',cin(1),pbase(1),
	3436	! .dnwd0(1,1),ftd(1,1),fqd(1,1)
	3437	!IM end
	3438	!IM cf. FH
	3439	clwcon0=qcondc
	3440	pmfu(:,:)=upwd(:,:)+dnwd(:,:)
	3441
	3442	do i = 1, klon
	3443	if (iflagctrl(i).le.1) itau_con(i)=itau_con(i)+1
	3444	enddo
	3445	!
	3446	!jyg<
	3447	! Add the tendency due to the dry adjustment of the wake profile
	3448	IF (iflag_wake>=1) THEN
	3449	DO k=1,klev
	3450	DO i=1,klon
	3451	ftd(i,k) = ftd(i,k) + wake_s(i)*d_t_adjwk(i,k)/dtime
	3452	fqd(i,k) = fqd(i,k) + wake_s(i)*d_q_adjwk(i,k)/dtime
	3453	d_t_con(i,k) = d_t_con(i,k) + wake_s(i)*d_t_adjwk(i,k)
	3454	d_q_con(i,k) = d_q_con(i,k) + wake_s(i)*d_q_adjwk(i,k)
	3455	#ifdef ISO
	3456	do ixt=1,ntraciso
	3457	fxtd(ixt,i,k) = fxtd(ixt,i,k) + wake_s(i)*d_xt_adjwk(ixt,i,k)/dtime
	3458	d_xt_con(ixt,i,k) = d_xt_con(ixt,i,k) + wake_s(i)*d_xt_adjwk(ixt,i,k)
	3459	enddo
	3460	#endif
	3461	ENDDO
	3462	ENDDO
	3463	ENDIF
	3464	!>jyg
	3465	!
	3466	ELSE ! ok_cvl
	3467
	3468	! MAF conema3 ne contient pas les traceurs
	3469	#ifdef ISO
	3470	CALL abort_gcm('physiq 3198','isos pas prevus ici',1)
	3471	#endif
	3472	CALL conema3 (dtime, &
	3473	paprs,pplay,t_seri,q_seri, &
	3474	u_seri,v_seri,tr_seri,ntra, &
	3475	sig1,w01, &
	3476	d_t_con,d_q_con,d_u_con,d_v_con,d_tr, &
	3477	rain_con, snow_con, ibas_con, itop_con, &
	3478	upwd,dnwd,dnwd0,bas,top, &
	3479	Ma,cape,tvp,rflag, &
	3480	pbase &
	3481	,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr &
	3482	,clwcon0)
	3483
	3484	ENDIF ! ok_cvl
	3485
	3486	!
	3487	! Correction precip
	3488	rain_con = rain_con * cvl_corr
	3489	snow_con = snow_con * cvl_corr
	3490	#ifdef ISO
	3491	xtrain_con = xtrain_con * cvl_corr
	3492	xtsnow_con = xtsnow_con * cvl_corr
	3493	#endif
	3494	!
	3495
	3496	IF (.NOT. ok_gust) THEN
	3497	do i = 1, klon
	3498	wd(i)=0.0
	3499	enddo
	3500	ENDIF
	3501
	3502	! =================================================================== c
	3503	! Calcul des proprietes des nuages convectifs
	3504	!
	3505
	3506	! calcul des proprietes des nuages convectifs
	3507	clwcon0(:,:)=fact_cldcon*clwcon0(:,:)
	3508	IF (iflag_cld_cv == 0) THEN
	3509	call clouds_gno &
	3510	(klon,klev,q_seri,zqsat,clwcon0,ptconv,ratqsc,rnebcon0)
	3511	ELSE
	3512	call clouds_bigauss &
	3513	(klon,klev,q_seri,zqsat,qtc_cv,sigt_cv,ptconv,ratqsc,rnebcon0)
	3514	ENDIF
	3515
	3516
	3517	! =================================================================== c
	3518
	3519	DO i = 1, klon
	3520	itop_con(i) = min(max(itop_con(i),1),klev)
	3521	ibas_con(i) = min(max(ibas_con(i),1),itop_con(i))
	3522	ENDDO
	3523
	3524	DO i = 1, klon
	3525	#ifdef CAMMODIF
	3526	! camille: pour éviter pb de dépassement d'indice dans les cas
	3527	! où i n'est pas un point convectif et donc ibas_con(i)=0
	3528	! c'est un pb indépendant des isotopes
	3529	if (ibas_con(i).gt.0) then
	3530	#endif
	3531	ema_pcb(i) = paprs(i,ibas_con(i))
	3532	#ifdef CAMMODIF
	3533	else ! if (ibas_con(i).gt.0) then
	3534	ema_pcb(i) = 0.0
	3535	endif ! if (ibas_con(i).gt.0) then
	3536	#endif
	3537	ENDDO
	3538	DO i = 1, klon
	3539	! L'idicage de itop_con peut cacher un pb potentiel
	3540	! FH sous la dictee de JYG, CR
	3541	ema_pct(i) = paprs(i,itop_con(i)+1)
	3542
	3543	if (itop_con(i).gt.klev-3) then
	3544	if(prt_level >= 9) then
	3545	write(lunout,*)'La convection monte trop haut '
	3546	write(lunout,*)'itop_con(,',i,',)=',itop_con(i)
	3547	endif
	3548	endif
	3549	ENDDO
	3550	ELSE IF (iflag_con.eq.0) THEN
	3551	write(lunout,*) 'On n appelle pas la convection'
	3552	clwcon0=0.
	3553	rnebcon0=0.
	3554	d_t_con=0.
	3555	d_q_con=0.
	3556	d_u_con=0.
	3557	d_v_con=0.
	3558	rain_con=0.
	3559	snow_con=0.
	3560	bas=1
	3561	top=1
	3562	#ifdef ISO
	3563	d_xt_con=0.
	3564	xtrain_con=0.
	3565	xtsnow_con=0.
	3566	#endif
	3567	ELSE
	3568	WRITE(lunout,*) "iflag_con non-prevu", iflag_con
	3569	call abort_physic("physiq", "", 1)
	3570	ENDIF
	3571
	3572	! CALL homogene(paprs, q_seri, d_q_con, u_seri,v_seri,
	3573	! . d_u_con, d_v_con)
	3574
	3575	CALL add_phys_tend(d_u_con, d_v_con, d_t_con, d_q_con, dql0, dqi0, paprs, &
	3576	'convection',abortphy,flag_inhib_tend &
	3577	#ifdef ISO
	3578	& ,d_xt_con,dxtl0,dxti0 &
	3579	#endif
	3580	& )
	3581
	3582
	3583	#ifdef ISO
	3584	#ifdef ISOVERIF
	3585	if (iso_HDO.gt.0) then
	3586	call iso_verif_aberrant_enc_vect2D( &
	3587	& xt_seri,q_seri, &
	3588	& 'physiq 3588: juste apres add_phys_tend',ntraciso,klon,klev)
	3589	endif
	3590	if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
	3591	call iso_verif_O18_aberrant_enc_vect2D( &
	3592	& xt_seri,q_seri, &
	3593	& 'physiq 3588b',ntraciso,klon,klev)
	3594	endif
	3595	#endif
	3596	#endif
	3597
	3598	!-------------------------------------------------------------------------
	3599
	3600	if (mydebug) then
	3601	call writefield_phy('u_seri',u_seri,nbp_lev)
	3602	call writefield_phy('v_seri',v_seri,nbp_lev)
	3603	call writefield_phy('t_seri',t_seri,nbp_lev)
	3604	call writefield_phy('q_seri',q_seri,nbp_lev)
	3605	endif
	3606
	3607	!IM
	3608	IF (ip_ebil_phy.ge.2) THEN
	3609	ztit='after convect'
	3610	CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
	3611	, t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
	3612	, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec &
	3613	!#ifdef ISO
	3614	! & , xt_seri,xtl_seri,xts_seri,d_xtw, d_xtl, d_xts &
	3615	!#endif
	3616	& )
	3617	call diagphy(cell_area,ztit,ip_ebil_phy &
	3618	, zero_v, zero_v, zero_v, zero_v, zero_v &
	3619	, zero_v, rain_con, snow_con, ztsol &
	3620	, d_h_vcol, d_qt, d_ec &
	3621	, fs_bound, fq_bound )
	3622	END IF
	3623	!
	3624	IF (check) THEN
	3625	za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
	3626	WRITE(lunout,*)"aprescon=", za
	3627	#ifdef ISO
	3628	do ixt=1,ntraciso
	3629	DO k = 1, klev
	3630	DO i = 1, klon
	3631	xt_iso(i,k)=xt_seri(ixt,i,k)
	3632	xtl_iso(i,k)=xtl_seri(ixt,i,k)
	3633	enddo
	3634	enddo
	3635	zxta(ixt)= qcheck(klon,klev,paprs,xt_iso,xtl_iso,cell_area)
	3636	WRITE(lunout,*)"aprescon: ixt: ",ixt, zxta(ixt)
	3637	enddo
	3638	#endif
	3639	zx_t = 0.0
	3640	za = 0.0
	3641	DO i = 1, klon
	3642	za = za + cell_area(i)/REAL(klon)
	3643	zx_t = zx_t + (rain_con(i)+ &
	3644	snow_con(i))*cell_area(i)/REAL(klon)
	3645	ENDDO
	3646	zx_t = zx_t/za*dtime
	3647	WRITE(lunout,*)"Precip=", zx_t
	3648	ENDIF
	3649	IF (zx_ajustq) THEN
	3650	DO i = 1, klon
	3651	z_apres(i) = 0.0
	3652	#ifdef ISO
	3653	zxt_apres = 0.0
	3654	#endif
	3655	ENDDO
	3656	DO k = 1, klev
	3657	DO i = 1, klon
	3658	z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k)) &
	3659	*(paprs(i,k)-paprs(i,k+1))/RG
	3660	ENDDO
	3661	ENDDO
	3662	#ifdef ISO
	3663	DO k = 1, klev
	3664	DO i = 1, klon
	3665	do ixt=1,ntraciso
	3666	zxt_apres(ixt,i) = zxt_apres(ixt,i) &
	3667	& + (xt_seri(ixt,i,k)+xtl_seri(ixt,i,k)) &
	3668	& *(paprs(i,k)-paprs(i,k+1))/RG
	3669	enddo ! do ixt=1,niso
	3670	ENDDO
	3671	ENDDO
	3672	#endif
	3673	DO i = 1, klon
	3674	z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*dtime) &
	3675	/z_apres(i)
	3676	ENDDO
	3677	#ifdef ISO
	3678	DO i = 1, klon
	3679	do ixt=1,ntraciso
	3680	zxt_factor(ixt,i) = (zxt_avant(ixt,i)-(xtrain_con(ixt,i) &
	3681	& +xtsnow_con(ixt,i))*dtime)/zxt_apres(ixt,i)
	3682	enddo ! do ixt=1,niso
	3683	ENDDO
	3684	#endif
	3685	DO k = 1, klev
	3686	DO i = 1, klon
	3687	IF (z_factor(i).GT.(1.0+1.0E-08) .OR. &
	3688	z_factor(i).LT.(1.0-1.0E-08)) THEN
	3689	q_seri(i,k) = q_seri(i,k) * z_factor(i)
	3690	#ifdef ISO
	3691	do ixt=1,ntraciso
	3692	xt_seri(ixt,i,k)=xt_seri(ixt,i,k)*zxt_factor(ixt,i)
	3693	enddo ! do ixt=1,niso
	3694	#endif
	3695	ENDIF
	3696	ENDDO
	3697	ENDDO
	3698	ENDIF
	3699	zx_ajustq=.FALSE.
	3700
	3701	#ifdef ISO
	3702	#ifdef ISOVERIF
	3703	write(,) 'physiq 3425'
	3704	if (iso_HDO.gt.0) then
	3705	call iso_verif_aberrant_enc_vect2D( &
	3706	& xt_seri,q_seri, &
	3707	& 'physiq 3691a',ntraciso,klon,klev)
	3708	endif
	3709	if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
	3710	call iso_verif_O18_aberrant_enc_vect2D( &
	3711	& xt_seri,q_seri, &
	3712	& 'physiq 3691a',ntraciso,klon,klev)
	3713	endif
	3714	#ifdef ISOTRAC
	3715	call iso_verif_traceur_vect(xt_seri,klon,klev, &
	3716	& 'physiq 3386 avant wakes')
	3717	#endif
	3718	#endif
	3719	#endif
	3720
	3721	!
	3722	!==========================================================================
	3723	!RR:Evolution de la poche froide: on ne fait pas de separation wake/env
	3724	!pour la couche limite diffuse pour l instant
	3725	!
	3726	!
	3727	! nrlmd le 22/03/2011---Si on met les poches hors des thermiques
	3728	! il faut rajouter cette tendance calcul\'ee hors des poches
	3729	! froides
	3730	!
	3731	if (iflag_wake>=1) then
	3732	DO k=1,klev
	3733	DO i=1,klon
	3734	dt_dwn(i,k) = ftd(i,k)
	3735	dq_dwn(i,k) = fqd(i,k)
	3736	M_dwn(i,k) = dnwd0(i,k)
	3737	M_up(i,k) = upwd(i,k)
	3738	dt_a(i,k) = d_t_con(i,k)/dtime - ftd(i,k)
	3739	dq_a(i,k) = d_q_con(i,k)/dtime - fqd(i,k)
	3740	#ifdef ISO
	3741	do ixt=1,ntraciso
	3742	dxt_dwn(ixt,i,k) = fxtd(ixt,i,k)
	3743	wdxt_PBL(ixt,i,k) = 0.
	3744	dxt_a(ixt,i,k) = d_xt_con(ixt,i,k)/dtime - fxtd(ixt,i,k)
	3745	udxt_PBL(ixt,i,k) = 0.
	3746	enddo !do ixt=1,ntraciso
	3747	#endif
	3748	ENDDO
	3749	ENDDO
	3750	!nrlmd+jyg<
	3751	DO k=1,klev
	3752	DO i=1,klon
	3753	wdt_PBL(i,k) = 0.
	3754	wdq_PBL(i,k) = 0.
	3755	udt_PBL(i,k) = 0.
	3756	udq_PBL(i,k) = 0.
	3757	#ifdef ISO
	3758	do ixt=1,ntraciso
	3759	wdxt_PBL(ixt,i,k) = 0.
	3760	udxt_PBL(ixt,i,k) = 0.
	3761	enddo
	3762	#endif
	3763	ENDDO
	3764	ENDDO
	3765	!
	3766	IF (mod(iflag_pbl_split,2) .EQ. 1) THEN
	3767	DO k=1,klev
	3768	DO i=1,klon
	3769	wdt_PBL(i,k) = wdt_PBL(i,k) + d_t_vdf_w(i,k)/dtime
	3770	wdq_PBL(i,k) = wdq_PBL(i,k) + d_q_vdf_w(i,k)/dtime
	3771	udt_PBL(i,k) = udt_PBL(i,k) + d_t_vdf_x(i,k)/dtime
	3772	udq_PBL(i,k) = udq_PBL(i,k) + d_q_vdf_x(i,k)/dtime
	3773	!! dt_dwn(i,k) = dt_dwn(i,k) + d_t_vdf_w(i,k)/dtime
	3774	!! dq_dwn(i,k) = dq_dwn(i,k) + d_q_vdf_w(i,k)/dtime
	3775	!! dt_a (i,k) = dt_a(i,k) + d_t_vdf_x(i,k)/dtime
	3776	!! dq_a (i,k) = dq_a(i,k) + d_q_vdf_x(i,k)/dtime
	3777	#ifdef ISO
	3778	do ixt=1,ntraciso
	3779	wdxt_PBL(ixt,i,k) = wdxt_PBL(ixt,i,k) + d_xt_vdf_w(ixt,i,k)/dtime
	3780	udxt_PBL(ixt,i,k) = udxt_PBL(ixt,i,k) + d_xt_vdf_x(ixt,i,k)/dtime
	3781	enddo
	3782	#endif
	3783	ENDDO
	3784	ENDDO
	3785	ENDIF
	3786	IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
	3787	DO k=1,klev
	3788	DO i=1,klon
	3789	!! dt_dwn(i,k) = dt_dwn(i,k) + 0.
	3790	!! dq_dwn(i,k) = dq_dwn(i,k) + 0.
	3791	!! dt_a(i,k) = dt_a(i,k) + d_t_ajs(i,k)/dtime
	3792	!! dq_a(i,k) = dq_a(i,k) + d_q_ajs(i,k)/dtime
	3793	udt_PBL(i,k) = udt_PBL(i,k) + d_t_ajs(i,k)/dtime
	3794	udq_PBL(i,k) = udq_PBL(i,k) + d_q_ajs(i,k)/dtime
	3795	#ifdef ISO
	3796	do ixt=1,ntraciso
	3797	udxt_PBL(ixt,i,k) = udxt_PBL(ixt,i,k) + d_xt_ajs(ixt,i,k)/dtime
	3798	enddo
	3799	#endif
	3800
	3801	ENDDO
	3802	ENDDO
	3803	ENDIF
	3804	!>nrlmd+jyg
	3805
	3806	IF (iflag_wake==2) THEN
	3807	ok_wk_lsp(:)=max(sign(1.,wake_s(:)-wake_s_min_lsp),0.)
	3808	DO k = 1,klev
	3809	dt_dwn(:,k)= dt_dwn(:,k)+ &
	3810	ok_wk_lsp(:)*(d_t_eva(:,k)+d_t_lsc(:,k))/dtime
	3811	dq_dwn(:,k)= dq_dwn(:,k)+ &
	3812	ok_wk_lsp(:)*(d_q_eva(:,k)+d_q_lsc(:,k))/dtime
	3813	#ifdef ISO
	3814	do ixt=1,ntraciso
	3815	dxt_dwn(ixt,:,k)= dxt_dwn(ixt,:,k)+ &
	3816	& ok_wk_lsp(:)*(d_xt_eva(ixt,:,k)+d_xt_lsc(ixt,:,k)) &
	3817	& /dtime
	3818	enddo !do ixt=1,ntraciso
	3819	#endif
	3820
	3821	ENDDO
	3822	ELSEIF (iflag_wake==3) THEN
	3823	ok_wk_lsp(:)=max(sign(1.,wake_s(:)-wake_s_min_lsp),0.)
	3824	DO k = 1,klev
	3825	DO i=1,klon
	3826	IF (rneb(i,k)==0.) THEN
	3827	! On ne tient compte des tendances qu'en dehors des
	3828	! nuages (c'est-\`a-dire a priri dans une region ou
	3829	! l'eau se reevapore).
	3830	dt_dwn(i,k)= dt_dwn(i,k)+ &
	3831	ok_wk_lsp(i)*d_t_lsc(i,k)/dtime
	3832	dq_dwn(i,k)= dq_dwn(i,k)+ &
	3833	ok_wk_lsp(i)*d_q_lsc(i,k)/dtime
	3834	#ifdef ISO
	3835	do ixt=1,ntraciso
	3836	dxt_dwn(ixt,:,k)= dxt_dwn(ixt,:,k)+ &
	3837	& ok_wk_lsp(:)*d_xt_lsc(ixt,:,k)/dtime
	3838	enddo !do ixt=1,ntraciso
	3839	#endif
	3840	ENDIF
	3841	ENDDO
	3842	ENDDO
	3843	ENDIF
	3844
	3845	!
	3846	!calcul caracteristiques de la poche froide
	3847	call calWAKE (paprs,pplay,dtime &
	3848	,t_seri,q_seri,omega &
	3849	,dt_dwn,dq_dwn,M_dwn,M_up &
	3850	,dt_a,dq_a,sigd &
	3851	,wdt_PBL,wdq_PBL &
	3852	,udt_PBL,udq_PBL &
	3853	,wake_deltat,wake_deltaq,wake_dth &
	3854	,wake_h,wake_s,wake_dens &
	3855	,wake_pe,wake_fip,wake_gfl &
	3856	,dt_wake,dq_wake &
	3857	,wake_k, t_undi,q_undi &
	3858	,wake_omgbdth,wake_dp_omgb &
	3859	,wake_dtKE,wake_dqKE &
	3860	,wake_dtPBL,wake_dqPBL &
	3861	,wake_omg,wake_dp_deltomg &
	3862	,wake_spread,wake_Cstar,wake_d_deltat_gw &
	3863	,wake_ddeltat,wake_ddeltaq &
	3864	#ifdef ISO
	3865	& ,xt_seri,dxt_dwn,dxt_a,wdxt_PBL,udxt_PBL &
	3866	& ,wake_deltaxt,dxt_wake,xt_undi &
	3867	& ,wake_dxtKE,wake_dxtPBL &
	3868	#endif
	3869	& )
	3870	!
	3871	!-----------------------------------------------------------------------
	3872	! ajout des tendances des poches froides
	3873	! Faire rapidement disparaitre l'ancien dt_wake pour garder un d_t_wake
	3874	! coherent avec les autres d_t_...
	3875	d_t_wake(:,:)=dt_wake(:,:)*dtime
	3876	d_q_wake(:,:)=dq_wake(:,:)*dtime
	3877	#ifdef ISO
	3878	d_xt_wake(:,:,:)=dxt_wake(:,:,:)*dtime
	3879	#endif
	3880	CALL add_phys_tend(du0,dv0,d_t_wake,d_q_wake,dql0,dqi0,paprs,'wake', &
	3881	abortphy,flag_inhib_tend &
	3882	#ifdef ISO
	3883	& ,d_xt_wake,dxtl0,dxti0 &
	3884	#endif
	3885	& )
	3886
	3887	#ifdef ISO
	3888	#ifdef ISOVERIF
	3889	write(,) 'physiq 3504: apres wakes'
	3890	if (iso_eau.gt.0) then
	3891	call iso_verif_egalite_vect2D( &
	3892	& xt_seri,q_seri, &
	3893	& 'physiq 3727, apres ajout wakes',ntraciso,klon,klev)
	3894	endif
	3895	if (iso_HDO.gt.0) then
	3896	call iso_verif_aberrant_enc_vect2D( &
	3897	& xt_seri,q_seri,'physiq 3540, apres ajout wakes', &
	3898	& ntraciso,klon,klev)
	3899	endif
	3900	if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
	3901	call iso_verif_O18_aberrant_enc_vect2D( &
	3902	& xt_seri,q_seri, &
	3903	& 'physiq 3540a',ntraciso,klon,klev)
	3904	endif
	3905	#ifdef ISOTRAC
	3906	call iso_verif_traceur_vect(xt_seri,klon,klev, &
	3907	& 'physiq 3456 apres calwake')
	3908	#endif
	3909	#endif
	3910	#endif
	3911
	3912	!------------------------------------------------------------------------
	3913
	3914	endif ! (iflag_wake>=1)
	3915	!
	3916	!===================================================================
	3917	!JYG
	3918	IF (ip_ebil_phy.ge.2) THEN
	3919	ztit='after wake'
	3920	CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
	3921	, t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
	3922	, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec &
	3923	!#ifdef ISO
	3924	! & , xt_seri,xtl_seri,xts_seri,d_xtw, d_xtl, d_xts &
	3925	!#endif
	3926	& )
	3927	call diagphy(cell_area,ztit,ip_ebil_phy &
	3928	, zero_v, zero_v, zero_v, zero_v, zero_v &
	3929	, zero_v, zero_v, zero_v, ztsol &
	3930	, d_h_vcol, d_qt, d_ec &
	3931	, fs_bound, fq_bound )
	3932	END IF
	3933
	3934	! print*,'apres callwake iflag_cld_th=', iflag_cld_th
	3935	!
	3936	!===================================================================
	3937	! Convection seche (thermiques ou ajustement)
	3938	!===================================================================
	3939	!
	3940	call stratocu_if(klon,klev,pctsrf,paprs, pplay,t_seri &
	3941	,seuil_inversion,weak_inversion,dthmin)
	3942
	3943
	3944
	3945	d_t_ajsb(:,:)=0.
	3946	d_q_ajsb(:,:)=0.
	3947	d_t_ajs(:,:)=0.
	3948	d_u_ajs(:,:)=0.
	3949	d_v_ajs(:,:)=0.
	3950	d_q_ajs(:,:)=0.
	3951	clwcon0th(:,:)=0.
	3952	#ifdef ISO
	3953	d_xt_ajs(:,:,:)=0.0
	3954	d_xt_ajsb(:,:,:)=0.0
	3955	#endif
	3956	!
	3957	! fm_therm(:,:)=0.
	3958	! entr_therm(:,:)=0.
	3959	! detr_therm(:,:)=0.
	3960	!
	3961	IF(prt_level>9)WRITE(lunout,*) &
	3962	'AVANT LA CONVECTION SECHE , iflag_thermals=' &
	3963	,iflag_thermals,' nsplit_thermals=',nsplit_thermals
	3964	if(iflag_thermals<0) then
	3965	! Rien
	3966	! ====
	3967	IF(prt_level>9)WRITE(lunout,*)'pas de convection seche'
	3968
	3969	#ifdef ISO
	3970	#ifdef ISOVERIF
	3971	call iso_verif_noNaN_vect2D(xt_seri,'physiq 3971', &
	3972	& ntraciso,klon,klev)
	3973	#endif
	3974	#ifdef ISOVERIF
	3975	write(,) 'physiq 3570'
	3976	do k=1,klev
	3977	do i=1,klon
	3978	if (iso_eau.gt.0) then
	3979	call iso_verif_egalite_choix(xt_seri(iso_eau,i,k), &
	3980	& q_seri(i,k),'physiq 2765',errmax,errmaxrel)
	3981	endif !if (iso_eau.gt.0) then
	3982	if (iso_HDO.gt.0) then
	3983	if (q_seri(i,k).gt.ridicule) then
	3984	call iso_verif_aberrant_encadre(xt_seri(iso_HDO,i,k)/ &
	3985	& q_seri(i,k),'physiq 2770')
	3986	endif !if (abs(d_q_ajs(i,k)).gt.ridicule) then
	3987	endif !if (iso_HDO.gt.0) then
	3988	if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
	3989	if (q_seri(i,k).gt.ridicule) then
	3990	if (iso_verif_o18_aberrant_nostop( &
	3991	& xt_seri(iso_HDO,i,k)/q_seri(i,k), &
	3992	& xt_seri(iso_O18,i,k)/q_seri(i,k), &
	3993	& 'physiq 3978, avant calltherm').eq.1) then
	3994	write(,) 'i,k,q_seri(i,k)=',i,k,q_seri(i,k)
	3995	stop
	3996	endif ! if (iso_verif_o18_aberrant_nostop
	3997	endif !if (q_seri(i,k).gt.errmax) then
	3998	endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
	3999	if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
	4000	if ((q_seri(i,k).gt.ridicule).and.(l.lt.nlevmaxO17)) then
	4001	call iso_verif_aberrant_o17(xt_seri(iso_o17,i,k) &
	4002	& /q_seri(i,k),xt_seri(iso_o18,i,k) &
	4003	& /q_seri(i,k),'physiq 3178: avant clmain')
	4004	endif !if (q_seri(i,k).gt.ridicule) then
	4005	endif !if (iso_O17.gt.0) then
	4006	#ifdef ISOTRAC
	4007	call iso_verif_traceur(xt_seri(1,i,k),'physiq 3389')
	4008	if (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k), &
	4009	& 'physiq 3481, avant ajsec',1e-5) &
	4010	& .eq.1) then
	4011	write(,) 'i,k=',i,k
	4012	#ifdef ISOVERIF
	4013	stop
	4014	#endif
	4015	!#ifdef ISOVERIF
	4016	endif !if (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k),
	4017	#endif
	4018	!#ifdef ISOTRAC
	4019	enddo !do i=1,klon
	4020	enddo !do k=1,klev
	4021	#endif
	4022	!#ifdef ISOVERIF
	4023	if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) then
	4024	do k=1,klev
	4025	do i=1,klon
	4026	xt_seri(iso_eau,i,k)=q_seri(i,k)
	4027	enddo !do i=1,klon
	4028	enddo !do k=1,klev
	4029	#ifdef ISOTRAC
	4030	call iso_verif_traceur_jbid_vect(xt_seri, &
	4031	& klon,klev)
	4032	#endif
	4033	endif !if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) then
	4034	#endif
	4035	!#ifdef ISO
	4036
	4037
	4038	else
	4039
	4040	! Thermiques
	4041	! ==========
	4042	IF(prt_level>9)WRITE(lunout,*)'JUSTE AVANT , iflag_thermals=' &
	4043	,iflag_thermals,' nsplit_thermals=',nsplit_thermals
	4044
	4045
	4046	!cc nrlmd le 10/04/2012
	4047	DO k=1,klev+1
	4048	DO i=1,klon
	4049	pbl_tke_input(i,k,is_oce)=pbl_tke(i,k,is_oce)
	4050	pbl_tke_input(i,k,is_ter)=pbl_tke(i,k,is_ter)
	4051	pbl_tke_input(i,k,is_lic)=pbl_tke(i,k,is_lic)
	4052	pbl_tke_input(i,k,is_sic)=pbl_tke(i,k,is_sic)
	4053	ENDDO
	4054	ENDDO
	4055	!cc fin nrlmd le 10/04/2012
	4056
	4057	if (iflag_thermals>=1) then
	4058	!jyg<
	4059	IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
	4060	! Appel des thermiques avec les profils exterieurs aux poches
	4061	DO k=1,klev
	4062	DO i=1,klon
	4063	t_therm(i,k) = t_seri(i,k) - wake_s(i)*wake_deltat(i,k)
	4064	q_therm(i,k) = q_seri(i,k) - wake_s(i)*wake_deltaq(i,k)
	4065	u_therm(i,k) = u_seri(i,k)
	4066	v_therm(i,k) = v_seri(i,k)
	4067	#ifdef ISO
	4068	do ixt=1,ntraciso
	4069	xt_therm(ixt,i,k) = xt_seri(ixt,i,k) - wake_s(i)*wake_deltaxt(ixt,i,k)
	4070	enddo !do ixt=1,ntraciso
	4071	#endif
	4072	ENDDO
	4073	ENDDO
	4074	ELSE
	4075	! Appel des thermiques avec les profils moyens
	4076	DO k=1,klev
	4077	DO i=1,klon
	4078	t_therm(i,k) = t_seri(i,k)
	4079	q_therm(i,k) = q_seri(i,k)
	4080	u_therm(i,k) = u_seri(i,k)
	4081	v_therm(i,k) = v_seri(i,k)
	4082	#ifdef ISO
	4083	do ixt=1,ntraciso
	4084	xt_therm(ixt,i,k) = xt_seri(ixt,i,k)
	4085	enddo !do ixt=1,ntraciso
	4086	#endif
	4087	ENDDO
	4088	ENDDO
	4089	ENDIF
	4090	!>jyg
	4091	call calltherm(pdtphys &
	4092	,pplay,paprs,pphi,weak_inversion &
	4093	! ,u_seri,v_seri,t_seri,q_seri,zqsat,debut & !jyg
	4094	,u_therm,v_therm,t_therm,q_therm,zqsat,debut & !jyg
	4095	,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs &
	4096	,fm_therm,entr_therm,detr_therm &
	4097	,zqasc,clwcon0th,lmax_th,ratqscth &
	4098	,ratqsdiff,zqsatth &
	4099	!on rajoute ale et alp, et les
	4100	!caracteristiques de la couche alim
	4101	,Ale_bl,Alp_bl,lalim_conv,wght_th, zmax0, f0, zw2,fraca &
	4102	,ztv,zpspsk,ztla,zthl &
	4103	!cc nrlmd le 10/04/2012
	4104	,pbl_tke_input,pctsrf,omega,cell_area &
	4105	,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &
	4106	,n2,s2,ale_bl_stat &
	4107	,therm_tke_max,env_tke_max &
	4108	,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &
	4109	,alp_bl_conv,alp_bl_stat &
	4110	!cc fin nrlmd le 10/04/2012
	4111	,zqla,ztva &
	4112	#ifdef ISO
	4113	& ,xt_seri,d_xt_ajs &
	4114	#ifdef DIAGISO
	4115	& ,q_the,xt_the &
	4116	#endif
	4117	#endif
	4118	& )
	4119
	4120	#ifdef ISO
	4121	#ifdef ISOVERIF
	4122	write(,) 'physiq 3651: apres calltherm'
	4123	if (iso_HDO.gt.0) then
	4124	call iso_verif_aberrant_enc_vect2D( &
	4125	& xt_seri,q_seri, &
	4126	& 'physiq 4084, apres calltherm',ntraciso,klon,klev)
	4127	endif
	4128
	4129	#ifdef ISOTRAC
	4130	call iso_verif_traceur_vect(xt_seri,klon,klev, &
	4131	& 'physiq 3600 apres calltherm')
	4132	#endif
	4133	#endif
	4134	#endif
	4135	!
	4136	!jyg<
	4137	IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
	4138	! Si les thermiques ne sont presents que hors des
	4139	! poches, la tendance moyenne associ\'ee doit etre
	4140	! multipliee par la fraction surfacique qu'ils couvrent.
	4141	DO k=1,klev
	4142	DO i=1,klon
	4143	!
	4144	wake_deltat(i,k) = wake_deltat(i,k) - d_t_ajs(i,k)
	4145	wake_deltaq(i,k) = wake_deltaq(i,k) - d_q_ajs(i,k)
	4146	!
	4147	!!!t_seri(i,k) = t_therm(i,k) + wake_s(i)*wake_deltat(i,k)
	4148	!!!q_seri(i,k) = q_therm(i,k) + wake_s(i)*wake_deltaq(i,k)
	4149	!
	4150	d_u_ajs(i,k) = d_u_ajs(i,k)*(1.-wake_s(i))
	4151	d_v_ajs(i,k) = d_v_ajs(i,k)*(1.-wake_s(i))
	4152	d_t_ajs(i,k) = d_t_ajs(i,k)*(1.-wake_s(i))
	4153	d_q_ajs(i,k) = d_q_ajs(i,k)*(1.-wake_s(i))
	4154	#ifdef ISO
	4155	do ixt=1,ntraciso
	4156	wake_deltaxt(ixt,i,k) = wake_deltaxt(ixt,i,k) - d_xt_ajs(ixt,i,k)
	4157	d_xt_ajs(ixt,i,k) = d_xt_ajs(ixt,i,k)*(1.-wake_s(i))
	4158	enddo
	4159	#endif
	4160	!
	4161	ENDDO
	4162	ENDDO
	4163	!!! ELSE
	4164	!!! DO k=1,klev
	4165	!!! DO i=1,klon
	4166	!!! t_seri(i,k) = t_therm(i,k)
	4167	!!! q_seri(i,k) = q_therm(i,k)
	4168	!!! ENDDO
	4169	!!! ENDDO
	4170	ENDIF
	4171	!
	4172	CALL add_phys_tend(d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs, &
	4173	dql0,dqi0,paprs,'thermals', abortphy,flag_inhib_tend &
	4174	#ifdef ISO
	4175	& ,d_xt_ajs,dxtl0,dxti0 &
	4176	#endif
	4177	& )
	4178	!
	4179	!>jyg
	4180	!jyg<
	4181	!
	4182	CALL alpale_th( dtime, lmax_th, t_seri, cell_area, &
	4183	cin, s2, n2, &
	4184	ale_bl_trig, ale_bl_stat, ale_bl, &
	4185	alp_bl, alp_bl_stat, &
	4186	proba_notrig, random_notrig)
	4187
	4188	! ------------------------------------------------------------------
	4189	! Transport de la TKE par les panaches thermiques.
	4190	! FH : 2010/02/01
	4191	! if (iflag_pbl.eq.10) then
	4192	! call thermcell_dtke(klon,klev,nbsrf,pdtphys,fm_therm,entr_therm,
	4193	! s rg,paprs,pbl_tke)
	4194	! endif
	4195	! -------------------------------------------------------------------
	4196
	4197	do i=1,klon
	4198	! zmax_th(i)=pphi(i,lmax_th(i))/rg
	4199	!CR:04/05/12:correction calcul zmax
	4200	zmax_th(i)=zmax0(i)
	4201	enddo
	4202
	4203	endif
	4204
	4205
	4206	! Ajustement sec
	4207	! ==============
	4208
	4209	! Dans le cas o\`u on active les thermiques, on fait partir l'ajustement
	4210	! a partir du sommet des thermiques.
	4211	! Dans le cas contraire, on demarre au niveau 1.
	4212
	4213	if (iflag_thermals>=13.or.iflag_thermals<=0) then
	4214
	4215	if(iflag_thermals.eq.0) then
	4216	IF(prt_level>9)WRITE(lunout,*)'ajsec'
	4217	limbas(:)=1
	4218	else
	4219	limbas(:)=lmax_th(:)
	4220	endif
	4221
	4222	! Attention : le call ajsec_convV2 n'est maintenu que momentanneement
	4223	! pour des test de convergence numerique.
	4224	! Le nouveau ajsec est a priori mieux, meme pour le cas
	4225	! iflag_thermals = 0 (l'ancienne version peut faire des tendances
	4226	! non nulles numeriquement pour des mailles non concernees.
	4227
	4228	#ifdef ISO
	4229	#ifdef ISOVERIF
	4230	call iso_verif_noNaN_vect2D(xt_seri,'physiq 4112', &
	4231	& ntraciso,klon,klev)
	4232	#endif
	4233	#ifdef ISOVERIF
	4234	write(,) 'physiq 3691b: avant call ajsec'
	4235	if (iso_eau.gt.0) then
	4236	call iso_verif_egalite_vect2D( &
	4237	& xt_seri,q_seri, &
	4238	& 'physiq 3727, avant ajsec',ntraciso,klon,klev)
	4239	endif
	4240	if (iso_HDO.gt.0) then
	4241	call iso_verif_aberrant_enc_vect2D( &
	4242	& xt_seri,q_seri, &
	4243	& 'physiq 3732, avant ajsec',ntraciso,klon,klev)
	4244	endif
	4245	if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
	4246	do k = 1, klev
	4247	do i = 1, klon
	4248	if (q_seri(i,k).gt.ridicule) then
	4249	if (iso_verif_o18_aberrant_nostop( &
	4250	& xt_seri(iso_HDO,i,k)/q_seri(i,k), &
	4251	& xt_seri(iso_O18,i,k)/q_seri(i,k), &
	4252	& 'physiq 4051, avant ajsec').eq.1) then
	4253	write(,) 'i,k,q_seri(i,k)=',i,k,q_seri(i,k)
	4254	stop
	4255	endif ! if (iso_verif_o18_aberrant_nostop
	4256	endif !if (q_seri(i,k).gt.errmax) then
	4257	enddo !do i = 1, klon
	4258	enddo !do k = 1, klev
	4259	endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
	4260	#ifdef ISOTRAC
	4261	call iso_verif_traceur_vect(xt_seri,klon,klev, &
	4262	& 'physiq 3600 avant ajsec')
	4263	#endif
	4264	!#ifdef ISOTRAC
	4265	#endif
	4266	!#ifdef ISOVERIF
	4267	#endif
	4268	!#ifdef ISO
	4269
	4270	if (iflag_thermals==0) then
	4271	! Calling adjustment alone (but not the thermal plume model)
	4272	CALL ajsec_convV2(paprs, pplay, t_seri,q_seri &
	4273	, d_t_ajsb, d_q_ajsb &
	4274	#ifdef ISO
	4275	& ,xt_seri,d_xt_ajsb &
	4276	#endif
	4277	& )
	4278	else if (iflag_thermals>0) then
	4279	! Calling adjustment above the top of thermal plumes
	4280	CALL ajsec(paprs, pplay, t_seri,q_seri,limbas &
	4281	, d_t_ajsb, d_q_ajsb &
	4282	#ifdef ISO
	4283	& ,xt_seri,d_xt_ajsb &
	4284	#endif
	4285	& )
	4286	endif
	4287
	4288	!--------------------------------------------------------------------
	4289	! ajout des tendances de l'ajustement sec ou des thermiques
	4290	CALL add_phys_tend(du0,dv0,d_t_ajsb,d_q_ajsb,dql0,dqi0,paprs, &
	4291	'ajsb',abortphy,flag_inhib_tend &
	4292	#ifdef ISO
	4293	& ,d_xt_ajsb,dxtl0,dxti0 &
	4294	#endif
	4295	& )
	4296	d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_ajsb(:,:)
	4297	d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_ajsb(:,:)
	4298	#ifdef ISO
	4299	d_xt_ajs(:,:,:)=d_xt_ajs(:,:,:)+d_xt_ajsb(:,:,:)
	4300	#endif
	4301
	4302	!---------------------------------------------------------------------
	4303
	4304	endif
	4305
	4306	endif
	4307	!
	4308	!===================================================================
	4309	!IM
	4310	IF (ip_ebil_phy.ge.2) THEN
	4311	ztit='after dry_adjust'
	4312	CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
	4313	, t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
	4314	, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec &
	4315	!#ifdef ISO
	4316	! & , xt_seri,xtl_seri,xts_seri,d_xtw, d_xtl, d_xts &
	4317	!#endif
	4318	& )
	4319	call diagphy(cell_area,ztit,ip_ebil_phy &
	4320	, zero_v, zero_v, zero_v, zero_v, zero_v &
	4321	, zero_v, zero_v, zero_v, ztsol &
	4322	, d_h_vcol, d_qt, d_ec &
	4323	, fs_bound, fq_bound )
	4324	END IF
	4325
	4326
	4327	!-------------------------------------------------------------------------
	4328	! Computation of ratqs, the width (normalized) of the subrid scale
	4329	! water distribution
	4330	CALL calcratqs(klon,klev,prt_level,lunout, &
	4331	iflag_ratqs,iflag_con,iflag_cld_th,pdtphys, &
	4332	ratqsbas,ratqshaut,ratqsp0, ratqsdp, &
	4333	tau_ratqs,fact_cldcon, &
	4334	ptconv,ptconvth,clwcon0th, rnebcon0th, &
	4335	paprs,pplay,q_seri,zqsat,fm_therm, &
	4336	ratqs,ratqsc)
	4337
	4338	#ifdef ISO
	4339	! expérience de sensi ciblée à ratqs
	4340	if (modif_ratqs.eq.1) then
	4341	! x3 seulement dans extratropiques
	4342	do k=1,klev
	4343	do i=1, klon
	4344	if (abs(latitude_deg(i)).gt.30.0) then
	4345	ratqs(i,k)=3.0*ratqs(i,k)
	4346	endif
	4347	enddo
	4348	enddo
	4349	endif
	4350	#endif
	4351
	4352	!
	4353	! Appeler le processus de condensation a grande echelle
	4354	! et le processus de precipitation
	4355	!-------------------------------------------------------------------------
	4356	IF (prt_level .GE.10) THEN
	4357	print *,'itap, ->fisrtilp ',itap
	4358	ENDIF
	4359	!
	4360	#ifdef ISO
	4361	#ifdef ISOVERIF
	4362	write(,) 'physiq 3837: verif avant ilp'
	4363	#endif
	4364	#ifdef ISOVERIF
	4365	if (iso_eau.gt.0) then
	4366	call iso_verif_egalite_vect2D( &
	4367	& xt_seri,q_seri, &
	4368	& 'physiq 3709, avant ilp',ntraciso,klon,klev)
	4369	endif
	4370	if (iso_HDO.gt.0) then
	4371	call iso_verif_aberrant_enc_vect2D( &
	4372	& xt_seri,q_seri, &
	4373	& 'physiq 3714, avant ilp',ntraciso,klon,klev)
	4374	endif
	4375	#endif
	4376	#ifdef ISOVERIF
	4377	do k=1,klev
	4378	do i=1,klon
	4379	if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
	4380	if ((q_seri(i,k).gt.ridicule).and.(l.lt.nlevmaxO17)) then
	4381	call iso_verif_aberrant_o17(xt_seri(iso_o17,i,k) &
	4382	& /q_seri(i,k),xt_seri(iso_o18,i,k) &
	4383	& /q_seri(i,k),'physiq 3389')
	4384	endif !if (q_seri(i,k).gt.ridicule) then
	4385	endif !if (iso_O17.gt.0) then
	4386	if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
	4387	if (q_seri(i,k).gt.ridicule) then
	4388	if (iso_verif_o18_aberrant_nostop( &
	4389	& xt_seri(iso_HDO,i,k)/q_seri(i,k), &
	4390	& xt_seri(iso_O18,i,k)/q_seri(i,k), &
	4391	& 'physiq 4177, avant il pleut').eq.1) then
	4392	write(,) 'i,k,q_seri(i,k)=',i,k,q_seri(i,k)
	4393	stop
	4394	endif ! if (iso_verif_o18_aberrant_nostop
	4395	endif !if (q_seri(i,k).gt.errmax) then
	4396	endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
	4397	#ifdef ISOTRAC
	4398	call iso_verif_traceur(xt_seri(1,i,k),'physiq 3609')
	4399	call iso_verif_traceur_pbidouille(xt_seri(1,i,k), &
	4400	& 'physiq 3609')
	4401	if (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k), &
	4402	& 'physiq 3707, avant fisrtilp',1e-5) &
	4403	& .eq.1) then
	4404	write(,) 'i,k=',i,k
	4405	#ifdef ISOVERIF
	4406	stop
	4407	#endif
	4408	endif
	4409	if (option_tmin.eq.1) then
	4410	call iso_verif_trac17_q_deltaD(xt_seri(1,i,k), &
	4411	& 'physiq 3905, avant ilp')
	4412	endif
	4413	#endif
	4414	!ISOTRAC
	4415	enddo !do i=1,klon
	4416	enddo !do k=1,klev
	4417
	4418	! verif température
	4419	do k=1,klev
	4420	do i=1,klon
	4421	call iso_verif_positif(370.0-t_seri(i,k), &
	4422	& 'physiq 3535, avant il pleut')
	4423	call iso_verif_positif(t_seri(i,k)-100.0, &
	4424	& 'physiq 3537, avant il pleut')
	4425	enddo
	4426	enddo
	4427	write(,) 'physiq 3113: appel de fisrtilp'
	4428	#endif
	4429	!ISOVERIF
	4430	if ((bidouille_anti_divergence).and. &
	4431	& (iso_eau.gt.0)) then
	4432	do k=1,klev
	4433	do i=1,klon
	4434	xt_seri(iso_eau,i,k)= q_seri(i,k)
	4435	enddo !do i=1,klon
	4436	enddo !do k=1,klev
	4437	endif !if ((bidouille_anti_divergence).and. &
	4438	#endif
	4439	!ISO
	4440
	4441	CALL fisrtilp(dtime,paprs,pplay, &
	4442	t_seri, q_seri,ptconv,ratqs, &
	4443	d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, cldliq, &
	4444	rain_lsc, snow_lsc, &
	4445	pfrac_impa, pfrac_nucl, pfrac_1nucl, &
	4446	frac_impa, frac_nucl, beta_prec_fisrt, &
	4447	prfl, psfl, rhcl, &
	4448	zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
	4449	iflag_ice_thermo &
	4450	#ifdef ISO
	4451	& ,xt_seri,xtrain_lsc,xtsnow_lsc &
	4452	& ,d_xt_lsc,d_xtl_lsc,d_xti_lsc,pxtrfl,pxtsfl &
	4453	#ifdef DIAGISO
	4454	& ,fcond_ls,taux_cond_ls,taux_precip_ls & ! juste diagnostique
	4455	#endif
	4456	#endif
	4457	& )
	4458
	4459	#ifdef ISO
	4460	#ifdef ISOVERIF
	4461	call iso_verif_noNaN_vect2D(xt_seri,'physiq 4555', &
	4462	& ntraciso,klon,klev)
	4463	#endif
	4464	#ifdef ISOVERIF
	4465	! write(,) 'physiq 2593: sortie de il pleut!'
	4466	do k=1,klev
	4467	do i=1,klon
	4468	#ifdef ISOVERIF
	4469	call iso_verif_positif(q_seri(i,k),'physiq 2301')
	4470	#endif
	4471	if (iso_eau.gt.0) then
	4472	call iso_verif_egalite_choix( &
	4473	& d_xt_lsc(iso_eau,i,k),d_q_lsc(i,k), &
	4474	& 'physiq 2601',errmax,errmaxrel)
	4475	call iso_verif_egalite_choix( &
	4476	& d_xtl_lsc(iso_eau,i,k),d_ql_lsc(i,k), &
	4477	& 'physiq 2603',errmax,errmaxrel)
	4478	endif !if (iso_eau.gt.0) then
	4479	if (iso_HDO.gt.0) then
	4480	if (q_seri(i,k).gt.ridicule) then
	4481	call iso_verif_aberrant(xt_seri(iso_HDO,i,k) &
	4482	& /q_seri(i,k),'physiq 3912')
	4483	endif !if (q_seri(i,k).gt.ridicule) then
	4484	endif !if (iso_HDO.gt.0) then
	4485	if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
	4486	if ((q_seri(i,k).gt.ridicule).and.(l.lt.nlevmaxO17)) then
	4487	call iso_verif_aberrant_o17(xt_seri(iso_o17,i,k) &
	4488	& /q_seri(i,k),xt_seri(iso_o18,i,k) &
	4489	& /q_seri(i,k),'physiq 2239: apres ilp')
	4490	endif !if (q_seri(i,k).gt.ridicule) then
	4491	endif !if (iso_O17.gt.0) then
	4492	#ifdef ISOTRAC
	4493	call iso_verif_traceur(xt_seri(1,i,k),'physiq 3493')
	4494	if (option_tmin.eq.1) then
	4495	call iso_verif_trac17_q_deltaD(xt_seri(1,i,k), &
	4496	& 'physiq 3988, apres ilp')
	4497	endif ! if (option_tmin.eq.1) then
	4498	#endif
	4499	enddo !do i=1,klon
	4500	enddo !do k=1,klev
	4501	do i=1,klon
	4502	if (iso_HDO.gt.0) then
	4503	call iso_verif_aberrant_choix(xtsnow_lsc(iso_hdo,i), &
	4504	& snow_lsc(i),ridicule_rain,deltalim_snow, &
	4505	& 'il pleut apres 3567')
	4506	call iso_verif_aberrant_choix(xtrain_lsc(iso_hdo,i), &
	4507	& rain_lsc(i),ridicule_rain,deltalim, &
	4508	& 'il pleut 3570')
	4509	endif !if (iso_HDO.gt.0) then
	4510	#ifdef ISOTRAC
	4511	call iso_verif_traceur(xtrain_lsc(1,i),'physiq 3703')
	4512	call iso_verif_traceur(xtsnow_lsc(1,i),'physiq 3704')
	4513	#endif
	4514	enddo !do i=1,klon
	4515	! fin cam verif
	4516	#endif
	4517	if (essai_convergence) then
	4518	else !if (essai_convergence) then
	4519	do k=1,klev
	4520	do i=1,klon
	4521	q_seri(i,k)=max(0.0,q_seri(i,k))
	4522	do ixt=1,ntraciso
	4523	xt_seri(ixt,i,k)=max(0.0,xt_seri(ixt,i,k))
	4524	enddo
	4525	enddo
	4526	enddo
	4527	endif !if (essai_convergence) then
	4528	#if ISOVERIF
	4529	do k=1,klev
	4530	do i=1,klon
	4531	if (iso_HDO.gt.0) then
	4532	call iso_verif_aberrant_choix(xtsnow_lsc(iso_hdo,i), &
	4533	& snow_lsc(i),ridicule_rain,deltalim_snow, &
	4534	& 'physiq 3568, après il pleut')
	4535	endif !if (iso_HDO.gt.0) then
	4536	enddo !do i=1,klon
	4537	enddo !do k=1,klev
	4538	#endif
	4539	#endif
	4540
	4541	!
	4542	WHERE (rain_lsc < 0) rain_lsc = 0.
	4543	WHERE (snow_lsc < 0) snow_lsc = 0.
	4544	#ifdef ISO
	4545	WHERE (xtrain_lsc < 0) xtrain_lsc = 0.
	4546	WHERE (xtsnow_lsc < 0) xtsnow_lsc = 0.
	4547	#endif
	4548
	4549	#ifdef ISO
	4550	#ifdef ISOVERIF
	4551	DO k = 1, klev
	4552	do i=1,klon
	4553	if (iso_O18.gt.0.and.iso_HDO.gt.0) then
	4554	if (ql_seri(i,k).gt.ridicule) then
	4555	call iso_verif_aberrant( &
	4556	& xtl_seri(iso_HDO,i,k)/ql_seri(i,k),'physiq 4330')
	4557	if (iso_O18.gt.0) then
	4558	call iso_verif_o18_aberrant( &
	4559	& xtl_seri(iso_HDO,i,k)/ql_seri(i,k), &
	4560	& xtl_seri(iso_O18,i,k)/ql_seri(i,k), &
	4561	& 'physiq 4335, avant il pleut')
	4562	endif ! if (iso_O18.gt.0) then
	4563	endif !if (ql_seri(i,k).gt.errmax) then
	4564	endif !if (iso_HDO.gt.0) then
	4565	ENDDO ! i=1,klon
	4566	ENDDO !DO k = 1, klev
	4567	#endif
	4568	#endif
	4569
	4570	CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc,paprs, &
	4571	'lsc',abortphy,flag_inhib_tend &
	4572	#ifdef ISO
	4573	& ,d_xt_lsc,d_xtl_lsc,d_xti_lsc &
	4574	#endif
	4575	& )
	4576	rain_num(:)=0.
	4577	DO k = 1, klev ! re-evaporation de l'eau liquide nuageuse
	4578	DO i = 1, klon
	4579	IF (ql_seri(i,k)>oliqmax) THEN
	4580	rain_num(i)=rain_num(i)+(ql_seri(i,k)-oliqmax)*zmasse(i,k)/pdtphys
	4581	#ifdef ISO
	4582	do ixt=1,ntraciso
	4583	xtl_seri(ixt,i,k)=xtl_seri(ixt,i,k)/ql_seri(i,k)*oliqmax
	4584	enddo
	4585	#endif
	4586	ql_seri(i,k)=oliqmax
	4587	ENDIF
	4588	ENDDO
	4589	ENDDO
	4590
	4591	!---------------------------------------------------------------------------
	4592	DO k = 1, klev
	4593	DO i = 1, klon
	4594	cldfra(i,k) = rneb(i,k)
	4595	!CR: a quoi ca sert? Faut-il ajouter qs_seri?
	4596	IF (.NOT.new_oliq) cldliq(i,k) = ql_seri(i,k)
	4597	ENDDO
	4598	ENDDO
	4599
	4600	#ifdef ISO
	4601	!#ifdef ISOVERIF
	4602	! write(,) 'physiq 4030: verif apres ajout lsc'
	4603	!#endif
	4604	#ifdef ISOVERIF
	4605	call iso_verif_noNaN_vect2D(xt_seri,'physiq 4565', &
	4606	& ntraciso,klon,klev)
	4607	#endif
	4608	#ifdef ISOVERIF
	4609	if (iso_eau.gt.0) then
	4610	call iso_verif_egalite_vect2D( &
	4611	& xt_seri,q_seri, &
	4612	& 'physiq 2599, apres ajout lsc',ntraciso,klon,klev)
	4613	endif
	4614	if (iso_HDO.gt.0) then
	4615	call iso_verif_aberrant_enc_vect2D( &
	4616	& xt_seri,q_seri, &
	4617	& 'physiq 2866, apres ajout lsc',ntraciso,klon,klev)
	4618	endif
	4619	#endif
	4620	#ifdef ISOVERIF
	4621	DO k = 1, klev
	4622	DO i = 1, klon
	4623	if (iso_eau.gt.0) then
	4624	call iso_verif_egalite_choix( &
	4625	& xtl_seri(iso_eau,i,k),ql_seri(i,k), &
	4626	& 'physiq 2601',errmax,errmaxrel)
	4627	endif !if (iso_eau.gt.0) then
	4628	if (iso_HDO.gt.0) then
	4629	if (q_seri(i,k).gt.ridicule) then
	4630	if (iso_O18.gt.0) then
	4631	if (iso_verif_o18_aberrant_nostop( &
	4632	& xt_seri(iso_HDO,i,k)/q_seri(i,k), &
	4633	& xt_seri(iso_O18,i,k)/q_seri(i,k), &
	4634	& 'physiq 2863, after il pleut').eq.1) then
	4635	write(,) 'i,k,q_seri(i,k)=',i,k,q_seri(i,k)
	4636	stop
	4637	endif
	4638	endif ! if (iso_O18.gt.0) then
	4639	endif !if (q_seri(i,k).gt.errmax) then
	4640	if (ql_seri(i,k).gt.ridicule) then
	4641	call iso_verif_aberrant( &
	4642	& xtl_seri(iso_HDO,i,k)/ql_seri(i,k),'physiq 2871')
	4643	if (iso_O18.gt.0) then
	4644	if (iso_verif_o18_aberrant_nostop( &
	4645	& xtl_seri(iso_HDO,i,k)/ql_seri(i,k), &
	4646	& xtl_seri(iso_O18,i,k)/ql_seri(i,k), &
	4647	& 'physiq 2872, after il pleut').eq.1) then
	4648	write(,) 'i,k,ql_seri(i,k)=',i,k,ql_seri(i,k)
	4649	write(,) 'd_ql_lsc(i,k)=',d_ql_lsc(i,k)
	4650	write(,) 'deltaD(d_ql_lsc(i,k))=',deltaD( &
	4651	& d_xtl_lsc(iso_HDO,i,k)/d_ql_lsc(i,k))
	4652	write(,) 'deltaO(d_ql_lsc(i,k))=',deltaO( &
	4653	& d_xtl_lsc(iso_O18,i,k)/d_ql_lsc(i,k))
	4654	stop
	4655	endif
	4656	endif ! if (iso_O18.gt.0) then
	4657	endif !if (ql_seri(i,k).gt.errmax) then
	4658	endif !if (iso_HDO.gt.0) then
	4659	ENDDO ! i=1,klon
	4660	ENDDO !DO k = 1, klev
	4661	if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
	4662	do i=1,klon
	4663	do k=1,nlev
	4664	if ((q_seri(i,k).gt.ridicule).and.(l.lt.nlevmaxO17)) then
	4665	call iso_verif_aberrant_o17(xt_seri(iso_o17,i,k) &
	4666	& /q_seri(i,k),xt_seri(iso_o18,i,k) &
	4667	& /q_seri(i,k),'physiq 3549')
	4668	endif !if (q_seri(i,k).gt.ridicule) then
	4669	enddo !do k=1,nlev
	4670	enddo !do i=1,klon
	4671	endif !if (iso_O17.gt.0) then
	4672	#endif
	4673	!#ifdef ISOVERIF
	4674	#ifdef ISOTRAC
	4675	#ifdef ISOVERIF
	4676	call iso_verif_traceur_vect(xt_seri,klon,klev,'physiq 3794')
	4677	if (option_tmin.eq.1) then
	4678	if (nzone_temp.ge.5) then
	4679	call iso_verif_tag17_q_deltaD_vect(xt_seri,klon,klev, &
	4680	& 'physiq 3385: apres ilp')
	4681	endif ! if (nzone_temp.ge.5) then
	4682	endif !if (option_tmin.eq.1) then
	4683	#endif
	4684	!#ifdef ISOVERIF
	4685	if (bidouille_anti_divergence) then
	4686	call iso_verif_traceur_jbid_vect(xt_seri, &
	4687	& klon,klev)
	4688	endif
	4689
	4690	! si tag 22, on recolorise les zones très convectives dans les
	4691	! tropiques
	4692	if (option_traceurs.eq.22) then
	4693	call isotrac_recolorise_conv(xt_seri,latitude_deg,presnivs,rain_con)
	4694	endif
	4695
	4696	#endif
	4697	!#ifdef ISOTRAC
	4698	#endif
	4699	!#ifdef ISO
	4700
	4701	IF (check) THEN
	4702	za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
	4703	WRITE(lunout,*)"apresilp=", za
	4704	#ifdef ISO
	4705	do ixt=1,ntraciso
	4706	DO k = 1, klev
	4707	DO i = 1, klon
	4708	xt_iso(i,k)=xt_seri(ixt,i,k)
	4709	xtl_iso(i,k)=xtl_seri(ixt,i,k)
	4710	enddo
	4711	enddo
	4712	zxta(ixt)= qcheck(klon,klev,paprs,xt_iso,xtl_iso,cell_area)
	4713	WRITE(lunout,*)"apresilp: ixt: ",ixt, zxta(ixt)
	4714	enddo !do ixt=1,ntraciso
	4715	#endif
	4716	zx_t = 0.0
	4717	za = 0.0
	4718	DO i = 1, klon
	4719	za = za + cell_area(i)/REAL(klon)
	4720	zx_t = zx_t + (rain_lsc(i) &
	4721	+ snow_lsc(i))*cell_area(i)/REAL(klon)
	4722	ENDDO
	4723	zx_t = zx_t/za*dtime
	4724	WRITE(lunout,*)"Precip=", zx_t
	4725	ENDIF
	4726	!IM
	4727	IF (ip_ebil_phy.ge.2) THEN
	4728	ztit='after fisrt'
	4729	CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
	4730	, t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
	4731	, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec &
	4732	!#ifdef ISO
	4733	! & , xt_seri,xtl_seri,xts_seri,d_xtw, d_xtl, d_xts &
	4734	!#endif
	4735	& )
	4736	call diagphy(cell_area,ztit,ip_ebil_phy &
	4737	, zero_v, zero_v, zero_v, zero_v, zero_v &
	4738	, zero_v, rain_lsc, snow_lsc, ztsol &
	4739	, d_h_vcol, d_qt, d_ec &
	4740	, fs_bound, fq_bound )
	4741	END IF
	4742
	4743	if (mydebug) then
	4744	call writefield_phy('u_seri',u_seri,nbp_lev)
	4745	call writefield_phy('v_seri',v_seri,nbp_lev)
	4746	call writefield_phy('t_seri',t_seri,nbp_lev)
	4747	call writefield_phy('q_seri',q_seri,nbp_lev)
	4748	endif
	4749
	4750	!
	4751	!-------------------------------------------------------------------
	4752	! PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
	4753	!-------------------------------------------------------------------
	4754
	4755	! 1. NUAGES CONVECTIFS
	4756	!
	4757	!IM cf FH
	4758	! IF (iflag_cld_th.eq.-1) THEN ! seulement pour Tiedtke
	4759	IF (iflag_cld_th.le.-1) THEN ! seulement pour Tiedtke
	4760	snow_tiedtke=0.
	4761	! print*,'avant calcul de la pseudo precip '
	4762	! print*,'iflag_cld_th',iflag_cld_th
	4763	if (iflag_cld_th.eq.-1) then
	4764	rain_tiedtke=rain_con
	4765	else
	4766	! print*,'calcul de la pseudo precip '
	4767	rain_tiedtke=0.
	4768	! print*,'calcul de la pseudo precip 0'
	4769	do k=1,klev
	4770	do i=1,klon
	4771	if (d_q_con(i,k).lt.0.) then
	4772	rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i,k)/pdtphys &
	4773	*(paprs(i,k)-paprs(i,k+1))/rg
	4774	endif
	4775	enddo
	4776	enddo
	4777	endif
	4778	!
	4779	! call dump2d(iim,jjm,rain_tiedtke(2:klon-1),'PSEUDO PRECIP ')
	4780	!
	4781
	4782	! Nuages diagnostiques pour Tiedtke
	4783	CALL diagcld1(paprs,pplay, &
	4784	!IM cf FH. rain_con,snow_con,ibas_con,itop_con,
	4785	rain_tiedtke,snow_tiedtke,ibas_con,itop_con, &
	4786	diafra,dialiq)
	4787	DO k = 1, klev
	4788	DO i = 1, klon
	4789	IF (diafra(i,k).GT.cldfra(i,k)) THEN
	4790	cldliq(i,k) = dialiq(i,k)
	4791	cldfra(i,k) = diafra(i,k)
	4792	ENDIF
	4793	ENDDO
	4794	ENDDO
	4795
	4796	ELSE IF (iflag_cld_th.ge.3) THEN
	4797	! On prend pour les nuages convectifs le max du calcul de la
	4798	! convection et du calcul du pas de temps precedent diminue d'un facteur
	4799	! facttemps
	4800	facteur = pdtphys *facttemps
	4801	do k=1,klev
	4802	do i=1,klon
	4803	rnebcon(i,k)=rnebcon(i,k)*facteur
	4804	if (rnebcon0(i,k)clwcon0(i,k).gt.rnebcon(i,k)clwcon(i,k)) &
	4805	then
	4806	rnebcon(i,k)=rnebcon0(i,k)
	4807	clwcon(i,k)=clwcon0(i,k)
	4808	endif
	4809	enddo
	4810	enddo
	4811
	4812	! On prend la somme des fractions nuageuses et des contenus en eau
	4813
	4814	if (iflag_cld_th>=5) then
	4815
	4816	do k=1,klev
	4817	ptconvth(:,k)=fm_therm(:,k+1)>0.
	4818	enddo
	4819
	4820	if (iflag_coupl==4) then
	4821
	4822	! Dans le cas iflag_coupl==4, on prend la somme des convertures
	4823	! convectives et lsc dans la partie des thermiques
	4824	! Le controle par iflag_coupl est peut etre provisoire.
	4825	do k=1,klev
	4826	do i=1,klon
	4827	if (ptconv(i,k).and.ptconvth(i,k)) then
	4828	cldliq(i,k)=cldliq(i,k)+rnebcon(i,k)*clwcon(i,k)
	4829	cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
	4830	else if (ptconv(i,k)) then
	4831	cldfra(i,k)=rnebcon(i,k)
	4832	cldliq(i,k)=rnebcon(i,k)*clwcon(i,k)
	4833	endif
	4834	enddo
	4835	enddo
	4836
	4837	else if (iflag_coupl==5) then
	4838	do k=1,klev
	4839	do i=1,klon
	4840	cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
	4841	cldliq(i,k)=cldliq(i,k)+rnebcon(i,k)*clwcon(i,k)
	4842	enddo
	4843	enddo
	4844
	4845	else
	4846
	4847	! Si on est sur un point touche par la convection
	4848	! profonde et pas par les thermiques, on prend la
	4849	! couverture nuageuse et l'eau nuageuse de la convection
	4850	! profonde.
	4851
	4852	!IM/FH: 2011/02/23
	4853	! definition des points sur lesquels ls thermiques sont actifs
	4854
	4855	do k=1,klev
	4856	do i=1,klon
	4857	if (ptconv(i,k).and. .not. ptconvth(i,k)) then
	4858	cldfra(i,k)=rnebcon(i,k)
	4859	cldliq(i,k)=rnebcon(i,k)*clwcon(i,k)
	4860	endif
	4861	enddo
	4862	enddo
	4863
	4864	endif
	4865
	4866	else
	4867
	4868	! Ancienne version
	4869	cldfra(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.)
	4870	cldliq(:,:)=cldliq(:,:)+rnebcon(:,:)*clwcon(:,:)
	4871	endif
	4872
	4873	ENDIF
	4874
	4875	! plulsc(:)=0.
	4876	! do k=1,klev,-1
	4877	! do i=1,klon
	4878	! zzz=prfl(:,k)+psfl(:,k)
	4879	! if (.not.ptconvth.zzz.gt.0.)
	4880	! enddo prfl, psfl,
	4881	! enddo
	4882	!
	4883	! 2. NUAGES STARTIFORMES
	4884	!
	4885	IF (ok_stratus) THEN
	4886	CALL diagcld2(paprs,pplay,t_seri,q_seri, diafra,dialiq)
	4887	DO k = 1, klev
	4888	DO i = 1, klon
	4889	IF (diafra(i,k).GT.cldfra(i,k)) THEN
	4890	cldliq(i,k) = dialiq(i,k)
	4891	cldfra(i,k) = diafra(i,k)
	4892	ENDIF
	4893	ENDDO
	4894	ENDDO
	4895	ENDIF
	4896	!
	4897	! Precipitation totale
	4898	!
	4899	DO i = 1, klon
	4900	rain_fall(i) = rain_con(i) + rain_lsc(i)
	4901	snow_fall(i) = snow_con(i) + snow_lsc(i)
	4902	ENDDO
	4903
	4904
	4905	#ifdef ISO
	4906	DO i = 1, klon
	4907	do ixt=1,ntraciso
	4908	xtrain_fall(ixt,i)=xtrain_con(ixt,i) + xtrain_lsc(ixt,i)
	4909	xtsnow_fall(ixt,i)=xtsnow_con(ixt,i) + xtsnow_lsc(ixt,i)
	4910	enddo
	4911	ENDDO !DO i = 1, klon
	4912	#ifdef ISOVERIF
	4913	if (iso_eau.gt.0) then
	4914	DO i = 1, klon
	4915	call iso_verif_egalite_choix(xtsnow_fall(iso_eau,i), &
	4916	& snow_fall(i),'physiq 3387', &
	4917	& errmax,errmaxrel)
	4918	if (iso_verif_positif_nostop(xtrain_lsc(iso_eau,i), &
	4919	& 'physiq 4298').eq.1) then
	4920	if (rain_lsc(i).ge.0.0) then
	4921	write(,) 'rain_fall(i)=',rain_lsc(i)
	4922	stop
	4923	endif !if (rain_con(i).ge.0.0) then
	4924	endif !if (iso_verif_positif_nostop
	4925	if (iso_verif_positif_nostop(xtrain_fall(iso_eau,i), &
	4926	& 'physiq 3405').eq.1) then
	4927	if (rain_fall(i).ge.0.0) then
	4928	write(,) 'rain_fall(i)=',rain_fall(i)
	4929	stop
	4930	endif !if (rain_con(i).ge.0.0) then
	4931	endif !if (iso_verif_positif_nostop
	4932	ENDDO !DO i = 1, klon
	4933	endif !if (iso_eau.gt.0) then
	4934	if (iso_HDO.gt.0) then
	4935	DO i = 1, klon
	4936	call iso_verif_aberrant_choix(xtsnow_fall(iso_hdo,i), &
	4937	& snow_fall(i),ridicule_snow, &
	4938	& deltalim_snow,'physiq 3856')
	4939	enddo !DO i = 1, klon
	4940	endif
	4941	#ifdef ISOTRAC
	4942	DO i = 1, klon
	4943	call iso_verif_traceur(xtrain_fall(1,i),'physiq 4012')
	4944	call iso_verif_traceur(xtsnow_fall(1,i),'physiq 4013')
	4945	enddo
	4946	#endif
	4947	#endif
	4948	#ifdef ISOVERIF
	4949	do i=1,klon
	4950	do ixt=1,ntraciso
	4951	call iso_verif_noNaN(xtsnow_con(ixt,i), &
	4952	& 'physiq 4942')
	4953	call iso_verif_noNaN(xtsnow_lsc(ixt,i), &
	4954	& 'physiq 4942')
	4955	call iso_verif_noNaN(xtsnow_fall(ixt,i), &
	4956	& 'physiq 4942')
	4957	enddo !do ixt=1,ntraciso
	4958	enddo ! do klon
	4959	#endif
	4960	#endif
	4961	#ifdef ISO
	4962	if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) then
	4963	do i=1,klon
	4964	xtrain_fall(iso_eau,i)=rain_fall(i)
	4965	enddo !do i=1,klon
	4966	endif
	4967	#endif
	4968
	4969	!IM
	4970	IF (ip_ebil_phy.ge.2) THEN
	4971	ztit="after diagcld"
	4972	CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
	4973	, t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
	4974	, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec &
	4975	!#ifdef ISO
	4976	! & , xt_seri,xtl_seri,xts_seri,d_xtw, d_xtl, d_xts &
	4977	!#endif
	4978	& )
	4979	call diagphy(cell_area,ztit,ip_ebil_phy &
	4980	, zero_v, zero_v, zero_v, zero_v, zero_v &
	4981	, zero_v, zero_v, zero_v, ztsol &
	4982	, d_h_vcol, d_qt, d_ec &
	4983	, fs_bound, fq_bound )
	4984	END IF
	4985	!
	4986	! Calculer l'humidite relative pour diagnostique
	4987	!
	4988	DO k = 1, klev
	4989	DO i = 1, klon
	4990	zx_t = t_seri(i,k)
	4991	IF (thermcep) THEN
	4992	!! if (iflag_ice_thermo.eq.0) then !jyg
	4993	zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
	4994	!! else !jyg
	4995	!! zdelta = MAX(0.,SIGN(1.,t_glace_min-zx_t)) !jyg
	4996	!! endif !jyg
	4997	zx_qs = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
	4998	zx_qs = MIN(0.5,zx_qs)
	4999	zcor = 1./(1.-retv*zx_qs)
	5000	zx_qs = zx_qs*zcor
	5001	ELSE
	5002	!! IF (zx_t.LT.t_coup) THEN !jyg
	5003	IF (zx_t.LT.rtt) THEN !jyg
	5004	zx_qs = qsats(zx_t)/pplay(i,k)
	5005	ELSE
	5006	zx_qs = qsatl(zx_t)/pplay(i,k)
	5007	ENDIF
	5008	ENDIF
	5009	zx_rh(i,k) = q_seri(i,k)/zx_qs
	5010	zqsat(i,k)=zx_qs
	5011	ENDDO
	5012	ENDDO
	5013
	5014	!IM Calcul temp.potentielle a 2m (tpot) et temp. potentielle
	5015	! equivalente a 2m (tpote) pour diagnostique
	5016	!
	5017	DO i = 1, klon
	5018	tpot(i)=zt2m(i)(100000./paprs(i,1))*RKAPPA
	5019	IF (thermcep) THEN
	5020	IF(zt2m(i).LT.RTT) then
	5021	Lheat=RLSTT
	5022	ELSE
	5023	Lheat=RLVTT
	5024	ENDIF
	5025	ELSE
	5026	IF (zt2m(i).LT.RTT) THEN
	5027	Lheat=RLSTT
	5028	ELSE
	5029	Lheat=RLVTT
	5030	ENDIF
	5031	ENDIF
	5032	tpote(i) = tpot(i)* &
	5033	EXP((Lheat qsat2m(i))/(RCPDzt2m(i)))
	5034	ENDDO
	5035
	5036	IF (type_trac == 'inca') THEN
	5037	#ifdef INCA
	5038	CALL VTe(VTphysiq)
	5039	CALL VTb(VTinca)
	5040	calday = REAL(days_elapsed + 1) + jH_cur
	5041
	5042	call chemtime(itap+itau_phy-1, date0, dtime, itap)
	5043	IF (config_inca == 'aero' .OR. config_inca == 'aeNP') THEN
	5044	CALL AEROSOL_METEO_CALC( &
	5045	calday,pdtphys,pplay,paprs,t,pmflxr,pmflxs, &
	5046	prfl,psfl,pctsrf,cell_area, &
	5047	latitude_deg,longitude_deg,u10m,v10m)
	5048	END IF
	5049
	5050	zxsnow_dummy(:) = 0.0
	5051
	5052	CALL chemhook_begin (calday, &
	5053	days_elapsed+1, &
	5054	jH_cur, &
	5055	pctsrf(1,1), &
	5056	latitude_deg, &
	5057	longitude_deg, &
	5058	cell_area, &
	5059	paprs, &
	5060	pplay, &
	5061	coefh(1:klon,1:klev,is_ave), &
	5062	pphi, &
	5063	t_seri, &
	5064	u, &
	5065	v, &
	5066	wo(:, :, 1), &
	5067	q_seri, &
	5068	zxtsol, &
	5069	zxsnow_dummy, &
	5070	solsw, &
	5071	albsol1, &
	5072	rain_fall, &
	5073	snow_fall, &
	5074	itop_con, &
	5075	ibas_con, &
	5076	cldfra, &
	5077	nbp_lon, &
	5078	nbp_lat-1, &
	5079	tr_seri, &
	5080	ftsol, &
	5081	paprs, &
	5082	cdragh, &
	5083	cdragm, &
	5084	pctsrf, &
	5085	pdtphys, &
	5086	itap)
	5087
	5088	CALL VTe(VTinca)
	5089	CALL VTb(VTphysiq)
	5090	#endif
	5091	END IF !type_trac = inca
	5092
	5093
	5094	!
	5095	! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.
	5096	!
	5097	IF (MOD(itaprad,radpas).EQ.0) THEN
	5098
	5099	!
	5100	!jq - introduce the aerosol direct and first indirect radiative forcings
	5101	!jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
	5102	IF (flag_aerosol .gt. 0) THEN
	5103	IF (iflag_rrtm .EQ. 0) THEN !--old radiation
	5104	IF (.NOT. aerosol_couple) THEN
	5105	!
	5106	CALL readaerosol_optic( &
	5107	debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, &
	5108	pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
	5109	mass_solu_aero, mass_solu_aero_pi, &
	5110	tau_aero, piz_aero, cg_aero, &
	5111	tausum_aero, tau3d_aero)
	5112	ENDIF
	5113	ELSE ! RRTM radiation
	5114	IF (aerosol_couple .AND. config_inca == 'aero' ) THEN
	5115	abort_message='config_inca=aero et rrtm=1 impossible'
	5116	call abort_physic(modname,abort_message,1)
	5117	ELSE
	5118	!
	5119	#ifdef CPP_RRTM
	5120	IF (NSW.EQ.6) THEN
	5121	!--new aerosol properties
	5122	!
	5123	CALL readaerosol_optic_rrtm( debut, aerosol_couple, &
	5124	new_aod, flag_aerosol, itap, jD_cur-jD_ref, &
	5125	pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
	5126	tr_seri, mass_solu_aero, mass_solu_aero_pi, &
	5127	tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
	5128	tausum_aero, tau3d_aero)
	5129
	5130	ELSE IF (NSW.EQ.2) THEN
	5131	!--for now we use the old aerosol properties
	5132	!
	5133	CALL readaerosol_optic( &
	5134	debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, &
	5135	pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
	5136	mass_solu_aero, mass_solu_aero_pi, &
	5137	tau_aero, piz_aero, cg_aero, &
	5138	tausum_aero, tau3d_aero)
	5139	!
	5140	!--natural aerosols
	5141	tau_aero_sw_rrtm(:,:,1,:)=tau_aero(:,:,3,:)
	5142	piz_aero_sw_rrtm(:,:,1,:)=piz_aero(:,:,3,:)
	5143	cg_aero_sw_rrtm (:,:,1,:)=cg_aero (:,:,3,:)
	5144	!--all aerosols
	5145	tau_aero_sw_rrtm(:,:,2,:)=tau_aero(:,:,2,:)
	5146	piz_aero_sw_rrtm(:,:,2,:)=piz_aero(:,:,2,:)
	5147	cg_aero_sw_rrtm (:,:,2,:)=cg_aero (:,:,2,:)
	5148	ELSE
	5149	abort_message='Only NSW=2 or 6 are possible with ' &
	5150	// 'aerosols and iflag_rrtm=1'
	5151	call abort_physic(modname,abort_message,1)
	5152	ENDIF
	5153
	5154	!--call LW optical properties for tropospheric aerosols
	5155	!--only works for INCA aerosol (aerosol_couple = TRUE)
	5156	CALL aeropt_lw_rrtm(aerosol_couple,paprs,tr_seri)
	5157	!
	5158	#else
	5159	abort_message='You should compile with -rrtm if running ' &
	5160	// 'with iflag_rrtm=1'
	5161	call abort_physic(modname,abort_message,1)
	5162	#endif
	5163	!
	5164	ENDIF
	5165	ENDIF
	5166	ELSE
	5167	tausum_aero(:,:,:) = 0.
	5168	IF (iflag_rrtm .EQ. 0) THEN !--old radiation
	5169	tau_aero(:,:,:,:) = 1.e-15
	5170	piz_aero(:,:,:,:) = 1.
	5171	cg_aero(:,:,:,:) = 0.
	5172	ELSE
	5173	tau_aero_sw_rrtm(:,:,:,:) = 1.e-15
	5174	tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
	5175	piz_aero_sw_rrtm(:,:,:,:) = 1.0
	5176	cg_aero_sw_rrtm(:,:,:,:) = 0.0
	5177	ENDIF
	5178	ENDIF
	5179	!
	5180	!--STRAT AEROSOL
	5181	!--updates tausum_aero,tau_aero,piz_aero,cg_aero
	5182	IF (flag_aerosol_strat.GT.0) THEN
	5183	IF (prt_level .GE.10) THEN
	5184	PRINT *,'appel a readaerosolstrat', mth_cur
	5185	ENDIF
	5186	IF (iflag_rrtm.EQ.0) THEN
	5187	IF (flag_aerosol_strat.EQ.1) THEN
	5188	CALL readaerosolstrato(debut)
	5189	ELSE
	5190	abort_message='flag_aerosol_strat must equal 1 for rrtm=0'
	5191	CALL abort_physic(modname,abort_message,1)
	5192	ENDIF
	5193	ELSE
	5194	#ifdef CPP_RRTM
	5195	IF (flag_aerosol_strat.EQ.1) THEN
	5196	CALL readaerosolstrato1_rrtm(debut)
	5197	ELSEIF (flag_aerosol_strat.EQ.2) THEN
	5198	CALL stratosphere_mask(t_seri, pplay, latitude_deg)
	5199	CALL readaerosolstrato2_rrtm(debut)
	5200	ELSE
	5201	abort_message='flag_aerosol_strat must equal 1 or 2 for rrtm=1'
	5202	CALL abort_physic(modname,abort_message,1)
	5203	ENDIF
	5204	#else
	5205	abort_message='You should compile with -rrtm if running ' &
	5206	// 'with iflag_rrtm=1'
	5207	CALL abort_physic(modname,abort_message,1)
	5208	#endif
	5209	ENDIF
	5210	ENDIF
	5211	!--fin STRAT AEROSOL
	5212	!
	5213
	5214	! Calculer les parametres optiques des nuages et quelques
	5215	! parametres pour diagnostiques:
	5216	!
	5217	IF (aerosol_couple.AND.config_inca=='aero') THEN
	5218	mass_solu_aero(:,:) = ccm(:,:,1)
	5219	mass_solu_aero_pi(:,:) = ccm(:,:,2)
	5220	END IF
	5221
	5222	IF (ok_newmicro) then
	5223	IF (iflag_rrtm.NE.0) THEN
	5224	#ifdef CPP_RRTM
	5225	IF (ok_cdnc.AND.NRADLP.NE.3) THEN
	5226	abort_message='RRTM choix incoherent NRADLP doit etre egal a 3 ' &
	5227	// 'pour ok_cdnc'
	5228	CALL abort_physic(modname,abort_message,1)
	5229	ENDIF
	5230	#else
	5231
	5232	abort_message='You should compile with -rrtm if running with '//'iflag_rrtm=1'
	5233	CALL abort_physic(modname,abort_message,1)
	5234	#endif
	5235	ENDIF
	5236	CALL newmicro (ok_cdnc, bl95_b0, bl95_b1, &
	5237	paprs, pplay, t_seri, cldliq, cldfra, &
	5238	cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, &
	5239	flwp, fiwp, flwc, fiwc, &
	5240	mass_solu_aero, mass_solu_aero_pi, &
	5241	cldtaupi, re, fl, ref_liq, ref_ice, &
	5242	ref_liq_pi, ref_ice_pi)
	5243	ELSE
	5244	CALL nuage (paprs, pplay, &
	5245	t_seri, cldliq, cldfra, cldtau, cldemi, &
	5246	cldh, cldl, cldm, cldt, cldq, &
	5247	ok_aie, &
	5248	mass_solu_aero, mass_solu_aero_pi, &
	5249	bl95_b0, bl95_b1, &
	5250	cldtaupi, re, fl)
	5251	ENDIF
	5252	!
	5253	!IM betaCRF
	5254	!
	5255	cldtaurad = cldtau
	5256	cldtaupirad = cldtaupi
	5257	cldemirad = cldemi
	5258	cldfrarad = cldfra
	5259
	5260	!
	5261	IF (lon1_beta.EQ.-180..AND.lon2_beta.EQ.180..AND. &
	5262	lat1_beta.EQ.90..AND.lat2_beta.EQ.-90.) THEN
	5263	!
	5264	! global
	5265	!
	5266	DO k=1, klev
	5267	DO i=1, klon
	5268	IF (pplay(i,k).GE.pfree) THEN
	5269	beta(i,k) = beta_pbl
	5270	ELSE
	5271	beta(i,k) = beta_free
	5272	ENDIF
	5273	IF (mskocean_beta) THEN
	5274	beta(i,k) = beta(i,k) * pctsrf(i,is_oce)
	5275	ENDIF
	5276	cldtaurad(i,k) = cldtau(i,k) * beta(i,k)
	5277	cldtaupirad(i,k) = cldtaupi(i,k) * beta(i,k)
	5278	cldemirad(i,k) = cldemi(i,k) * beta(i,k)
	5279	cldfrarad(i,k) = cldfra(i,k) * beta(i,k)
	5280	ENDDO
	5281	ENDDO
	5282	!
	5283	ELSE
	5284	!
	5285	! regional
	5286	!
	5287	DO k=1, klev
	5288	DO i=1,klon
	5289	!
	5290	IF (longitude_deg(i).ge.lon1_beta.AND. &
	5291	longitude_deg(i).le.lon2_beta.AND. &
	5292	latitude_deg(i).le.lat1_beta.AND. &
	5293	latitude_deg(i).ge.lat2_beta) THEN
	5294	IF (pplay(i,k).GE.pfree) THEN
	5295	beta(i,k) = beta_pbl
	5296	ELSE
	5297	beta(i,k) = beta_free
	5298	ENDIF
	5299	IF (mskocean_beta) THEN
	5300	beta(i,k) = beta(i,k) * pctsrf(i,is_oce)
	5301	ENDIF
	5302	cldtaurad(i,k) = cldtau(i,k) * beta(i,k)
	5303	cldtaupirad(i,k) = cldtaupi(i,k) * beta(i,k)
	5304	cldemirad(i,k) = cldemi(i,k) * beta(i,k)
	5305	cldfrarad(i,k) = cldfra(i,k) * beta(i,k)
	5306	ENDIF
	5307	!
	5308	ENDDO
	5309	ENDDO
	5310	!
	5311	ENDIF
	5312
	5313	!lecture de la chlorophylle pour le nouvel albedo de Sunghye Baek
	5314	IF (ok_chlorophyll) THEN
	5315	print*,"-- reading chlorophyll"
	5316	CALL readchlorophyll(debut)
	5317	ENDIF
	5318
	5319	!
	5320	!jq - introduce the aerosol direct and first indirect radiative forcings
	5321	!jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
	5322	IF (flag_aerosol .gt. 0) THEN
	5323	IF (iflag_rrtm .EQ. 0) THEN !--old radiation
	5324	IF (.NOT. aerosol_couple) THEN
	5325	!
	5326	CALL readaerosol_optic( &
	5327	debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, &
	5328	pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
	5329	mass_solu_aero, mass_solu_aero_pi, &
	5330	tau_aero, piz_aero, cg_aero, &
	5331	tausum_aero, tau3d_aero)
	5332	ENDIF
	5333	ELSE ! RRTM radiation
	5334	IF (aerosol_couple .AND. config_inca == 'aero' ) THEN
	5335	abort_message='config_inca=aero et rrtm=1 impossible'
	5336	call abort_physic(modname,abort_message,1)
	5337	ELSE
	5338	!
	5339	#ifdef CPP_RRTM
	5340	IF (NSW.EQ.6) THEN
	5341	!--new aerosol properties
	5342	!
	5343	CALL readaerosol_optic_rrtm( debut, aerosol_couple, &
	5344	new_aod, flag_aerosol, itap, jD_cur-jD_ref, &
	5345	pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
	5346	tr_seri, mass_solu_aero, mass_solu_aero_pi, &
	5347	tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
	5348	tausum_aero, tau3d_aero)
	5349
	5350	ELSE IF (NSW.EQ.2) THEN
	5351	!--for now we use the old aerosol properties
	5352	!
	5353	CALL readaerosol_optic( &
	5354	debut, new_aod, flag_aerosol, itap, jD_cur-jD_ref, &
	5355	pdtphys, pplay, paprs, t_seri, rhcl, presnivs, &
	5356	mass_solu_aero, mass_solu_aero_pi, &
	5357	tau_aero, piz_aero, cg_aero, &
	5358	tausum_aero, tau3d_aero)
	5359	!
	5360	!--natural aerosols
	5361	tau_aero_sw_rrtm(:,:,1,:)=tau_aero(:,:,3,:)
	5362	piz_aero_sw_rrtm(:,:,1,:)=piz_aero(:,:,3,:)
	5363	cg_aero_sw_rrtm (:,:,1,:)=cg_aero (:,:,3,:)
	5364	!--all aerosols
	5365	tau_aero_sw_rrtm(:,:,2,:)=tau_aero(:,:,2,:)
	5366	piz_aero_sw_rrtm(:,:,2,:)=piz_aero(:,:,2,:)
	5367	cg_aero_sw_rrtm (:,:,2,:)=cg_aero (:,:,2,:)
	5368	ELSE
	5369	abort_message='Only NSW=2 or 6 are possible with ' &
	5370	// 'aerosols and iflag_rrtm=1'
	5371	call abort_physic(modname,abort_message,1)
	5372	ENDIF
	5373
	5374	!--call LW optical properties for tropospheric aerosols
	5375	!--only works for INCA aerosol (aerosol_couple = TRUE)
	5376	CALL aeropt_lw_rrtm(aerosol_couple,paprs,tr_seri)
	5377	!
	5378	#else
	5379	abort_message='You should compile with -rrtm if running ' &
	5380	// 'with iflag_rrtm=1'
	5381	call abort_physic(modname,abort_message,1)
	5382	#endif
	5383	!
	5384	ENDIF
	5385	ENDIF
	5386	ELSE
	5387	tausum_aero(:,:,:) = 0.
	5388	IF (iflag_rrtm .EQ. 0) THEN !--old radiation
	5389	tau_aero(:,:,:,:) = 1.e-15
	5390	piz_aero(:,:,:,:) = 1.
	5391	cg_aero(:,:,:,:) = 0.
	5392	ELSE
	5393	tau_aero_sw_rrtm(:,:,:,:) = 1.e-15
	5394	tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
	5395	piz_aero_sw_rrtm(:,:,:,:) = 1.0
	5396	cg_aero_sw_rrtm(:,:,:,:) = 0.0
	5397	ENDIF
	5398	ENDIF
	5399	!
	5400	!--STRAT AEROSOL
	5401	!--updates tausum_aero,tau_aero,piz_aero,cg_aero
	5402	IF (flag_aerosol_strat.GT.0) THEN
	5403	IF (prt_level .GE.10) THEN
	5404	PRINT *,'appel a readaerosolstrat', mth_cur
	5405	ENDIF
	5406	IF (iflag_rrtm.EQ.0) THEN
	5407	IF (flag_aerosol_strat.EQ.1) THEN
	5408	CALL readaerosolstrato(debut)
	5409	ELSE
	5410	abort_message='flag_aerosol_strat must equal 1 for rrtm=0'
	5411	call abort_physic(modname,abort_message,1)
	5412	ENDIF
	5413	ELSE
	5414	#ifdef CPP_RRTM
	5415	IF (flag_aerosol_strat.EQ.1) THEN
	5416	CALL readaerosolstrato1_rrtm(debut)
	5417	ELSEIF (flag_aerosol_strat.EQ.2) THEN
	5418	CALL stratosphere_mask(t_seri, pplay, latitude_deg)
	5419	CALL readaerosolstrato2_rrtm(debut)
	5420	ELSE
	5421	abort_message='flag_aerosol_strat must equal 1 or 2 for rrtm=1'
	5422	call abort_physic(modname,abort_message,1)
	5423	ENDIF
	5424	#else
	5425	abort_message='You should compile with -rrtm if running ' &
	5426	// 'with iflag_rrtm=1'
	5427	call abort_physic(modname,abort_message,1)
	5428	#endif
	5429	ENDIF
	5430	ENDIF
	5431	!--fin STRAT AEROSOL
	5432
	5433	!--if ok_suntime_rrtm we use ancillay data for RSUN
	5434	!--previous values are therefore overwritten
	5435	!--this is needed for CMIP6 runs
	5436	!--and only possible for new radiation scheme
	5437	IF (iflag_rrtm.EQ.1.AND.ok_suntime_rrtm) THEN
	5438	#ifdef CPP_RRTM
	5439	CALL read_rsun_rrtm(debut)
	5440	#endif
	5441	ENDIF
	5442
	5443	if (mydebug) then
	5444	call writefield_phy('u_seri',u_seri,nbp_lev)
	5445	call writefield_phy('v_seri',v_seri,nbp_lev)
	5446	call writefield_phy('t_seri',t_seri,nbp_lev)
	5447	call writefield_phy('q_seri',q_seri,nbp_lev)
	5448	endif
	5449
	5450	!
	5451	!sonia : If Iflag_radia >=2, pertubation of some variables
	5452	!input to radiation (DICE)
	5453	!
	5454	IF (iflag_radia .ge. 2) THEN
	5455	zsav_tsol (:) = zxtsol(:)
	5456	call perturb_radlwsw(zxtsol,iflag_radia)
	5457	ENDIF
	5458
	5459	IF (aerosol_couple.AND.config_inca=='aero') THEN
	5460	#ifdef INCA
	5461	CALL radlwsw_inca &
	5462	(kdlon,kflev,dist, rmu0, fract, solaire, &
	5463	paprs, pplay,zxtsol,albsol1, albsol2, t_seri,q_seri, &
	5464	wo(:, :, 1), &
	5465	cldfrarad, cldemirad, cldtaurad, &
	5466	heat,heat0,cool,cool0,albpla, &
	5467	topsw,toplw,solsw,sollw, &
	5468	sollwdown, &
	5469	topsw0,toplw0,solsw0,sollw0, &
	5470	lwdn0, lwdn, lwup0, lwup, &
	5471	swdn0, swdn, swup0, swup, &
	5472	ok_ade, ok_aie, &
	5473	tau_aero, piz_aero, cg_aero, &
	5474	topswad_aero, solswad_aero, &
	5475	topswad0_aero, solswad0_aero, &
	5476	topsw_aero, topsw0_aero, &
	5477	solsw_aero, solsw0_aero, &
	5478	cldtaupirad, &
	5479	topswai_aero, solswai_aero)
	5480	#endif
	5481	ELSE
	5482	!
	5483	!IM calcul radiatif pour le cas actuel
	5484	!
	5485	RCO2 = RCO2_act
	5486	RCH4 = RCH4_act
	5487	RN2O = RN2O_act
	5488	RCFC11 = RCFC11_act
	5489	RCFC12 = RCFC12_act
	5490	!
	5491	IF (prt_level .GE.10) THEN
	5492	print *,' ->radlwsw, number 1 '
	5493	ENDIF
	5494	!
	5495	CALL radlwsw &
	5496	(dist, rmu0, fract, &
	5497	!albedo SB >>>
	5498	! paprs, pplay,zxtsol,albsol1, albsol2, &
	5499	paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, &
	5500	!albedo SB <<<
	5501	t_seri,q_seri,wo, &
	5502	cldfrarad, cldemirad, cldtaurad, &
	5503	ok_ade.OR.flag_aerosol_strat.GT.0, ok_aie, flag_aerosol, &
	5504	flag_aerosol_strat, &
	5505	tau_aero, piz_aero, cg_aero, &
	5506	tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
	5507	! Rajoute par OB pour RRTM
	5508	tau_aero_lw_rrtm, &
	5509	cldtaupirad,new_aod, &
	5510	zqsat, flwc, fiwc, &
	5511	ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
	5512	heat,heat0,cool,cool0,albpla, &
	5513	topsw,toplw,solsw,sollw, &
	5514	sollwdown, &
	5515	topsw0,toplw0,solsw0,sollw0, &
	5516	lwdn0, lwdn, lwup0, lwup, &
	5517	swdn0, swdn, swup0, swup, &
	5518	topswad_aero, solswad_aero, &
	5519	topswai_aero, solswai_aero, &
	5520	topswad0_aero, solswad0_aero, &
	5521	topsw_aero, topsw0_aero, &
	5522	solsw_aero, solsw0_aero, &
	5523	topswcf_aero, solswcf_aero, &
	5524	!-C. Kleinschmitt for LW diagnostics
	5525	toplwad_aero, sollwad_aero,&
	5526	toplwai_aero, sollwai_aero, &
	5527	toplwad0_aero, sollwad0_aero,&
	5528	!-end
	5529	ZLWFT0_i, ZFLDN0, ZFLUP0, &
	5530	ZSWFT0_i, ZFSDN0, ZFSUP0)
	5531
	5532	!--OB 30/05/2016
	5533	!--here we return swaero_diag to FALSE
	5534	!--and histdef will switch it back to TRUE if necessary
	5535	!--this is necessary to get the right swaero at first step
	5536	IF (debut) swaero_diag = .FALSE.
	5537	!
	5538	!IM 2eme calcul radiatif pour le cas perturbe ou au moins un
	5539	!IM des taux doit etre different du taux actuel
	5540	!IM Par defaut on a les taux perturbes egaux aux taux actuels
	5541	!
	5542	if (ok_4xCO2atm) then
	5543	if (RCO2_per.NE.RCO2_act.OR.RCH4_per.NE.RCH4_act.OR. &
	5544	RN2O_per.NE.RN2O_act.OR.RCFC11_per.NE.RCFC11_act.OR. &
	5545	RCFC12_per.NE.RCFC12_act) THEN
	5546	!
	5547	RCO2 = RCO2_per
	5548	RCH4 = RCH4_per
	5549	RN2O = RN2O_per
	5550	RCFC11 = RCFC11_per
	5551	RCFC12 = RCFC12_per
	5552	!
	5553	IF (prt_level .GE.10) THEN
	5554	print *,' ->radlwsw, number 2 '
	5555	ENDIF
	5556	!
	5557	CALL radlwsw &
	5558	(dist, rmu0, fract, &
	5559	!albedo SB >>>
	5560	! paprs, pplay,zxtsol,albsol1, albsol2, &
	5561	paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, &
	5562	!albedo SB <<<
	5563	t_seri,q_seri,wo, &
	5564	cldfra, cldemi, cldtau, &
	5565	ok_ade.OR.flag_aerosol_strat.GT.0, ok_aie, flag_aerosol, &
	5566	flag_aerosol_strat, &
	5567	tau_aero, piz_aero, cg_aero, &
	5568	tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
	5569	! Rajoute par OB pour RRTM
	5570	tau_aero_lw_rrtm, &
	5571	cldtaupi,new_aod, &
	5572	zqsat, flwc, fiwc, &
	5573	ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
	5574	heatp,heat0p,coolp,cool0p,albplap, &
	5575	topswp,toplwp,solswp,sollwp, &
	5576	sollwdownp, &
	5577	topsw0p,toplw0p,solsw0p,sollw0p, &
	5578	lwdn0p, lwdnp, lwup0p, lwupp, &
	5579	swdn0p, swdnp, swup0p, swupp, &
	5580	topswad_aerop, solswad_aerop, &
	5581	topswai_aerop, solswai_aerop, &
	5582	topswad0_aerop, solswad0_aerop, &
	5583	topsw_aerop, topsw0_aerop, &
	5584	solsw_aerop, solsw0_aerop, &
	5585	topswcf_aerop, solswcf_aerop, &
	5586	!-C. Kleinschmitt for LW diagnostics
	5587	toplwad_aerop, sollwad_aerop,&
	5588	toplwai_aerop, sollwai_aerop, &
	5589	toplwad0_aerop, sollwad0_aerop,&
	5590	!-end
	5591	ZLWFT0_i, ZFLDN0, ZFLUP0, &
	5592	ZSWFT0_i, ZFSDN0, ZFSUP0)
	5593	endif
	5594	endif
	5595	!
	5596	ENDIF ! aerosol_couple
	5597	itaprad = 0
	5598	!
	5599	! If Iflag_radia >=2, reset pertubed variables
	5600	!
	5601	IF (iflag_radia .ge. 2) THEN
	5602	zxtsol(:) = zsav_tsol (:)
	5603	ENDIF
	5604	ENDIF ! MOD(itaprad,radpas)
	5605	itaprad = itaprad + 1
	5606
	5607	IF (iflag_radia.eq.0) THEN
	5608	IF (prt_level.ge.9) THEN
	5609	PRINT *,'--------------------------------------------------'
	5610	PRINT *,'>>>> ATTENTION rayonnement desactive pour ce cas'
	5611	PRINT *,'>>>> heat et cool mis a zero '
	5612	PRINT *,'--------------------------------------------------'
	5613	END IF
	5614	heat=0.
	5615	cool=0.
	5616	sollw=0. ! MPL 01032011
	5617	solsw=0.
	5618	radsol=0.
	5619	swup=0. ! MPL 27102011 pour les fichiers AMMA_profiles et AMMA_scalars
	5620	swup0=0.
	5621	lwup=0.
	5622	lwup0=0.
	5623	lwdn=0.
	5624	lwdn0=0.
	5625	END IF
	5626
	5627	!
	5628	! Calculer radsol a l'exterieur de radlwsw
	5629	! pour prendre en compte le cycle diurne
	5630	! recode par Olivier Boucher en sept 2015
	5631	!
	5632	radsol=solsw*swradcorr+sollw
	5633
	5634	if (ok_4xCO2atm) then
	5635	radsolp=solswp*swradcorr+sollwp
	5636	endif
	5637
	5638	!
	5639	! Ajouter la tendance des rayonnements (tous les pas)
	5640	! avec une correction pour le cycle diurne dans le SW
	5641	!
	5642
	5643	DO k=1, klev
	5644	d_t_swr(:,k)=swradcorr(:)heat(:,k)dtime/RDAY
	5645	d_t_sw0(:,k)=swradcorr(:)heat0(:,k)dtime/RDAY
	5646	d_t_lwr(:,k)=-cool(:,k)*dtime/RDAY
	5647	d_t_lw0(:,k)=-cool0(:,k)*dtime/RDAY
	5648	ENDDO
	5649
	5650	CALL add_phys_tend(du0,dv0,d_t_swr,dq0,dql0,dqi0,paprs,'SW',abortphy,flag_inhib_tend &
	5651	#ifdef ISO
	5652	& ,dxt0,dxtl0,dxti0 &
	5653	#endif
	5654	& )
	5655	CALL add_phys_tend(du0,dv0,d_t_lwr,dq0,dql0,dqi0,paprs,'LW',abortphy,flag_inhib_tend &
	5656	#ifdef ISO
	5657	& ,dxt0,dxtl0,dxti0 &
	5658	#endif
	5659	& )
	5660
	5661	!
	5662	if (mydebug) then
	5663	call writefield_phy('u_seri',u_seri,nbp_lev)
	5664	call writefield_phy('v_seri',v_seri,nbp_lev)
	5665	call writefield_phy('t_seri',t_seri,nbp_lev)
	5666	call writefield_phy('q_seri',q_seri,nbp_lev)
	5667	endif
	5668
	5669	!IM
	5670	IF (ip_ebil_phy.ge.2) THEN
	5671	ztit='after rad'
	5672	CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
	5673	, t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
	5674	, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec &
	5675	!#ifdef ISO
	5676	! & , xt_seri,xtl_seri,xts_seri,d_xtw, d_xtl, d_xts &
	5677	!#endif
	5678	& )
	5679	call diagphy(cell_area,ztit,ip_ebil_phy &
	5680	, topsw, toplw, solsw, sollw, zero_v &
	5681	, zero_v, zero_v, zero_v, ztsol &
	5682	, d_h_vcol, d_qt, d_ec &
	5683	, fs_bound, fq_bound )
	5684	END IF
	5685	!
	5686	!
	5687	! Calculer l'hydrologie de la surface
	5688	!
	5689	! CALL hydrol(dtime,pctsrf,rain_fall, snow_fall, zxevap,
	5690	! . agesno, ftsol,fqsurf,fsnow, ruis)
	5691	!
	5692
	5693	!
	5694	! Calculer le bilan du sol et la derive de temperature (couplage)
	5695	!
	5696	DO i = 1, klon
	5697	! bils(i) = radsol(i) - sens(i) - evap(i)*RLVTT
	5698	! a la demande de JLD
	5699	bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
	5700	ENDDO
	5701	!
	5702	!moddeblott(jan95)
	5703	! Appeler le programme de parametrisation de l'orographie
	5704	! a l'echelle sous-maille:
	5705	!
	5706	IF (prt_level .GE.10) THEN
	5707	print *,' call orography ? ', ok_orodr
	5708	ENDIF
	5709	!
	5710	IF (ok_orodr) THEN
	5711	!
	5712	! selection des points pour lesquels le shema est actif:
	5713	igwd=0
	5714	DO i=1,klon
	5715	itest(i)=0
	5716	! IF ((zstd(i).gt.10.0)) THEN
	5717	IF (((zpic(i)-zmea(i)).GT.100.).AND.(zstd(i).GT.10.0)) THEN
	5718	itest(i)=1
	5719	igwd=igwd+1
	5720	idx(igwd)=i
	5721	ENDIF
	5722	ENDDO
	5723	! igwdim=MAX(1,igwd)
	5724	!
	5725	IF (ok_strato) THEN
	5726
	5727	CALL drag_noro_strato(klon,klev,dtime,paprs,pplay, &
	5728	zmea,zstd, zsig, zgam, zthe,zpic,zval, &
	5729	igwd,idx,itest, &
	5730	t_seri, u_seri, v_seri, &
	5731	zulow, zvlow, zustrdr, zvstrdr, &
	5732	d_t_oro, d_u_oro, d_v_oro)
	5733
	5734	ELSE
	5735	CALL drag_noro(klon,klev,dtime,paprs,pplay, &
	5736	zmea,zstd, zsig, zgam, zthe,zpic,zval, &
	5737	igwd,idx,itest, &
	5738	t_seri, u_seri, v_seri, &
	5739	zulow, zvlow, zustrdr, zvstrdr, &
	5740	d_t_oro, d_u_oro, d_v_oro)
	5741	ENDIF
	5742	!
	5743	! ajout des tendances
	5744	!-----------------------------------------------------------------------
	5745	! ajout des tendances de la trainee de l'orographie
	5746	CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,dqi0,paprs,'oro', &
	5747	abortphy,flag_inhib_tend &
	5748	#ifdef ISO
	5749	& ,dxt0,dxtl0,dxti0 &
	5750	#endif
	5751	& )
	5752	!----------------------------------------------------------------------
	5753	!
	5754	ENDIF ! fin de test sur ok_orodr
	5755	!
	5756	if (mydebug) then
	5757	call writefield_phy('u_seri',u_seri,nbp_lev)
	5758	call writefield_phy('v_seri',v_seri,nbp_lev)
	5759	call writefield_phy('t_seri',t_seri,nbp_lev)
	5760	call writefield_phy('q_seri',q_seri,nbp_lev)
	5761	endif
	5762
	5763	IF (ok_orolf) THEN
	5764	!
	5765	! selection des points pour lesquels le shema est actif:
	5766	igwd=0
	5767	DO i=1,klon
	5768	itest(i)=0
	5769	IF ((zpic(i)-zmea(i)).GT.100.) THEN
	5770	itest(i)=1
	5771	igwd=igwd+1
	5772	idx(igwd)=i
	5773	ENDIF
	5774	ENDDO
	5775	! igwdim=MAX(1,igwd)
	5776	!
	5777	IF (ok_strato) THEN
	5778
	5779	CALL lift_noro_strato(klon,klev,dtime,paprs,pplay, &
	5780	latitude_deg,zmea,zstd,zpic,zgam,zthe,zpic,zval, &
	5781	igwd,idx,itest, &
	5782	t_seri, u_seri, v_seri, &
	5783	zulow, zvlow, zustrli, zvstrli, &
	5784	d_t_lif, d_u_lif, d_v_lif )
	5785
	5786	ELSE
	5787	CALL lift_noro(klon,klev,dtime,paprs,pplay, &
	5788	latitude_deg,zmea,zstd,zpic, &
	5789	itest, &
	5790	t_seri, u_seri, v_seri, &
	5791	zulow, zvlow, zustrli, zvstrli, &
	5792	d_t_lif, d_u_lif, d_v_lif)
	5793	ENDIF
	5794
	5795	! ajout des tendances de la portance de l'orographie
	5796	CALL add_phys_tend(d_u_lif, d_v_lif, d_t_lif, dq0, dql0, dqi0, paprs, &
	5797	'lif', abortphy,flag_inhib_tend &
	5798	#ifdef ISO
	5799	& ,dxt0,dxtl0,dxti0 &
	5800	#endif
	5801	& )
	5802	ENDIF ! fin de test sur ok_orolf
	5803
	5804	IF (ok_hines) then
	5805	! HINES GWD PARAMETRIZATION
	5806	east_gwstress=0.
	5807	west_gwstress=0.
	5808	du_gwd_hines=0.
	5809	dv_gwd_hines=0.
	5810	CALL hines_gwd(klon, klev, dtime, paprs, pplay, latitude_deg, t_seri, &
	5811	u_seri, v_seri, zustr_gwd_hines, zvstr_gwd_hines, d_t_hin, &
	5812	du_gwd_hines, dv_gwd_hines)
	5813	zustr_gwd_hines=0.
	5814	zvstr_gwd_hines=0.
	5815	DO k = 1, klev
	5816	zustr_gwd_hines(:)=zustr_gwd_hines(:)+ du_gwd_hines(:, k)/dtime &
	5817	* (paprs(:, k)-paprs(:, k+1))/rg
	5818	zvstr_gwd_hines(:)=zvstr_gwd_hines(:)+ dv_gwd_hines(:, k)/dtime &
	5819	* (paprs(:, k)-paprs(:, k+1))/rg
	5820	ENDDO
	5821
	5822	d_t_hin(:, :)=0.
	5823	CALL add_phys_tend(du_gwd_hines, dv_gwd_hines, d_t_hin, dq0, dql0, &
	5824	dqi0, paprs, 'hin', abortphy,flag_inhib_tend &
	5825	#ifdef ISO
	5826	& ,dxt0,dxtl0,dxti0 &
	5827	#endif
	5828	& )
	5829	ENDIF
	5830
	5831	IF (.not. ok_hines .and. ok_gwd_rando) then
	5832	CALL acama_GWD_rando(DTIME, pplay, latitude_deg, t_seri, u_seri, &
	5833	v_seri, rot, zustr_gwd_front, zvstr_gwd_front, du_gwd_front, &
	5834	dv_gwd_front, east_gwstress, west_gwstress)
	5835	zustr_gwd_front=0.
	5836	zvstr_gwd_front=0.
	5837	DO k = 1, klev
	5838	zustr_gwd_front(:)=zustr_gwd_front(:)+ du_gwd_front(:, k)/dtime &
	5839	* (paprs(:, k)-paprs(:, k+1))/rg
	5840	zvstr_gwd_front(:)=zvstr_gwd_front(:)+ dv_gwd_front(:, k)/dtime &
	5841	* (paprs(:, k)-paprs(:, k+1))/rg
	5842	ENDDO
	5843
	5844	CALL add_phys_tend(du_gwd_front, dv_gwd_front, dt0, dq0, dql0, dqi0, &
	5845	paprs, 'front_gwd_rando', abortphy,flag_inhib_tend &
	5846	#ifdef ISO
	5847	& ,dxt0,dxtl0,dxti0 &
	5848	#endif
	5849	& )
	5850	ENDIF
	5851
	5852	if (ok_gwd_rando) then
	5853	call FLOTT_GWD_rando(DTIME, pplay, t_seri, u_seri, v_seri, &
	5854	rain_fall + snow_fall, zustr_gwd_rando, zvstr_gwd_rando, &
	5855	du_gwd_rando, dv_gwd_rando, east_gwstress, west_gwstress)
	5856	CALL add_phys_tend(du_gwd_rando, dv_gwd_rando, dt0, dq0, dql0, dqi0, &
	5857	paprs, 'flott_gwd_rando', abortphy,flag_inhib_tend &
	5858	#ifdef ISO
	5859	& ,dxt0,dxtl0,dxti0 &
	5860	#endif
	5861	& )
	5862	zustr_gwd_rando=0.
	5863	zvstr_gwd_rando=0.
	5864	DO k = 1, klev
	5865	zustr_gwd_rando(:)=zustr_gwd_rando(:)+ du_gwd_rando(:, k)/dtime &
	5866	* (paprs(:, k)-paprs(:, k+1))/rg
	5867	zvstr_gwd_rando(:)=zvstr_gwd_rando(:)+ dv_gwd_rando(:, k)/dtime &
	5868	* (paprs(:, k)-paprs(:, k+1))/rg
	5869	ENDDO
	5870	end if
	5871
	5872	! STRESS NECESSAIRES: TOUTE LA PHYSIQUE
	5873
	5874	if (mydebug) then
	5875	call writefield_phy('u_seri',u_seri,nbp_lev)
	5876	call writefield_phy('v_seri',v_seri,nbp_lev)
	5877	call writefield_phy('t_seri',t_seri,nbp_lev)
	5878	call writefield_phy('q_seri',q_seri,nbp_lev)
	5879	endif
	5880
	5881	DO i = 1, klon
	5882	zustrph(i)=0.
	5883	zvstrph(i)=0.
	5884	ENDDO
	5885	DO k = 1, klev
	5886	DO i = 1, klon
	5887	zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/dtime* &
	5888	(paprs(i,k)-paprs(i,k+1))/rg
	5889	zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/dtime* &
	5890	(paprs(i,k)-paprs(i,k+1))/rg
	5891	ENDDO
	5892	ENDDO
	5893	!
	5894	!IM calcul composantes axiales du moment angulaire et couple des montagnes
	5895	!
	5896	IF (is_sequential .and. ok_orodr) THEN
	5897	CALL aaam_bud (27,klon,klev,jD_cur-jD_ref,jH_cur, &
	5898	ra,rg,romega, &
	5899	latitude_deg,longitude_deg,pphis, &
	5900	zustrdr,zustrli,zustrph, &
	5901	zvstrdr,zvstrli,zvstrph, &
	5902	paprs,u,v, &
	5903	aam, torsfc)
	5904	ENDIF
	5905	!IM cf. FLott END
	5906	!IM
	5907	IF (ip_ebil_phy.ge.2) THEN
	5908	ztit='after orography'
	5909	CALL diagetpq(cell_area,ztit,ip_ebil_phy,2,2,dtime &
	5910	, t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
	5911	, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec &
	5912	!#ifdef ISO
	5913	! & , xt_seri,xtl_seri,xts_seri,d_xtw, d_xtl, d_xts &
	5914	!#endif
	5915	& )
	5916	call diagphy(cell_area,ztit,ip_ebil_phy &
	5917	, zero_v, zero_v, zero_v, zero_v, zero_v &
	5918	, zero_v, zero_v, zero_v, ztsol &
	5919	, d_h_vcol, d_qt, d_ec &
	5920	, fs_bound, fq_bound )
	5921	END IF
	5922
	5923	#ifdef ISO
	5924	#ifdef ISOVERIF
	5925	if (iso_HDO.gt.0) then
	5926	call iso_verif_aberrant_enc_vect2D( &
	5927	& xt_seri,q_seri, &
	5928	& 'physiq 5902, juste avant method',ntraciso,klon,klev)
	5929	endif
	5930	#endif
	5931	#endif
	5932
	5933	!DC Calcul de la tendance due au methane
	5934	IF(ok_qch4) THEN
	5935	CALL METHOX(1,klon,klon,klev,q_seri,d_q_ch4,pplay)
	5936	! ajout de la tendance d'humidite due au methane
	5937	CALL add_phys_tend(du0, dv0, dt0, d_q_ch4*dtime, dql0, dqi0, paprs, &
	5938	'q_ch4', abortphy,flag_inhib_tend &
	5939	#ifdef ISO
	5940	& ,d_xt_ch4*dtime,dxtl0,dxti0 &
	5941	#endif
	5942	& )
	5943	END IF
	5944
	5945	#ifdef ISO
	5946	#ifdef ISOVERIF
	5947	if (iso_HDO.gt.0) then
	5948	call iso_verif_aberrant_enc_vect2D( &
	5949	& xt_seri,q_seri, &
	5950	& 'physiq 5924, juste apres method',ntraciso,klon,klev)
	5951	endif
	5952	#endif
	5953	#endif
	5954
	5955	!
	5956	!
	5957	!====================================================================
	5958	! Interface Simulateur COSP (Calipso, ISCCP, MISR, ..)
	5959	!====================================================================
	5960	! Abderrahmane 24.08.09
	5961
	5962	IF (ok_cosp) THEN
	5963	! adeclarer
	5964	#ifdef CPP_COSP
	5965	IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/dtime)).EQ.0) THEN
	5966
	5967	IF (prt_level .GE.10) THEN
	5968	print*,'freq_cosp',freq_cosp
	5969	ENDIF
	5970	mr_ozone=wo(:, :, 1) * dobson_u * 1e3 / zmasse
	5971	! print*,'Dans physiq.F avant appel cosp ref_liq,ref_ice=',
	5972	! s ref_liq,ref_ice
	5973	call phys_cosp(itap,dtime,freq_cosp, &
	5974	ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
	5975	ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, &
	5976	klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
	5977	JrNt,ref_liq,ref_ice, &
	5978	pctsrf(:,is_ter)+pctsrf(:,is_lic), &
	5979	zu10m,zv10m,pphis, &
	5980	zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, &
	5981	qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
	5982	prfl(:,1:klev),psfl(:,1:klev), &
	5983	pmflxr(:,1:klev),pmflxs(:,1:klev), &
	5984	mr_ozone,cldtau, cldemi)
	5985
	5986	! L calipso2D,calipso3D,cfadlidar,parasolrefl,atb,betamol,
	5987	! L cfaddbze,clcalipso2,dbze,cltlidarradar,
	5988	! M clMISR,
	5989	! R clisccp2,boxtauisccp,boxptopisccp,tclisccp,ctpisccp,
	5990	! I tauisccp,albisccp,meantbisccp,meantbclrisccp)
	5991
	5992	ENDIF
	5993
	5994	#endif
	5995	ENDIF !ok_cosp
	5996
	5997
	5998	!c====================================================================
	5999	!c Ajout de la production de tritium (naturelle et essais nucléaires)
	6000	!c====================================================================
	6001	!C
	6002	#ifdef ISO
	6003	#ifdef ISOVERIF
	6004	call iso_verif_noNaN_vect2D(xt_seri, &
	6005	& 'physiq 5595: avant appel tritium',ntraciso,klon,klev)
	6006	#endif
	6007	call iso_tritium(paprs,pplay, &
	6008	& zphi,dtime, &
	6009	& d_xt_prod_nucl, &
	6010	& d_xt_cosmo, &
	6011	& d_xt_decroiss, &
	6012	& xt_seri)
	6013	#ifdef ISOVERIF
	6014	call iso_verif_noNaN_vect2D(xt_seri, &
	6015	& 'physiq 5607: apres appel tritium',ntraciso,klon,klev)
	6016	#endif
	6017
	6018	#ifdef ISOVERIF
	6019	if (iso_HTO.gt.0) then ! Tritium
	6020	ixt=iso_HTO
	6021	do i=1,klon
	6022	do k=1,klev
	6023	if (iso_verif_positif_strict_nostop(xt_seri(ixt,i,k), &
	6024	& 'physiq 5620 : xt_seri(HTO) nul ou negatif').eq.1) then
	6025	write(,) 'ixt,i,klon,k,klev=',ixt,i,klon,k,klev
	6026	write(,) 'xt_seri(iso_HTO,i,k)=',xt_seri(ixt,i,k)
	6027	stop
	6028	endif
	6029	enddo
	6030	enddo
	6031	endif
	6032	#endif
	6033	! write(,)'itap=',itap
	6034	! write(,)'itau_phy=',itau_phy
	6035	! write(,)'jD_cur=',jD_cur
	6036	#endif
	6037	!ifdef ISO
	6038
	6039	! Marine
	6040
	6041	IF (ok_airs) then
	6042
	6043	IF (itap.eq.1.or.MOD(itap,NINT(freq_airs/dtime)).EQ.0) THEN
	6044	write(,) 'je vais appeler simu_airs, ok_airs, freq_airs=', &
	6045	& ok_airs, freq_airs
	6046	call simu_airs(itap,rneb, t_seri, cldemi, fiwc, ref_ice, pphi, pplay, paprs,&
	6047	& map_prop_hc,map_prop_hist,&
	6048	& map_emis_hc,map_iwp_hc,map_deltaz_hc,map_pcld_hc,map_tcld_hc,&
	6049	& map_emis_Cb,map_pcld_Cb,map_tcld_Cb,&
	6050	& map_emis_ThCi,map_pcld_ThCi,map_tcld_ThCi,&
	6051	& map_emis_Anv,map_pcld_Anv,map_tcld_Anv,&
	6052	& map_emis_hist,map_iwp_hist,map_deltaz_hist,map_rad_hist,&
	6053	& map_ntot,map_hc,map_hist,&
	6054	& map_Cb,map_ThCi,map_Anv,&
	6055	& alt_tropo )
	6056	ENDIF
	6057
	6058	ENDIF ! ok_airs
	6059
	6060
	6061	! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	6062	!AA
	6063	!AA Installation de l'interface online-offline pour traceurs
	6064	!AA
	6065	!====================================================================
	6066	! Calcul des tendances traceurs
	6067	!====================================================================
	6068	!
	6069
	6070	IF (type_trac=='repr') THEN
	6071	sh_in(:,:) = q_seri(:,:)
	6072	ELSE
	6073	sh_in(:,:) = qx(:,:,ivap)
	6074	END IF
	6075
	6076	call phytrac ( &
	6077	itap, days_elapsed+1, jH_cur, debut, &
	6078	lafin, dtime, u, v, t, &
	6079	paprs, pplay, pmfu, pmfd, &
	6080	pen_u, pde_u, pen_d, pde_d, &
	6081	cdragh, coefh(1:klon,1:klev,is_ave), fm_therm, entr_therm, &
	6082	u1, v1, ftsol, pctsrf, &
	6083	zustar, zu10m, zv10m, &
	6084	wstar(:,is_ave), ale_bl, ale_wake, &
	6085	latitude_deg, longitude_deg, &
	6086	frac_impa,frac_nucl, beta_prec_fisrt,beta_prec, &
	6087	presnivs, pphis, pphi, albsol1, &
	6088	sh_in, rhcl, cldfra, rneb, &
	6089	diafra, cldliq, itop_con, ibas_con, &
	6090	pmflxr, pmflxs, prfl, psfl, &
	6091	da, phi, mp, upwd, &
	6092	phi2, d1a, dam, sij, wght_cvfd, & !<<RomP+RL
	6093	wdtrainA, wdtrainM, sigd, clw,elij, & !<<RomP
	6094	ev, ep, epmlmMm, eplaMm, & !<<RomP
	6095	dnwd, aerosol_couple, flxmass_w, &
	6096	tau_aero, piz_aero, cg_aero, ccm, &
	6097	rfname, &
	6098	d_tr_dyn, & !<<RomP
	6099	tr_seri)
	6100
	6101	IF (offline) THEN
	6102
	6103	IF (prt_level.ge.9) &
	6104	print*,'Attention on met a 0 les thermiques pour phystoke'
	6105	call phystokenc ( &
	6106	nlon,klev,pdtphys,longitude_deg,latitude_deg, &
	6107	t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
	6108	fm_therm,entr_therm, &
	6109	cdragh,coefh(1:klon,1:klev,is_ave),u1,v1,ftsol,pctsrf, &
	6110	frac_impa, frac_nucl, &
	6111	pphis,cell_area,dtime,itap, &
	6112	qx(:,:,ivap),da,phi,mp,upwd,dnwd)
	6113
	6114
	6115	ENDIF
	6116
	6117	!
	6118	! Calculer le transport de l'eau et de l'energie (diagnostique)
	6119	!
	6120	CALL transp (paprs,zxtsol, &
	6121	t_seri, q_seri, u_seri, v_seri, zphi, &
	6122	ve, vq, ue, uq)
	6123	!
	6124	!IM global posePB BEG
	6125	IF(1.EQ.0) THEN
	6126	!
	6127	CALL transp_lay (paprs,zxtsol, &
	6128	t_seri, q_seri, u_seri, v_seri, zphi, &
	6129	ve_lay, vq_lay, ue_lay, uq_lay)
	6130	!
	6131	ENDIF !(1.EQ.0) THEN
	6132	!IM global posePB END
	6133	! Accumuler les variables a stocker dans les fichiers histoire:
	6134	!
	6135
	6136	!================================================================
	6137	! Conversion of kinetic and potential energy into heat, for
	6138	! parameterisation of subgrid-scale motions
	6139	!================================================================
	6140
	6141	d_t_ec(:,:)=0.
	6142	forall (k=1: nbp_lev) exner(:, k) = (pplay(:, k)/paprs(:,1))**RKAPPA
	6143	CALL ener_conserv(klon,klev,pdtphys,u,v,t,qx(:,:,ivap), &
	6144	u_seri,v_seri,t_seri,q_seri,pbl_tke(:,:,is_ave)-tke0(:,:), &
	6145	zmasse,exner,d_t_ec)
	6146	t_seri(:,:)=t_seri(:,:)+d_t_ec(:,:)
	6147
	6148	!IM
	6149	IF (ip_ebil_phy.ge.1) THEN
	6150	ztit='after physic'
	6151	CALL diagetpq(cell_area,ztit,ip_ebil_phy,1,1,dtime &
	6152	, t_seri,q_seri,ql_seri,qs_seri,u_seri,v_seri,paprs,pplay &
	6153	, d_h_vcol, d_qt, d_qw, d_ql, d_qs, d_ec &
	6154	!#ifdef ISO
	6155	! & , xt_seri,xtl_seri,xts_seri,d_xtw, d_xtl, d_xts &
	6156	!#endif
	6157	& )
	6158	! Comme les tendances de la physique sont ajoute dans la dynamique,
	6159	! on devrait avoir que la variation d'entalpie par la dynamique
	6160	! est egale a la variation de la physique au pas de temps precedent.
	6161	! Donc la somme de ces 2 variations devrait etre nulle.
	6162
	6163	call diagphy(cell_area,ztit,ip_ebil_phy &
	6164	, topsw, toplw, solsw, sollw, sens &
	6165	, evap, rain_fall, snow_fall, ztsol &
	6166	, d_h_vcol, d_qt, d_ec &
	6167	, fs_bound, fq_bound )
	6168	!
	6169	d_h_vcol_phy=d_h_vcol
	6170	!
	6171	END IF
	6172	!
	6173	!=======================================================================
	6174	! SORTIES
	6175	!=======================================================================
	6176	!
	6177	!IM initialisation + calculs divers diag AMIP2
	6178	!
	6179	include "calcul_divers.h"
	6180	!
	6181	!IM Interpolation sur les niveaux de pression du NMC
	6182	! -------------------------------------------------
	6183	#ifdef CPP_XIOS
	6184	!$OMP MASTER
	6185	!On recupere la valeur de la missing value donnee dans le xml
	6186	CALL xios_get_field_attr("t850",default_value=missing_val_omp)
	6187	! PRINT *,"ARNAUD value missing ",missing_val_omp
	6188	!$OMP END MASTER
	6189	!$OMP BARRIER
	6190	missing_val=missing_val_omp
	6191	#endif
	6192	#ifndef CPP_XIOS
	6193	missing_val=missing_val_nf90
	6194	#endif
	6195	!
	6196	include "calcul_STDlev.h"
	6197	!
	6198	! slp sea level pressure derived from Arpege-IFS : CALL ctstar + CALL pppmer
	6199	CALL diag_slp(klon,t_seri,paprs,pplay,pphis,ptstar,pt0,slp)
	6200	!
	6201	!cc prw = eau precipitable
	6202	! prlw = colonne eau liquide
	6203	! prlw = colonne eau solide
	6204	prw(:) = 0.
	6205	prlw(:) = 0.
	6206	prsw(:) = 0.
	6207	DO k = 1, klev
	6208	prw(:) = prw(:) + q_seri(:,k)*zmasse(:,k)
	6209	prlw(:) = prlw(:) + ql_seri(:,k)*zmasse(:,k)
	6210	prsw(:) = prsw(:) + qs_seri(:,k)*zmasse(:,k)
	6211	ENDDO
	6212	#ifdef ISO
	6213	!#ifdef ISOVERIF
	6214	! write(,) 'physiq 4868: calcul prw'
	6215	!#endif
	6216
	6217	DO i = 1, klon
	6218	do ixt=1,ntraciso
	6219	xtprw(ixt,i) = 0.
	6220	DO k = 1, klev
	6221	xtprw(ixt,i) = xtprw(ixt,i) + &
	6222	& xt_seri(ixt,i,k)*(paprs(i,k)-paprs(i,k+1))/RG
	6223	ENDDO !DO k = 1, klev
	6224	enddo !do ixt=1,ntraciso
	6225	enddo !DO i = 1, klon
	6226	#endif
	6227	!
	6228	IF (type_trac == 'inca') THEN
	6229	#ifdef INCA
	6230	CALL VTe(VTphysiq)
	6231	CALL VTb(VTinca)
	6232
	6233	CALL chemhook_end ( &
	6234	dtime, &
	6235	pplay, &
	6236	t_seri, &
	6237	tr_seri, &
	6238	nbtr, &
	6239	paprs, &
	6240	q_seri, &
	6241	cell_area, &
	6242	pphi, &
	6243	pphis, &
	6244	zx_rh)
	6245
	6246	CALL VTe(VTinca)
	6247	CALL VTb(VTphysiq)
	6248	#endif
	6249	END IF
	6250
	6251
	6252	!
	6253	! Convertir les incrementations en tendances
	6254	!
	6255	IF (prt_level .GE.10) THEN
	6256	print *,'Convertir les incrementations en tendances '
	6257	ENDIF
	6258	!
	6259	if (mydebug) then
	6260	call writefield_phy('u_seri',u_seri,nbp_lev)
	6261	call writefield_phy('v_seri',v_seri,nbp_lev)
	6262	call writefield_phy('t_seri',t_seri,nbp_lev)
	6263	call writefield_phy('q_seri',q_seri,nbp_lev)
	6264	endif
	6265
	6266	DO k = 1, klev
	6267	DO i = 1, klon
	6268	d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / dtime
	6269	d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / dtime
	6270	d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / dtime
	6271	d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / dtime
	6272	d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / dtime
	6273	!CR: on ajoute le contenu en glace
	6274	if (nqo.eq.3) then
	6275	d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / dtime
	6276	endif
	6277	ENDDO
	6278	ENDDO
	6279
	6280	! C Risi: dispatcher les isotopes dans les xt_seri
	6281	#ifdef ISO
	6282	do ixt=1,ntraciso
	6283	DO k = 1, klev
	6284	DO i = 1, klon
	6285	iq=iqiso(ixt,ivap)
	6286	d_qx(i,k,iq) = ( xt_seri(ixt,i,k) - qx(i,k,iq) ) / dtime
	6287	iq=iqiso(ixt,iliq)
	6288	d_qx(i,k,iq) = ( xtl_seri(ixt,i,k) - qx(i,k,iq) ) / dtime
	6289	if (nqo.eq.3) then
	6290	iq=iqiso(ixt,isol)
	6291	d_qx(i,k,iq) = ( xts_seri(ixt,i,k) - qx(i,k,iq) ) / dtime
	6292	endif
	6293	enddo !DO i = 1, klon
	6294	enddo ! DO k = 1, klev
	6295	enddo !do ixt=1,niso
	6296	!#ifdef ISOVERIF
	6297	! write(,) 'physiq 6120: d_qx(1,1,:)=',d_qx(1,1,:)
	6298	! write(,) 'qx(1,1,:)=',qx(1,1,:)
	6299	! write(,) 'xt_seri(:,1,1)=',xt_seri(:,1,1)
	6300	!#endif
	6301	#endif
	6302	! #ifdef ISO
	6303	!
	6304	!CR: nb de traceurs eau: nqo
	6305	! IF (nqtot.GE.3) THEN
	6306	IF (nqtot.GE.(nqo+1)) THEN
	6307	! DO iq = 3, nqtot
	6308
	6309	! write(,) 'nqtot,nqo=',nqtot,nqo
	6310	#ifdef ISO
	6311	do itr=1,nqtottr
	6312	iq=itr_indice(itr)
	6313	DO k = 1, klev
	6314	DO i = 1, klon
	6315	d_qx(i,k,iq) = ( tr_seri(i,k,itr) - qx(i,k,iq) ) / dtime
	6316	ENDDO
	6317	ENDDO !DO k = 1, klev
	6318	enddo !do itr=1,nqtottr
	6319	#else
	6320	DO iq = nqo+1, nqtot
	6321	itr=iq-nqo
	6322	DO k = 1, klev
	6323	DO i = 1, klon
	6324	! d_qx(i,k,iq) = ( tr_seri(i,k,iq-2) - qx(i,k,iq) ) / dtime
	6325	! d_qx(i,k,iq) = ( tr_seri(i,k,iq-nqo) - qx(i,k,iq) ) / dtime
	6326	! modif CRisi
	6327	d_qx(i,k,iq) = ( tr_seri(i,k,itr) - qx(i,k,iq) ) / dtime
	6328	ENDDO
	6329	ENDDO
	6330	ENDDO !DO iq = nqo+1, nqtot
	6331	#endif
	6332	ENDIF
	6333
	6334	!#ifdef ISOVERIF
	6335	! write(,) 'physiq 6155: qx(1,1,:)=',qx(1,1,:)
	6336	! write(,) 'physiq 6155b: d_qx(1,1,:)=',d_qx(1,1,:)
	6337	!#endif
	6338	!
	6339	!IM rajout diagnostiques bilan KP pour analyse MJO par Jun-Ichi Yano
	6340	!IM global posePB include "write_bilKP_ins.h"
	6341	!IM global posePB include "write_bilKP_ave.h"
	6342	!
	6343	#ifdef ISO
	6344	#ifdef ISOVERIF
	6345	if (iso_HDO.gt.0) then
	6346	call iso_verif_aberrant_enc_vect2D( &
	6347	& xt_seri,q_seri, &
	6348	& 'physiq 6322, juste avant OB mass fixer',ntraciso,klon,klev)
	6349	endif
	6350	#endif
	6351	#endif
	6352
	6353	!--OB mass fixer
	6354	!--profile is corrected to force mass conservation of water
	6355	IF (mass_fixer) THEN
	6356	qql2(:)=0.0
	6357	DO k = 1, klev
	6358	qql2(:)=qql2(:)+(q_seri(:,k)+ql_seri(:,k)+qs_seri(:,k))*zmasse(:,k)
	6359	ENDDO
	6360	DO i = 1, klon
	6361	!--compute ratio of what q+ql should be with conservation to what it is
	6362	corrqql=(qql1(i)+(evap(i)-rain_fall(i)-snow_fall(i))*pdtphys)/qql2(i)
	6363	DO k = 1, klev
	6364	q_seri(i,k) =q_seri(i,k)*corrqql
	6365	ql_seri(i,k)=ql_seri(i,k)*corrqql
	6366	ENDDO
	6367	ENDDO
	6368	#ifdef ISO
	6369	do ixt=1,ntraciso
	6370	xtql2(ixt,:)=0.0
	6371	DO k = 1, klev
	6372	xtql2(ixt,:)=xtql2(ixt,:)+(xt_seri(ixt,:,k)+xtl_seri(ixt,:,k)+xts_seri(ixt,:,k))*zmasse(:,k)
	6373	ENDDO
	6374	DO i = 1, klon
	6375	!--compute ratio of what q+ql should be with conservation to what it is
	6376	corrxtql(ixt)=(xtql1(ixt,i)+(xtevap(ixt,i)-xtrain_fall(ixt,i)-xtsnow_fall(ixt,i))*pdtphys)/xtql2(ixt,i)
	6377	DO k = 1, klev
	6378	xt_seri(ixt,i,k) =xt_seri(ixt,i,k)*corrxtql(ixt)
	6379	xtl_seri(ixt,i,k)=xtl_seri(ixt,i,k)*corrxtql(ixt)
	6380	ENDDO
	6381	ENDDO
	6382	enddo !do ixt=1,ntraciso
	6383	#endif
	6384	ENDIF
	6385
	6386	!--fin mass fixer
	6387
	6388	#ifdef ISO
	6389	#ifdef ISOVERIF
	6390	if (iso_HDO.gt.0) then
	6391	call iso_verif_aberrant_enc_vect2D( &
	6392	& xt_seri,q_seri, &
	6393	& 'physiq 6367, juste apres OB mass fixer',ntraciso,klon,klev)
	6394	endif
	6395	#endif
	6396	#endif
	6397
	6398
	6399	! Sauvegarder les valeurs de t et q a la fin de la physique:
	6400	!
	6401	u_ancien(:,:) = u_seri(:,:)
	6402	v_ancien(:,:) = v_seri(:,:)
	6403	t_ancien(:,:) = t_seri(:,:)
	6404	q_ancien(:,:) = q_seri(:,:)
	6405	ql_ancien(:,:) = ql_seri(:,:)
	6406	qs_ancien(:,:) = qs_seri(:,:)
	6407	#ifdef ISO
	6408	xt_ancien(:,:,:)=xt_seri(:,:,:)
	6409	xtl_ancien(:,:,:)=xtl_seri(:,:,:)
	6410	xts_ancien(:,:,:)=xts_seri(:,:,:)
	6411	#endif
	6412	CALL water_int(klon,klev,q_ancien,zmasse,prw_ancien)
	6413	CALL water_int(klon,klev,ql_ancien,zmasse,prlw_ancien)
	6414	CALL water_int(klon,klev,qs_ancien,zmasse,prsw_ancien)
	6415	! !! RomP >>>
	6416	!CR: nb de traceurs eau: nqo
	6417	IF (nqtot.GT.nqo) THEN
	6418	#ifdef ISO
	6419	do itr=1,nqtottr
	6420	! iq=itr_indice(itr)
	6421	tr_ancien(:,:,itr) = tr_seri(:,:,itr)
	6422	enddo !do itr=1,nqtottr
	6423	#else
	6424	DO iq = nqo+1, nqtot
	6425	tr_ancien(:,:,iq-nqo) = tr_seri(:,:,iq-nqo)
	6426	ENDDO
	6427	#endif
	6428	ENDIF
	6429	! !! RomP <<<
	6430
	6431
	6432	!==========================================================================
	6433	! Sorties des tendances pour un point particulier
	6434	! a utiliser en 1D, avec igout=1 ou en 3D sur un point particulier
	6435	! pour le debug
	6436	! La valeur de igout est attribuee plus haut dans le programme
	6437	!==========================================================================
	6438
	6439	if (prt_level.ge.1) then
	6440	write(lunout,*) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
	6441	write(lunout,*) &
	6442	'nlon,klev,nqtot,debut,lafin,jD_cur, jH_cur, pdtphys pct tlos'
	6443	write(lunout,*) &
	6444	nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur ,pdtphys, &
	6445	pctsrf(igout,is_ter), pctsrf(igout,is_lic),pctsrf(igout,is_oce), &
	6446	pctsrf(igout,is_sic)
	6447	write(lunout,*) 'd_t_dyn,d_t_con,d_t_lsc,d_t_ajsb,d_t_ajs,d_t_eva'
	6448	do k=1,klev
	6449	write(lunout,*) d_t_dyn(igout,k),d_t_con(igout,k), &
	6450	d_t_lsc(igout,k),d_t_ajsb(igout,k),d_t_ajs(igout,k), &
	6451	d_t_eva(igout,k)
	6452	enddo
	6453	write(lunout,*) 'cool,heat'
	6454	do k=1,klev
	6455	write(lunout,*) cool(igout,k),heat(igout,k)
	6456	enddo
	6457
	6458	!jyg< (En attendant de statuer sur le sort de d_t_oli)
	6459	!jyg! write(lunout,*) 'd_t_oli,d_t_vdf,d_t_oro,d_t_lif,d_t_ec'
	6460	!jyg! do k=1,klev
	6461	!jyg! write(lunout,*) d_t_oli(igout,k),d_t_vdf(igout,k), &
	6462	!jyg! d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
	6463	!jyg! enddo
	6464	write(lunout,*) 'd_t_vdf,d_t_oro,d_t_lif,d_t_ec'
	6465	do k=1,klev
	6466	write(lunout,*) d_t_vdf(igout,k), &
	6467	d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
	6468	enddo
	6469	!>jyg
	6470
	6471	write(lunout,*) 'd_ps ',d_ps(igout)
	6472	write(lunout,*) 'd_u, d_v, d_t, d_qx1, d_qx2 '
	6473	do k=1,klev
	6474	write(lunout,*) d_u(igout,k),d_v(igout,k),d_t(igout,k), &
	6475	d_qx(igout,k,1),d_qx(igout,k,2)
	6476	enddo
	6477	endif
	6478
	6479	!==========================================================================
	6480
	6481	!============================================================
	6482	! Calcul de la temperature potentielle
	6483	!============================================================
	6484	DO k = 1, klev
	6485	DO i = 1, klon
	6486	!JYG/IM theta en debut du pas de temps
	6487	!JYG/IM theta(i,k)=t(i,k)(100000./pplay(i,k))*(RD/RCPD)
	6488	!JYG/IM theta en fin de pas de temps de physique
	6489	theta(i,k)=t_seri(i,k)(100000./pplay(i,k))*(RD/RCPD)
	6490	! thetal: 2 lignes suivantes a decommenter si vous avez les fichiers
	6491	! MPL 20130625
	6492	! fth_fonctions.F90 et parkind1.F90
	6493	! sinon thetal=theta
	6494	! thetal(i,k)=fth_thetal(pplay(i,k),t_seri(i,k),q_seri(i,k),
	6495	! : ql_seri(i,k))
	6496	thetal(i,k)=theta(i,k)
	6497	ENDDO
	6498	ENDDO
	6499	!
	6500
	6501	! 22.03.04 BEG
	6502	!=============================================================
	6503	! Ecriture des sorties
	6504	!=============================================================
	6505	#ifdef CPP_IOIPSL
	6506
	6507	! Recupere des varibles calcule dans differents modules
	6508	! pour ecriture dans histxxx.nc
	6509
	6510	! Get some variables from module fonte_neige_mod
	6511	CALL fonte_neige_get_vars(pctsrf, &
	6512	zxfqcalving, zxfqfonte, zxffonte, zxrunofflic &
	6513	#ifdef ISO
	6514	& ,zxfxtcalving, zxfxtfonte,zxxtrunofflic &
	6515	#endif
	6516	& )
	6517
	6518
	6519	!=============================================================
	6520	! Separation entre thermiques et non thermiques dans les sorties
	6521	! de fisrtilp
	6522	!=============================================================
	6523
	6524	if (iflag_thermals>=1) then
	6525	d_t_lscth=0.
	6526	d_t_lscst=0.
	6527	d_q_lscth=0.
	6528	d_q_lscst=0.
	6529	do k=1,klev
	6530	do i=1,klon
	6531	if (ptconvth(i,k)) then
	6532	d_t_lscth(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
	6533	d_q_lscth(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
	6534	else
	6535	d_t_lscst(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
	6536	d_q_lscst(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
	6537	endif
	6538	enddo
	6539	enddo
	6540
	6541	do i=1,klon
	6542	plul_st(i)=prfl(i,lmax_th(i)+1)+psfl(i,lmax_th(i)+1)
	6543	plul_th(i)=prfl(i,1)+psfl(i,1)
	6544	enddo
	6545	endif
	6546
	6547
	6548	!On effectue les sorties:
	6549
	6550	! write(,) 'physiq tmp 6338'
	6551	CALL phys_output_write(itap, pdtphys, paprs, pphis, &
	6552	pplay, lmax_th, aerosol_couple, &
	6553	ok_ade, ok_aie, ivap, iliq, isol, new_aod, &
	6554	ok_sync, ptconv, read_climoz, clevSTD, &
	6555	ptconvth, d_t, qx, d_qx, zmasse, &
	6556	flag_aerosol, flag_aerosol_strat, ok_cdnc)
	6557
	6558	include "write_histday_seri.h"
	6559
	6560	CALL write_paramLMDZ_phy(itap,nid_ctesGCM,ok_sync)
	6561
	6562	#endif
	6563
	6564
	6565	!====================================================================
	6566	! Arret du modele apres hgardfou en cas de detection d'un
	6567	! plantage par hgardfou
	6568	!====================================================================
	6569
	6570	IF (abortphy==1) THEN
	6571	abort_message ='Plantage hgardfou'
	6572	CALL abort_physic (modname,abort_message,1)
	6573	ENDIF
	6574
	6575	! 22.03.04 END
	6576	!
	6577	!====================================================================
	6578	! Si c'est la fin, il faut conserver l'etat de redemarrage
	6579	!====================================================================
	6580	!
	6581	#ifdef ISO
	6582	#ifdef ISOVERIF
	6583	if (iso_HDO.gt.0) then
	6584	call iso_verif_aberrant_enc_vect2D( &
	6585	& xt_ancien,q_ancien, &
	6586	& 'physiq 6577',ntraciso,klon,klev)
	6587	endif
	6588	write(,) 'physiq 3731: verif avant phyisoredem'
	6589	do k=1,klev
	6590	do i=1,klon
	6591	if (iso_eau.gt.0) then
	6592	call iso_verif_egalite_choix(xt_ancien(iso_eau,i,k), &
	6593	& q_ancien(i,k),'physiq 3728: avant phyisoredem', &
	6594	& errmax,errmaxrel)
	6595	endif ! if (iso_eau.gt.0) then
	6596	#ifdef ISOTRAC
	6597	if (ok_isotrac) then
	6598	call iso_verif_traceur(xt_ancien(1,i,k),'physiq 4802')
	6599	endif !if (ok_isotrac) then
	6600	#endif
	6601	enddo
	6602	enddo !do k=1,klev
	6603	#endif
	6604	#endif
	6605	! ISO
	6606
	6607	IF (lafin) THEN
	6608	itau_phy = itau_phy + itap
	6609	CALL phyredem ("restartphy.nc")
	6610	! open(97,form="unformatted",file="finbin")
	6611	! write(97) u_seri,v_seri,t_seri,q_seri
	6612	! close(97)
	6613	!$OMP MASTER
	6614	if (read_climoz >= 1) then
	6615	if (is_mpi_root) then
	6616	call nf95_close(ncid_climoz)
	6617	end if
	6618	deallocate(press_climoz) ! pointer
	6619	end if
	6620	!$OMP END MASTER
	6621	ENDIF
	6622
	6623	! first=.false.
	6624
	6625
	6626	END SUBROUTINE physiq
	6627
	6628	END MODULE physiq_mod

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

Download in other formats:

Original Format