Context Navigation

physiq_mod.F90 @ 4143

Last change on this file since 4143 was 4143, checked in by dcugnet, 2 years ago

Some variables are renamed or replaced by direct equivalents:
- iso_indnum -> tracers(:)%iso_iName
- niso_possibles -> niso
- iqiso -> iqIsoPha ; index_trac -> itZonIso
- ok_iso_verif -> isoCheck
- ntraceurs_zone -> nzone ; ntraciso -> ntiso
- qperemin -> min_qparent ; masseqmin -> min_qmass ; ratiomin -> min_ratio
Some renamed variables are only aliased with the older name (using USE <module>, ONLY: <oldName> => <newName>) in routines where they are repeated many times.
Few hard-coded indexes are now computed (examples: ilic, iso, ivap, irneb, iq_vap, iq_liq, iso_H2O, iso_HDO, iso_HTO, iso_O17, iso_O18).
The IF(isoCheck) test is now embedded in the check_isotopes_seq and check_isotopes_loc routines (lighter calling).

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

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

Download in other formats:

Original Format