Context Navigation

physiq_mod.F90 @ 4622

Last change on this file since 4622 was 4619, checked in by yann meurdesoif, 12 months ago

Suppress usage of preprocessing key CPP_XIOS.
Wrapper file is used to suppress XIOS symbol when xios is not linked and not used (-io ioipsl)
The CPP_XIOS key is replaced in model by "using_xios" boolean variable to switch between IOIPSL or XIOS output.

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

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

Download in other formats:

Original Format