Context Navigation

physiq_mod.F90 @ 4124

Last change on this file since 4124 was 4124, checked in by dcugnet, 2 years ago
Remove solsym, ok_isotopes (=niso>0), ok_isotrac (=nzone>0)
File size: 241.7 KB

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

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

Download in other formats:

Original Format