Context Navigation

physiq_mod.F90 @ 4722

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

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

Download in other formats:

Original Format