Context Navigation

physiq_mod.F90 @ 4704

Last change on this file since 4704 was 4703, checked in by Laurent Fairhead, 22 months ago
Moving around some variable declarations to their right place
File size: 255.5 KB

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

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

Download in other formats:

Original Format