Context Navigation

physiq_mod.F90 @ 5836

Last change on this file since 5836 was 5836, checked in by rkazeroni, 2 months ago

For GPU porting of add_phys_tend and add_wake_tend routines:

Put routine into module (speeds up source-to-source transformation)
Add "horizontal" comment to specify possible names of horizontal variables
Move declaration of variables with SAVE attributes from the compute routine to the module
Modernize declarations of character arguments to fortran90 standards

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

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

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

Download in other formats:

Original Format