Context Navigation

physiq_mod.F90 @ 3531

Last change on this file since 3531 was 3531, checked in by Laurent Fairhead, 5 years ago
Replaced STOP statements by a call to abort_physic in phylmd as per ticket #86 Still some work to be done in phylmd subdirectories
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 182.7 KB

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

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

Download in other formats:

Original Format