Context Navigation

physiq_mod.F90 @ 3927

Last change on this file since 3927 was 3927, checked in by Laurent Fairhead, 3 years ago
Initial import of the physics wih isotopes from Camille Risi CR
File size: 236.6 KB

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

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

Download in other formats:

Original Format