Context Navigation

physiq_mod.F90 @ 4120

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

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

Download in other formats:

Original Format