Context Navigation

physiq_mod.F90 @ 5589

Last change on this file since 5589 was 5589, checked in by aborella, 2 months ago

Multiple changes:

added new radiative diagnostics for contrails
added ok_rad_contrail option to allow for a double call of RRTM (w/ and w/o contrails)
transformed resuspension of snow into ice sedimentation (poprecip)
some modifications in poprecip in line with the ones from EV
cleaned sublimation of ice clouds in lmdz_lscp_condensation, option ok_ice_supersat
aviation emissions can now be read with IOIPSL (in lon/lat mode)

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: 219.3 KB

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

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

Download in other formats:

Original Format