Context Navigation

physiq_mod.F90 @ 4594

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

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

Download in other formats:

Original Format