Context Navigation

physiq_mod.F90 @ 5655

Last change on this file since 5655 was 5655, checked in by idelkadi, 6 weeks ago
Output of direct radiative fluxes when running LMDZ with Ecrad
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Id`
File size: 216.7 KB

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

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

Download in other formats:

Original Format