Context Navigation

physiq_mod.F90 @ 4690

Last change on this file since 4690 was 4690, checked in by fhourdin, 10 months ago
Preparation/test de convergence num en temps
File size: 254.9 KB

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

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

Download in other formats:

Original Format