Context Navigation

physiq_mod.F90 @ 4539

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

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

Download in other formats:

Original Format