Context Navigation

physiq_mod.F90 @ 5877

Last change on this file since 5877 was 5877, checked in by aborella, 20 hours ago
Bugfix for compiling SCM and with ecRad with contrails
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: 225.6 KB

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

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

Download in other formats:

Original Format