Context Navigation

physiq_mod.F90 @ 3940

Last change on this file since 3940 was 3940, checked in by crisi, 3 years ago
replace files by symbloic liks from phylmdiso towards phylmd. Many files at once
File size: 237.8 KB

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

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

Download in other formats:

Original Format