Context Navigation

physiq_mod.F90 @ 4358

Last change on this file since 4358 was 4358, checked in by dcugnet, 19 months ago

remove "config_inca" variable from "control_mod" and "infotrac_phy" (read in infotrac)
only kept version of "type_trac" is in tracinca ; few tests are moved from infotrac to this module.
simplify and generalize a bit the routines "phyetat0_get" and "phyetat0_srf" from phyetat0, converted to a module.
fix the isotopic version: few "USE … » were misplaced between ISOVERIF CPP keys
fix the old water and derived isotopes names in the ISOTRAC case

File size: 241.7 KB

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

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

Download in other formats:

Original Format