Context Navigation

physiq_mod.F90 @ 4056

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

Most of the changes are intended to help to eventually remove the constraints about the tracers assumptions, in particular water tracers.

Remove index tables itr_indice and niadv, replaced by tracers(:)%isAdvected and tracers(:)%isH2OFamily. Most of the loops are now from 1 to nqtot:
- DO iq=nqo+1,nqtot loops are replaced with: DO iq=1,nqtot

IF(tracers(iq)%isH2Ofamily) CYCLE

DO it=1,nbtr; iq=niadv(it+nqo)

and DO it=1,nqtottr; iq=itr_indice(it) loops are replaced with:

it = 0
DO iq = 1, nqtot

IF(.NOT.tracers(iq)%isAdvected .OR. tracers(iq)%isH2Ofamily) CYCLE
it = it+1

Move some StratAer? related code from infotrac to infotrac_phy
Remove "nqperes" variable:

DO iq=1,nqpere loops are replaced with:
DO iq=1,nqtot

IF(tracers(iq)%parent/='air') CYCLE

Cosmetic changes (justification, SELECT CASE instead of multiple IF...) mostly in advtrac* routines.

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

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

Download in other formats:

Original Format