Context Navigation

physiq_mod.F90 @ 5609

Last change on this file since 5609 was 5609, checked in by aborella, 8 weeks ago
changed treatment of prognostic variables for prognostic clouds adapted sedimentation and autoconversion for prognostic cirrus clouds cloud mixing, ice sedimentation and ISSR diagnosis are now consistent with the water vapor PDF simplified assumptions for ice crystals deposition / sublimation first version of the coupling between prognostic cirrus clouds and deep convection added persistent contrail cirrus clouds in radiative diagnostics
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: 221.3 KB

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

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

Download in other formats:

Original Format