Context Navigation

physiq_mod.F90 @ 5096

Last change on this file since 5096 was 4576, checked in by Laurent Fairhead, 17 months ago
Forgot modifications in phylmdiso LF
File size: 250.9 KB

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

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

Download in other formats:

Original Format