
! $Id: physiq_mod.F90 3908 2021-05-20 07:11:13Z idelkadi $

!#define IO_DEBUG
MODULE physiq_mod

  IMPLICIT NONE

CONTAINS

  SUBROUTINE physiq (nlon,nlev, &
       debut,lafin,pdtphys_, &
       paprs,pplay,pphi,pphis,presnivs, &
       u,v,rot,t,qx, &
       flxmass_w, &
       d_u, d_v, d_t, d_qx, d_ps)

! For clarity, the "USE" section is now arranged in alphabetical order,
! with a separate section for CPP keys
! PLEASE try to follow this rule 

    USE ACAMA_GWD_rando_m, only: ACAMA_GWD_rando
    USE aero_mod
    USE add_phys_tend_mod, only : add_pbl_tend, add_phys_tend, diag_phys_tend, prt_enerbil, &
         fl_ebil, fl_cor_ebil
    USE assert_m, only: assert
    USE change_srf_frac_mod
    USE conf_phys_m, only: conf_phys
    USE carbon_cycle_mod, ONLY : infocfields_init, RCO2_glo, carbon_cycle_rad
    USE CFMIP_point_locations   ! IM stations CFMIP
    USE cmp_seri_mod
    USE dimphy
    USE etat0_limit_unstruct_mod
    USE FLOTT_GWD_rando_m, only: FLOTT_GWD_rando
    USE fonte_neige_mod, ONLY  : fonte_neige_get_vars
    USE geometry_mod, ONLY: cell_area, latitude_deg, longitude_deg
    USE ioipsl, only: histbeg, histvert, histdef, histend, histsync, &
         histwrite, ju2ymds, ymds2ju, getin
    USE ioipsl_getin_p_mod, ONLY : getin_p
    USE indice_sol_mod
    USE infotrac_phy, ONLY: nqtot, nbtr, nqo, tracers, type_trac,ivap,iliq,isol
    USE readTracFiles_mod, ONLY: addPhase
    USE strings_mod,  ONLY: strIdx
    USE iophy
    USE limit_read_mod, ONLY : init_limit_read
    USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, nbp_lev, klon_glo, grid1dTo2d_glo, grid_type, unstructured
    USE mod_phys_lmdz_mpi_data, only: is_mpi_root
    USE mod_phys_lmdz_para
    USE netcdf95, only: nf95_close
    USE netcdf, only: nf90_fill_real     ! IM for NMC files
    USE open_climoz_m, only: open_climoz ! ozone climatology from a file
    USE ozonecm_m, only: ozonecm ! ozone of J.-F. Royer
    USE pbl_surface_mod, ONLY : pbl_surface
    USE phyaqua_mod, only: zenang_an
    USE phyetat0_mod, only: phyetat0
    USE phystokenc_mod, ONLY: offline, phystokenc
    USE phys_cal_mod, only: year_len, mth_len, days_elapsed, jh_1jan, &
         year_cur, mth_cur,jD_cur, jH_cur, jD_ref, day_cur, hour, calend
!!  USE phys_local_var_mod, ONLY : a long list of variables
!!              ==> see below, after "CPP Keys" section
    USE phys_state_var_mod ! Variables sauvegardees de la physique
    USE phys_output_mod
    USE phys_output_ctrlout_mod
    USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level, &
         alert_first_call, call_alert, prt_alerte
    USE readaerosol_mod, ONLY : init_aero_fromfile
    USE readaerosolstrato_m, ONLY : init_readaerosolstrato
    USE radlwsw_m, only: radlwsw
    USE regr_horiz_time_climoz_m, ONLY: regr_horiz_time_climoz
    USE regr_pr_time_av_m, only: regr_pr_time_av
    USE surface_data,     ONLY : type_ocean, ok_veget
    USE time_phylmdz_mod, only: current_time, itau_phy, pdtphys, raz_date, update_time
    USE tracinca_mod, ONLY: config_inca
    USE tropopause_m,     ONLY: dyn_tropopause
    USE ice_sursat_mod,  ONLY: flight_init, airplane
    USE vampir
    USE write_field_phy
    USE wxios, ONLY: g_ctx, wxios_set_context
    USE lmdz_lscp, ONLY : lscp
    USE lmdz_call_cloud_optics_prop, ONLY : call_cloud_optics_prop
    USE lmdz_lscp_old, ONLY : fisrtilp
    USE lmdz_call_blowing_snow, ONLY : call_blowing_snow_sublim_sedim
    USE lmdz_wake_ini, ONLY : wake_ini
    USE yamada_ini_mod, ONLY : yamada_ini
    USE lmdz_atke_turbulence_ini, ONLY : atke_ini
    USE lmdz_thermcell_ini, ONLY : thermcell_ini, iflag_thermals_tenv
    USE lmdz_thermcell_dtke, ONLY : thermcell_dtke
    USE lmdz_blowing_snow_ini, ONLY : blowing_snow_ini , qbst_bs 
    USE lmdz_lscp_ini, ONLY : lscp_ini
    USE lmdz_ratqs_main, ONLY : ratqs_main
    USE lmdz_ratqs_ini, ONLY : ratqs_ini
    USE lmdz_cloud_optics_prop_ini, ONLY : cloud_optics_prop_ini
    USE phys_output_var_mod, ONLY :      cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv
    USE phys_output_var_mod, ONLY : cloud_cover_sw, cloud_cover_sw_s2
    USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA

    USE geometry_mod,      ONLY: longitude, latitude, boundslon, boundslat, ind_cell_glo
    USE time_phylmdz_mod,  ONLY: ndays
    USE infotrac_phy,      ONLY: nqCO2

    USE time_phylmdz_mod,    ONLY: annee_ref, day_ini, day_ref, start_time
    USE vertical_layers_mod, ONLY: aps, bps, ap, bp

    USE lmdz_xios, ONLY: xios_update_calendar, xios_context_finalize, xios_get_field_attr, &
            xios_field_is_active, xios_context, xios_set_current_context
    USE wxios, ONLY: missing_val, using_xios
    USE paramLMDZ_phy_mod

        USE phytracr_spl_mod, ONLY: phytracr_spl, phytracr_spl_out_init
    USE phys_output_write_spl_mod
    USE phytrac_mod, ONLY : phytrac_init, phytrac
    USE phys_output_write_mod

    USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_DUST

!!!!!!!!!!!!!!!!!! "USE" section for CPP keys !!!!!!!!!!!!!!!!!!!!!!!!


#ifdef REPROBUS
    USE chem_rep, ONLY: Init_chem_rep_xjour, d_q_rep, d_ql_rep, d_qi_rep, &
                        ptrop, ttrop, ztrop, gravit, itroprep, Z1, Z2, fac, B
    USE strataer_local_var_mod
    USE strataer_emiss_mod, ONLY: strataer_emiss_init
#endif

#ifdef CPP_RRTM
    USE YOERAD, ONLY : NRADLP
!    USE YOESW, ONLY : RSUN
#endif


    USE phys_local_var_mod, ONLY: d_q_emiss
    USE strataer_local_var_mod
    USE strataer_nuc_mod, ONLY: strataer_nuc_init
    USE strataer_emiss_mod, ONLY: strataer_emiss_init

#ifdef ISO
    USE infotrac_phy, ONLY: iqIsoPha,niso, ntraciso=>ntiso, nzone
    USE isotopes_mod, ONLY: iso_eau,iso_HDO,iso_O18,iso_O17,iso_HTO, &
          bidouille_anti_divergence,ok_bidouille_wake, &
          modif_ratqs,essai_convergence,iso_init,ridicule_rain,tnat, &
          ridicule,ridicule_snow
    USE isotopes_routines_mod, ONLY: iso_tritium,dispatch,together
#ifdef ISOVERIF
    USE isotopes_verif_mod, ONLY: errmax,errmaxrel, &
          deltalim,deltalim_snow, deltaD,deltaO,nlevmaxO17, &
          iso_verif_positif_nostop,iso_verif_egalite_vect2D, &
          iso_verif_aberrant_enc_vect2D,iso_verif_noNaN_vect2D, &
          iso_verif_noNaN,iso_verif_aberrant_vect2D, &
          iso_verif_o18_aberrant,iso_verif_aberrant_o17, &
          iso_verif_aberrant,iso_verif_egalite_choix, &
          iso_verif_aberrant_encadre,iso_verif_egalite, &
          iso_verif_aberrant_choix,iso_verif_positif, &
          iso_verif_positif_choix_vect,iso_verif_o18_aberrant_nostop, &
          iso_verif_init,iso_verif_aberrant_enc_choix_nostop,&
          iso_verif_positif_strict_nostop,iso_verif_O18_aberrant_enc_vect2D
#endif
#ifdef ISOTRAC
    USE isotrac_mod, ONLY: option_traceurs,iso_traceurs_init, &
&       option_tmin,nzone_temp
    USE isotrac_routines_mod, only: initialise_bassins_boites, &
          isotrac_recolorise_general,isotrac_recolorise_conv, &
          iso_verif_traceur_jbid_vect,iso_verif_traceur_jbid_pos_vect
#ifdef ISOVERIF
    USE isotrac_routines_mod, only: iso_verif_traceur_pbidouille
    USE isotopes_verif_mod, ONLY: iso_verif_traceur, &
&       iso_verif_traceur_justmass,iso_verif_traceur_vect, &
&       iso_verif_trac17_q_deltad,iso_verif_trac_masse_vect, &
&       iso_verif_tag17_q_deltaD_vect, iso_verif_tracpos_choix_nostop
#endif
#endif
#endif


!!!!!!!!!!!!!!!!!!  END "USE" for CPP keys !!!!!!!!!!!!!!!!!!!!!!

USE physiqex_mod, ONLY : physiqex
USE phys_local_var_mod, ONLY: phys_local_var_init, phys_local_var_end, &
       ! [Variables internes non sauvegardees de la physique]
       ! Variables locales pour effectuer les appels en serie
       t_seri,q_seri,ql_seri,qs_seri,qbs_seri,u_seri,v_seri,tr_seri,rneb_seri, &
       qx_seri, & ! CR
       rhcl, &        
       ! Dynamic tendencies (diagnostics)
       d_t_dyn,d_q_dyn,d_ql_dyn,d_qs_dyn,d_qbs_dyn,d_u_dyn,d_v_dyn,d_tr_dyn,d_rneb_dyn, &
       d_q_dyn2d,d_ql_dyn2d,d_qs_dyn2d,d_qbs_dyn2d, &
       ! Physic tendencies
       d_t_con,d_q_con,d_q_con_zmasse,d_u_con,d_v_con, &
       d_tr, &                              !! to be removed?? (jyg)
       d_t_wake,d_q_wake, &
       d_t_lwr,d_t_lw0,d_t_swr,d_t_sw0, &
       d_t_ajsb,d_q_ajsb, &
       d_t_ajs,d_q_ajs,d_u_ajs,d_v_ajs, &
!       d_t_ajs_w,d_q_ajs_w, &
!       d_t_ajs_x,d_q_ajs_x, &

       d_t_eva,d_q_eva,d_ql_eva,d_qi_eva, &
       d_qx_eva, &
       d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc, &
       d_t_lscst,d_q_lscst, &
       d_t_lscth,d_q_lscth, &
       plul_st,plul_th, &

       d_t_vdf,d_q_vdf, d_qbs_vdf, d_u_vdf,d_v_vdf,d_t_diss, &
       d_t_vdf_x, d_t_vdf_w, &
       d_q_vdf_x, d_q_vdf_w, &
       d_ts, &

       d_t_bsss,d_q_bsss,d_qbs_bsss, &

!       d_t_oli,d_u_oli,d_v_oli, &
       d_t_oro,d_u_oro,d_v_oro, &
       d_t_oro_gw,d_u_oro_gw,d_v_oro_gw, &
       d_t_lif,d_u_lif,d_v_lif, &
       d_t_ec, &

       du_gwd_hines,dv_gwd_hines,d_t_hin, &
       dv_gwd_rando,dv_gwd_front, &
       east_gwstress,west_gwstress, &
       d_q_ch4, &
       ! proprecip
       qraindiag, qsnowdiag, &
       dqreva, dqssub, &
       dqrauto,dqrcol,dqrmelt,dqrfreez, &
       dqsauto,dqsagg,dqsrim,dqsmelt,dqsfreez, &
       !  Special RRTM
       ZLWFT0_i,ZSWFT0_i,ZFLDN0,  &
       ZFLUP0,ZFSDN0,ZFSUP0,      &

       topswad_aero,solswad_aero,   &
       topswai_aero,solswai_aero,   &
       topswad0_aero,solswad0_aero, &
       !LW additional
       toplwad_aero,sollwad_aero,   &
       toplwai_aero,sollwai_aero,   &
       toplwad0_aero,sollwad0_aero, &
       !pour Ecrad
       topswad_aero_s2, solswad_aero_s2,   &
       topswai_aero_s2, solswai_aero_s2,   &
       topswad0_aero_s2, solswad0_aero_s2, &
       topsw_aero_s2, topsw0_aero_s2,      &
       solsw_aero_s2, solsw0_aero_s2,      &
       topswcf_aero_s2, solswcf_aero_s2,   &
       !LW diagnostics
       toplwad_aero_s2, sollwad_aero_s2,   &
       toplwai_aero_s2, sollwai_aero_s2,   &
       toplwad0_aero_s2, sollwad0_aero_s2, &

       topsw_aero,solsw_aero,       &
       topsw0_aero,solsw0_aero,     &
       topswcf_aero,solswcf_aero,   &
       tausum_aero,tau3d_aero,      &
       drytausum_aero,              &

       !variables CFMIP2/CMIP5
       topswad_aerop, solswad_aerop,   &
       topswai_aerop, solswai_aerop,   &
       topswad0_aerop, solswad0_aerop, &
       topsw_aerop, topsw0_aerop,      & 
       solsw_aerop, solsw0_aerop,      &
       topswcf_aerop, solswcf_aerop,   &
       !LW diagnostics
       toplwad_aerop, sollwad_aerop,   &
       toplwai_aerop, sollwai_aerop,   &
       toplwad0_aerop, sollwad0_aerop, &
       !pour Ecrad
       topswad_aero_s2, solswad_aero_s2,   &
       topswai_aero_s2, solswai_aero_s2,   &
       topswad0_aero_s2, solswad0_aero_s2, &
       topsw_aero_s2, topsw0_aero_s2,      &
       solsw_aero_s2, solsw0_aero_s2,      &
       topswcf_aero_s2, solswcf_aero_s2,   &
       !LW diagnostics
       toplwad_aero_s2, sollwad_aero_s2,   &
       toplwai_aero_s2, sollwai_aero_s2,   &
       toplwad0_aero_s2, sollwad0_aero_s2, &

       ptstar, pt0, slp, &

       bils, &

       cldh, cldl,cldm, cldq, cldt,      &
       JrNt,                             &
       dthmin, evap, snowerosion,fder, plcl, plfc,   &
       prw, prlw, prsw, prbsw, water_budget,         &
       s_lcl, s_pblh, s_pblt, s_therm,   &
       cdragm, cdragh,                   &
       zustar, zu10m, zv10m, rh2m, qsat2m, &
       zq2m, zt2m, zn2mout, weak_inversion, &
       zt2m_min_mon, zt2m_max_mon,   &         ! pour calcul_divers.h
       t2m_min_mon, t2m_max_mon,  &            ! pour calcul_divers.h

       s_pblh_x, s_pblh_w, &
       s_lcl_x, s_lcl_w,   &

       slab_wfbils, tpot, tpote,               &
       ue, uq, ve, vq, zxffonte,               &
       uwat, vwat,                             &
       zxfqcalving, zxfluxlat,                 &
       zxrunofflic,                            &
       zxtsol, snow_lsc, zxfqfonte, zxqsurf,   &
       delta_qsurf,                            &
       rain_lsc, rain_num,                     &

       sens_x, sens_w, &
       zxfluxlat_x, zxfluxlat_w, &

       pbl_tke_input, pbl_eps, l_mix, wprime,&
       t_therm, q_therm, u_therm, v_therm, &
       cdragh_x, cdragh_w, &
       cdragm_x, cdragm_w, &
       kh, kh_x, kh_w, &

       wake_k, &
       alp_wake, & 
       wake_h, wake_omg, &
                       ! tendencies of delta T and delta q:
       d_deltat_wk, d_deltaq_wk, &         ! due to wakes
       d_deltat_wk_gw, d_deltaq_wk_gw, &   ! due to wake induced gravity waves
       d_deltat_vdf, d_deltaq_vdf, &       ! due to vertical diffusion
       d_deltat_the, d_deltaq_the, &       ! due to thermals
       d_deltat_ajs_cv, d_deltaq_ajs_cv, & ! due to dry adjustment of (w) before convection
                       ! tendencies of wake fractional area and wake number per unit area:
       d_s_wk,  d_dens_a_wk,  d_dens_wk, &  ! due to wakes
!!!       d_s_vdf, d_dens_a_vdf, d_dens_vdf, & ! due to vertical diffusion
!!!       d_s_the, d_dens_a_the, d_dens_the, & ! due to thermals

       ptconv, ratqsc, &
       wbeff, convoccur, zmax_th, &
       sens, flwp, fiwp,  &
       alp_bl_conv,alp_bl_det,  &
       alp_bl_fluct_m,alp_bl_fluct_tke,  &
       alp_bl_stat, n2, s2,  strig, zcong, zlcl_th, &
       proba_notrig, random_notrig,  &
!!       cv_gen,  &  !moved to phys_state_var_mod

       dnwd0,  &
       omega,  &
       epmax_diag,  &
       !    Deep convective variables used in phytrac
       pmflxr, pmflxs,  &
       wdtrainA, wdtrainS, wdtrainM,  &
       upwd, dnwd, &
       ep,  &
       da, mp, &
       phi, &
       wght_cvfd, &
       phi2, &
       d1a, dam, &
       ev, &
       elij, &
       qtaa, &
       clw, &
       epmlmMm, eplaMm, &
       sij, &

       rneblsvol, &
       pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb,  &
       distcltop, temp_cltop,  &
       zqsatl, zqsats, &
       qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, &
       Tcontr, qcontr, qcontr2, fcontrN, fcontrP, &
       cldemi,  &
       cldfra, cldtau, fiwc,  &
       fl, re, flwc,  &
       ref_liq, ref_ice, theta,  &
       ref_liq_pi, ref_ice_pi,  &
       zphi, zx_rh, zx_rhl, zx_rhi,  &
       pmfd, pmfu,  &

       t2m, fluxlat,  &
       fsollw, evap_pot,  &
       fsolsw, wfbils, wfevap, &  
       prfl, psfl,bsfl, fraca, Vprecip,  &
       zw2,  &

       fluxu, fluxv,  &
       fluxt,  &

       uwriteSTD, vwriteSTD, &                !pour calcul_STDlev.h
       wwriteSTD, phiwriteSTD, &              !pour calcul_STDlev.h
       qwriteSTD, twriteSTD, rhwriteSTD, &    !pour calcul_STDlev.h

       beta_prec,  &
       rneb,  &
       zxsnow,snowhgt,qsnow,to_ice,sissnow,runoff,albsol3_lic, &
       zxfluxt,zxfluxq 


#ifdef ISO
       USE phys_local_var_mod, ONLY: xt_seri,xtl_seri,xts_seri,xtbs_seri, &
       d_xt_eva,d_xtl_eva,d_xti_eva,           &
       d_xt_dyn,d_xtl_dyn,d_xts_dyn,d_xtbs_dyn, &
       d_xt_con, d_xt_wake,                    &
       d_xt_ajsb, d_xt_ajs,                    &
       d_xt_ajs_w, d_xt_ajs_x,                 &
       d_xt_vdf, d_xt_vdf_w, d_xt_vdf_x,       &
       d_xt_eva, d_xt_lsc, d_xtl_lsc, d_xti_lsc, &
       d_xt_ch4,d_xt_prod_nucl,d_xt_cosmo,d_xt_decroiss, & 
       zxfxtcalving, xtevap,xtprw,    &
       xt_therm, dxtvdf_w, dxtvdf_x,           & 
       zxfxtcalving, zxfxtfonte,       &
       zxxtrunofflic, & ! pas besoin du runoff, c'est seulement quand on couple à sisvat
       h1_diag,runoff_diag,xtrunoff_diag,zxxtsnow,xtVprecip,xtVprecipi, &
       xtrain_lsc,xtsnow_lsc,pxtrfl,pxtsfl,xtclw,d_deltaxt_wk, &
       d_deltaxt_the,d_deltaxt_vdf,d_deltaxt_ajs_cv, &
       xtwdtrainA,xtev
#ifdef DIAGISO
       USE phys_local_var_mod, ONLY: fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip, &
          fxt_detrainement,fxt_ddft,fxt_fluxmasse,fxt_evapprecip, &
          f_detrainement,q_detrainement,xt_detrainement, &
          qlp,xtlp,qvp,xtvp,q_the,xt_the
#endif
#endif

       USE phys_local_var_mod, ONLY: zfice, dNovrN, ptconv
       USE phys_output_var_mod, ONLY: scdnc, cldncl, reffclwtop, lcc, reffclws, &
       reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra
       USE output_physiqex_mod, ONLY: output_physiqex


    IMPLICIT NONE
    !>======================================================================
    !!
    !! Auteur(s) Z.X. Li (LMD/CNRS) date: 19930818
    !!
    !! Objet: Moniteur general de la physique du modele
    !!AA      Modifications quant aux traceurs :
    !!AA                  -  uniformisation des parametrisations ds phytrac
    !!AA                  -  stockage des moyennes des champs necessaires
    !!AA                     en mode traceur off-line 
    !!======================================================================
    !!   CLEFS CPP POUR LES IO
    !!   =====================
#define histNMC
    !!======================================================================
    !!    modif   ( P. Le Van ,  12/10/98 )
    !!
    !!  Arguments:
    !!
    !! nlon----input-I-nombre de points horizontaux
    !! nlev----input-I-nombre de couches verticales, doit etre egale a klev
    !! debut---input-L-variable logique indiquant le premier passage
    !! lafin---input-L-variable logique indiquant le dernier passage
    !! jD_cur       -R-jour courant a l'appel de la physique (jour julien)
    !! jH_cur       -R-heure courante a l'appel de la physique (jour julien)
    !! pdtphys-input-R-pas d'integration pour la physique (seconde)
    !! paprs---input-R-pression pour chaque inter-couche (en Pa)
    !! pplay---input-R-pression pour le mileu de chaque couche (en Pa)
    !! pphi----input-R-geopotentiel de chaque couche (g z) (reference sol)
    !! pphis---input-R-geopotentiel du sol
    !! presnivs-input_R_pressions approximat. des milieux couches ( en PA)
    !! u-------input-R-vitesse dans la direction X (de O a E) en m/s
    !! v-------input-R-vitesse Y (de S a N) en m/s
    !! t-------input-R-temperature (K)
    !! qx------input-R-humidite specifique (kg/kg) et d'autres traceurs
    !! d_t_dyn-input-R-tendance dynamique pour "t" (K/s)
    !! d_q_dyn-input-R-tendance dynamique pour "q" (kg/kg/s)
    !! d_ql_dyn-input-R-tendance dynamique pour "ql" (kg/kg/s)
    !! d_qs_dyn-input-R-tendance dynamique pour "qs" (kg/kg/s)
    !! flxmass_w -input-R- flux de masse verticale
    !! d_u-----output-R-tendance physique de "u" (m/s/s)
    !! d_v-----output-R-tendance physique de "v" (m/s/s)
    !! d_t-----output-R-tendance physique de "t" (K/s)
    !! d_qx----output-R-tendance physique de "qx" (kg/kg/s)
    !! d_ps----output-R-tendance physique de la pression au sol
    !!======================================================================
    integer jjmp1
    !  parameter (jjmp1=jjm+1-1/jjm) ! => (jjmp1=nbp_lat-1/(nbp_lat-1))
    !  integer iip1
    !  parameter (iip1=iim+1)

    include "regdim.h"
    include "dimsoil.h"
    include "clesphys.h"
    include "alpale.h"
    include "dimpft.h"
    !======================================================================
    LOGICAL, SAVE :: ok_volcan ! pour activer les diagnostics volcaniques
    !$OMP THREADPRIVATE(ok_volcan)
    INTEGER, SAVE :: flag_volc_surfstrat ! pour imposer le cool/heat rate à la surf/strato
    !$OMP THREADPRIVATE(flag_volc_surfstrat)
    LOGICAL ok_cvl  ! pour activer le nouveau driver pour convection KE
    PARAMETER (ok_cvl=.TRUE.)
    LOGICAL ok_gust ! pour activer l'effet des gust sur flux surface
    PARAMETER (ok_gust=.FALSE.)
    INTEGER, SAVE :: iflag_radia     ! active ou non le rayonnement (MPL)
    !$OMP THREADPRIVATE(iflag_radia)
    !======================================================================
    LOGICAL check ! Verifier la conservation du modele en eau
    PARAMETER (check=.FALSE.)
    LOGICAL ok_stratus ! Ajouter artificiellement les stratus
    PARAMETER (ok_stratus=.FALSE.)
    !======================================================================
    REAL amn, amx
    INTEGER igout
    !======================================================================
    ! Clef iflag_cycle_diurne controlant l'activation du cycle diurne:
    ! en attente du codage des cles par Fred
    ! iflag_cycle_diurne est initialise par conf_phys et se trouve 
    ! dans clesphys.h (IM)
    !======================================================================
    ! Modele thermique du sol, a activer pour le cycle diurne:
    !cc      LOGICAL soil_model
    !cc      PARAMETER (soil_model=.FALSE.)
    !======================================================================
    ! Dans les versions precedentes, l'eau liquide nuageuse utilisee dans
    ! le calcul du rayonnement est celle apres la precipitation des nuages.
    ! Si cette cle new_oliq est activee, ce sera une valeur moyenne entre
    ! la condensation et la precipitation. Cette cle augmente les impacts
    ! radiatifs des nuages.
    !cc      LOGICAL new_oliq
    !cc      PARAMETER (new_oliq=.FALSE.)
    !======================================================================
    ! Clefs controlant deux parametrisations de l'orographie:
    !c      LOGICAL ok_orodr
    !cc      PARAMETER (ok_orodr=.FALSE.)
    !cc      LOGICAL ok_orolf
    !cc      PARAMETER (ok_orolf=.FALSE.)
    !======================================================================
    LOGICAL ok_journe ! sortir le fichier journalier
    SAVE ok_journe
    !$OMP THREADPRIVATE(ok_journe)

    LOGICAL ok_mensuel ! sortir le fichier mensuel
    SAVE ok_mensuel
    !$OMP THREADPRIVATE(ok_mensuel)

    LOGICAL ok_instan ! sortir le fichier instantane
    SAVE ok_instan
    !$OMP THREADPRIVATE(ok_instan)

    LOGICAL ok_LES ! sortir le fichier LES 
    SAVE ok_LES                            
    !$OMP THREADPRIVATE(ok_LES)                  

    LOGICAL callstats ! sortir le fichier stats 
    SAVE callstats                            
    !$OMP THREADPRIVATE(callstats)                  

    LOGICAL ok_region ! sortir le fichier regional
    PARAMETER (ok_region=.FALSE.)
    !======================================================================
    REAL seuil_inversion
    SAVE seuil_inversion
    !$OMP THREADPRIVATE(seuil_inversion)
    
    
    
    real facteur

    REAL wmax_th(klon)
    REAL tau_overturning_th(klon)

    INTEGER lmax_th(klon)
    INTEGER limbas(klon)
    REAL ratqscth(klon,klev)
    REAL ratqsdiff(klon,klev)
    REAL zqsatth(klon,klev)

    !======================================================================

    ! indices de traceurs eau vapeur, liquide, glace, fraction nuageuse LS (optional), blowing snow (optional)
!    INTEGER,SAVE :: ivap, iliq, isol, irneb, ibs
!!$OMP THREADPRIVATE(ivap, iliq, isol, irneb, ibs)
! Camille Risi 25 juillet 2023: ivap,iliq,isol deja definis dans infotrac_phy. 
! Et ils sont utiles ailleurs que dans physiq_mod (ex:
! reevap -> je commente les 2 lignes au dessus et je laisse la definition
! plutot dans infotrac_phy
    INTEGER,SAVE :: irneb, ibs
!$OMP THREADPRIVATE(irneb, ibs)


    ! Variables argument:

    INTEGER nlon
    INTEGER nlev
    REAL,INTENT(IN) :: pdtphys_
    ! NB: pdtphys to be used in physics is in time_phylmdz_mod
    LOGICAL debut, lafin
    REAL paprs(klon,klev+1)
    REAL pplay(klon,klev)
    REAL pphi(klon,klev)
    REAL pphis(klon)
    REAL presnivs(klev)
!JLD    REAL znivsig(klev)
!JLD    real pir

    REAL u(klon,klev)
    REAL v(klon,klev)

    REAL, intent(in):: rot(klon, klev)
    ! relative vorticity, in s-1, needed for frontal waves

    REAL t(klon,klev),thetal(klon,klev)
    ! thetal: ligne suivante a decommenter si vous avez les fichiers
    !     MPL 20130625
    ! fth_fonctions.F90 et parkind1.F90
    ! sinon thetal=theta
    !     REAL fth_thetae,fth_thetav,fth_thetal
    REAL qx(klon,klev,nqtot)
    REAL flxmass_w(klon,klev)
    REAL d_u(klon,klev)
    REAL d_v(klon,klev)
    REAL d_t(klon,klev)
    REAL d_qx(klon,klev,nqtot)
    REAL d_ps(klon)
  ! variables pour tend_to_tke
    REAL duadd(klon,klev)
    REAL dvadd(klon,klev)
    REAL dtadd(klon,klev)

!!   Variables moved to phys_local_var_mod
!!    ! Variables pour le transport convectif
!!    real da(klon,klev),phi(klon,klev,klev),mp(klon,klev)
!!    real wght_cvfd(klon,klev)
!!    ! Variables pour le lessivage convectif
!!    ! RomP >>> 
!!    real phi2(klon,klev,klev)
!!    real d1a(klon,klev),dam(klon,klev)
!!    real ev(klon,klev)
!!    real clw(klon,klev),elij(klon,klev,klev)
!!    real epmlmMm(klon,klev,klev),eplaMm(klon,klev)
!!    ! RomP <<<
    !IM definition dynamique o_trac dans phys_output_open
    !      type(ctrl_out) :: o_trac(nqtot)

    ! variables a une pression donnee

    include "declare_STDlev.h"


    include "radepsi.h"
    include "radopt.h"


    INTEGER n
    !ym      INTEGER npoints
    !ym      PARAMETER(npoints=klon) 

    INTEGER nregISCtot
    PARAMETER(nregISCtot=1) 

    ! imin_debut, nbpti, jmin_debut, nbptj : parametres pour sorties
    ! sur 1 region rectangulaire y compris pour 1 point
    ! imin_debut : indice minimum de i; nbpti : nombre de points en
    ! direction i (longitude)
    ! jmin_debut : indice minimum de j; nbptj : nombre de points en
    ! direction j (latitude)
!JLD    INTEGER imin_debut, nbpti
!JLD    INTEGER jmin_debut, nbptj 
    !IM: region='3d' <==> sorties en global
    CHARACTER*3 region
    PARAMETER(region='3d')
    LOGICAL ok_hf

    SAVE ok_hf
    !$OMP THREADPRIVATE(ok_hf)

    INTEGER, PARAMETER :: longcles=20
    REAL, SAVE :: clesphy0(longcles)
    !$OMP THREADPRIVATE(clesphy0)

    ! Variables propres a la physique
    INTEGER, SAVE :: itap         ! compteur pour la physique
    !$OMP THREADPRIVATE(itap)

    INTEGER, SAVE :: abortphy=0   ! Reprere si on doit arreter en fin de phys
    !$OMP THREADPRIVATE(abortphy)

    REAL,SAVE ::  solarlong0
    !$OMP THREADPRIVATE(solarlong0)

    !  Parametres de l'Orographie a l'Echelle Sous-Maille (OESM):

    !IM 141004     REAL zulow(klon),zvlow(klon),zustr(klon), zvstr(klon)
    REAL zulow(klon),zvlow(klon)

    INTEGER igwd,idx(klon),itest(klon)

    !      REAL,allocatable,save :: run_off_lic_0(:)
    ! !$OMP THREADPRIVATE(run_off_lic_0)
    !ym      SAVE run_off_lic_0
    !KE43
    ! Variables liees a la convection de K. Emanuel (sb):

    REAL, SAVE :: bas, top             ! cloud base and top levels
    !$OMP THREADPRIVATE(bas, top)
    !------------------------------------------------------------------
    ! Upmost level reached by deep convection and related variable (jyg)

!    INTEGER izero
    INTEGER k_upper_cv
    !------------------------------------------------------------------
    ! Compteur de l'occurence de cvpas=1
    INTEGER Ncvpaseq1
    SAVE Ncvpaseq1
    !$OMP THREADPRIVATE(Ncvpaseq1)

    !==========================================================================
    !CR04.12.07: on ajoute les nouvelles variables du nouveau schema
    !de convection avec poches froides
    ! Variables li\'ees \`a la poche froide (jyg)

!!    REAL mipsh(klon,klev)  ! mass flux shed by the adiab ascent at each level
!!      Moved to phys_state_var_mod

    REAL wape_prescr, fip_prescr
    INTEGER it_wape_prescr
    SAVE wape_prescr, fip_prescr, it_wape_prescr
    !$OMP THREADPRIVATE(wape_prescr, fip_prescr, it_wape_prescr)

    ! variables supplementaires de concvl
    REAL Tconv(klon,klev)
!!    variable moved to phys_local_var_mod
!!    REAL sij(klon,klev,klev)
!!    !
!!    ! variables pour tester la conservation de l'energie dans concvl
!!    REAL, DIMENSION(klon,klev)     :: d_t_con_sat
!!    REAL, DIMENSION(klon,klev)     :: d_q_con_sat
!!    REAL, DIMENSION(klon,klev)     :: dql_sat

    REAL, SAVE :: alp_bl_prescr=0.
    REAL, SAVE :: ale_bl_prescr=0.
    REAL, SAVE :: wake_s_min_lsp=0.1
    !$OMP THREADPRIVATE(alp_bl_prescr,ale_bl_prescr)
    !$OMP THREADPRIVATE(wake_s_min_lsp)

    REAL ok_wk_lsp(klon)

    !RC
    ! Variables li\'ees \`a la poche froide (jyg et rr)

    INTEGER,  SAVE               :: iflag_wake_tend  ! wake: if =0, then wake state variables are
                                                     ! updated within calwake
    !$OMP THREADPRIVATE(iflag_wake_tend)
    INTEGER,  SAVE               :: iflag_alp_wk_cond=0 ! wake: if =0, then Alp_wk is the average lifting
                                                        ! power provided by the wakes; else, Alp_wk is the
                                                        ! lifting power conditionned on the presence of a 
                                                        ! gust-front in the grid cell.
    !$OMP THREADPRIVATE(iflag_alp_wk_cond)

    REAL t_w(klon,klev),q_w(klon,klev) ! temperature and moisture profiles in the wake region
    REAL t_x(klon,klev),q_x(klon,klev) ! temperature and moisture profiles in the off-wake region

    REAL wake_dth(klon,klev)        ! wake : temp pot difference

    REAL wake_omgbdth(klon,klev)    ! Wake : flux of Delta_Theta
    ! transported by LS omega
    REAL wake_dp_omgb(klon,klev)    ! Wake : vertical gradient of
    ! large scale omega
    REAL wake_dtKE(klon,klev)       ! Wake : differential heating
    ! (wake - unpertubed) CONV
    REAL wake_dqKE(klon,klev)       ! Wake : differential moistening
    ! (wake - unpertubed) CONV
    REAL wake_dp_deltomg(klon,klev) ! Wake : gradient vertical de wake_omg
    REAL wake_spread(klon,klev)     ! spreading term in wake_delt

    !pourquoi y'a pas de save??

!!!    INTEGER, SAVE, DIMENSION(klon)   :: wake_k
!!!    !$OMP THREADPRIVATE(wake_k) 
#ifdef ISO
    REAL xt_x(ntraciso,klon,klev)
    REAL xt_w(ntraciso,klon,klev)
#endif

    !jyg<
    !cc      REAL wake_pe(klon)              ! Wake potential energy - WAPE 
    !>jyg

    REAL wake_fip_0(klon)           ! Average Front Incoming Power (unconditionned)
    REAL wake_gfl(klon)             ! Gust Front Length
!!!    REAL wake_dens(klon)         ! moved to phys_state_var_mod


    REAL dt_dwn(klon,klev)
    REAL dq_dwn(klon,klev)
    REAL M_dwn(klon,klev)
    REAL M_up(klon,klev)
    REAL dt_a(klon,klev)
    REAL dq_a(klon,klev)
    REAL d_t_adjwk(klon,klev)                !jyg
    REAL d_q_adjwk(klon,klev)                !jyg
    LOGICAL,SAVE :: ok_adjwk=.FALSE.
    !$OMP THREADPRIVATE(ok_adjwk) 
    INTEGER,SAVE :: iflag_adjwk=0            !jyg
    !$OMP THREADPRIVATE(iflag_adjwk)         !jyg
    REAL,SAVE :: oliqmax=999.,oicemax=999.
    !$OMP THREADPRIVATE(oliqmax,oicemax) 
    REAL, SAVE :: alp_offset
    !$OMP THREADPRIVATE(alp_offset)
    REAL, SAVE :: dtcon_multistep_max=1.e6
    !$OMP THREADPRIVATE(dtcon_multistep_max)
    REAL, SAVE :: dqcon_multistep_max=1.e6
    !$OMP THREADPRIVATE(dqcon_multistep_max)
#ifdef ISO
    REAL dxt_dwn(ntraciso,klon,klev)
    REAL dxt_a(ntraciso,klon,klev)  
    REAL d_xt_adjwk(ntraciso,klon,klev)
#endif

    !RR:fin declarations poches froides
    !==========================================================================

    REAL ztv(klon,klev),ztva(klon,klev)
    REAL zpspsk(klon,klev)
    REAL ztla(klon,klev),zqla(klon,klev) 
    REAL zthl(klon,klev)

    !cc nrlmd le 10/04/2012

    !--------Stochastic Boundary Layer Triggering: ALE_BL--------
    !---Propri\'et\'es du thermiques au LCL 
!    real zlcl_th(klon)          ! Altitude du LCL calcul\'e
    ! continument (pcon dans
    ! thermcell_main.F90)
    real fraca0(klon)           ! Fraction des thermiques au LCL
    real w0(klon)               ! Vitesse des thermiques au LCL
    real w_conv(klon)           ! Vitesse verticale de grande \'echelle au LCL
    real tke0(klon,klev+1)      ! TKE au d\'ebut du pas de temps
    real therm_tke_max0(klon)   ! TKE dans les thermiques au LCL 
    real env_tke_max0(klon)     ! TKE dans l'environnement au LCL 
    INTEGER, SAVE :: iflag_thermcell_tke ! transtport TKE by thermals
    !$OMP THREADPRIVATE(iflag_thermcell_tke)

!JLD    !---D\'eclenchement stochastique
!JLD    integer :: tau_trig(klon)

    REAL,SAVE :: random_notrig_max=1.
    !$OMP THREADPRIVATE(random_notrig_max) 

    !--------Statistical Boundary Layer Closure: ALP_BL--------
    !---Profils de TKE dans et hors du thermique
    real therm_tke_max(klon,klev)   ! Profil de TKE dans les thermiques
    real env_tke_max(klon,klev)     ! Profil de TKE dans l'environnement

    !-------Activer les tendances de TKE due a l'orograp??ie---------
     INTEGER, SAVE :: addtkeoro
    !$OMP THREADPRIVATE(addtkeoro) 
     REAL, SAVE :: alphatkeoro
    !$OMP THREADPRIVATE(alphatkeoro) 
     LOGICAL, SAVE :: smallscales_tkeoro
    !$OMP THREADPRIVATE(smallscales_tkeoro) 



    !cc fin nrlmd le 10/04/2012

    ! Variables locales pour la couche limite (al1):

    !Al1      REAL pblh(klon)           ! Hauteur de couche limite
    !Al1      SAVE pblh
    !34EK

    ! Variables locales:

    !AA
    !AA  Pour phytrac 
    REAL u1(klon)             ! vents dans la premiere couche U
    REAL v1(klon)             ! vents dans la premiere couche V

    !@$$      LOGICAL offline           ! Controle du stockage ds "physique"
    !@$$      PARAMETER (offline=.false.)
    !@$$      INTEGER physid
    REAL frac_impa(klon,klev) ! fractions d'aerosols lessivees (impaction)
    REAL frac_nucl(klon,klev) ! idem (nucleation)
    ! RomP >>> 
    REAL beta_prec_fisrt(klon,klev) ! taux de conv de l'eau cond (fisrt)
    ! RomP <<<

    !IM cf FH pour Tiedtke 080604
    REAL rain_tiedtke(klon),snow_tiedtke(klon)

    !IM 050204 END
    REAL devap(klon) ! evaporation et sa derivee
    REAL dsens(klon) ! chaleur sensible et sa derivee
#ifdef ISO
    REAL dxtevap(ntraciso,klon) 
#endif

    ! Conditions aux limites


    REAL :: day_since_equinox
    ! Date de l'equinoxe de printemps
    INTEGER, parameter :: mth_eq=3, day_eq=21
    REAL :: jD_eq

    LOGICAL, parameter :: new_orbit = .TRUE.

    INTEGER lmt_pas
    SAVE lmt_pas                ! frequence de mise a jour
    !$OMP THREADPRIVATE(lmt_pas) 
    real zmasse(klon, nbp_lev),exner(klon, nbp_lev) 
    !     (column-density of mass of air in a cell, in kg m-2)
    real, parameter:: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2

    !IM sorties
    REAL un_jour
    PARAMETER(un_jour=86400.)
    INTEGER itapm1 !pas de temps de la physique du(es) mois precedents
    SAVE itapm1    !mis a jour le dernier pas de temps du mois en cours
    !$OMP THREADPRIVATE(itapm1)
    !======================================================================

    ! Declaration des procedures appelees

    EXTERNAL angle     ! calculer angle zenithal du soleil
    EXTERNAL alboc     ! calculer l'albedo sur ocean
    EXTERNAL ajsec     ! ajustement sec
    EXTERNAL conlmd    ! convection (schema LMD)
    EXTERNAL conema3  ! convect4.3
    EXTERNAL hgardfou  ! verifier les temperatures
    EXTERNAL nuage     ! calculer les proprietes radiatives
    !C      EXTERNAL o3cm      ! initialiser l'ozone
    EXTERNAL orbite    ! calculer l'orbite terrestre
    EXTERNAL phyredem  ! ecrire l'etat de redemarrage de la physique
    EXTERNAL suphel    ! initialiser certaines constantes
    EXTERNAL transp    ! transport total de l'eau et de l'energie
    !IM
    EXTERNAL haut2bas  !variables de haut en bas
    EXTERNAL ini_undefSTD  !initialise a 0 une variable a 1 niveau de pression
    EXTERNAL undefSTD !somme les valeurs definies d'1 var a 1 niveau de pression
    !     EXTERNAL moy_undefSTD  !moyenne d'1 var a 1 niveau de pression
    ! EXTERNAL moyglo_aire
    ! moyenne globale d'1 var ponderee par l'aire de la maille (moyglo_pondaire)
    ! par la masse/airetot (moyglo_pondaima) et la vraie masse (moyglo_pondmass)


    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! Local variables
    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

!    REAL rhcl(klon,klev)    ! humiditi relative ciel clair
    REAL dialiq(klon,klev)  ! eau liquide nuageuse
    REAL diafra(klon,klev)  ! fraction nuageuse
    REAL radocond(klon,klev)  ! eau condensee nuageuse

    !XXX PB 
    REAL fluxq(klon,klev, nbsrf)   ! flux turbulent d'humidite
    REAL fluxqbs(klon,klev, nbsrf)   ! flux turbulent de neige soufflee

    !FC    REAL zxfluxt(klon, klev)
    !FC    REAL zxfluxq(klon, klev)
    REAL zxfluxqbs(klon,klev)
    REAL zxfluxu(klon, klev)
    REAL zxfluxv(klon, klev)
#ifdef ISO
    real fluxxt(ntraciso,klon,klev, nbsrf)
    REAL zxfluxxt(ntraciso,klon, klev)
#endif

    ! Le rayonnement n'est pas calcule tous les pas, il faut donc
    !                      sauvegarder les sorties du rayonnement
    !ym      SAVE  heat,cool,albpla,topsw,toplw,solsw,sollw,sollwdown
    !ym      SAVE  sollwdownclr, toplwdown, toplwdownclr
    !ym      SAVE  topsw0,toplw0,solsw0,sollw0, heat0, cool0

    INTEGER itaprad
    SAVE itaprad
    !$OMP THREADPRIVATE(itaprad)

    REAL conv_q(klon,klev) ! convergence de l'humidite (kg/kg/s)
    REAL conv_t(klon,klev) ! convergence de la temperature(K/s)

    REAL zsav_tsol(klon)

    REAL dist, rmu0(klon), fract(klon)
    REAL zrmu0(klon), zfract(klon)
    REAL zdtime, zdtime1, zdtime2, zlongi

    REAL qcheck
    REAL z_avant(klon), z_apres(klon), z_factor(klon)
    LOGICAL zx_ajustq

    REAL za
    REAL zx_t, zx_qs, zdelta, zcor
    real zqsat(klon,klev)

    INTEGER i, k, iq, nsrf, l, itr
#ifdef ISO
    real zxt_apres(ntraciso,klon)
    REAL xt_iso(klon,klev),xtl_iso(klon,klev)
    REAL zxt_factor(ntraciso,klon),zxt_avant(ntraciso,klon)
    INTEGER ixt
    real wake_deltaq_prec(klon,klev)  
#endif

    REAL t_coup
    PARAMETER (t_coup=234.0)

    !ym A voir plus tard !!
    !ym      REAL zx_relief(iim,jjmp1)
    !ym      REAL zx_aire(iim,jjmp1)

    ! Grandeurs de sorties
    REAL s_capCL(klon)
    REAL s_oliqCL(klon), s_cteiCL(klon)
    REAL s_trmb1(klon), s_trmb2(klon)
    REAL s_trmb3(klon)

    ! La convection n'est pas calculee tous les pas, il faut donc
    !                      sauvegarder les sorties de la convection
    !ym      SAVE  
    !ym      SAVE  
    !ym      SAVE  

    INTEGER itapcv, itapwk
    SAVE itapcv, itapwk
    !$OMP THREADPRIVATE(itapcv, itapwk)

    !KE43
    ! Variables locales pour la convection de K. Emanuel (sb):

    REAL tvp(klon,klev)       ! virtual temp of lifted parcel
    CHARACTER*40 capemaxcels  !max(CAPE)

    REAL rflag(klon)          ! flag fonctionnement de convect
    INTEGER iflagctrl(klon)          ! flag fonctionnement de convect

    ! -- convect43:
    INTEGER ntra              ! nb traceurs pour convect4.3
    REAL dtvpdt1(klon,klev), dtvpdq1(klon,klev)
    REAL dplcldt(klon), dplcldr(klon)
    !?     .     condm_con(klon,klev),conda_con(klon,klev),
    !?     .     mr_con(klon,klev),ep_con(klon,klev)
    !?     .    ,sadiab(klon,klev),wadiab(klon,klev)
    ! --
    !34EK

    ! Variables du changement

    ! con: convection
    ! lsc: condensation a grande echelle (Large-Scale-Condensation)
    ! ajs: ajustement sec
    ! eva: evaporation de l'eau liquide nuageuse
    ! vdf: couche limite (Vertical DiFfusion)

    ! tendance nulles
    REAL, dimension(klon,klev):: du0, dv0, dt0, dq0, dql0, dqi0, dqbs0
#ifdef ISO
    REAL, dimension(ntraciso,klon,klev):: dxt0, dxtl0, dxti0
#endif
    REAL, dimension(klon)     :: dsig0, ddens0
    INTEGER, dimension(klon)  :: wkoccur1
    ! tendance buffer pour appel de add_phys_tend
    REAL, DIMENSION(klon,klev)  :: d_q_ch4_dtime
#ifdef ISO
    REAL, DIMENSION(ntraciso,klon,klev)  :: d_xt_ch4_dtime
#endif

    ! Flag pour pouvoir ne pas ajouter les tendances. 
    ! Par defaut, les tendances doivente etre ajoutees et
    ! flag_inhib_tend = 0
    ! flag_inhib_tend > 0 : tendances non ajoutees, avec un nombre 
    ! croissant de print quand la valeur du flag augmente
    !!! attention, ce flag doit etre change avec prudence !!!
    INTEGER :: flag_inhib_tend = 0 !  0 is the default value
!!    INTEGER :: flag_inhib_tend = 2

    ! Logical switch to a bug : reseting to 0 convective variables at the 
    ! begining of physiq.
    LOGICAL, SAVE :: ok_bug_cv_trac = .TRUE.
    !$OMP THREADPRIVATE(ok_bug_cv_trac)

    ! Logical switch to a bug : changing wake_deltat when thermals are active
    ! even when there are no wakes.
    LOGICAL, SAVE :: ok_bug_split_th = .TRUE.
    !$OMP THREADPRIVATE(ok_bug_split_th)

    ! Logical switch to a bug : modifying directly wake_deltat  by adding 
    ! the (w) dry adjustment tendency to wake_deltat
    LOGICAL, SAVE :: ok_bug_ajs_cv = .TRUE.
    !$OMP THREADPRIVATE(ok_bug_ajs_cv)

    !********************************************************
    !     declarations

    !********************************************************
    !IM 081204 END

    REAL pen_u(klon,klev), pen_d(klon,klev)
    REAL pde_u(klon,klev), pde_d(klon,klev)
    INTEGER kcbot(klon), kctop(klon), kdtop(klon)

    REAL ratqsbas,ratqshaut,tau_ratqs
    SAVE ratqsbas,ratqshaut,tau_ratqs
    !$OMP THREADPRIVATE(ratqsbas,ratqshaut,tau_ratqs)
    REAL, SAVE :: ratqsp0=50000., ratqsdp=20000.
    !$OMP THREADPRIVATE(ratqsp0, ratqsdp)

    ! Parametres lies au nouveau schema de nuages (SB, PDF)
    REAL, SAVE :: fact_cldcon
    REAL, SAVE :: facttemps
    !$OMP THREADPRIVATE(fact_cldcon,facttemps)
    LOGICAL, SAVE :: ok_newmicro
    !$OMP THREADPRIVATE(ok_newmicro)

    INTEGER, SAVE :: iflag_cld_th
    !$OMP THREADPRIVATE(iflag_cld_th)
!IM logical ptconv(klon,klev)  !passe dans phys_local_var_mod
    !IM cf. AM 081204 BEG
    LOGICAL ptconvth(klon,klev)

    REAL picefra(klon,klev)
    REAL zrel_oro(klon)
    !IM cf. AM 081204 END

    ! Variables liees a l'ecriture de la bande histoire physique

    !======================================================================


!JLD    integer itau_w   ! pas de temps ecriture = itap + itau_phy


    ! Variables locales pour effectuer les appels en serie

    !IM RH a 2m (la surface)
    REAL Lheat

    INTEGER        length
    PARAMETER    ( length = 100 )
    REAL tabcntr0( length       )

!JLD    INTEGER ndex2d(nbp_lon*nbp_lat)
    !IM

    !IM AMIP2 BEG
!JLD    REAL moyglo, mountor
    !IM 141004 BEG
    REAL zustrdr(klon), zvstrdr(klon)
    REAL zustrli(klon), zvstrli(klon)
    REAL zustrph(klon), zvstrph(klon)
    REAL aam, torsfc
    !IM 141004 END
    !IM 190504 BEG
    !  INTEGER imp1jmp1
    !  PARAMETER(imp1jmp1=(iim+1)*jjmp1)
    !ym A voir plus tard
    !  REAL zx_tmp((nbp_lon+1)*nbp_lat)
    !  REAL airedyn(nbp_lon+1,nbp_lat)
    !IM 190504 END
!JLD    LOGICAL ok_msk
!JLD    REAL msk(klon)
    !ym A voir plus tard
    !ym      REAL zm_wo(jjmp1, klev)
    !IM AMIP2 END

    REAL zx_tmp_fi2d(klon)      ! variable temporaire grille physique
    REAL zx_tmp_fi3d(klon,klev) ! variable temporaire pour champs 3D 
!JLD    REAL zx_tmp_2d(nbp_lon,nbp_lat)
!JLD    REAL zx_lon(nbp_lon,nbp_lat)
!JLD    REAL zx_lat(nbp_lon,nbp_lat)

    INTEGER nid_ctesGCM
    SAVE nid_ctesGCM
    !$OMP THREADPRIVATE(nid_ctesGCM)

    !IM 280405 BEG
    !  INTEGER nid_bilKPins, nid_bilKPave
    !  SAVE nid_bilKPins, nid_bilKPave
    !  !$OMP THREADPRIVATE(nid_bilKPins, nid_bilKPave)

    REAL ve_lay(klon,klev) ! transport meri. de l'energie a chaque niveau vert.
    REAL vq_lay(klon,klev) ! transport meri. de l'eau a chaque niveau vert.
    REAL ue_lay(klon,klev) ! transport zonal de l'energie a chaque niveau vert.
    REAL uq_lay(klon,klev) ! transport zonal de l'eau a chaque niveau vert.

!JLD    REAL zjulian
!JLD    SAVE zjulian
!JLD!$OMP THREADPRIVATE(zjulian)

!JLD    INTEGER nhori, nvert
!JLD    REAL zsto
!JLD    REAL zstophy, zout

    CHARACTER (LEN=20) :: modname='physiq_mod'
    CHARACTER*80 abort_message
    LOGICAL, SAVE ::  ok_sync, ok_sync_omp
    !$OMP THREADPRIVATE(ok_sync)
    REAL date0

    ! essai writephys
    INTEGER fid_day, fid_mth, fid_ins
    PARAMETER (fid_ins = 1, fid_day = 2, fid_mth = 3) 
    INTEGER prof2d_on, prof3d_on, prof2d_av, prof3d_av
    PARAMETER (prof2d_on = 1, prof3d_on = 2, prof2d_av = 3, prof3d_av = 4)
    REAL ztsol(klon)
    REAL q2m(klon,nbsrf)  ! humidite a 2m
    REAL fsnowerosion(klon,nbsrf) ! blowing snow flux at surface
    REAL qbsfra  ! blowing snow fraction
#ifdef ISO
    REAL d_xtw(ntraciso),d_xtl(ntraciso), d_xts(ntraciso)
#endif

    !IM: t2m, q2m, ustar, u10m, v10m et t2mincels, t2maxcels
    CHARACTER*40 t2mincels, t2maxcels       !t2m min., t2m max
    CHARACTER*40 tinst, tave
    REAL cldtaupi(klon,klev) ! Cloud optical thickness for
    ! pre-industrial (pi) aerosols

    INTEGER :: naero
    ! Aerosol optical properties
    CHARACTER*4, DIMENSION(naero_grp) :: rfname 
    REAL, DIMENSION(klon,klev)     :: mass_solu_aero ! total mass
    ! concentration
    ! for all soluble
    ! aerosols[ug/m3]
    REAL, DIMENSION(klon,klev)     :: mass_solu_aero_pi
    ! - " - (pre-industrial value)
    REAL, DIMENSION(klon,klev,naero_tot) :: m_allaer

    ! Parameters
    LOGICAL ok_ade, ok_aie    ! Apply aerosol (in)direct effects or not
    LOGICAL ok_alw            ! Apply aerosol LW effect or not
    LOGICAL ok_cdnc ! ok cloud droplet number concentration (O. Boucher 01-2013)
    REAL bl95_b0, bl95_b1   ! Parameter in Boucher and Lohmann (1995)
    SAVE ok_ade, ok_aie, ok_alw, ok_cdnc, bl95_b0, bl95_b1
    !$OMP THREADPRIVATE(ok_ade, ok_aie, ok_alw, ok_cdnc, bl95_b0, bl95_b1)
    LOGICAL, SAVE :: aerosol_couple ! true  : calcul des aerosols dans INCA
    ! false : lecture des aerosol dans un fichier
    !$OMP THREADPRIVATE(aerosol_couple)    
    LOGICAL, SAVE :: chemistry_couple ! true  : use INCA chemistry O3 
    ! false : use offline chemistry O3
    !$OMP THREADPRIVATE(chemistry_couple)    
    INTEGER, SAVE :: flag_aerosol 
    !$OMP THREADPRIVATE(flag_aerosol) 
    LOGICAL, SAVE :: flag_bc_internal_mixture
    !$OMP THREADPRIVATE(flag_bc_internal_mixture)

    !--STRAT AEROSOL
    INTEGER, SAVE :: flag_aerosol_strat
    !$OMP THREADPRIVATE(flag_aerosol_strat)

    !--INTERACTIVE AEROSOL FEEDBACK ON RADIATION
    LOGICAL, SAVE :: flag_aer_feedback
    !$OMP THREADPRIVATE(flag_aer_feedback)

    !c-fin STRAT AEROSOL

    ! Declaration des constantes et des fonctions thermodynamiques

    LOGICAL,SAVE :: first=.TRUE.
    !$OMP THREADPRIVATE(first)

    ! VARIABLES RELATED TO OZONE CLIMATOLOGIES ; all are OpenMP shared
    ! Note that pressure vectors are in Pa and in stricly ascending order
    INTEGER,SAVE :: read_climoz                ! Read ozone climatology
    !     (let it keep the default OpenMP shared attribute)
    !     Allowed values are 0, 1 and 2
    !     0: do not read an ozone climatology
    !     1: read a single ozone climatology that will be used day and night
    !     2: read two ozone climatologies, the average day and night
    !     climatology and the daylight climatology
    INTEGER,SAVE :: ncid_climoz                ! NetCDF file identifier
    REAL, ALLOCATABLE, SAVE :: press_cen_climoz(:) ! Pressure levels
    REAL, ALLOCATABLE, SAVE :: press_edg_climoz(:) ! Edges of pressure intervals
    REAL, ALLOCATABLE, SAVE :: time_climoz(:)      ! Time vector
    CHARACTER(LEN=13), PARAMETER :: vars_climoz(2) &
                                  = ["tro3         ","tro3_daylight"]
    ! vars_climoz(1:read_climoz): variables names in climoz file.
    ! vars_climoz(1:read_climoz-2) if read_climoz>2 (temporary)
    REAL :: ro3i ! 0<=ro3i<=360 ; required time index in NetCDF file for
                 ! the ozone fields, old method.

    include "YOMCST.h"
    include "YOETHF.h"
    include "FCTTRE.h"
    !IM 100106 BEG : pouvoir sortir les ctes de la physique
    include "conema3.h"
    include "nuage.h"
    include "compbl.h"
    !IM 100106 END : pouvoir sortir les ctes de la physique

    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! Declarations pour Simulateur COSP
    !============================================================
    ! AI 10-22
#ifdef CPP_COSP
    include "ini_COSP.h"
#endif
#ifdef CPP_COSPV2
    include "ini_COSP.h"
#endif
    real :: mr_ozone(klon,klev), phicosp(klon,klev)

    !IM stations CFMIP
    INTEGER, SAVE :: nCFMIP
    !$OMP THREADPRIVATE(nCFMIP)
    INTEGER, PARAMETER :: npCFMIP=120
    INTEGER, ALLOCATABLE, SAVE :: tabCFMIP(:)
    REAL, ALLOCATABLE, SAVE :: lonCFMIP(:), latCFMIP(:)
    !$OMP THREADPRIVATE(tabCFMIP, lonCFMIP, latCFMIP) 
    INTEGER, ALLOCATABLE, SAVE :: tabijGCM(:)
    REAL, ALLOCATABLE, SAVE :: lonGCM(:), latGCM(:)
    !$OMP THREADPRIVATE(tabijGCM, lonGCM, latGCM)
    INTEGER, ALLOCATABLE, SAVE :: iGCM(:), jGCM(:)
    !$OMP THREADPRIVATE(iGCM, jGCM)
    logical, dimension(nfiles)            :: phys_out_filestations
    logical, parameter :: lNMC=.FALSE.

    !IM betaCRF
    REAL, SAVE :: pfree, beta_pbl, beta_free
    !$OMP THREADPRIVATE(pfree, beta_pbl, beta_free)
    REAL, SAVE :: lon1_beta,  lon2_beta, lat1_beta, lat2_beta
    !$OMP THREADPRIVATE(lon1_beta,  lon2_beta, lat1_beta, lat2_beta)
    LOGICAL, SAVE :: mskocean_beta
    !$OMP THREADPRIVATE(mskocean_beta)
    REAL, dimension(klon, klev) :: beta ! facteur sur cldtaurad et
    ! cldemirad pour evaluer les
    ! retros liees aux CRF
    REAL, dimension(klon, klev) :: cldtaurad   ! epaisseur optique
    ! pour radlwsw pour
    ! tester "CRF off"
    REAL, dimension(klon, klev) :: cldtaupirad ! epaisseur optique
    ! pour radlwsw pour
    ! tester "CRF off"
    REAL, dimension(klon, klev) :: cldemirad   ! emissivite pour
    ! radlwsw pour tester
    ! "CRF off"
    REAL, dimension(klon, klev) :: cldfrarad   ! fraction nuageuse

    REAL :: calday, zxsnow_dummy(klon)
    ! set de variables utilisees pour l'initialisation des valeurs provenant de INCA
    REAL, DIMENSION(klon,klev,naero_grp,nbands) :: init_tauinca
    REAL, DIMENSION(klon,klev,naero_grp,nbands) :: init_pizinca
    REAL, DIMENSION(klon,klev,naero_grp,nbands) :: init_cginca
    REAL, DIMENSION(klon,klev,nbands) :: init_ccminca
    REAL, DIMENSION(klon,nbtr) :: init_source

    !lwoff=y : offset LW CRE for radiation code and other schemes
    REAL, SAVE :: betalwoff 
    !$OMP THREADPRIVATE(betalwoff)

    INTEGER :: nbtr_tmp ! Number of tracer inside concvl
    REAL, dimension(klon,klev) :: sh_in ! Specific humidity entering in phytrac
    REAL, dimension(klon,klev) :: ch_in ! Condensed humidity entering in phytrac (eau liquide)
    integer iostat

    REAL, dimension(klon,klev+1) :: l_mix_ave, wprime_ave
    REAL zzz
    !albedo SB >>>
    REAL,DIMENSION(6), SAVE :: SFRWL
!$OMP THREADPRIVATE(SFRWL)
    !albedo SB <<<

    !--OB variables for mass fixer (hard coded for now)
    LOGICAL, PARAMETER :: mass_fixer=.FALSE.
    REAL qql1(klon),qql2(klon),corrqql
#ifdef ISO
    real xtql1(ntraciso,klon),xtql2(ntraciso,klon),corrxtql(ntraciso)
#endif

    !--OB flag to activate better conservation of water tendency when convection is not called every timestep
    LOGICAL, PARAMETER :: ok_conserv_d_q_con=.FALSE.

    REAL, dimension(klon,klev) :: t_env,q_env
#ifdef ISO
    real, dimension(ntraciso,klon,klev) ::  xt_env
#endif

    REAL, dimension(klon) :: pr_et
    REAL, dimension(klon) :: w_et, jlr_g_c, jlr_g_s

    REAL pi
    REAL viscom, viscoh
    INTEGER ieru

    !AI namelist pour gerer le double appel de Ecrad
    CHARACTER(len=512) :: namelist_ecrad_file

    !======================================================================!
    ! Bifurcation vers un nouveau moniteur physique pour experimenter      !
    ! des solutions et préparer le couplage avec la physique de MesoNH     !
    ! 14 mai 2023                                                          !
    !======================================================================!
    if (debut) then                                                        !
       iflag_physiq=0
       call getin_p('iflag_physiq', iflag_physiq)                          !
    endif                                                                  !
    if ( iflag_physiq == 2 ) then
#ifdef ISO
       abort_message='isotopes pas encore dans physiqex'
       CALL abort_physic(modname,abort_message,1)
#endif
       call physiqex (nlon,nlev, &                                         !
       debut,lafin,pdtphys_, &                                             !
       paprs,pplay,pphi,pphis,presnivs, &                                  !
       u,v,rot,t,qx, &                                                     !
       flxmass_w, &                                                        !
       d_u, d_v, d_t, d_qx, d_ps)                                          !
       return                                                              !
    endif                                                                  !
    !======================================================================!


    pi = 4. * ATAN(1.)

    ! set-up call to alerte function
    call_alert = (alert_first_call .AND. is_master)
    
    ! Ehouarn: set value of jjmp1 since it is no longer a "fixed parameter"
    jjmp1=nbp_lat

    !======================================================================
    ! Gestion calendrier : mise a jour du module phys_cal_mod

    pdtphys=pdtphys_
    CALL update_time(pdtphys)
    phys_tstep=NINT(pdtphys)
    IF (.NOT. using_xios) missing_val=nf90_fill_real

    IF (using_xios) THEN
      ! switch to XIOS LMDZ physics context 
      IF (.NOT. debut .AND. is_omp_master) THEN
        CALL wxios_set_context()
        CALL xios_update_calendar(itap+1)
      ENDIF
    ENDIF

    !======================================================================
    ! Ecriture eventuelle d'un profil verticale en entree de la physique.
    ! Utilise notamment en 1D mais peut etre active egalement en 3D
    ! en imposant la valeur de igout.
    !======================================================================
    IF (prt_level>=1) THEN
       igout=klon/2+1/klon
       write(lunout,*) 'DEBUT DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
       write(lunout,*) 'igout, lat, lon ',igout, latitude_deg(igout), &
            longitude_deg(igout)
       write(lunout,*) &
            'nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys'
       write(lunout,*) &
            nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur,pdtphys 

       write(lunout,*) 'paprs, play, phi, u, v, t'
       DO k=1,klev
          write(lunout,*) paprs(igout,k),pplay(igout,k),pphi(igout,k), &
               u(igout,k),v(igout,k),t(igout,k)
       ENDDO
       write(lunout,*) 'ovap (g/kg),  oliq (g/kg)'
       DO k=1,klev
          write(lunout,*) qx(igout,k,1)*1000,qx(igout,k,2)*1000.
       ENDDO
    ENDIF

    ! Quick check on pressure levels:
    CALL assert(paprs(:, nbp_lev + 1) < paprs(:, nbp_lev), &
            "physiq_mod paprs bad order")

    IF (first) THEN 
       ivap = strIdx(tracers(:)%name, addPhase('H2O', 'g'))
       iliq = strIdx(tracers(:)%name, addPhase('H2O', 'l'))
       isol = strIdx(tracers(:)%name, addPhase('H2O', 's'))
       irneb= strIdx(tracers(:)%name, addPhase('H2O', 'r'))
       ibs  = strIdx(tracers(:)%name, addPhase('H2O', 'b'))
!       CALL init_etat0_limit_unstruct
!       IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed)
       !CR:nvelles variables convection/poches froides

       WRITE(lunout,*) '================================================='
       WRITE(lunout,*) 'Allocation des variables locales et sauvegardees'
       WRITE(lunout,*) '================================================='
       CALL phys_local_var_init

       !     appel a la lecture du run.def physique
       CALL conf_phys(ok_journe, ok_mensuel, &
            ok_instan, ok_hf, &
            ok_LES, &
            callstats, &
            solarlong0,seuil_inversion, &
            fact_cldcon, facttemps,ok_newmicro,iflag_radia, &
            iflag_cld_th,ratqsbas,ratqshaut,tau_ratqs, &
            ok_ade, ok_aie, ok_alw, ok_cdnc, ok_volcan, flag_volc_surfstrat, aerosol_couple, &
            chemistry_couple, flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
            flag_bc_internal_mixture, bl95_b0, bl95_b1, &
                                ! nv flags pour la convection et les
                                ! poches froides
            read_climoz, &
            alp_offset)
       CALL init_etat0_limit_unstruct
       IF (.NOT. create_etat0_limit) CALL init_limit_read(days_elapsed)
       CALL phys_state_var_init(read_climoz)
       CALL phys_output_var_init
       IF (read_climoz>=1 .AND. create_etat0_limit .AND. grid_type==unstructured) & 
          CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz)

#ifdef REPROBUS
       CALL strataer_init
       CALL strataer_emiss_init
#endif

IF (CPPKEY_STRATAER) THEN
       CALL strataer_init
       CALL strataer_nuc_init
       CALL strataer_emiss_init
END IF

       print*, '================================================='

       !CR: check sur le nb de traceurs de l eau
       IF ((iflag_ice_thermo>0).and.(nqo==2)) THEN
          WRITE (lunout, *) ' iflag_ice_thermo==1 requires 3 H2O tracers ', &
               '(H2O_g, H2O_l, H2O_s) but nqo=', nqo, '. Might as well stop here.'
          abort_message='see above'
          CALL abort_physic(modname,abort_message,1)
       ENDIF

       IF (ok_ice_sursat.AND.(iflag_ice_thermo==0)) THEN
          WRITE (lunout, *) ' ok_ice_sursat=y requires iflag_ice_thermo=1 as well'
          abort_message='see above'
          CALL abort_physic(modname,abort_message,1)
       ENDIF

       IF (ok_ice_sursat.AND.(nqo<4)) THEN
          WRITE (lunout, *) ' ok_ice_sursat=y requires 4 H2O tracers ', &
               '(H2O_g, H2O_l, H2O_s, H2O_r) but nqo=', nqo, '. Might as well stop here.'
          abort_message='see above'
          CALL abort_physic(modname,abort_message,1)
       ENDIF

       IF (ok_plane_h2o.AND..NOT.ok_ice_sursat) THEN
          WRITE (lunout, *) ' ok_plane_h2o=y requires ok_ice_sursat=y '
          abort_message='see above'
          CALL abort_physic(modname,abort_message,1)
       ENDIF

       IF (ok_plane_contrail.AND..NOT.ok_ice_sursat) THEN
          WRITE (lunout, *) ' ok_plane_contrail=y requires ok_ice_sursat=y '
          abort_message='see above'
          CALL abort_physic(modname,abort_message,1)
       ENDIF

        IF (ok_bs) THEN
#ifdef ISO
          abort_message='blowing snow cannot be activated with water isotopes yet'
          CALL abort_physic(modname,abort_message, 1)
#endif
         IF ((ok_ice_sursat.AND.nqo <5).OR.(.NOT.ok_ice_sursat.AND.nqo<4)) THEN
             WRITE (lunout, *) 'activation of blowing snow needs a specific H2O tracer', &
                               'but nqo=', nqo
             abort_message='see above'
             CALL abort_physic(modname,abort_message, 1)
         ENDIF
        ENDIF

       Ncvpaseq1 = 0
       dnwd0=0.0
       ftd=0.0
       fqd=0.0
       cin=0.
       !ym Attention pbase pas initialise dans concvl !!!!
       pbase=0
       !IM 180608

       itau_con=0
       first=.FALSE.

    ENDIF  ! first

    !ym => necessaire pour iflag_con != 2    
    pmfd(:,:) = 0.
    pen_u(:,:) = 0.
    pen_d(:,:) = 0.
    pde_d(:,:) = 0.
    pde_u(:,:) = 0.
    aam=0.
    d_t_adjwk(:,:)=0
    d_q_adjwk(:,:)=0
#ifdef ISO
    d_xt_adjwk(:,:,:)=0
#endif
    alp_bl_conv(:)=0.

    torsfc=0.
    forall (k=1: nbp_lev) zmasse(:, k) = (paprs(:, k)-paprs(:, k+1)) / rg


    IF (debut) THEN
       CALL suphel ! initialiser constantes et parametres phys.
! tau_gl : constante de rappel de la temperature a la surface de la glace - en
       tau_gl=5.
       CALL getin_p('tau_gl', tau_gl)
! tau_gl : constante de rappel de la temperature a la surface de la glace - en
! secondes
       tau_gl=86400.*tau_gl
       WRITE(lunout,*) 'debut physiq_mod tau_gl=',tau_gl
       iflag_thermcell_tke=0
       call getin_p('iflag_thermcell_tke', iflag_thermcell_tke)                          !

       CALL getin_p('iflag_alp_wk_cond', iflag_alp_wk_cond) 
       CALL getin_p('random_notrig_max',random_notrig_max)
       CALL getin_p('ok_adjwk',ok_adjwk) 
       IF (ok_adjwk) iflag_adjwk=2  ! for compatibility with older versions
       ! iflag_adjwk: ! 0 = Default: no convective adjustment of w-region
                      ! 1 => convective adjustment but state variables are unchanged
                      ! 2 => convective adjustment and state variables are changed
       CALL getin_p('iflag_adjwk',iflag_adjwk)
       CALL getin_p('dtcon_multistep_max',dtcon_multistep_max)
       CALL getin_p('dqcon_multistep_max',dqcon_multistep_max)
       CALL getin_p('oliqmax',oliqmax)
       CALL getin_p('oicemax',oicemax)
       CALL getin_p('ratqsp0',ratqsp0)
       CALL getin_p('ratqsdp',ratqsdp)
       iflag_wake_tend = 0
       CALL getin_p('iflag_wake_tend',iflag_wake_tend)
       ok_bad_ecmwf_thermo=.TRUE. ! By default thermodynamical constants are set 
                                  ! in rrtm/suphec.F90 (and rvtmp2 is set to 0).
       CALL getin_p('ok_bad_ecmwf_thermo',ok_bad_ecmwf_thermo)
       CALL getin_p('ok_bug_cv_trac',ok_bug_cv_trac)
       CALL getin_p('ok_bug_split_th',ok_bug_split_th)
       CALL getin_p('ok_bug_ajs_cv',ok_bug_ajs_cv)
       fl_ebil = 0 ! by default, conservation diagnostics are desactivated
       CALL getin_p('fl_ebil',fl_ebil)
       fl_cor_ebil = 0 ! by default, no correction to ensure energy conservation
       CALL getin_p('fl_cor_ebil',fl_cor_ebil)
       iflag_phytrac = 1 ! by default we do want to call phytrac
       CALL getin_p('iflag_phytrac',iflag_phytrac)
IF (CPPKEY_DUST) THEN
       IF (iflag_phytrac.EQ.0) THEN 
         WRITE(lunout,*) 'In order to run with SPLA, iflag_phytrac will be forced to 1'
         iflag_phytrac = 1
       ENDIF
END IF
       nvm_lmdz = 13
       CALL getin_p('NVM',nvm_lmdz)

       WRITE(lunout,*) 'iflag_alp_wk_cond=',  iflag_alp_wk_cond
       WRITE(lunout,*) 'random_ntrig_max=',   random_notrig_max
       WRITE(lunout,*) 'ok_adjwk=',           ok_adjwk
       WRITE(lunout,*) 'iflag_adjwk=',        iflag_adjwk
       WRITE(lunout,*) 'qtcon_multistep_max=',dtcon_multistep_max 
       WRITE(lunout,*) 'qdcon_multistep_max=',dqcon_multistep_max 
       WRITE(lunout,*) 'ratqsp0=',            ratqsp0
       WRITE(lunout,*) 'ratqsdp=',            ratqsdp 
       WRITE(lunout,*) 'iflag_wake_tend=',    iflag_wake_tend
       WRITE(lunout,*) 'ok_bad_ecmwf_thermo=',ok_bad_ecmwf_thermo 
       WRITE(lunout,*) 'ok_bug_cv_trac=',     ok_bug_cv_trac 
       WRITE(lunout,*) 'ok_bug_split_th=',    ok_bug_split_th
       WRITE(lunout,*) 'fl_ebil=',            fl_ebil
       WRITE(lunout,*) 'fl_cor_ebil=',        fl_cor_ebil
       WRITE(lunout,*) 'iflag_phytrac=',      iflag_phytrac
       WRITE(lunout,*) 'NVM=',                nvm_lmdz

       !--PC: defining fields to be exchanged between LMDz, ORCHIDEE and NEMO
       WRITE(lunout,*) 'Call to infocfields from physiq'
       CALL infocfields_init

       !AI 08 2023
#ifdef CPP_ECRAD
       ok_3Deffect=.false.
       CALL getin_p('ok_3Deffect',ok_3Deffect)
       namelist_ecrad_file='namelist_ecrad'
#endif

    ENDIF

    IF (prt_level>=1) print *,'CONVERGENCE PHYSIQUE THERM 1 '

    !======================================================================
    ! Gestion calendrier : mise a jour du module phys_cal_mod

    !     CALL phys_cal_update(jD_cur,jH_cur)

    ! Si c'est le debut, il faut initialiser plusieurs choses
    !          ********

    IF (debut) THEN
       !rv CRinitialisation de wght_th et lalim_conv pour la
       !definition de la couche alimentation de la convection a partir
       !des caracteristiques du thermique
       wght_th(:,:)=1.
       lalim_conv(:)=1 
       !RC
       ustar(:,:)=0.
!       u10m(:,:)=0.
!       v10m(:,:)=0.
       rain_con(:)=0.
       snow_con(:)=0.
       topswai(:)=0.
       topswad(:)=0.
       solswai(:)=0.
       solswad(:)=0.

       wmax_th(:)=0.
       tau_overturning_th(:)=0.

       IF (ANY(type_trac == ['inca','inco'])) THEN
          ! jg : initialisation jusqu'au ces variables sont dans restart
          ccm(:,:,:) = 0.
          tau_aero(:,:,:,:) = 0.
          piz_aero(:,:,:,:) = 0.
          cg_aero(:,:,:,:) = 0.
          d_q_ch4(:,:) = 0.

          config_inca='none' ! default
          CALL getin_p('config_inca',config_inca)

       ELSE 
          config_inca='none' ! default
       ENDIF

       tau_aero(:,:,:,:) = 1.e-15
       piz_aero(:,:,:,:) = 1.
       cg_aero(:,:,:,:)  = 0.
       d_q_ch4(:,:) = 0.

       IF (aerosol_couple .AND. (config_inca /= "aero" &
            .AND. config_inca /= "aeNP ")) THEN
          abort_message &
               = 'if aerosol_couple is activated, config_inca need to be ' &
               // 'aero or aeNP'
          CALL abort_physic (modname,abort_message,1)
       ENDIF

       rnebcon0(:,:) = 0.0
       clwcon0(:,:) = 0.0
       rnebcon(:,:) = 0.0
       clwcon(:,:) = 0.0

       print*,'iflag_coupl,iflag_clos,iflag_wake', &
            iflag_coupl,iflag_clos,iflag_wake
       print*,'iflag_cycle_diurne', iflag_cycle_diurne

       IF (iflag_con==2.AND.iflag_cld_th>-1) THEN
          abort_message = 'Tiedtke needs iflag_cld_th=-2 or -1'
          CALL abort_physic (modname,abort_message,1)
       ENDIF


       ! Initialiser les compteurs:

       itap    = 0
       itaprad = 0
       itapcv = 0
       itapwk = 0

! C Risi: vérifier compatibilité des options isotopiques entre 
! dyn3dmem et physiq
#ifdef ISO
    write(*,*) 'physiq 1846a: ok_isotopes,ntraciso,niso=',niso>0,ntraciso,niso
    IF(niso  <= 0) CALL abort_gcm('physiq 1756','options iso incompatibles',1)
#ifdef ISOTRAC
    IF(nzone <= 0) CALL abort_gcm('physiq 1758','options isotrac incompatibles',1)
#else
    IF(nzone  > 0) CALL abort_gcm('physiq 1762','options isotrac incompatibles',1)
#endif
#else
    if(niso   > 0) CALL abort_gcm('physiq 1772','options iso incompatibles',1)
#endif

#ifdef ISO
        ! initialisations isotopiques
#ifdef ISOVERIF
           write(*,*) 'physiq 1366: call iso_init'
           write(*,*) 'ok_isotopes=',niso > 0
#endif
        if (niso > 0) call iso_init()
#ifdef ISOTRAC
IF(nzone > 0) then
        write(*,*) 'physiq 1416: call iso_traceurs_init'
        call iso_traceurs_init()
endif
#endif
!write(*,*) 'gcm 265: ntraciso=',ntraciso
#ifdef ISOVERIF
        write(*,*) 'physiq 1421: call iso_verif_init'
        call iso_verif_init()
#endif
#endif


       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       !! Un petit travail \`a faire ici.
       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

       IF (iflag_pbl>1) THEN
          PRINT*, "Using method MELLOR&YAMADA" 
       ENDIF

       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       ! FH 2008/05/02 changement lie a la lecture de nbapp_rad dans
       ! phylmd plutot que dyn3d
       ! Attention : la version precedente n'etait pas tres propre.
       ! Il se peut qu'il faille prendre une valeur differente de nbapp_rad
       ! pour obtenir le meme resultat.
!jyg for fh<
       WRITE(lunout,*) 'Pas de temps phys_tstep pdtphys ',phys_tstep,pdtphys
       IF (abs(phys_tstep-pdtphys)>1.e-10) THEN
          abort_message='pas de temps doit etre entier en seconde pour orchidee et XIOS'
          CALL abort_physic(modname,abort_message,1)
       ENDIF
!>jyg
       IF (MOD(NINT(86400./phys_tstep),nbapp_rad)==0) THEN
          radpas = NINT( 86400./phys_tstep)/nbapp_rad
       ELSE 
          WRITE(lunout,*) 'le nombre de pas de temps physique doit etre un ', &
               'multiple de nbapp_rad'
          WRITE(lunout,*) 'changer nbapp_rad ou alors commenter ce test ', &
               'mais 1+1<>2'
          abort_message='nbre de pas de temps physique n est pas multiple ' &
               // 'de nbapp_rad'
          CALL abort_physic(modname,abort_message,1)
       ENDIF
       IF (nbapp_cv == 0) nbapp_cv=86400./phys_tstep
       IF (nbapp_wk == 0) nbapp_wk=86400./phys_tstep
       print *,'physiq, nbapp_cv, nbapp_wk ',nbapp_cv,nbapp_wk
       IF (MOD(NINT(86400./phys_tstep),nbapp_cv)==0) THEN
          cvpas_0 = NINT( 86400./phys_tstep)/nbapp_cv
          cvpas = cvpas_0
       print *,'physiq, cvpas ',cvpas
       ELSE 
          WRITE(lunout,*) 'le nombre de pas de temps physique doit etre un ', &
               'multiple de nbapp_cv'
          WRITE(lunout,*) 'changer nbapp_cv ou alors commenter ce test ', &
               'mais 1+1<>2'
          abort_message='nbre de pas de temps physique n est pas multiple ' &
               // 'de nbapp_cv'
          CALL abort_physic(modname,abort_message,1)
       ENDIF
       IF (MOD(NINT(86400./phys_tstep),nbapp_wk)==0) THEN
          wkpas = NINT( 86400./phys_tstep)/nbapp_wk
!       print *,'physiq, wkpas ',wkpas
       ELSE 
          WRITE(lunout,*) 'le nombre de pas de temps physique doit etre un ', &
               'multiple de nbapp_wk'
          WRITE(lunout,*) 'changer nbapp_wk ou alors commenter ce test ', &
               'mais 1+1<>2'
          abort_message='nbre de pas de temps physique n est pas multiple ' &
               // 'de nbapp_wk'
          CALL abort_physic(modname,abort_message,1)
       ENDIF
       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       CALL init_iophy_new(latitude_deg,longitude_deg)

          !===================================================================
          !IM stations CFMIP
          nCFMIP=npCFMIP
          OPEN(98,file='npCFMIP_param.data',status='old', &
               form='formatted',iostat=iostat)
          IF (iostat == 0) THEN
             READ(98,*,end=998) nCFMIP
998          CONTINUE
             CLOSE(98)
             IF(nCFMIP>npCFMIP) THEN
                print*,'nCFMIP > npCFMIP : augmenter npCFMIP et recompiler'
                CALL abort_physic("physiq", "", 1)
             ELSE
                print*,'physiq npCFMIP=',npCFMIP,'nCFMIP=',nCFMIP
             ENDIF

             ALLOCATE(tabCFMIP(nCFMIP))
             ALLOCATE(lonCFMIP(nCFMIP), latCFMIP(nCFMIP))
             ALLOCATE(tabijGCM(nCFMIP))
             ALLOCATE(lonGCM(nCFMIP), latGCM(nCFMIP))
             ALLOCATE(iGCM(nCFMIP), jGCM(nCFMIP))

             ! lecture des nCFMIP stations CFMIP, de leur numero 
             ! et des coordonnees geographiques lonCFMIP, latCFMIP

             CALL read_CFMIP_point_locations(nCFMIP, tabCFMIP,  &
                  lonCFMIP, latCFMIP)

             ! identification des
             ! 1) coordonnees lonGCM, latGCM des points CFMIP dans la
             ! grille de LMDZ
             ! 2) indices points tabijGCM de la grille physique 1d sur
             ! klon points
             ! 3) indices iGCM, jGCM de la grille physique 2d

             CALL LMDZ_CFMIP_point_locations(nCFMIP, lonCFMIP, latCFMIP, &
                  tabijGCM, lonGCM, latGCM, iGCM, jGCM)

          ELSE
             ALLOCATE(tabijGCM(0))
             ALLOCATE(lonGCM(0), latGCM(0))
             ALLOCATE(iGCM(0), jGCM(0))
          ENDIF

#ifdef CPP_IOIPSL

       !$OMP MASTER
       ! FH : if ok_sync=.true. , the time axis is written at each time step
       ! in the output files. Only at the end in the opposite case
       ok_sync_omp=.FALSE.
       CALL getin('ok_sync',ok_sync_omp)
       CALL phys_output_open(longitude_deg,latitude_deg,nCFMIP,tabijGCM, &
            iGCM,jGCM,lonGCM,latGCM, &
            jjmp1,nlevSTD,clevSTD,rlevSTD, phys_tstep,ok_veget, &
            type_ocean,iflag_pbl,iflag_pbl_split,ok_mensuel,ok_journe, &
            ok_hf,ok_instan,ok_LES,ok_ade,ok_aie, &
            read_climoz, phys_out_filestations, &
            aerosol_couple, &
            flag_aerosol_strat, pdtphys, paprs, pphis,  &
            pplay, lmax_th, ptconv, ptconvth, ivap,  &
            d_u, d_t, qx, d_qx, zmasse, ok_sync_omp)
       !$OMP END MASTER
       !$OMP BARRIER
       ok_sync=ok_sync_omp

       freq_outNMC(1) = ecrit_files(7)
       freq_outNMC(2) = ecrit_files(8)
       freq_outNMC(3) = ecrit_files(9)
       WRITE(lunout,*)'OK freq_outNMC(1)=',freq_outNMC(1)
       WRITE(lunout,*)'OK freq_outNMC(2)=',freq_outNMC(2)
       WRITE(lunout,*)'OK freq_outNMC(3)=',freq_outNMC(3)

    IF (.NOT. using_xios) THEN
       CALL ini_paramLMDZ_phy(phys_tstep,nid_ctesGCM)
END IF

#endif
       ecrit_reg = ecrit_reg * un_jour
       ecrit_tra = ecrit_tra * un_jour

       !XXXPB Positionner date0 pour initialisation de ORCHIDEE
       date0 = jD_ref 
       WRITE(*,*) 'physiq date0 : ',date0

!       CALL create_climoz(read_climoz)
      IF (.NOT. create_etat0_limit) CALL init_aero_fromfile(flag_aerosol, aerosol_couple)  !! initialise aero from file for XIOS interpolation (unstructured_grid)
      IF (.NOT. create_etat0_limit) CALL init_readaerosolstrato(flag_aerosol_strat)  !! initialise aero strato from file for XIOS interpolation (unstructured_grid)

      if (ok_cosp) then
#ifdef CPP_COSP
        ! A.I : Initialisations pour le 1er passage a Cosp
        CALL ini_COSP(ref_liq_cosp0,ref_ice_cosp0,pctsrf_cosp0,zu10m_cosp0,zv10m_cosp0, &
               zxtsol_cosp0,zx_rh_cosp0,cldfra_cosp0,rnebcon_cosp0,flwc_cosp0, &
               fiwc_cosp0,prfl_cosp0,psfl_cosp0,pmflxr_cosp0,pmflxs_cosp0, &
               mr_ozone_cosp0,cldtau_cosp0,cldemi_cosp0,JrNt_cosp0)

        CALL phys_cosp(itap,phys_tstep,freq_cosp, &
               ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
               ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
               klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
               JrNt_cosp0,ref_liq_cosp0,ref_ice_cosp0, &
               pctsrf_cosp0, &
               zu10m_cosp0,zv10m_cosp0,pphis, &
               pphi,paprs(:,1:klev),pplay,zxtsol_cosp0,t, &
               qx(:,:,ivap),zx_rh_cosp0,cldfra_cosp0,rnebcon_cosp0,flwc_cosp0,fiwc_cosp0, &
               prfl_cosp0(:,1:klev),psfl_cosp0(:,1:klev), &
               pmflxr_cosp0(:,1:klev),pmflxs_cosp0(:,1:klev), &
               mr_ozone_cosp0,cldtau_cosp0, cldemi_cosp0)
#endif

#ifdef CPP_COSP2
        CALL ini_COSP(ref_liq_cosp0,ref_ice_cosp0,pctsrf_cosp0,zu10m_cosp0,zv10m_cosp0, &
               zxtsol_cosp0,zx_rh_cosp0,cldfra_cosp0,rnebcon_cosp0,flwc_cosp0, &
               fiwc_cosp0,prfl_cosp0,psfl_cosp0,pmflxr_cosp0,pmflxs_cosp0, &
               mr_ozone_cosp0,cldtau_cosp0,cldemi_cosp0,JrNt_cosp0)
     
        CALL phys_cosp2(itap,phys_tstep,freq_cosp, &
               ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
               ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
               klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
               JrNt,ref_liq,ref_ice, &
               pctsrf(:,is_ter)+pctsrf(:,is_lic), &
               zu10m,zv10m,pphis, &
               zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, &
               qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
               prfl(:,1:klev),psfl(:,1:klev), &
               pmflxr(:,1:klev),pmflxs(:,1:klev), &
               mr_ozone,cldtau, cldemi)
#endif

#ifdef CPP_COSPV2
          CALL lmdz_cosp_interface(itap,phys_tstep,freq_cosp, &
               ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
               ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
               klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
               JrNt,ref_liq,ref_ice, &
               pctsrf(:,is_ter)+pctsrf(:,is_lic), &
               zu10m,zv10m,pphis, &
               phicosp,paprs(:,1:klev),pplay,zxtsol,t_seri, &
               qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
               prfl(:,1:klev),psfl(:,1:klev), &
               pmflxr(:,1:klev),pmflxs(:,1:klev), &
               mr_ozone,cldtau, cldemi)
#endif
      ENDIF


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       ! Nouvelle initialisation pour le rayonnement RRTM
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

       CALL iniradia(klon,klev,paprs(1,1:klev+1))

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       CALL wake_ini(rg,rd,rv,prt_level)
       CALL yamada_ini(klon,lunout,prt_level)
       viscom=1.46E-5
       viscoh=2.06E-5
       CALL atke_ini(RG, RD, RPI, RCPD, RV, viscom, viscoh)
       CALL thermcell_ini(iflag_thermals,prt_level,tau_thermals,lunout, &
        RG,RD,RCPD,RKAPPA,RLVTT,RETV)
       CALL ratqs_ini(klon,klev,iflag_thermals,lunout,nbsrf,is_lic,is_ter,RG,RV,RD,RCPD,RLSTT,RLVTT,RTT)
       CALL lscp_ini(pdtphys,lunout,prt_level,ok_ice_sursat,iflag_ratqs,fl_cor_ebil,RCPD,RLSTT,RLVTT,RLMLT,RVTMP2,RTT,RD,RG,RV,RPI)
       CALL blowing_snow_ini(RCPD, RLSTT, RLVTT, RLMLT, &
                             RVTMP2, RTT,RD,RG, RV, RPI)
       ! Test de coherence sur oc_cdnc utilisé uniquement par cloud_optics_prop
       IF (ok_newmicro) then
          IF (iflag_rrtm==1) THEN
#ifdef CPP_RRTM
             IF (ok_cdnc.AND.NRADLP.NE.3) THEN
             abort_message='RRTM choix incoherent NRADLP doit etre egal a 3 ' &
                  // 'pour ok_cdnc' 
             CALL abort_physic(modname,abort_message,1)
             ENDIF
#else

             abort_message='You should compile with -rrtm if running with '//'iflag_rrtm=1'
             CALL abort_physic(modname,abort_message,1)
#endif
          ENDIF
       ENDIF   
       CALL cloud_optics_prop_ini(klon, prt_level, lunout, flag_aerosol, &
                                    ok_cdnc, bl95_b0, &
                                    bl95_b1, latitude_deg, rpi, rg, rd, &
                                    zepsec, novlp, iflag_ice_thermo, ok_new_lscp)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       ! Initialisation des champs dans phytrac* qui sont utilises par phys_output_write*

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

IF (CPPKEY_DUST) THEN
       ! Quand on utilise SPLA, on force iflag_phytrac=1
       CALL phytracr_spl_out_init()
       CALL phys_output_write_spl(itap, pdtphys, paprs, pphis,                  &
                                pplay, lmax_th, aerosol_couple,                 &
                                ok_ade, ok_aie, ivap, ok_sync,                  &
                                ptconv, read_climoz, clevSTD,                   &
                                ptconvth, d_t, qx, d_qx, d_tr_dyn, zmasse,      &
                                flag_aerosol, flag_aerosol_strat, ok_cdnc)
ELSE
       ! phys_output_write écrit des variables traceurs seulement si iflag_phytrac == 1 
       ! donc seulement dans ce cas on doit appeler phytrac_init()
       IF (iflag_phytrac == 1 ) THEN
          CALL phytrac_init()
       ENDIF
       CALL phys_output_write(itap, pdtphys, paprs, pphis,                    &
                              pplay, lmax_th, aerosol_couple,                 &
                              ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, ibs,  ok_sync,&
                              ptconv, read_climoz, clevSTD,                   &
                              ptconvth, d_u, d_t, qx, d_qx, zmasse,           &
                              flag_aerosol, flag_aerosol_strat, ok_cdnc, t, u1, v1)
END IF


       IF (using_xios) THEN
         IF (is_omp_master) CALL xios_update_calendar(1)
       ENDIF
       
       IF(read_climoz>=1 .AND. create_etat0_limit) CALL regr_horiz_time_climoz(read_climoz,ok_daily_climoz)
       CALL create_etat0_limit_unstruct
       CALL phyetat0 ("startphy.nc",clesphy0,tabcntr0)

!jyg<
       IF (iflag_pbl<=1) THEN
          ! No TKE for Standard Physics
          pbl_tke(:,:,:)=0.

       ELSE IF (klon_glo==1) THEN
          pbl_tke(:,:,is_ave) = 0.
          DO nsrf=1,nbsrf
            DO k = 1,klev+1
                 pbl_tke(:,k,is_ave) = pbl_tke(:,k,is_ave) &
                     +pctsrf(:,nsrf)*pbl_tke(:,k,nsrf)
            ENDDO
          ENDDO
       ELSE
          pbl_tke(:,:,is_ave) = 0. !ym missing init : maybe must be initialized in the same way that for klon_glo==1 ??
!>jyg
       ENDIF
       !IM begin
       print*,'physiq: clwcon rnebcon ratqs',clwcon(1,1),rnebcon(1,1) &
            ,ratqs(1,1)
       !IM end

#ifdef ISO
#ifdef ISOTRAC
! on initialise les cartes des bassins pour les traceurs si besoin:
       call initialise_bassins_boites(presnivs)
#endif
#endif

       ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

       ! on remet le calendrier a zero

       IF (raz_date == 1) THEN
          itau_phy = 0
       ENDIF

!       IF (ABS(phys_tstep-pdtphys).GT.0.001) THEN
!          WRITE(lunout,*) 'Pas physique n est pas correct',phys_tstep, &
!               pdtphys
!          abort_message='Pas physique n est pas correct '
!          !           call abort_physic(modname,abort_message,1)
!          phys_tstep=pdtphys
!       ENDIF
       IF (nlon /= klon) THEN
          WRITE(lunout,*)'nlon et klon ne sont pas coherents', nlon,  &
               klon
          abort_message='nlon et klon ne sont pas coherents'
          CALL abort_physic(modname,abort_message,1)
       ENDIF
       IF (nlev /= klev) THEN
          WRITE(lunout,*)'nlev et klev ne sont pas coherents', nlev, &
               klev
          abort_message='nlev et klev ne sont pas coherents'
          CALL abort_physic(modname,abort_message,1)
       ENDIF

       IF (phys_tstep*REAL(radpas)>21600..AND.iflag_cycle_diurne>=1) THEN
          WRITE(lunout,*)'Nbre d appels au rayonnement insuffisant'
          WRITE(lunout,*)"Au minimum 4 appels par jour si cycle diurne"
          abort_message='Nbre d appels au rayonnement insuffisant'
          CALL abort_physic(modname,abort_message,1)
       ENDIF

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       ! Initialisation pour la convection de K.E. et pour les poches froides

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

       WRITE(lunout,*)"Clef pour la convection, iflag_con=", iflag_con
       WRITE(lunout,*)"Clef pour le driver de la convection, ok_cvl=", ok_cvl

       !KE43
       ! Initialisation pour la convection de K.E. (sb):
       IF (iflag_con>=3) THEN

          WRITE(lunout,*)"*** Convection de Kerry Emanuel 4.3  "
          WRITE(lunout,*) &
               "On va utiliser le melange convectif des traceurs qui"
          WRITE(lunout,*)"est calcule dans convect4.3"
          WRITE(lunout,*)" !!! penser aux logical flags de phytrac"

          DO i = 1, klon
             ema_cbmf(i) = 0.
             ema_pcb(i)  = 0.
             ema_pct(i)  = 0.
             !          ema_workcbmf(i) = 0.
          ENDDO
          !IM15/11/02 rajout initialisation ibas_con,itop_con cf. SB =>BEG
          DO i = 1, klon
             ibas_con(i) = 1
             itop_con(i) = 1
          ENDDO
          !IM15/11/02 rajout initialisation ibas_con,itop_con cf. SB =>END
          !================================================================
          !CR:04.12.07: initialisations poches froides
          ! Controle de ALE et ALP pour la fermeture convective (jyg)
          IF (iflag_wake>=1) THEN
             CALL ini_wake(0.,0.,it_wape_prescr,wape_prescr,fip_prescr &
                  ,alp_bl_prescr, ale_bl_prescr)
             ! 11/09/06 rajout initialisation ALE et ALP du wake et PBL(YU)
             !        print*,'apres ini_wake iflag_cld_th=', iflag_cld_th

             ! Initialize tendencies of wake state variables (for some flag values
             ! they are not computed).
             d_deltat_wk(:,:) = 0.
             d_deltaq_wk(:,:) = 0.
             d_deltat_wk_gw(:,:) = 0.
             d_deltaq_wk_gw(:,:) = 0.
             d_deltat_vdf(:,:) = 0.
             d_deltaq_vdf(:,:) = 0.
             d_deltat_the(:,:) = 0.
             d_deltaq_the(:,:) = 0.
             d_deltat_ajs_cv(:,:) = 0.
             d_deltaq_ajs_cv(:,:) = 0.
             d_s_wk(:) = 0.
             d_dens_wk(:) = 0.
#ifdef ISO
             d_deltaxt_wk(:,:,:) = 0.
             d_deltaxt_vdf(:,:,:) = 0.
             d_deltaxt_the(:,:,:) = 0.
             d_deltaxt_ajs_cv(:,:,:) = 0.
#endif
          ENDIF  !  (iflag_wake>=1)

          !        do i = 1,klon
          !           Ale_bl(i)=0.
          !           Alp_bl(i)=0.
          !        enddo

       !ELSE
       !   ALLOCATE(tabijGCM(0))
       !   ALLOCATE(lonGCM(0), latGCM(0))
       !   ALLOCATE(iGCM(0), jGCM(0))
       ENDIF  !  (iflag_con.GE.3)

       DO i=1,klon
          rugoro(i) = f_rugoro * MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
       ENDDO

       !34EK
       IF (ok_orodr) THEN

          ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
          ! FH sans doute a enlever de finitivement ou, si on le
          ! garde, l'activer justement quand ok_orodr = false.
          ! ce rugoro est utilise par la couche limite et fait double emploi
          ! avec les param\'etrisations sp\'ecifiques de Francois Lott.
          !           DO i=1,klon
          !             rugoro(i) = MAX(1.0e-05, zstd(i)*zsig(i)/2.0)
          !           ENDDO
          ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
          IF (ok_strato) THEN
             CALL SUGWD_strato(klon,klev,paprs,pplay)
          ELSE
             CALL SUGWD(klon,klev,paprs,pplay)
          ENDIF

          DO i=1,klon
             zuthe(i)=0.
             zvthe(i)=0.
             IF (zstd(i)>10.) THEN
                zuthe(i)=(1.-zgam(i))*cos(zthe(i))
                zvthe(i)=(1.-zgam(i))*sin(zthe(i))
             ENDIF
          ENDDO
       ENDIF


       lmt_pas = NINT(86400./phys_tstep * 1.0)   ! tous les jours
       WRITE(lunout,*)'La frequence de lecture surface est de ',  &
            lmt_pas

       capemaxcels = 't_max(X)'
       t2mincels = 't_min(X)'
       t2maxcels = 't_max(X)'
       tinst = 'inst(X)'
       tave = 'ave(X)'
       !IM cf. AM 081204 BEG
       write(lunout,*)'AVANT HIST IFLAG_CON=',iflag_con
       !IM cf. AM 081204 END

       !=============================================================
       !   Initialisation des sorties
       !=============================================================

       IF (using_xios) THEN    
         ! Get "missing_val" value from XML files (from temperature variable)
         IF (is_omp_master) CALL xios_get_field_attr("temp",default_value=missing_val)
         CALL bcast_omp(missing_val)
       ENDIF

       IF (using_xios) THEN    
         ! Need to put this initialisation after phyetat0 as in the coupled model the XIOS context is only
         ! initialised at that moment
         ! Get "missing_val" value from XML files (from temperature variable)
         IF (is_omp_master) CALL xios_get_field_attr("temp",default_value=missing_val)
         CALL bcast_omp(missing_val)

       ! Now we activate some double radiation call flags only if some
       ! diagnostics are requested, otherwise there is no point in doing this
         IF (is_master) THEN
           !--setting up swaero_diag to TRUE in XIOS case 
           IF (xios_field_is_active("topswad").OR.xios_field_is_active("topswad0").OR. & 
              xios_field_is_active("solswad").OR.xios_field_is_active("solswad0").OR. & 
              xios_field_is_active("topswai").OR.xios_field_is_active("solswai").OR.  & 
                (iflag_rrtm==1.AND.(xios_field_is_active("toplwad").OR.xios_field_is_active("toplwad0").OR. & 
                                    xios_field_is_active("sollwad").OR.xios_field_is_active("sollwad0"))))  & 
              !!!--for now these fields are not in the XML files so they are omitted 
              !!!  xios_field_is_active("toplwai").OR.xios_field_is_active("sollwai") !))) & 
              swaero_diag=.TRUE. 
 
           !--setting up swaerofree_diag to TRUE in XIOS case 
           IF (xios_field_is_active("SWdnSFCcleanclr").OR.xios_field_is_active("SWupSFCcleanclr").OR. &
              xios_field_is_active("SWupTOAcleanclr").OR.xios_field_is_active("rsucsaf").OR.   &
              xios_field_is_active("rsdcsaf") .OR. xios_field_is_active("LWdnSFCcleanclr").OR. &
              xios_field_is_active("LWupTOAcleanclr")) &
              swaerofree_diag=.TRUE. 
 
           !--setting up dryaod_diag to TRUE in XIOS case 
           DO naero = 1, naero_tot-1
             IF (xios_field_is_active("dryod550_"//name_aero_tau(naero))) dryaod_diag=.TRUE. 
           ENDDO

          !--setting up ok_4xCO2atm to TRUE in XIOS case 
           IF (xios_field_is_active("rsut4co2").OR.xios_field_is_active("rlut4co2").OR. & 
              xios_field_is_active("rsutcs4co2").OR.xios_field_is_active("rlutcs4co2").OR. &
              xios_field_is_active("rsu4co2").OR.xios_field_is_active("rsucs4co2").OR. &
              xios_field_is_active("rsd4co2").OR.xios_field_is_active("rsdcs4co2").OR. &
              xios_field_is_active("rlu4co2").OR.xios_field_is_active("rlucs4co2").OR. &
              xios_field_is_active("rld4co2").OR.xios_field_is_active("rldcs4co2")) &
              ok_4xCO2atm=.TRUE. 
           ENDIF
           !$OMP BARRIER
           CALL bcast(swaero_diag)
           CALL bcast(swaerofree_diag)
           CALL bcast(dryaod_diag)
           CALL bcast(ok_4xCO2atm)
         ENDIF !using_xios

       CALL printflag( tabcntr0,radpas,ok_journe, &
            ok_instan, ok_region )


       ! Prescrire l'ozone dans l'atmosphere

       !c         DO i = 1, klon
       !c         DO k = 1, klev
       !c            CALL o3cm (paprs(i,k)/100.,paprs(i,k+1)/100., wo(i,k),20)
       !c         ENDDO
       !c         ENDDO

       IF (ANY(type_trac == ['inca','inco'])) THEN ! ModThL
IF (CPPKEY_INCA) THEN
          CALL VTe(VTphysiq)
          CALL VTb(VTinca)
          calday = REAL(days_elapsed) + jH_cur
          WRITE(lunout,*) 'initial time chemini', days_elapsed, calday

          call init_const_lmdz( &
          ndays, nbsrf, is_oce,is_sic, is_ter,is_lic, calend, &
          config_inca)

          CALL init_inca_geometry( & 
               longitude, latitude, &
               boundslon, boundslat, &
               cell_area, ind_cell_glo) 

          if (grid_type==unstructured) THEN 
             CALL chemini(  pplay, &
                  nbp_lon, nbp_lat, &
                  latitude_deg, &
                  longitude_deg, &
                  presnivs, &
                  calday, &
                  klon, &
                  nqtot, &
                  nqo+nqCO2, &
                  pdtphys, &
                  annee_ref, &
                  year_cur, &
                  day_ref,  &
                  day_ini, &
                  start_time, &
                  itau_phy, &
                  date0, &
                  chemistry_couple, &
                  init_source, &
                  init_tauinca, &
                  init_pizinca, &
                  init_cginca, &
                  init_ccminca)
          ELSE
             CALL chemini(  pplay, &
                  nbp_lon, nbp_lat, &
                  latitude_deg, &
                  longitude_deg, &
                  presnivs, &
                  calday, &
                  klon, &
                  nqtot, &
                  nqo+nqCO2, &
                  pdtphys, &
                  annee_ref, &
                  year_cur, &
                  day_ref,  &
                  day_ini, &
                  start_time, &
                  itau_phy, &
                  date0, &
                  chemistry_couple, &
                  init_source, &
                  init_tauinca, &
                  init_pizinca, &
                  init_cginca, &
                  init_ccminca, &
                  io_lon, &
                  io_lat)
          ENDIF


          ! initialisation des variables depuis le restart de inca
          ccm(:,:,:) = init_ccminca
          tau_aero(:,:,:,:) = init_tauinca
          piz_aero(:,:,:,:) = init_pizinca
          cg_aero(:,:,:,:) = init_cginca

          CALL VTe(VTinca)
          CALL VTb(VTphysiq)
END IF
       ENDIF

       IF (type_trac == 'repr') THEN
#ifdef REPROBUS
          CALL chemini_rep(  &
               presnivs, &
               pdtphys, &
               annee_ref, &
               day_ref,  &
               day_ini, &
               start_time, &
               itau_phy, &
               io_lon, &
               io_lat)
#endif
       ENDIF

       !$omp single
       IF (read_climoz >= 1) CALL open_climoz(ncid_climoz, press_cen_climoz,   &
           press_edg_climoz, time_climoz, ok_daily_climoz, adjust_tropopause)
       !$omp end single

       !IM betaCRF
       pfree=70000. !Pa
       beta_pbl=1.
       beta_free=1.
       lon1_beta=-180.
       lon2_beta=+180.
       lat1_beta=90.
       lat2_beta=-90.
       mskocean_beta=.FALSE.

       !albedo SB >>>
       SELECT CASE(nsw)
       CASE(2)
          SFRWL(1)=0.45538747
          SFRWL(2)=0.54461211
       CASE(4)
          SFRWL(1)=0.45538747
          SFRWL(2)=0.32870591
          SFRWL(3)=0.18568763
          SFRWL(4)=3.02191470E-02
       CASE(6)
          SFRWL(1)=1.28432794E-03
          SFRWL(2)=0.12304168
          SFRWL(3)=0.33106142
          SFRWL(4)=0.32870591
          SFRWL(5)=0.18568763
          SFRWL(6)=3.02191470E-02
       END SELECT
       !albedo SB <<<

       OPEN(99,file='beta_crf.data',status='old', &
            form='formatted',err=9999)
       READ(99,*,end=9998) pfree
       READ(99,*,end=9998) beta_pbl
       READ(99,*,end=9998) beta_free
       READ(99,*,end=9998) lon1_beta
       READ(99,*,end=9998) lon2_beta
       READ(99,*,end=9998) lat1_beta
       READ(99,*,end=9998) lat2_beta
       READ(99,*,end=9998) mskocean_beta
9998   Continue
       CLOSE(99)
9999   Continue
       WRITE(*,*)'pfree=',pfree
       WRITE(*,*)'beta_pbl=',beta_pbl
       WRITE(*,*)'beta_free=',beta_free
       WRITE(*,*)'lon1_beta=',lon1_beta
       WRITE(*,*)'lon2_beta=',lon2_beta
       WRITE(*,*)'lat1_beta=',lat1_beta
       WRITE(*,*)'lat2_beta=',lat2_beta
       WRITE(*,*)'mskocean_beta=',mskocean_beta

      !lwoff=y : offset LW CRE for radiation code and other schemes
      !lwoff=y : betalwoff=1.
      betalwoff=0.
      IF (ok_lwoff) THEN
         betalwoff=1.
      ENDIF
      WRITE(*,*)'ok_lwoff=',ok_lwoff

      !lwoff=y to begin only sollw and sollwdown are set up to CS values
      sollw = sollw + betalwoff * (sollw0 - sollw)
      sollwdown(:)= sollwdown(:) + betalwoff *(-1.*ZFLDN0(:,1) - &
                    sollwdown(:))



    ENDIF

    !   ****************     Fin  de   IF ( debut  )   ***************


    ! Incrementer le compteur de la physique

    itap   = itap + 1
    IF (is_master .OR. prt_level > 9) THEN
      IF (prt_level > 5 .or. MOD(itap,5) == 0) THEN
         WRITE(LUNOUT,*)'Entering physics elapsed seconds since start ', current_time
         WRITE(LUNOUT,100)year_cur,mth_cur,day_cur,hour/3600.
 100     FORMAT('Date = ',i4.4,' / ',i2.2, ' / ',i2.2,' : ',f20.17)
      ENDIF
    ENDIF


    ! Update fraction of the sub-surfaces (pctsrf) and 
    ! initialize, where a new fraction has appeared, all variables depending 
    ! on the surface fraction.

    CALL change_srf_frac(itap, phys_tstep, days_elapsed+1,  &
         pctsrf, fevap, z0m, z0h, agesno,              &
         falb_dir, falb_dif, ftsol, ustar, u10m, v10m, pbl_tke &
#ifdef ISO
     ,fxtevap  &
#endif
&       )

    ! Update time and other variables in Reprobus
    IF (type_trac == 'repr') THEN
#ifdef REPROBUS
       CALL Init_chem_rep_xjour(jD_cur-jD_ref+day_ref)
       print*,'xjour equivalent rjourvrai',jD_cur-jD_ref+day_ref
       CALL Rtime(debut)
#endif
    ENDIF

    ! Tendances bidons pour les processus qui n'affectent pas certaines
    ! variables.
    du0(:,:)=0.
    dv0(:,:)=0.
    dt0 = 0.
    dq0(:,:)=0.
    dql0(:,:)=0.
    dqi0(:,:)=0.
    dqbs0(:,:)=0.
#ifdef ISO
      dxt0(:,:,:)=0.
      dxtl0(:,:,:)=0.
      dxti0(:,:,:)=0.
#endif
    dsig0(:) = 0.
    ddens0(:) = 0.
    wkoccur1(:)=1

    ! Mettre a zero des variables de sortie (pour securite)

    DO i = 1, klon
       d_ps(i) = 0.0
    ENDDO
    DO k = 1, klev
       DO i = 1, klon
          d_t(i,k) = 0.0
          d_u(i,k) = 0.0
          d_v(i,k) = 0.0
       ENDDO
    ENDDO
    DO iq = 1, nqtot
       DO k = 1, klev
          DO i = 1, klon
             d_qx(i,k,iq) = 0.0
          ENDDO
       ENDDO
    ENDDO
    beta_prec_fisrt(:,:)=0.
    beta_prec(:,:)=0.

    !   Output variables from the convective scheme should not be set to 0 
    !   since convection is not always called at every time step.
    IF (ok_bug_cv_trac) THEN
      da(:,:)=0.
      mp(:,:)=0.
      phi(:,:,:)=0.
      ! RomP >>>
      phi2(:,:,:)=0.
      epmlmMm(:,:,:)=0.
      eplaMm(:,:)=0.
      d1a(:,:)=0.
      dam(:,:)=0.
      pmflxr(:,:)=0.
      pmflxs(:,:)=0.
      ! RomP <<<
    ENDIF

    ! Ne pas affecter les valeurs entrees de u, v, h, et q

    DO k = 1, klev
       DO i = 1, klon
          t_seri(i,k)  = t(i,k)
          u_seri(i,k)  = u(i,k)
          v_seri(i,k)  = v(i,k)
          qx_seri(i,k,:)  = qx(i,k,:)
          q_seri(i,k)  = qx(i,k,ivap)
          ql_seri(i,k) = qx(i,k,iliq)
          qbs_seri(i,k) = 0.
          !CR: ATTENTION, on rajoute la variable glace
          IF (nqo==2) THEN             !--vapour and liquid only
             qs_seri(i,k) = 0.
             rneb_seri(i,k) = 0.
          ELSE IF (nqo==3) THEN        !--vapour, liquid and ice
             qs_seri(i,k) = qx(i,k,isol)
             rneb_seri(i,k) = 0.
          ELSE IF (nqo>=4) THEN        !--vapour, liquid, ice and rneb and blowing snow
             qs_seri(i,k) = qx(i,k,isol)
             IF (ok_ice_sursat) THEN
               rneb_seri(i,k) = qx(i,k,irneb)
             ENDIF
             IF (ok_bs) THEN
               qbs_seri(i,k)= qx(i,k,ibs)
             ENDIF
          ENDIF
       ENDDO
    ENDDO

    ! C Risi: dispatcher les isotopes dans les xt_seri
#ifdef ISO
#ifdef ISOVERIF
    write(*,*) 'physiq 1847: qx(1,1,:)=',qx(1,1,:)
    write(*,*) 'iqIsoPha(:,ivap)=',iqIsoPha(:,ivap)
    write(*,*) 'physiq 1846b: ok_isotopes,ntraciso,niso=',niso>0,ntraciso,niso
#endif
    do ixt=1,ntraciso
#ifdef ISOVERIF
      write(*,*) 'physiq tmp 1762a: ixt,iqiso_vap=',ixt,iqIsoPha(ixt,ivap)
      write(*,*) 'physiq tmp 1762b: ixt,iqiso_liq=',ixt,iqIsoPha(ixt,iliq)
      if (nqo.eq.3) then  
        write(*,*) 'physiq tmp 1762c: ixt,iqiso_liq=',ixt,iqIsoPha(ixt,iliq)
      endif !if (nqo.eq.3) then
#endif
      if (ixt.gt.niso) write(*,*) 'izone=',tracers(iqIsoPha(ixt,ivap))%iso_iZone 
      DO k = 1, klev
       DO i = 1, klon
          xtbs_seri(ixt,i,k) = 0.
          xt_seri(ixt,i,k)  = qx(i,k,iqIsoPha(ixt,ivap))
          xtl_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,iliq))
          if (nqo.eq.2) then
             xts_seri(ixt,i,k) = 0.
          else if (nqo.eq.3) then
             xts_seri(ixt,i,k) = qx(i,k,iqIsoPha(ixt,isol))
          endif
       enddo !DO i = 1, klon
      enddo ! DO k = 1, klev
      !write(*,*) 'physiq tmp 1897: dispatch termine pour ixt=',ixt 
    enddo !do ixt=1,niso
!    write(*,*) 'physiq tmp 1898: dispatch termine pour tous'
#endif
! #ifdef ISO

    !--OB mass fixer 
    IF (mass_fixer) THEN
    !--store initial water burden
    qql1(:)=0.0
    DO k = 1, klev
      qql1(:)=qql1(:)+(q_seri(:,k)+ql_seri(:,k))*zmasse(:,k)
      IF (nqo >= 3) THEN
        qql1(:)=qql1(:)+qs_seri(:,k)*zmasse(:,k)
      ENDIF
      IF (ok_bs) THEN
        qql1(:)=qql1(:)+qbs_seri(:,k)*zmasse(:,k)
      ENDIF
    ENDDO
#ifdef ISO
    DO ixt=1,ntraciso
    xtql1(ixt,:)=0.0
    DO k = 1, klev
      xtql1(ixt,:)=xtql1(ixt,:)+(xt_seri(ixt,:,k)+xtl_seri(ixt,:,k))*zmasse(:,k)
      IF (nqo >= 3) THEN
        xtql1(ixt,:)=xtql1(ixt,:)+xts_seri(ixt,:,k)*zmasse(:,k)
      ENDIF
      IF (ok_bs) THEN
        xtql1(ixt,:)=xtql1(ixt,:)+xtbs_seri(ixt,:,k)*zmasse(:,k)
      ENDIF
    ENDDO !DO k = 1, klev
    ENDDO !DO ixt=1,ntraciso
#endif
    ENDIF
    !--fin mass fixer

    tke0(:,:)=pbl_tke(:,:,is_ave)
    IF (nqtot > nqo) THEN
       ! water isotopes are not included in tr_seri
       itr = 0
       DO iq = 1, nqtot
         IF(.NOT.tracers(iq)%isInPhysics) CYCLE
         itr = itr+1
          DO  k = 1, klev
             DO  i = 1, klon
                tr_seri(i,k,itr) = qx(i,k,iq)
             ENDDO
          ENDDO
       ENDDO
    ELSE
! DC: make sure the final "1" index was meant for 1st H2O phase (vapor) !!!
       tr_seri(:,:,strIdx(tracers(:)%name,addPhase('H2O','g'))) = 0.0
    ENDIF

! Temporary solutions adressing ticket #104 and the non initialisation of tr_ancien
! LF
    IF (debut) THEN
      WRITE(lunout,*)' WARNING: tr_ancien initialised to tr_seri'
       itr = 0
       do iq = 1, nqtot
         IF(.NOT.tracers(iq)%isInPhysics) CYCLE
         itr = itr+1
         tr_ancien(:,:,itr)=tr_seri(:,:,itr)       
       enddo
    ENDIF

    DO i = 1, klon
       ztsol(i) = 0.
    ENDDO
    DO nsrf = 1, nbsrf
       DO i = 1, klon
          ztsol(i) = ztsol(i) + ftsol(i,nsrf)*pctsrf(i,nsrf)
       ENDDO
    ENDDO
    ! Initialize variables used for diagnostic purpose
    IF (flag_inhib_tend /= 0) CALL init_cmp_seri

    ! Diagnostiquer la tendance dynamique
#ifdef ISOVERIF
      if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then  
        do i=1,klon 
         do k=1,klev 
            if (q_seri(i,k).gt.ridicule) then  
               if (iso_verif_o18_aberrant_nostop( &
                    xt_seri(iso_HDO,i,k)/q_seri(i,k), &
                    xt_seri(iso_O18,i,k)/q_seri(i,k), &
                    'physiq 2099 qv').eq.1) then
                  write(*,*) 'physic 2444: i,k,q_seri(i,k)=',i,k,q_seri(i,k) 
                  write(*,*) 'xt_seri(:,i,k)=',xt_seri(:,i,k)
                  stop
              endif !  if (iso_verif_o18_aberrant_nostop 
            endif !if (q_seri(i,k).gt.errmax) then  
            if (ql_seri(i,k).gt.ridicule) then  
               if (iso_verif_o18_aberrant_nostop( &
                    xtl_seri(iso_HDO,i,k)/ql_seri(i,k), &
                    xtl_seri(iso_O18,i,k)/ql_seri(i,k), &
                    'physiq 2099 ql').eq.1) then
                  write(*,*) 'i,k,ql_seri(i,k)=',i,k,ql_seri(i,k) 
                  !stop
              endif !  if (iso_verif_o18_aberrant_nostop 
            endif !if (q_seri(i,k).gt.errmax) then  
            if (qs_seri(i,k).gt.ridicule) then  
               if (iso_verif_o18_aberrant_nostop( &
                    xts_seri(iso_HDO,i,k)/qs_seri(i,k), &
                    xts_seri(iso_O18,i,k)/qs_seri(i,k), &
                    'physiq 2099 qs').eq.1) then
                  write(*,*) 'i,k,qs_seri(i,k)=',i,k,qs_seri(i,k) 
                  !stop
              endif !  if (iso_verif_o18_aberrant_nostop 
            endif !if (q_seri(i,k).gt.errmax) then
          enddo !k=1,klev
         enddo  !i=1,klon
        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then         
#ifdef ISOTRAC  
         DO k = 1, klev
           DO i = 1, klon    
             call iso_verif_traceur(xt_seri(1,i,k),'physiq 2620a')
             call iso_verif_traceur(xtl_seri(1,i,k),'physiq 2620b')
             call iso_verif_traceur(xts_seri(1,i,k),'physiq 2620c') 
           enddo
         enddo
#endif
#endif

    IF (ancien_ok) THEN

       d_u_dyn(:,:)  = (u_seri(:,:)-u_ancien(:,:))/phys_tstep
       d_v_dyn(:,:)  = (v_seri(:,:)-v_ancien(:,:))/phys_tstep
       d_t_dyn(:,:)  = (t_seri(:,:)-t_ancien(:,:))/phys_tstep
       d_q_dyn(:,:)  = (q_seri(:,:)-q_ancien(:,:))/phys_tstep
       d_ql_dyn(:,:) = (ql_seri(:,:)-ql_ancien(:,:))/phys_tstep
       d_qs_dyn(:,:) = (qs_seri(:,:)-qs_ancien(:,:))/phys_tstep
       d_qbs_dyn(:,:) = (qbs_seri(:,:)-qbs_ancien(:,:))/phys_tstep
       CALL water_int(klon,klev,q_seri,zmasse,zx_tmp_fi2d)
       d_q_dyn2d(:)=(zx_tmp_fi2d(:)-prw_ancien(:))/phys_tstep
       CALL water_int(klon,klev,ql_seri,zmasse,zx_tmp_fi2d)
       d_ql_dyn2d(:)=(zx_tmp_fi2d(:)-prlw_ancien(:))/phys_tstep
       CALL water_int(klon,klev,qs_seri,zmasse,zx_tmp_fi2d)
       d_qs_dyn2d(:)=(zx_tmp_fi2d(:)-prsw_ancien(:))/phys_tstep
       CALL water_int(klon,klev,qbs_seri,zmasse,zx_tmp_fi2d)
       d_qbs_dyn2d(:)=(zx_tmp_fi2d(:)-prbsw_ancien(:))/phys_tstep
       ! !! RomP >>>   td dyn traceur
       IF (nqtot > nqo) d_tr_dyn(:,:,:)=(tr_seri(:,:,:)-tr_ancien(:,:,:))/phys_tstep
       ! !! RomP <<<
       !!d_rneb_dyn(:,:)=(rneb_seri(:,:)-rneb_ancien(:,:))/phys_tstep
       d_rneb_dyn(:,:)=0.0

#ifdef ISO
!       write(*,*) 'physiq tmp 2112'
         DO k = 1, klev
         DO i = 1, klon
            do ixt=1,ntraciso
              d_xt_dyn(ixt,i,k) =  &
                 (xt_seri(ixt,i,k)-xt_ancien(ixt,i,k))/phys_tstep
              d_xtl_dyn(ixt,i,k) =  &
                 (xtl_seri(ixt,i,k)-xtl_ancien(ixt,i,k))/phys_tstep
              d_xts_dyn(ixt,i,k) =  &
                 (xts_seri(ixt,i,k)-xts_ancien(ixt,i,k))/phys_tstep
              d_xtbs_dyn(ixt,i,k) =  &
                 (xtbs_seri(ixt,i,k)-xtbs_ancien(ixt,i,k))/phys_tstep
            enddo ! do ixt=1,ntraciso
         ENDDO
         ENDDO   
#ifdef ISOVERIF
         DO k = 1, klev
         DO i = 1, klon 
           do ixt=1,ntraciso
           call iso_verif_noNaN(xt_seri(ixt,i,k),'physiq 2220')
           call iso_verif_noNaN(xtl_seri(ixt,i,k),'physiq 2220b')
           call iso_verif_noNaN(xts_seri(ixt,i,k),'physiq 2220b')
           call iso_verif_noNaN(d_xt_dyn(ixt,i,k),'physiq 2220c')
           call iso_verif_noNaN(d_xtl_dyn(ixt,i,k),'physiq 2220d')
           call iso_verif_noNaN(d_xts_dyn(ixt,i,k),'physiq 2220e')
           call iso_verif_noNaN(d_xtbs_dyn(ixt,i,k),'physiq 2220f')
           enddo ! do ixt=1,ntraciso
         enddo
         enddo
#endif    
#ifdef ISOVERIF      
         if (iso_eau.gt.0) then
         DO k = 1, klev
         DO i = 1, klon   
           call iso_verif_egalite_choix(xt_seri(iso_eau,i,k), &
                  q_seri(i,k),'physiq 2033a',errmax,errmaxrel)
           call iso_verif_egalite_choix(xtl_seri(iso_eau,i,k), &
                  ql_seri(i,k),'physiq 2033al',errmax,errmaxrel)
           call iso_verif_egalite_choix(xts_seri(iso_eau,i,k), &
                  qs_seri(i,k),'physiq 2033as',errmax,errmaxrel)
           call iso_verif_egalite_choix(xt_ancien(iso_eau,i,k), &
                  q_ancien(i,k),'physiq 2033b',errmax,errmaxrel)
           call iso_verif_egalite_choix(d_xt_dyn(iso_eau,i,k), &
                  d_q_dyn(i,k),'physiq 2033c',errmax,errmaxrel)
         enddo
         enddo   
         endif 
         if (iso_HDO.gt.0) then
            DO k = 1, klev
             DO i = 1, klon
              if (q_seri(i,k).gt.3e-3) then
              call iso_verif_positif(deltaD(xt_seri(iso_HDO,i,k) &
                 /q_seri(i,k))+400.0,'physiq 2045a')
              call iso_verif_positif(deltaD(xt_ancien(iso_HDO,i,k) &
                  /q_ancien(i,k))+400.0,'physiq 2045b')
!              call iso_verif_egalite_choix(d_xt_dyn(iso_hdo,i,k) &
!     &          /tnat(iso_hdo),d_q_dyn(i,k),'physiq 2045c',1e-7,0.4)
              endif
             enddo
            enddo
         endif           
#ifdef ISOTRAC  
         DO k = 1, klev
           DO i = 1, klon    
             call iso_verif_traceur(xt_seri(1,i,k),'physiq 2065') 
             call iso_verif_traceur(xt_ancien(1,i,k),'physiq 2066') 
           enddo
         enddo
#endif            
#endif         
#endif

    ELSE ! ancien_OK
       d_u_dyn(:,:)  = 0.0
       d_v_dyn(:,:)  = 0.0
       d_t_dyn(:,:)  = 0.0
       d_q_dyn(:,:)  = 0.0
       d_ql_dyn(:,:) = 0.0
       d_qs_dyn(:,:) = 0.0
       d_q_dyn2d(:)  = 0.0
       d_ql_dyn2d(:) = 0.0
       d_qs_dyn2d(:) = 0.0
       d_qbs_dyn2d(:)= 0.0

#ifdef ISO
!        write(*,*) 'physiq tmp 2115'
!        i=496
!        k=18
!        write(*,*) 'physiq 2105: q_seri(i,k),ql_seri(i,k),qs_seri(i,k),ridicule=', &
!                q_seri(i,k),ql_seri(i,k),qs_seri(i,k),ridicule
         DO k = 1, klev
          DO i = 1, klon
           do ixt=1,ntraciso
            d_xt_dyn(ixt,i,k)= 0.0
            d_xtl_dyn(ixt,i,k)= 0.0
            d_xts_dyn(ixt,i,k)= 0.0
           enddo
          enddo
         enddo
!        write(*,*) 'physiq tmp 2125'
#endif

       ! !! RomP >>>   td dyn traceur
       IF (nqtot > nqo) d_tr_dyn(:,:,:)= 0.0
       ! !! RomP <<<
       d_rneb_dyn(:,:)=0.0
       d_qbs_dyn(:,:)=0.0
       ancien_ok = .TRUE.
#ifdef ISO
       d_xtbs_dyn(:,:,:)=0.0
#endif
    ENDIF

    ! Ajouter le geopotentiel du sol:

    DO k = 1, klev
       DO i = 1, klon
          zphi(i,k) = pphi(i,k) + pphis(i)
       ENDDO
    ENDDO

    ! Verifier les temperatures

    !IM BEG
    IF (check) THEN
       amn=MIN(ftsol(1,is_ter),1000.)
       amx=MAX(ftsol(1,is_ter),-1000.)
       DO i=2, klon
          amn=MIN(ftsol(i,is_ter),amn)
          amx=MAX(ftsol(i,is_ter),amx)
       ENDDO

       PRINT*,' debut avant hgardfou min max ftsol',itap,amn,amx
    ENDIF !(check) THEN
    !IM END

    CALL hgardfou(t_seri,ftsol,'debutphy',abortphy)
    IF (abortphy==1) Print*,'ERROR ABORT hgardfou debutphy'

    !IM BEG
    IF (check) THEN
       amn=MIN(ftsol(1,is_ter),1000.)
       amx=MAX(ftsol(1,is_ter),-1000.)
       DO i=2, klon
          amn=MIN(ftsol(i,is_ter),amn)
          amx=MAX(ftsol(i,is_ter),amx)
       ENDDO

       PRINT*,' debut apres hgardfou min max ftsol',itap,amn,amx
    ENDIF !(check) THEN
    !IM END

    ! Mettre en action les conditions aux limites (albedo, sst, etc.).
    ! Prescrire l'ozone et calculer l'albedo sur l'ocean.

    ! Update ozone if day change
    IF (MOD(itap-1,lmt_pas) == 0) THEN
       IF (read_climoz <= 0) THEN
          ! Once per day, update ozone from Royer:
          IF (solarlong0<-999.) then
             ! Generic case with evolvoing season
             zzz=real(days_elapsed+1)
          ELSE IF (abs(solarlong0-1000.)<1.e-4) then
             ! Particular case with annual mean insolation
             zzz=real(90) ! could be revisited
             IF (read_climoz/=-1) THEN
                abort_message ='read_climoz=-1 is recommended when ' &
                     // 'solarlong0=1000.'
                CALL abort_physic (modname,abort_message,1)
             ENDIF
          ELSE
             ! Case where the season is imposed with solarlong0
             zzz=real(90) ! could be revisited
          ENDIF

          wo(:,:,1)=ozonecm(latitude_deg, paprs,read_climoz,rjour=zzz)
#ifdef REPROBUS
          ptrop=dyn_tropopause(t_seri, ztsol, paprs, pplay, rot)/100.
          DO i = 1, klon
             Z1=t_seri(i,itroprep(i)+1)
             Z2=t_seri(i,itroprep(i))
             fac=(Z1-Z2)/alog(pplay(i,itroprep(i)+1)/pplay(i,itroprep(i)))
             B=Z2-fac*alog(pplay(i,itroprep(i)))
             ttrop(i)= fac*alog(ptrop(i))+B

             Z1= 1.e-3 * ( pphi(i,itroprep(i)+1)+pphis(i) ) / gravit
             Z2= 1.e-3 * ( pphi(i,itroprep(i))  +pphis(i) ) / gravit
             fac=(Z1-Z2)/alog(pplay(i,itroprep(i)+1)/pplay(i,itroprep(i)))
             B=Z2-fac*alog(pplay(i,itroprep(i)))
             ztrop(i)=fac*alog(ptrop(i))+B
          ENDDO
#endif
       ELSE
          !--- ro3i = elapsed days number since current year 1st january, 0h
          ro3i=days_elapsed+jh_cur-jh_1jan
          !--- scaling for old style files (360 records)
          IF(SIZE(time_climoz)==360.AND..NOT.ok_daily_climoz) ro3i=ro3i*360./year_len
          IF(adjust_tropopause) THEN
             CALL regr_pr_time_av(ncid_climoz, vars_climoz(1:read_climoz),   &
                      ro3i, 'C', press_cen_climoz, pplay, wo, paprs(:,1),    &
                      time_climoz ,  longitude_deg,   latitude_deg,          &
                      dyn_tropopause(t_seri, ztsol, paprs, pplay, rot))
          ELSE
             CALL regr_pr_time_av(ncid_climoz,  vars_climoz(1:read_climoz),  &
                      ro3i, 'C', press_cen_climoz, pplay, wo, paprs(:,1),    &
                      time_climoz )
          ENDIF
          ! Convert from mole fraction of ozone to column density of ozone in a
          ! cell, in kDU:
          FORALL (l = 1: read_climoz) wo(:, :, l) = wo(:, :, l) * rmo3 / rmd &
               * zmasse / dobson_u / 1e3
          ! (By regridding ozone values for LMDZ only once a day, we
          ! have already neglected the variation of pressure in one
          ! day. So do not recompute "wo" at each time step even if
          ! "zmasse" changes a little.)
       ENDIF
    ENDIF

#ifdef ISO
#ifdef ISOVERIF 
#ifdef ISOTRAC 
         DO k = 1, klev
           DO i = 1, klon         
             call iso_verif_traceur(xt_seri(1,i,k), &
                 'physiq 2856: avant reevp')
           enddo
         enddo
#endif
#endif
#endif

    ! Re-evaporer l'eau liquide nuageuse

     CALL reevap (klon,klev,iflag_ice_thermo,t_seri,qx_seri, &
             d_t_eva,d_qx_eva)

     call dispatch(klon,klev,qx_seri,q_seri,xt_seri,ql_seri,xtl_seri,qs_seri,xts_seri)
     call dispatch(klon,klev,d_qx_eva,d_q_eva,d_xt_eva,d_ql_eva,d_xtl_eva,d_qi_eva,d_xti_eva)


#ifdef ISO
#ifdef ISOVERIF
 DO k = 1, klev 
     DO i = 1, klon
      do ixt=1,ntraciso
      call iso_verif_noNaN(xt_seri(ixt,i,k), &
           'reevap 2417: apres evap tot')
      enddo
      if (iso_eau.gt.0) then
              call iso_verif_egalite_choix( &
                 xt_seri(iso_eau,i,k),q_seri(i,k), &
                'reevap 1891, après réévap totale',errmax,errmaxrel)
              call iso_verif_egalite_choix( &
                 xtl_seri(iso_eau,i,k),ql_seri(i,k), &
                'reevap 2209, après réévap totale',errmax,errmaxrel)
              call iso_verif_egalite_choix( &
                 xts_seri(iso_eau,i,k),qs_seri(i,k), &
                'reevap 2209b, après réévap totale',errmax,errmaxrel)
       endif !if (iso_eau.gt.0) then
     
      if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then  
            if (q_seri(i,k).gt.ridicule) then  
               if (iso_verif_o18_aberrant_nostop( &
                    xt_seri(iso_HDO,i,k)/q_seri(i,k), &
                    xt_seri(iso_O18,i,k)/q_seri(i,k), &
                    'reevap 2408: apres reevap totale').eq.1) then
                  write(*,*) 'i,k,q_seri(i,k)=',i,k,q_seri(i,k)                       
                  stop
              endif !  if (iso_verif_o18_aberrant_nostop
            endif !if (q_seri(i,k).gt.errmax) then   
        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then        
#ifdef ISOTRAC      
             call iso_verif_traceur(xt_seri(1,i,k), &
                 'reevap 2165c')
             call iso_verif_traceur_pbidouille(xt_seri(1,i,k), &
                 'reevap 2165d')
#endif
       ENDDO
    ENDDO               
#endif                  
#endif


     CALL add_phys_tend &
            (du0,dv0,d_t_eva,d_q_eva,d_ql_eva,d_qi_eva,dqbs0,paprs,&
               'eva',abortphy,flag_inhib_tend,itap,0 &
#ifdef ISO
          ,d_xt_eva,d_xtl_eva,d_xti_eva &
#endif      
         )
    CALL prt_enerbil('eva',itap)

    !=========================================================================
    ! Calculs de l'orbite.
    ! Necessaires pour le rayonnement et la surface (calcul de l'albedo).
    ! doit donc etre plac\'e avant radlwsw et pbl_surface

    ! !!   jyg 17 Sep 2010 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    CALL ymds2ju(year_cur, mth_eq, day_eq,0., jD_eq)
    day_since_equinox = (jD_cur + jH_cur) - jD_eq

    !   choix entre calcul de la longitude solaire vraie ou valeur fixee a 
    !   solarlong0
    IF (solarlong0<-999.) THEN
       IF (new_orbit) THEN
          ! calcul selon la routine utilisee pour les planetes
          CALL solarlong(day_since_equinox, zlongi, dist)
       ELSE
          ! calcul selon la routine utilisee pour l'AR4
          CALL orbite(REAL(days_elapsed+1),zlongi,dist)
       ENDIF
    ELSE
       zlongi=solarlong0  ! longitude solaire vraie
       dist=1.            ! distance au soleil / moyenne 
    ENDIF

    IF (prt_level>=1) write(lunout,*)'Longitude solaire ',zlongi,solarlong0,dist


    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    ! Calcul de l'ensoleillement :
    ! ============================
    ! Pour une solarlong0=1000., on calcule un ensoleillement moyen sur
    ! l'annee a partir d'une formule analytique.
    ! Cet ensoleillement est sym\'etrique autour de l'\'equateur et
    ! non nul aux poles.
    IF (abs(solarlong0-1000.)<1.e-4) THEN
       CALL zenang_an(iflag_cycle_diurne>=1,jH_cur, &
            latitude_deg,longitude_deg,rmu0,fract)
       swradcorr(:) = 1.0
       JrNt(:) = 1.0
       zrmu0(:) = rmu0(:)
    ELSE
       ! recode par Olivier Boucher en sept 2015
       SELECT CASE (iflag_cycle_diurne)
       CASE(0)  
          !  Sans cycle diurne
          CALL angle(zlongi, latitude_deg, fract, rmu0)
          swradcorr = 1.0
          JrNt = 1.0
          zrmu0 = rmu0
       CASE(1)  
          !  Avec cycle diurne sans application des poids
          !  bit comparable a l ancienne formulation cycle_diurne=true
          !  on integre entre gmtime et gmtime+radpas
          zdtime=phys_tstep*REAL(radpas) ! pas de temps du rayonnement (s)
          CALL zenang(zlongi,jH_cur,0.0,zdtime, &
               latitude_deg,longitude_deg,rmu0,fract)
          zrmu0 = rmu0
          swradcorr = 1.0
          ! Calcul du flag jour-nuit
          JrNt = 0.0
          WHERE (fract>0.0) JrNt = 1.0
       CASE(2)  
          !  Avec cycle diurne sans application des poids
          !  On integre entre gmtime-pdtphys et gmtime+pdtphys*(radpas-1)
          !  Comme cette routine est appele a tous les pas de temps de
          !  la physique meme si le rayonnement n'est pas appele je
          !  remonte en arriere les radpas-1 pas de temps
          !  suivant. Petite ruse avec MOD pour prendre en compte le
          !  premier pas de temps de la physique pendant lequel
          !  itaprad=0
          zdtime1=phys_tstep*REAL(-MOD(itaprad,radpas)-1)      
          zdtime2=phys_tstep*REAL(radpas-MOD(itaprad,radpas)-1) 
          CALL zenang(zlongi,jH_cur,zdtime1,zdtime2, &
               latitude_deg,longitude_deg,rmu0,fract)

          ! Calcul des poids

          zdtime1=-phys_tstep !--on corrige le rayonnement pour representer le
          zdtime2=0.0    !--pas de temps de la physique qui se termine
          CALL zenang(zlongi,jH_cur,zdtime1,zdtime2, &
               latitude_deg,longitude_deg,zrmu0,zfract)
          swradcorr = 0.0
          WHERE (rmu0>=1.e-10 .OR. fract>=1.e-10) &
               swradcorr=zfract/fract*zrmu0/rmu0
          ! Calcul du flag jour-nuit
          JrNt = 0.0
          WHERE (zfract>0.0) JrNt = 1.0
       END SELECT
    ENDIF
    sza_o = ACOS (rmu0) *180./pi

    IF (mydebug) THEN
       CALL writefield_phy('u_seri',u_seri,nbp_lev)
       CALL writefield_phy('v_seri',v_seri,nbp_lev)
       CALL writefield_phy('t_seri',t_seri,nbp_lev)
       CALL writefield_phy('q_seri',q_seri,nbp_lev)
    ENDIF

    !cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
    ! Appel au pbl_surface : Planetary Boudary Layer et Surface
    ! Cela implique tous les interactions des sous-surfaces et la
    ! partie diffusion turbulent du couche limit.

    ! Certains varibales de sorties de pbl_surface sont utiliser que pour 
    ! ecriture des fihiers hist_XXXX.nc, ces sont :
    !   qsol,      zq2m,      s_pblh,  s_lcl,
    !   s_capCL,   s_oliqCL,  s_cteiCL,s_pblT,
    !   s_therm,   s_trmb1,   s_trmb2, s_trmb3,
    !   zu10m,     zv10m,   fder,
    !   zxqsurf,   delta_qsurf,
    !   rh2m,      zxfluxu, zxfluxv,
    !   frugs,     agesno,    fsollw,  fsolsw,
    !   d_ts,      fevap,     fluxlat, t2m,
    !   wfbils,    fluxt,   fluxu, fluxv,

    ! Certains ne sont pas utiliser du tout : 
    !   dsens, devap, zxsnow, zxfluxt, zxfluxq, q2m, fluxq

    ! Calcul de l'humidite de saturation au niveau du sol

! Tests Fredho, instensibilite au pas de temps -------------------------------
! A detruire en 2024 une fois les tests documentes et les choix faits        !
! Conservation des variables avant l'appel à l a diffusion pour les tehrmic  !
    if (iflag_thermals_tenv / 10 == 1 ) then                                 !
        do k=1,klev                                                          !
           do i=1,klon                                                       !
              t_env(i,k)=t_seri(i,k)                                         !
              q_env(i,k)=q_seri(i,k)   
#ifdef ISO
              do ixt=1,ntraciso
                xt_env(ixt,i,k)=xt_seri(ixt,i,k)
              enddo
#endif
           enddo                                                             !
        enddo                                                                !
    else if (iflag_thermals_tenv / 10 == 2 ) then                            !
        do k=1,klev                                                          !
           do i=1,klon                                                       !
              t_env(i,k)=t_seri(i,k)                                         !
           enddo                                                             !
        enddo                                                                !
    endif                                                                    !
! Tests Fredho, instensibilite au pas de temps -------------------------------


    IF (iflag_pbl/=0) THEN

       !jyg+nrlmd<
!!jyg       IF (prt_level .ge. 2 .and. mod(iflag_pbl_split,2) .eq. 1) THEN
       IF (prt_level >= 2 .and. mod(iflag_pbl_split,10) >= 1) THEN
          print *,'debut du splitting de la PBL, wake_s = ', wake_s(:)
          print *,'debut du splitting de la PBL, wake_deltat = ', wake_deltat(:,1)
          print *,'debut du splitting de la PBL, wake_deltaq = ', wake_deltaq(:,1)
       ENDIF
       ! !!
       !>jyg+nrlmd

       !-------gustiness calculation-------!
       !ym : Warning gustiness non inialized for iflag_gusts=2 & iflag_gusts=3
       gustiness=0  !ym missing init
       
       IF (iflag_gusts==0) THEN
          gustiness(1:klon)=0
       ELSE IF (iflag_gusts==1) THEN
          gustiness(1:klon)=f_gust_bl*ale_bl(1:klon)+f_gust_wk*ale_wake(1:klon)
       ELSE IF (iflag_gusts==2) THEN
          gustiness(1:klon)=f_gust_bl*ale_bl_stat(1:klon)+f_gust_wk*ale_wake(1:klon)
       !!!! modif olivier torres
       ELSE IF (iflag_gusts==3) THEN
          w_et=wstar(1,3)
          jlr_g_s=(0.65*w_et)**2
          pr_et=rain_con*8640
          jlr_g_c = (((19.8*(pr_et(1:klon)**2))/(1.5+pr_et(1:klon)+pr_et(1:klon)**2))**(0.4))**2
          gustiness(1:klon)=jlr_g_c+jlr_g_s
!!       write(*,*) "rain ",pr_et
!!       write(*,*) "jlr_g_c",jlr_g_c
!!       write(*,*) "wstar",wstar(1,3)
!!       write(*,*) "jlr_g_s",jlr_g_s
          ! ELSE IF (iflag_gusts==2) THEN
          !    do i = 1, klon
          !       gustiness(i)=f_gust_bl*ale_bl(i)+sigma_wk(i)*f_gust_wk&
          !           *ale_wake(i) !! need to make sigma_wk accessible here
          !    enddo
          ! ELSE IF (iflag_gusts==3) THEN
          !    do i = 1, klon
          !       gustiness(i)=f_gust_bl*alp_bl(i)+f_gust_wk*alp_wake(i)
          !    enddo
       ENDIF

       CALL pbl_surface(  &
            phys_tstep,     date0,     itap,    days_elapsed+1, &
            debut,     lafin, &
            longitude_deg, latitude_deg, rugoro,  zrmu0,      &
            sollwdown,    cldt,      &
            rain_fall, snow_fall, bs_fall, solsw,   solswfdiff, sollw,     &
            gustiness,                                &
            t_seri,    q_seri,   qbs_seri,  u_seri,  v_seri,    &
                                !nrlmd+jyg<
            wake_deltat, wake_deltaq, wake_cstar, wake_s, &
                                !>nrlmd+jyg
            pplay,     paprs,     pctsrf,             &
            ftsol,SFRWL,falb_dir,falb_dif,ustar,u10m,v10m,wstar, &
                                !albedo SB <<<
            cdragh,    cdragm,  u1,    v1,            &
            beta_aridity, &
                                !albedo SB >>>
                                ! albsol1,   albsol2,   sens,    evap,      &
            albsol_dir,   albsol_dif,   sens,    evap, snowerosion, &  
                                !albedo SB <<<
            albsol3_lic,runoff,   snowhgt,   qsnow, to_ice, sissnow, &
            zxtsol,    zxfluxlat, zt2m,    qsat2m,  zn2mout, &
            d_t_vdf,   d_q_vdf, d_qbs_vdf,  d_u_vdf, d_v_vdf, d_t_diss, &
                                !nrlmd<
                                !jyg<
            d_t_vdf_w, d_q_vdf_w, &
            d_t_vdf_x, d_q_vdf_x, &
            sens_x, zxfluxlat_x, sens_w, zxfluxlat_w, &
                                !>jyg
            delta_tsurf,wake_dens, &
            cdragh_x,cdragh_w,cdragm_x,cdragm_w, &
            kh,kh_x,kh_w, &
                                !>nrlmd
            coefh(1:klon,1:klev,1:nbsrf+1), coefm(1:klon,1:klev,1:nbsrf+1), &
            slab_wfbils,                 &
            qsol,      zq2m,      s_pblh,  s_lcl, &
                                !jyg<
            s_pblh_x, s_lcl_x, s_pblh_w, s_lcl_w, &
                                !>jyg
            s_capCL,   s_oliqCL,  s_cteiCL,s_pblT, &
            s_therm,   s_trmb1,   s_trmb2, s_trmb3, &
            zustar, zu10m,     zv10m,   fder, &
            zxqsurf, delta_qsurf,   rh2m,      zxfluxu, zxfluxv, &
            z0m, z0h,     agesno,    fsollw,  fsolsw, &
            d_ts,      fevap,     fluxlat, t2m, &
            wfbils, wfevap, & 
            fluxt,   fluxu,  fluxv, &
            dsens,     devap,     zxsnow, &
            zxfluxt,   zxfluxq,  zxfluxqbs,  q2m, fluxq, fluxqbs, pbl_tke, pbl_eps,  &
                                !nrlmd+jyg<
            wake_delta_pbl_TKE, &
                                !>nrlmd+jyg
             treedrg &            
#ifdef ISO
         ,xtrain_fall, xtsnow_fall,xt_seri, &
         wake_deltaxt,xtevap,fxtevap, &
         d_xt_vdf,d_xt_vdf_w,d_xt_vdf_x, &
         xtsol,dxtevap,zxxtsnow,zxfluxxt,fluxxt, &
         h1_diag,runoff_diag,xtrunoff_diag &
#endif      
         )
!FC

#ifdef ISO
       ! write(*,*) 'physiq 2402: apres pbl_surface'
#ifdef ISOVERIF 
      do i=1,klon
       do k=1,klev
        do ixt=1,ntraciso
            call iso_verif_noNaN(d_xt_vdf(ixt,i,k),'physiq 1993a')
            call iso_verif_noNaN(xt_seri(ixt,i,k),'physiq 1993b')
        enddo !do ixt=1,ntraciso   
       enddo
      enddo
#endif  
#ifdef ISOVERIF   
      do i=1,klon
       do k=1,klev     
#ifdef ISOTRAC      
        call iso_verif_traceur_justmass(d_xt_vdf(1,i,k),'physiq 2443')
#endif            
       enddo
      enddo
        
      ! verif iso_eau
      !write(*,*) 'physiq tmp 2748: iso_eau=',iso_eau
      !write(*,*) 'iso_eau.gt.0=',iso_eau.gt.0
      !write(*,*) 'd_xt_vdf(iso_eau,1,1),d_q_vdf(1,1)=',d_xt_vdf(iso_eau,1,1),d_q_vdf(1,1)
      !write(*,*) 'bidouille_anti_divergence=',bidouille_anti_divergence
      if (iso_eau.gt.0) then
!        write(*,*) 'physiq 2665: d_q_vdf,d_xt_vdf(iso_eau,554,19)=',d_q_vdf(554,19),d_xt_vdf(iso_eau,554,19)
!        write(*,*) 'd_q_vdf,d_xt_vdf(iso_eau,2,1)=',d_q_vdf(2,1),d_xt_vdf(iso_eau,2,1)
      do i=1,klon
!        write(*,*) 'physiq 2667: i,k=',i,k
!        write(*,*) 'd_q_vdf,d_xt_vdf(iso_eau,554,19)=',d_q_vdf(554,19),d_xt_vdf(iso_eau,554,19)
!        write(*,*) 'd_q_vdf,d_xt_vdf(iso_eau,2,1)=',d_q_vdf(2,1),d_xt_vdf(iso_eau,2,1)
        do k=1,klev
!          write(*,*) 'physiq 2670: i,k=',i,k
!        write(*,*) 'd_q_vdf,d_xt_vdf(iso_eau,554,19)=',d_q_vdf(554,19),d_xt_vdf(iso_eau,554,19)
!        write(*,*) 'd_q_vdf,d_xt_vdf(iso_eau,2,1)=',d_q_vdf(2,1),d_xt_vdf(iso_eau,2,1)
!        write(*,*) 'd_q_vdf,d_xt_vdf(iso_eau,i,k)=',d_q_vdf(i,k),d_xt_vdf(iso_eau,i,k)
          call iso_verif_egalite_choix( &
                 d_xt_vdf(iso_eau,i,k),d_q_vdf(i,k), &
                 'physiq 1984',errmax,errmaxrel)
         call iso_verif_egalite_choix( &
                 xt_seri(iso_eau,i,k),q_seri(i,k), &
                 'physiq 1985',errmax,errmaxrel)
          do nsrf=1,nbsrf
              call iso_verif_egalite_choix(fluxxt(iso_eau,i,k,nsrf), &
                 fluxq(i,k,nsrf),'physiq 1991',errmax,errmaxrel)
          enddo !do nsrf=1,nbsrf
        enddo !k=1,klev
      enddo  !i=1,klon
      endif !if (iso_eau.gt.0) then
      if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then  
        do i=1,klon 
         do k=1,klev 
            if (q_seri(i,k).gt.ridicule) then  
               if (iso_verif_o18_aberrant_nostop( &
                    xt_seri(iso_HDO,i,k)/q_seri(i,k), &
                    xt_seri(iso_O18,i,k)/q_seri(i,k), &
                    'physiq 4177, apres pbl_surface').eq.1) then
                  write(*,*) 'i,k,q_seri(i,k)=',i,k,q_seri(i,k)                       
                  stop
              endif !  if (iso_verif_o18_aberrant_nostop 
            endif !if (q_seri(i,k).gt.errmax) then   
          enddo !k=1,klev
         enddo  !i=1,klon
        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
        !write(*,*) 'physiq tmp 2689'
#endif
!#ifdef ISOVERIF 
#endif 
!#ifdef ISO

       !  Add turbulent diffusion tendency to the wake difference variables
!!jyg       IF (mod(iflag_pbl_split,2) .NE. 0) THEN
       IF (mod(iflag_pbl_split,10) /= 0) THEN
!jyg<
          d_deltat_vdf(:,:) = d_t_vdf_w(:,:)-d_t_vdf_x(:,:)
          d_deltaq_vdf(:,:) = d_q_vdf_w(:,:)-d_q_vdf_x(:,:)
          CALL add_wake_tend &
             (d_deltat_vdf, d_deltaq_vdf, dsig0, dsig0, ddens0, ddens0, wkoccur1, 'vdf', abortphy &
#ifdef ISO
               ,d_deltaxt_vdf &
#endif
                ) 
       ELSE
          d_deltat_vdf(:,:) = 0.
          d_deltaq_vdf(:,:) = 0.
!>jyg
#ifdef ISO
          d_deltaxt_vdf(:,:,:) = 0.
#endif
       ENDIF

       !---------------------------------------------------------------------
       ! ajout des tendances de la diffusion turbulente
       IF (klon_glo==1) THEN
          CALL add_pbl_tend &
               (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,d_qbs_vdf,paprs,&
               'vdf',abortphy,flag_inhib_tend,itap &
#ifdef ISO
          ,d_xt_vdf,dxtl0,dxti0 &
#endif      
         )
       ELSE
          CALL add_phys_tend &
               (d_u_vdf,d_v_vdf,d_t_vdf+d_t_diss,d_q_vdf,dql0,dqi0,d_qbs_vdf,paprs,&
               'vdf',abortphy,flag_inhib_tend,itap,0 &
#ifdef ISO
          ,d_xt_vdf,dxtl0,dxti0 &
#endif      
         )
       ENDIF
       CALL prt_enerbil('vdf',itap)

       !--------------------------------------------------------------------

       IF (mydebug) THEN
          CALL writefield_phy('u_seri',u_seri,nbp_lev)
          CALL writefield_phy('v_seri',v_seri,nbp_lev)
          CALL writefield_phy('t_seri',t_seri,nbp_lev)
          CALL writefield_phy('q_seri',q_seri,nbp_lev)
       ENDIF

       !albedo SB >>>
       albsol1=0.
       albsol2=0.
       falb1=0.
       falb2=0.
       SELECT CASE(nsw)
       CASE(2)
          albsol1=albsol_dir(:,1)
          albsol2=albsol_dir(:,2)
          falb1=falb_dir(:,1,:)
          falb2=falb_dir(:,2,:)
       CASE(4)
          albsol1=albsol_dir(:,1)
          albsol2=albsol_dir(:,2)*SFRWL(2)+albsol_dir(:,3)*SFRWL(3) &
               +albsol_dir(:,4)*SFRWL(4)
          albsol2=albsol2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
          falb1=falb_dir(:,1,:)
          falb2=falb_dir(:,2,:)*SFRWL(2)+falb_dir(:,3,:)*SFRWL(3) &
               +falb_dir(:,4,:)*SFRWL(4)
          falb2=falb2/(SFRWL(2)+SFRWL(3)+SFRWL(4))
       CASE(6)
          albsol1=albsol_dir(:,1)*SFRWL(1)+albsol_dir(:,2)*SFRWL(2) &
               +albsol_dir(:,3)*SFRWL(3)
          albsol1=albsol1/(SFRWL(1)+SFRWL(2)+SFRWL(3))
          albsol2=albsol_dir(:,4)*SFRWL(4)+albsol_dir(:,5)*SFRWL(5) &
               +albsol_dir(:,6)*SFRWL(6)
          albsol2=albsol2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
          falb1=falb_dir(:,1,:)*SFRWL(1)+falb_dir(:,2,:)*SFRWL(2) &
               +falb_dir(:,3,:)*SFRWL(3)
          falb1=falb1/(SFRWL(1)+SFRWL(2)+SFRWL(3))
          falb2=falb_dir(:,4,:)*SFRWL(4)+falb_dir(:,5,:)*SFRWL(5) &
               +falb_dir(:,6,:)*SFRWL(6)
          falb2=falb2/(SFRWL(4)+SFRWL(5)+SFRWL(6))
       END SELECt
       !albedo SB <<<


       CALL evappot(klon,nbsrf,ftsol,pplay(:,1),cdragh, &
            t_seri(:,1),q_seri(:,1),u_seri(:,1),v_seri(:,1),evap_pot)

    ENDIF

    ! ==================================================================
    ! Blowing snow sublimation and sedimentation

    d_t_bsss(:,:)=0.
    d_q_bsss(:,:)=0.
    d_qbs_bsss(:,:)=0.
    bsfl(:,:)=0.
    bs_fall(:)=0.
    IF (ok_bs) THEN

     CALL call_blowing_snow_sublim_sedim(klon,klev,phys_tstep,t_seri,q_seri,qbs_seri,pplay,paprs, &
                                        d_t_bsss,d_q_bsss,d_qbs_bsss,bsfl,bs_fall)

     CALL add_phys_tend &
               (du0,dv0,d_t_bsss,d_q_bsss,dql0,dqi0,d_qbs_bsss,paprs,&
               'bs',abortphy,flag_inhib_tend,itap,0  &
#ifdef ISO                                       
            ,dxt0,dxtl0,dxti0 &
#endif                                       
           )

    ENDIF

    ! =================================================================== c
    !   Calcul de Qsat

    DO k = 1, klev
       DO i = 1, klon
          zx_t = t_seri(i,k)
          IF (thermcep) THEN
             zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
             zx_qs  = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
             zx_qs  = MIN(0.5,zx_qs)
             zcor   = 1./(1.-retv*zx_qs)
             zx_qs  = zx_qs*zcor
          ELSE
             !!           IF (zx_t.LT.t_coup) THEN             !jyg
             IF (zx_t<rtt) THEN                  !jyg
                zx_qs = qsats(zx_t)/pplay(i,k)
             ELSE
                zx_qs = qsatl(zx_t)/pplay(i,k)
             ENDIF
          ENDIF
          zqsat(i,k)=zx_qs
       ENDDO
    ENDDO

    IF (prt_level>=1) THEN
       write(lunout,*) 'L   qsat (g/kg) avant clouds_gno'
       write(lunout,'(i4,f15.4)') (k,1000.*zqsat(igout,k),k=1,klev)
    ENDIF

    ! Appeler la convection (au choix)

    DO k = 1, klev
       DO i = 1, klon
          conv_q(i,k) = d_q_dyn(i,k)  &
               + d_q_vdf(i,k)/phys_tstep
          conv_t(i,k) = d_t_dyn(i,k)  &
               + d_t_vdf(i,k)/phys_tstep
       ENDDO
    ENDDO
    IF (check) THEN
       za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
       WRITE(lunout,*) "avantcon=", za
    ENDIF
    zx_ajustq = .FALSE.
    IF (iflag_con==2) zx_ajustq=.TRUE.
    IF (zx_ajustq) THEN
       DO i = 1, klon
          z_avant(i) = 0.0
       ENDDO
       DO k = 1, klev
          DO i = 1, klon
             z_avant(i) = z_avant(i) + (q_seri(i,k)+ql_seri(i,k)) &
                  *(paprs(i,k)-paprs(i,k+1))/RG
          ENDDO
       ENDDO
    ENDIF

    ! Calcule de vitesse verticale a partir de flux de masse verticale
    DO k = 1, klev
       DO i = 1, klon
          omega(i,k) = RG*flxmass_w(i,k) / cell_area(i)
       ENDDO
    ENDDO

    IF (prt_level>=1) write(lunout,*) 'omega(igout, :) = ', &
         omega(igout, :)

    ! Appel de la convection tous les "cvpas"

!!jyg    IF (MOD(itapcv,cvpas).EQ.0) THEN
!!    print *,' physiq : itapcv, cvpas, itap-1, cvpas_0 ', &
!!                       itapcv, cvpas, itap-1, cvpas_0
    IF (MOD(itapcv,cvpas)==0 .OR. MOD(itap-1,cvpas_0)==0) THEN

    ! Mettre a zero des variables de sortie (pour securite)

    pmflxr(:,:) = 0.
    pmflxs(:,:) = 0.
    wdtrainA(:,:) = 0.
    wdtrainS(:,:) = 0.
    wdtrainM(:,:) = 0.
    upwd(:,:) = 0.
    dnwd(:,:) = 0.
    ep(:,:) = 0.
    da(:,:)=0.
    mp(:,:)=0.
    wght_cvfd(:,:)=0.
    phi(:,:,:)=0.
    phi2(:,:,:)=0.
    epmlmMm(:,:,:)=0.
    eplaMm(:,:)=0.
    d1a(:,:)=0.
    dam(:,:)=0.
    elij(:,:,:)=0.
    ev(:,:)=0.
    qtaa(:,:)=0.
    clw(:,:)=0.
    sij(:,:,:)=0.
#ifdef ISO
    xtclw(:,:,:)=0.
    xtev(:,:,:)=0.
    xtwdtrainA(:,:,:) = 0.
#endif

    IF (iflag_con==1) THEN
       abort_message ='reactiver le call conlmd dans physiq.F'
       CALL abort_physic (modname,abort_message,1)
       !     CALL conlmd (phys_tstep, paprs, pplay, t_seri, q_seri, conv_q,
       !    .             d_t_con, d_q_con,
       !    .             rain_con, snow_con, ibas_con, itop_con)
    ELSE IF (iflag_con==2) THEN
#ifdef ISO
      CALL abort_gcm('physiq 2770','isos pas prevus ici',1)
#endif
       CALL conflx(phys_tstep, paprs, pplay, t_seri, q_seri, &
            conv_t, conv_q, -evap, omega, &
            d_t_con, d_q_con, rain_con, snow_con, &
            pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
            kcbot, kctop, kdtop, pmflxr, pmflxs)
       d_u_con = 0.
       d_v_con = 0.

       WHERE (rain_con < 0.) rain_con = 0.
       WHERE (snow_con < 0.) snow_con = 0.
       DO i = 1, klon
          ibas_con(i) = klev+1 - kcbot(i)
          itop_con(i) = klev+1 - kctop(i)
       ENDDO
    ELSE IF (iflag_con>=3) THEN
       ! nb of tracers for the KE convection:
       ! MAF la partie traceurs est faite dans phytrac
       ! on met ntra=1 pour limiter les appels mais on peut
       ! supprimer les calculs / ftra.

          
#ifdef ISOVERIF
       do k = 1, klev
        do i = 1, klon
          call iso_verif_positif(q_seri(i,k),'physic 2929')
        enddo
       enddo
#endif
#ifdef ISO
#ifdef ISOVERIF
        write(*,*) 'physiq 2877'
      call iso_verif_noNaN_vect2D( &
                 wake_deltaxt, &
                 'physiq 2704c, wake_deltaxt',ntraciso,klon,klev)
      do k = 1, klev
        do i = 1, klon
           do ixt=1,ntraciso
             call iso_verif_noNaN(xt_seri(ixt,i,k),'physiq 2757')
           enddo ! do ixt=1,ntraciso 
        enddo !do i = 1, klon
       enddo    !do k = 1, klev 
      if (iso_eau.gt.0) then
      call iso_verif_egalite_vect2D( &
                 xt_seri,q_seri, &
                 'physiq 2704a, avant calcul undi',ntraciso,klon,klev)
      call iso_verif_egalite_vect2D( &
                 wake_deltaxt,wake_deltaq, &
                 'physiq 2704b, wake_deltaq',ntraciso,klon,klev)
      endif
      if (iso_HDO.gt.0) then
      call iso_verif_aberrant_enc_vect2D( &
                 xt_seri,q_seri, &
                 'physiq 2709, avant calcul undi',ntraciso,klon,klev)
      endif
      if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then  
        do k = 1, klev
        do i = 1, klon
            if (q_seri(i,k).gt.ridicule) then  
               if (iso_verif_o18_aberrant_nostop( &
                    xt_seri(iso_HDO,i,k)/q_seri(i,k), &
                    xt_seri(iso_O18,i,k)/q_seri(i,k), &
                    'physiq 2947, avant calcul undi').eq.1) then
                  write(*,*) 'physic 3315: i,k,q_seri(i,k)=',i,k,q_seri(i,k)                       
                  stop
              endif !  if (iso_verif_o18_aberrant_nostop 
            endif !if (q_seri(i,k).gt.errmax) then   
        enddo !do i = 1, klon
        enddo !do k = 1, klev
        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then  
#endif 
#endif   

       ntra = 1

       !=======================================================================
       !ajout pour la parametrisation des poches froides: calcul de
       !t_w et t_x: si pas de poches froides, t_w=t_x=t_seri
       IF (iflag_wake>=1) THEN
         DO k=1,klev
            DO i=1,klon
                t_w(i,k) = t_seri(i,k) + (1-wake_s(i))*wake_deltat(i,k)
                q_w(i,k) = q_seri(i,k) + (1-wake_s(i))*wake_deltaq(i,k)
                t_x(i,k) = t_seri(i,k) - wake_s(i)*wake_deltat(i,k)
                q_x(i,k) = q_seri(i,k) - wake_s(i)*wake_deltaq(i,k)
#ifdef ISO
                do ixt=1,ntraciso
                  xt_w(ixt,i,k) = xt_seri(ixt,i,k) + (1-wake_s(i))*wake_deltaxt(ixt,i,k)
                  xt_x(ixt,i,k) = xt_seri(ixt,i,k) - wake_s(i)*wake_deltaxt(ixt,i,k)
                enddo
#ifdef ISOVERIF
                if (iso_eau.gt.0) then
                  call iso_verif_egalite(wake_deltaq(i,k),wake_deltaxt(iso_eau,i,k),'physiq 3337')
                  call iso_verif_egalite(q_w(i,k),xt_w(iso_eau,i,k),'physiq 3338')
                endif
                if (iso_HDO.gt.0) then
                  if ((iso_verif_aberrant_enc_choix_nostop(xt_x(iso_hdo,i,k),q_x(i,k), &
                        ridicule,deltalim,'physic 3462a xt_x').eq.1).or. &
                        (iso_verif_aberrant_enc_choix_nostop(xt_w(iso_hdo,i,k),q_w(i,k), &
                        ridicule,deltalim,'physic 3462b xt_w').eq.1)) then
                     write(*,*) 'i,k=',i,k
                     write(*,*) 'q_x(i,k),q_seri(i,k),wake_s(i),wake_deltaq(i,k)=', &
                                q_x(i,k),q_seri(i,k),wake_s(i),wake_deltaq(i,k)
                     write(*,*) 'xt_x(iso_hdo,i,k),xt_seri(iso_hdo,i,k),wake_s(i),wake_deltaxt(iso_hdo,i,k)=', &
                                xt_x(iso_hdo,i,k),xt_seri(iso_hdo,i,k),wake_s(i),wake_deltaxt(iso_hdo,i,k)
                     write(*,*) 'deltaD_seri,wake=',deltaD(xt_seri(iso_hdo,i,k)/q_seri(i,k)), &
                                deltaD(wake_deltaxt(iso_hdo,i,k)/wake_deltaq(i,k))
                     write(*,*) 'deltaD_x,deltaD_w=',deltaD(xt_x(iso_hdo,i,k)/q_x(i,k)),deltaD(xt_w(iso_hdo,i,k)/q_w(i,k))
                     stop
                  endif
                endif
#endif
#endif
            ENDDO
         ENDDO
       ELSE
                t_w(:,:) = t_seri(:,:)
                q_w(:,:) = q_seri(:,:)
                t_x(:,:) = t_seri(:,:)
                q_x(:,:) = q_seri(:,:)
#ifdef ISO
                do ixt=1,ntraciso
                  xt_w(ixt,:,:) = xt_seri(ixt,:,:)
                  xt_x(ixt,:,:) = xt_seri(ixt,:,:)
                enddo
#endif
       ENDIF !IF (iflag_wake>=1) THEN

#ifdef ISOVERIF
         if (iso_eau.gt.0) then
           DO k=1,klev
            DO i=1,klon
                  call iso_verif_egalite(q_w(i,k),xt_w(iso_eau,i,k),'physiq 3358')
            enddo
          enddo
        endif ! if (iso_eau.gt.0) then
#endif

       !jyg<
       ! Perform dry adiabatic adjustment on wake profile
       ! The corresponding tendencies are added to the convective tendencies
       ! after the call to the convective scheme.
       IF (iflag_wake>=1) then
          IF (iflag_adjwk >= 1) THEN
             limbas(:) = 1
             CALL ajsec(paprs, pplay, t_w, q_w, limbas, &
                  d_t_adjwk, d_q_adjwk &
#ifdef ISO
            ,xt_w,d_xt_adjwk &
#endif         
         )

             DO k=1,klev
                DO i=1,klon
                   IF (wake_s(i) > 1.e-3) THEN
                      t_w(i,k) = t_w(i,k) + d_t_adjwk(i,k)
                      q_w(i,k) = q_w(i,k) + d_q_adjwk(i,k)
                      d_deltat_ajs_cv(i,k) = d_t_adjwk(i,k)
                      d_deltaq_ajs_cv(i,k) = d_q_adjwk(i,k)
#ifdef ISO
                      do ixt=1,ntraciso
                       xt_w(ixt,i,k) = xt_w(ixt,i,k) + d_xt_adjwk(ixt,i,k)
                       d_deltaxt_ajs_cv(ixt,i,k) = d_xt_adjwk(ixt,i,k)
                      enddo
#endif
                   ELSE
                      d_deltat_ajs_cv(i,k) = 0.
                      d_deltaq_ajs_cv(i,k) = 0.
#ifdef ISO
                      do ixt=1,ntraciso
                       d_deltaxt_ajs_cv(ixt,i,k) = 0.
                      enddo
#endif
                   ENDIF
                ENDDO
             ENDDO
             IF (iflag_adjwk == 2 .AND. OK_bug_ajs_cv) THEN
               CALL add_wake_tend &
                 (d_deltat_ajs_cv, d_deltaq_ajs_cv, dsig0, dsig0, ddens0, ddens0, wkoccur1, 'ajs_cv', abortphy &
#ifdef ISO
                      ,d_deltaxt_ajs_cv  &
#endif
                 ) 
             ENDIF  ! (iflag_adjwk == 2 .AND. OK_bug_ajs_cv)
          ENDIF  ! (iflag_adjwk >= 1)
       ENDIF ! (iflag_wake>=1)
       !>jyg

!!      print *,'physiq. q_w(1,k), q_x(1,k) ', &
!!             (k, q_w(1,k), q_x(1,k),k=1,25)

!jyg<
       CALL alpale( debut, itap, phys_tstep, paprs, omega, t_seri,   &
                    alp_offset, it_wape_prescr,  wape_prescr, fip_prescr, &
                    ale_bl_prescr, alp_bl_prescr, &
                    wake_pe, wake_fip,  &
                    Ale_bl, Ale_bl_trig, Alp_bl, &
                    Ale, Alp , Ale_wake, Alp_wake)
!>jyg

       ! sb, oct02:
       ! Schema de convection modularise et vectorise:
       ! (driver commun aux versions 3 et 4)

       IF (ok_cvl) THEN ! new driver for convectL

#ifdef ISO
#ifdef ISOVERIF
       write(*,*) 'physic 2553: avant appel concvl'
       do k = 1, klev
        do i = 1, klon
           do ixt=1,ntraciso
             call iso_verif_noNaN(xt_seri(ixt,i,k),'physiq 2925a')
             call iso_verif_noNaN(xt_x(ixt,i,k),'physiq 2925b')
           enddo ! do ixt=1,ntraciso 
           call iso_verif_positif(q_seri(i,k),'physic 3133a')
           if (iso_eau.gt.0) then
             call iso_verif_egalite_choix( &
                 xt_seri(iso_eau,i,k),q_seri(i,k), &
                'physic 2559a',errmax,errmaxrel)
             call iso_verif_egalite_choix( &
                 xt_x(iso_eau,i,k),q_x(i,k), &
                'physic 2559b',errmax,errmaxrel)
             call iso_verif_egalite_choix( &
                 xt_w(iso_eau,i,k),q_w(i,k), &
                'physic 2559c',errmax,errmaxrel)
           endif !if (iso_eau.gt.0) then
           if (iso_HDO.gt.0) then
             if (q_seri(i,k).gt.ridicule) then
              call iso_verif_aberrant_encadre( &
                 xt_seri(iso_hdo,i,k)/q_seri(i,k), &
                'physic 2657a')
             endif !if (q_seri(i,k).gt.ridicule) then
             if (q_x(i,k).gt.ridicule) then
              call iso_verif_aberrant_encadre( &
                 xt_x(iso_hdo,i,k)/q_x(i,k), &
                'physic 2657b')
             endif !if (q_x(i,k).gt.ridicule) then
             if (q_w(i,k).gt.ridicule) then
              call iso_verif_aberrant_encadre( &
                 xt_w(iso_hdo,i,k)/q_w(i,k), &
                'physic 2657c')
             endif !if (q_x(i,k).gt.ridicule) then
           endif !if (iso_HDO.gt.0) then
           if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
            if (q_seri(i,k).gt.ridicule) then
             call iso_verif_O18_aberrant( &
                    xt_seri(iso_HDO,i,k)/q_seri(i,k), &
                    xt_seri(iso_O18,i,k)/q_seri(i,k), &
                    'physiq 3285')
            endif ! if (q_seri(i,k).gt.ridicule) then
           endif ! if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
           if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
             if ((q_seri(i,k).gt.ridicule).and.(k.lt.nlevmaxO17)) then
              call iso_verif_aberrant_o17(xt_seri(iso_o17,i,k) &
                 /q_seri(i,k),xt_seri(iso_o18,i,k) &
                 /q_seri(i,k),'physiq 2781: avat clmain')
             endif !if (q_seri(i,k).gt.ridicule) then
           endif ! if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
#ifdef ISOTRAC 
           call iso_verif_traceur(xt_seri(1,i,k),'physiq 2975a')
           call iso_verif_traceur(xt_x(1,i,k),'physiq 2975b')
           call iso_verif_traceur(xt_w(1,i,k),'physiq 2975b')
           if (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k), &
                 'physiq 3060, avantconcvl',1e-5) &
                 .eq.1) then
              write(*,*) 'i,k=',i,k 
              stop
            endif !if (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k),
            if (option_tmin.eq.1) then
               call iso_verif_trac17_q_deltaD(xt_seri(1,i,k), &
                 'physiq 1456, avant concvl')
            endif   
#endif     
      enddo !do k=1,nlev
   enddo  !do i=1,klon   
#endif
!ISOVERIF         
          if ((bidouille_anti_divergence).and. &
                 (iso_eau.gt.0)) then
           do k=1,klev
            do i=1,klon  
             xt_seri(iso_eau,i,k)= q_seri(i,k) 
             xt_x(iso_eau,i,k)= q_x(i,k)
             xt_w(iso_eau,i,k)= q_w(i,k)
            enddo !do i=1,klon
           enddo !do k=1,klev
          endif !if ((bidouille_anti_divergence).and. &       
#endif 
          !jyg<
          ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
          ! Calculate the upmost level of deep convection loops: k_upper_cv
          !  (near 22 km)
          k_upper_cv = klev
          !izero = klon/2+1/klon
          !DO k = klev,1,-1
          !   IF (pphi(izero,k) > 22.e4) k_upper_cv = k
          !ENDDO
          ! FH : nouveau calcul base sur un profil global sans quoi
          ! le modele etait sensible au decoupage de domaines
          DO k = klev,1,-1
             IF (-7*log(presnivs(k)/presnivs(1)) > 25.) k_upper_cv = k
          ENDDO
          IF (prt_level >= 5) THEN
             Print *, 'upmost level of deep convection loops: k_upper_cv = ', &
                  k_upper_cv
          ENDIF

          !>jyg
          IF (type_trac == 'repr') THEN
             nbtr_tmp=ntra
          ELSE
             nbtr_tmp=nbtr
          ENDIF
          !jyg   iflag_con est dans clesphys
          !c          CALL concvl (iflag_con,iflag_clos,
          CALL concvl (iflag_clos, &
               phys_tstep, paprs, pplay, k_upper_cv, t_x,q_x, &
               t_w,q_w,wake_s, &
               u_seri,v_seri,tr_seri,nbtr_tmp, &
               ALE,ALP, &
               sig1,w01, &
               d_t_con,d_q_con,fqcomp,d_u_con,d_v_con,d_tr, &
               rain_con, snow_con, ibas_con, itop_con, sigd, &
               ema_cbmf,plcl,plfc,wbeff,convoccur,upwd,dnwd,dnwd0, &
               Ma,mipsh,Vprecip,cape,cin,tvp,Tconv,iflagctrl, &
               pbase,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr,qcondc,wd, &
                                ! RomP >>>
                                !!     .        pmflxr,pmflxs,da,phi,mp,
                                !!     .        ftd,fqd,lalim_conv,wght_th)
               pmflxr,pmflxs,da,phi,mp,phi2,d1a,dam,sij,qtaa,clw,elij, &
               ftd,fqd,lalim_conv,wght_th, &
               ev, ep,epmlmMm,eplaMm, &
               wdtrainA, wdtrainS, wdtrainM,wght_cvfd,qtc_cv,sigt_cv,detrain_cv, &
               tau_cld_cv,coefw_cld_cv,epmax_diag &
#ifdef ISO
             ,xt_x,xt_w,d_xt_con,xtrain_con,xtsnow_con &
             ,xtVprecip,xtVprecipi &
             ,xtclw,fxtd,xtev,xtwdtrainA &
#ifdef DIAGISO
             , qlp,xtlp,qvp,xtvp & ! juste diagnostique
             , fq_detrainement,fq_ddft,fq_fluxmasse,fq_evapprecip &
             , fxt_detrainement,fxt_ddft,fxt_fluxmasse,fxt_evapprecip &
             , f_detrainement,q_detrainement,xt_detrainement &
#endif          
#endif
              )
          ! RomP <<<

#ifdef ISO
#ifdef ISOVERIF
!          write(*,*) 'q_detrainement(1,:)=',q_detrainement(1,:)
      call iso_verif_noNaN_vect2D(d_xt_con, &
                 'physiq 3203a apres conv',ntraciso,klon,klev)
      call iso_verif_noNaN_vect2D(xt_seri, &
                 'physiq 3203b apres conv',ntraciso,klon,klev)
      if (iso_HDO.gt.0) then
      call iso_verif_aberrant_enc_vect2D( &
                 xt_seri,q_seri, &
                 'physiq 3619a',ntraciso,klon,klev)
      endif
      if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
      call iso_verif_O18_aberrant_enc_vect2D( &
                 xt_seri,q_seri, &
                 'physiq 3619b',ntraciso,klon,klev)
      endif         
#endif
#ifdef ISOVERIF
#ifdef ISOTRAC
        call iso_verif_trac_masse_vect(d_xt_con,klon,klev, &
                 'physiq 3003 apres tend concvl', &
                  errmax,errmaxrel)
        call iso_verif_traceur_vect(xt_seri,klon,klev, &
                 'physiq 3005 apres tend concvl')
#endif
#endif
#endif  

          !IM begin
          !       print*,'physiq: cin pbase dnwd0 ftd fqd ',cin(1),pbase(1),
          !    .dnwd0(1,1),ftd(1,1),fqd(1,1)
          !IM end
          !IM cf. FH
          clwcon0=qcondc
          pmfu(:,:)=upwd(:,:)+dnwd(:,:)
          fm_cv(:,:)=upwd(:,:)+dnwd(:,:)+dnwd0(:,:)

          !jyg<
          ! If convective tendencies are too large, then call convection 
          !  every time step
          cvpas = cvpas_0
          DO k=1,k_upper_cv
             DO i=1,klon
               IF (d_t_con(i,k) > 6.721 .AND. d_t_con(i,k) < 6.722 .AND.&
                   d_q_con(i,k) > -.0002171 .AND. d_q_con(i,k) < -.0002170) THEN
                     dtcon_multistep_max = 3.
                     dqcon_multistep_max = 0.02
               ENDIF
             ENDDO
          ENDDO

          DO k=1,k_upper_cv
             DO i=1,klon
!!               IF (abs(d_t_con(i,k)) > 0.24 .OR. &
!!                   abs(d_q_con(i,k)) > 2.e-2) THEN
               IF (abs(d_t_con(i,k)) > dtcon_multistep_max .OR. &
                   abs(d_q_con(i,k)) > dqcon_multistep_max) THEN
                 cvpas = 1
!!                 print *,'physiq1, i,k,d_t_con(i,k),d_q_con(i,k) ', &
!!                                   i,k,d_t_con(i,k),d_q_con(i,k)
               ENDIF
             ENDDO
          ENDDO
!!!   Ligne a ne surtout pas remettre sans avoir murement reflechi (jyg)
!!!          call bcast(cvpas)
!!!   ------------------------------------------------------------
          !>jyg

          DO i = 1, klon
             IF (iflagctrl(i)<=1) itau_con(i)=itau_con(i)+cvpas
          ENDDO

          !jyg<
          !    Add the tendency due to the dry adjustment of the wake profile
          IF (iflag_wake>=1) THEN
            IF (iflag_adjwk == 2) THEN
              DO k=1,klev
                 DO i=1,klon
                    ftd(i,k) = ftd(i,k) + wake_s(i)*d_t_adjwk(i,k)/phys_tstep
                    fqd(i,k) = fqd(i,k) + wake_s(i)*d_q_adjwk(i,k)/phys_tstep
                    d_t_con(i,k) = d_t_con(i,k) + wake_s(i)*d_t_adjwk(i,k)
                    d_q_con(i,k) = d_q_con(i,k) + wake_s(i)*d_q_adjwk(i,k)
#ifdef ISO
                   do ixt=1,ntraciso
                     fxtd(ixt,i,k) = fxtd(ixt,i,k) + wake_s(i)*d_xt_adjwk(ixt,i,k)/phys_tstep
                     d_xt_con(ixt,i,k) = d_xt_con(ixt,i,k) + wake_s(i)*d_xt_adjwk(ixt,i,k)
                   enddo
#endif
                 ENDDO
              ENDDO
            ENDIF  ! (iflag_adjwk = 2)
          ENDIF   ! (iflag_wake>=1)
          !>jyg

       ELSE ! ok_cvl

          ! MAF conema3 ne contient pas les traceurs
          CALL conema3 (phys_tstep, &
               paprs,pplay,t_seri,q_seri, &
               u_seri,v_seri,tr_seri,ntra, &
               sig1,w01, &
               d_t_con,d_q_con,d_u_con,d_v_con,d_tr, &
               rain_con, snow_con, ibas_con, itop_con, &
               upwd,dnwd,dnwd0,bas,top, &
               Ma,cape,tvp,rflag, &
               pbase &
               ,bbase,dtvpdt1,dtvpdq1,dplcldt,dplcldr &
               ,clwcon0)

       ENDIF ! ok_cvl

       ! Correction precip
       rain_con = rain_con * cvl_corr
       snow_con = snow_con * cvl_corr
#ifdef ISO
          xtrain_con = xtrain_con * cvl_corr
          xtsnow_con = xtsnow_con * cvl_corr
#endif

       IF (.NOT. ok_gust) THEN
          do i = 1, klon
             wd(i)=0.0
          enddo
       ENDIF

       ! =================================================================== c
       ! Calcul des proprietes des nuages convectifs

       !   calcul des proprietes des nuages convectifs
       clwcon0(:,:)=fact_cldcon*clwcon0(:,:)
       IF (iflag_cld_cv == 0) THEN
          CALL clouds_gno &
               (klon,klev,q_seri,zqsat,clwcon0,ptconv,ratqsc,rnebcon0)
       ELSE
          CALL clouds_bigauss &
               (klon,klev,q_seri,zqsat,qtc_cv,sigt_cv,ptconv,ratqsc,rnebcon0)
       ENDIF


       ! =================================================================== c

       DO i = 1, klon
          itop_con(i) = min(max(itop_con(i),1),klev)
          ibas_con(i) = min(max(ibas_con(i),1),itop_con(i))
       ENDDO

       DO i = 1, klon
          ! C Risi modif: pour éviter pb de dépassement d'indice dans les cas
          ! où i n'est pas un point convectif et donc ibas_con(i)=0
          ! c'est un pb indépendant des isotopes
          if (ibas_con(i) > 0) then
             ema_pcb(i)  = paprs(i,ibas_con(i))
          else
             ema_pcb(i)  = 0.0
          endif
       ENDDO
       DO i = 1, klon
          ! L'idicage de itop_con peut cacher un pb potentiel
          ! FH sous la dictee de JYG, CR
          ema_pct(i)  = paprs(i,itop_con(i)+1)

          IF (itop_con(i)>klev-3) THEN
             IF (prt_level >= 9) THEN
                write(lunout,*)'La convection monte trop haut '
                write(lunout,*)'itop_con(,',i,',)=',itop_con(i)
             ENDIF
          ENDIF
       ENDDO
    ELSE IF (iflag_con==0) THEN
       write(lunout,*) 'On n appelle pas la convection'
       clwcon0=0.
       rnebcon0=0.
       d_t_con=0.
       d_q_con=0.
       d_u_con=0.
       d_v_con=0.
       rain_con=0.
       snow_con=0.
       bas=1
       top=1
#ifdef ISO
       d_xt_con=0.
       xtrain_con=0.
       xtsnow_con=0.
#endif
    ELSE
       WRITE(lunout,*) "iflag_con non-prevu", iflag_con
       CALL abort_physic("physiq", "", 1)
    ENDIF

    !--saving d_q_con * zmass for next timestep if convection is not called every timestep
    IF (ok_conserv_d_q_con) THEN
      d_q_con_zmasse(:,:) = d_q_con(:,:) * zmasse(:,:)
    ENDIF

    !     CALL homogene(paprs, q_seri, d_q_con, u_seri,v_seri,
    !    .              d_u_con, d_v_con)

!jyg    Reinitialize proba_notrig and itapcv when convection has been called
    proba_notrig(:) = 1.
    itapcv = 0
    ENDIF !  (MOD(itapcv,cvpas).EQ.0 .OR. MOD(itapcv,cvpas_0).EQ.0)

    itapcv = itapcv+1

    ! Compter les steps ou cvpas=1
    IF (cvpas == 1) THEN
      Ncvpaseq1 = Ncvpaseq1+1
    ENDIF
    IF (mod(itap,1000) == 0) THEN
      print *,' physiq, nombre de steps ou cvpas = 1 : ', Ncvpaseq1
    ENDIF

!!!jyg  Appel diagnostique a add_phys_tend pour tester la conservation de 
!!!     l'energie dans les courants satures.
!!    d_t_con_sat(:,:) = d_t_con(:,:) - ftd(:,:)*dtime
!!    d_q_con_sat(:,:) = d_q_con(:,:) - fqd(:,:)*dtime
!!    dql_sat(:,:) = (wdtrainA(:,:)+wdtrainM(:,:))*dtime/zmasse(:,:)
!!    CALL add_phys_tend(d_u_con, d_v_con, d_t_con_sat, d_q_con_sat, dql_sat,   &
!!                     dqi0, paprs, 'convection_sat', abortphy, flag_inhib_tend,&  
!!                     itap, 1)
!!    call prt_enerbil('convection_sat',itap)
!!
!!

    !--recompute d_q_con with zmasse from new timestep
    IF (ok_conserv_d_q_con) THEN
      d_q_con(:,:)=d_q_con_zmasse(:,:)/zmasse(:,:)
    ENDIF

    CALL add_phys_tend(d_u_con, d_v_con, d_t_con, d_q_con, dql0, dqi0, dqbs0, paprs, &
         'convection',abortphy,flag_inhib_tend,itap,0 &
#ifdef ISO
          ,d_xt_con,dxtl0,dxti0 &
#endif      
         )
    CALL prt_enerbil('convection',itap)

    !-------------------------------------------------------------------------

    IF (mydebug) THEN
       CALL writefield_phy('u_seri',u_seri,nbp_lev)
       CALL writefield_phy('v_seri',v_seri,nbp_lev)
       CALL writefield_phy('t_seri',t_seri,nbp_lev)
       CALL writefield_phy('q_seri',q_seri,nbp_lev)
    ENDIF

    IF (check) THEN
       za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
       WRITE(lunout,*)"aprescon=", za
       zx_t = 0.0
       za = 0.0
       DO i = 1, klon
          za = za + cell_area(i)/REAL(klon)
          zx_t = zx_t + (rain_con(i)+ &
               snow_con(i))*cell_area(i)/REAL(klon)
       ENDDO
       zx_t = zx_t/za*phys_tstep
       WRITE(lunout,*)"Precip=", zx_t
    ENDIF
    IF (zx_ajustq) THEN
       DO i = 1, klon
          z_apres(i) = 0.0
#ifdef ISO
        do ixt=1,ntraciso
          zxt_apres(ixt,i) = 0.0
        enddo !do ixt=1,ntraciso
#endif
       ENDDO
       DO k = 1, klev
          DO i = 1, klon
             z_apres(i) = z_apres(i) + (q_seri(i,k)+ql_seri(i,k)) &
                  *(paprs(i,k)-paprs(i,k+1))/RG
          ENDDO
       ENDDO
#ifdef ISO
          DO k = 1, klev
            DO i = 1, klon
              do ixt=1,ntraciso
                zxt_apres(ixt,i) = zxt_apres(ixt,i)  &
                  + (xt_seri(ixt,i,k)+xtl_seri(ixt,i,k)) &
                  *(paprs(i,k)-paprs(i,k+1))/RG
              enddo ! do ixt=1,ntraciso
            ENDDO
          ENDDO  
#endif
       DO i = 1, klon
          z_factor(i) = (z_avant(i)-(rain_con(i)+snow_con(i))*phys_tstep) &
               /z_apres(i)
       ENDDO
#ifdef ISO
         DO i = 1, klon
            do ixt=1,ntraciso
              zxt_factor(ixt,i) = (zxt_avant(ixt,i)-(xtrain_con(ixt,i) &
                +xtsnow_con(ixt,i))*phys_tstep)/zxt_apres(ixt,i)
            enddo ! do ixt=1,ntraciso
         ENDDO   
#endif
       DO k = 1, klev
          DO i = 1, klon
             IF (z_factor(i)>(1.0+1.0E-08) .OR. &
                  z_factor(i)<(1.0-1.0E-08)) THEN
                q_seri(i,k) = q_seri(i,k) * z_factor(i)
#ifdef ISO
                do ixt=1,ntraciso
                  xt_seri(ixt,i,k)=xt_seri(ixt,i,k)*zxt_factor(ixt,i)  
                enddo ! do ixt=1,ntraciso
#endif
             ENDIF
          ENDDO
       ENDDO
    ENDIF
    zx_ajustq=.FALSE.

#ifdef ISO
#ifdef ISOVERIF
     write(*,*) 'physiq 3425: apres convection'
      if (iso_HDO.gt.0) then
      call iso_verif_aberrant_enc_vect2D( &
                 xt_seri,q_seri, &
                 'physiq 3691a',ntraciso,klon,klev)
      endif
      if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
      call iso_verif_O18_aberrant_enc_vect2D( &
                 xt_seri,q_seri, &
                 'physiq 3691b',ntraciso,klon,klev)
      endif
#ifdef ISOTRAC
        call iso_verif_traceur_vect(xt_seri,klon,klev, &
                 'physiq 3386 avant wakes')
#endif
#endif
#endif 

    !==========================================================================
    !RR:Evolution de la poche froide: on ne fait pas de separation wake/env 
    !pour la couche limite diffuse pour l instant


    ! nrlmd le 22/03/2011---Si on met les poches hors des thermiques
    ! il faut rajouter cette tendance calcul\'ee hors des poches
    ! froides

    IF (iflag_wake>=1) THEN


       ! Call wakes every "wkpas" step

       IF (MOD(itapwk,wkpas)==0) THEN

          DO k=1,klev
             DO i=1,klon
                dt_dwn(i,k)  = ftd(i,k) 
                dq_dwn(i,k)  = fqd(i,k) 
                M_dwn(i,k)   = dnwd0(i,k)
                M_up(i,k)    = upwd(i,k)
                dt_a(i,k)    = d_t_con(i,k)/phys_tstep - ftd(i,k) 
                dq_a(i,k)    = d_q_con(i,k)/phys_tstep - fqd(i,k)
#ifdef ISO
                do ixt=1,ntraciso
                dxt_dwn(ixt,i,k)  = fxtd(ixt,i,k)  
                dxt_a(ixt,i,k)    = d_xt_con(ixt,i,k)/phys_tstep - fxtd(ixt,i,k)
                enddo !do ixt=1,ntraciso
#endif
             ENDDO
          ENDDO
         
          IF (iflag_wake==2) THEN
             ok_wk_lsp(:)=max(sign(1.,wake_s(:)-wake_s_min_lsp),0.)
             DO k = 1,klev
                dt_dwn(:,k)= dt_dwn(:,k)+ &
                     ok_wk_lsp(:)*(d_t_eva(:,k)+d_t_lsc(:,k))/phys_tstep
                dq_dwn(:,k)= dq_dwn(:,k)+ &
                     ok_wk_lsp(:)*(d_q_eva(:,k)+d_q_lsc(:,k))/phys_tstep
#ifdef ISO
             do ixt=1,ntraciso
                dxt_dwn(:,k,ixt)= dxt_dwn(:,k,ixt)+ &
                     ok_wk_lsp(:)*(d_xt_eva(:,k,ixt)+d_xt_lsc(:,k,ixt))/phys_tstep
             enddo
#endif
             ENDDO
          ELSEIF (iflag_wake==3) THEN
             ok_wk_lsp(:)=max(sign(1.,wake_s(:)-wake_s_min_lsp),0.)
             DO k = 1,klev
                DO i=1,klon
                   IF (rneb(i,k)==0.) THEN
                      ! On ne tient compte des tendances qu'en dehors des
                      ! nuages (c'est-\`a-dire a priri dans une region ou
                      ! l'eau se reevapore).
                      dt_dwn(i,k)= dt_dwn(i,k)+ &
                           ok_wk_lsp(i)*d_t_lsc(i,k)/phys_tstep
                      dq_dwn(i,k)= dq_dwn(i,k)+ &
                           ok_wk_lsp(i)*d_q_lsc(i,k)/phys_tstep
#ifdef ISO
                      do ixt=1,ntraciso
                        dxt_dwn(:,k,ixt)= dxt_dwn(:,k,ixt)+ &
                           ok_wk_lsp(:)*d_xt_lsc(:,k,ixt)/phys_tstep
                      enddo
#endif
                   ENDIF
                ENDDO
             ENDDO
          ENDIF
         
#ifdef ISOVERIF
        write(*,*) 'physiq 3977: verif des inputs de calwake'
        DO k = 1,klev
          DO i=1,klon
            if (iso_eau.gt.0) then
              call iso_verif_egalite(q_seri(i,k),xt_seri(iso_eau,i,k),'physiq 3981a')
              call iso_verif_egalite(dq_dwn(i,k),dxt_dwn(iso_eau,i,k),'physiq 3981b')
              call iso_verif_egalite(dq_a(i,k),dxt_a(iso_eau,i,k),'physiq 3981c')
              call iso_verif_egalite(wake_deltaq(i,k),wake_deltaxt(iso_eau,i,k),'physiq 3981d')
            endif
          enddo
        enddo        
#endif 

          !calcul caracteristiques de la poche froide
          CALL calWAKE (iflag_wake_tend, paprs, pplay, phys_tstep, &
               t_seri, q_seri, omega,  &
               dt_dwn, dq_dwn, M_dwn, M_up,  &
               dt_a, dq_a, cv_gen,  &
               sigd, cin,  &
               wake_deltat, wake_deltaq, wake_s, awake_dens, wake_dens,  &
               wake_dth, wake_h,  &
!!               wake_pe, wake_fip, wake_gfl,  &
               wake_pe, wake_fip_0, wake_gfl,  &   !! jyg
               d_t_wake, d_q_wake,  &
               wake_k, t_x, q_x,  &
               wake_omgbdth, wake_dp_omgb,  &
               wake_dtKE, wake_dqKE,  &
               wake_omg, wake_dp_deltomg,  &
               wake_spread, wake_Cstar, d_deltat_wk_gw,  &
               d_deltat_wk, d_deltaq_wk, d_s_wk, d_dens_a_wk, d_dens_wk &
#ifdef ISO
                     ,xt_seri,dxt_dwn,dxt_a &
                     ,wake_deltaxt,d_xt_wake,xt_x,d_deltaxt_wk &
#endif      
         )

          !jyg    Reinitialize itapwk when wakes have been called
          itapwk = 0
       ENDIF !  (MOD(itapwk,wkpas).EQ.0)

       itapwk = itapwk+1
#ifdef ISOVERIF
        write(*,*) 'physiq 4020: verif des outputs de calwake'
        DO k = 1,klev
          DO i=1,klon
            if (iso_eau.gt.0) then
              call iso_verif_egalite(d_q_wake(i,k),d_xt_wake(iso_eau,i,k),'physiq 4023a')
              call iso_verif_egalite(q_x(i,k),xt_x(iso_eau,i,k),'physiq 4023b')
              call iso_verif_egalite(d_deltaq_wk(i,k),d_deltaxt_wk(iso_eau,i,k),'physiq 4023c')
            endif
          enddo
        enddo
#endif

       !-----------------------------------------------------------------------
       ! ajout des tendances des poches froides
       CALL add_phys_tend(du0,dv0,d_t_wake,d_q_wake,dql0,dqi0,dqbs0,paprs,'wake', &
            abortphy,flag_inhib_tend,itap,0 &
#ifdef ISO
          ,d_xt_wake,dxtl0,dxti0 &
#endif      
         )
       CALL prt_enerbil('wake',itap)
       !------------------------------------------------------------------------

       ! Increment Wake state variables
       IF (iflag_wake_tend > 0.) THEN

         CALL add_wake_tend &
            (d_deltat_wk, d_deltaq_wk, d_s_wk, d_dens_a_wk, d_dens_wk, wake_k, &
             'wake', abortphy &
#ifdef ISO
                ,d_deltaxt_wk &
#endif
         ) 
          CALL prt_enerbil('wake',itap)
       ENDIF   ! (iflag_wake_tend .GT. 0.)

       IF (prt_level >= 10) THEN
         print *,' physiq, after calwake, wake_s: ',wake_s(:)
         print *,' physiq, after calwake, wake_deltat: ',wake_deltat(:,1)
         print *,' physiq, after calwake, wake_deltaq: ',wake_deltaq(:,1)
       ENDIF

       IF (iflag_alp_wk_cond > 0.) THEN

         CALL alpale_wk(phys_tstep, cell_area, wake_k, wake_s, wake_dens, wake_fip_0, &
                        wake_fip)
       ELSE
         wake_fip(:) = wake_fip_0(:)
       ENDIF   ! (iflag_alp_wk_cond .GT. 0.)

    ENDIF  ! (iflag_wake>=1)

    !===================================================================
    ! Convection seche (thermiques ou ajustement)
    !===================================================================

    CALL stratocu_if(klon,klev,pctsrf,paprs, pplay,t_seri &
         ,seuil_inversion,weak_inversion,dthmin)



    d_t_ajsb(:,:)=0.
    d_q_ajsb(:,:)=0.
    d_t_ajs(:,:)=0.
    d_u_ajs(:,:)=0.
    d_v_ajs(:,:)=0.
    d_q_ajs(:,:)=0.
    clwcon0th(:,:)=0.
#ifdef ISO
      d_xt_ajs(:,:,:)=0.0
      d_xt_ajsb(:,:,:)=0.0
#endif

    !      fm_therm(:,:)=0.
    !      entr_therm(:,:)=0.
    !      detr_therm(:,:)=0.

    IF (prt_level>9) WRITE(lunout,*) &
         'AVANT LA CONVECTION SECHE , iflag_thermals=' &
         ,iflag_thermals,'   nsplit_thermals=',nsplit_thermals
    IF (iflag_thermals<0) THEN
       !  Rien
       !  ====
       IF (prt_level>9) WRITE(lunout,*)'pas de convection seche'
       WRITE(lunout,*) 'WARNING : running without dry convection. Somme intermediate variables are not properly defined in physiq_mod.F90'
       ! Reprendre proprement les initialisation ci dessouds si on veut vraiment utiliser l'option (FH)
          fraca(:,:)=0.
          fm_therm(:,:)=0.
          ztv(:,:)=t_seri(:,:)
          zqasc(:,:)=q_seri(:,:)
          ztla(:,:)=0.
          zthl(:,:)=0.
          zpspsk(:,:)=(pplay(:,:)/100000.)**RKAPPA


#ifdef ISO
#ifdef ISOVERIF
      call iso_verif_noNaN_vect2D(xt_seri,'physiq 3971', &
                  ntraciso,klon,klev)
#endif         
#ifdef ISOVERIF         
      write(*,*) 'physiq 3570'
         do k=1,klev
           do i=1,klon
             if (iso_eau.gt.0) then
                call iso_verif_egalite_choix(xt_seri(iso_eau,i,k), &
                       q_seri(i,k),'physiq 2765',errmax,errmaxrel)
             endif !if (iso_eau.gt.0) then
             if (iso_HDO.gt.0) then
               if (q_seri(i,k).gt.ridicule) then
                  call iso_verif_aberrant_encadre(xt_seri(iso_HDO,i,k)/ &
                       q_seri(i,k),'physiq 2770')
               endif !if (abs(d_q_ajs(i,k)).gt.ridicule) then               
             endif !if (iso_HDO.gt.0) then
             if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then     
               if (q_seri(i,k).gt.ridicule) then  
                 if (iso_verif_o18_aberrant_nostop( &
                    xt_seri(iso_HDO,i,k)/q_seri(i,k), &
                    xt_seri(iso_O18,i,k)/q_seri(i,k), &
                    'physiq 3978, avant calltherm').eq.1) then
                  write(*,*) 'physic 4115: i,k,q_seri(i,k)=',i,k,q_seri(i,k)                       
                  stop
                 endif !  if (iso_verif_o18_aberrant_nostop 
               endif !if (q_seri(i,k).gt.errmax) then   
             endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then    
             if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
               if ((q_seri(i,k).gt.ridicule).and.(k.lt.nlevmaxO17)) then
                 call iso_verif_aberrant_o17(xt_seri(iso_o17,i,k) &
                 /q_seri(i,k),xt_seri(iso_o18,i,k) &
                 /q_seri(i,k),'physiq 3178: avant clmain')
               endif !if (q_seri(i,k).gt.ridicule) then
             endif !if (iso_O17.gt.0) then
#ifdef ISOTRAC      
        call iso_verif_traceur(xt_seri(1,i,k),'physiq 3389')
        if (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k), &
                 'physiq 3481, avant ajsec',1e-5) &
                 .eq.1) then
              write(*,*) 'i,k=',i,k 
#ifdef ISOVERIF
                  stop
#endif
!#ifdef ISOVERIF     
        endif !if (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k),             
#endif   
!#ifdef ISOTRAC                     
            enddo !do i=1,klon
         enddo !do k=1,klev
#endif
!#ifdef ISOVERIF         
       if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) then
        do k=1,klev   
        do i=1,klon
            xt_seri(iso_eau,i,k)=q_seri(i,k)
        enddo !do i=1,klon
        enddo !do k=1,klev  
#ifdef ISOTRAC        
        call iso_verif_traceur_jbid_vect(xt_seri, &
                  klon,klev)
#endif        
      endif !if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) then  
#endif
!#ifdef ISO      


    ELSE

       !  Thermiques
       !  ==========
       IF (prt_level>9) WRITE(lunout,*)'JUSTE AVANT , iflag_thermals=' &
            ,iflag_thermals,'   nsplit_thermals=',nsplit_thermals


       !cc nrlmd le 10/04/2012
       DO k=1,klev+1
          DO i=1,klon
             pbl_tke_input(i,k,is_oce)=pbl_tke(i,k,is_oce)
             pbl_tke_input(i,k,is_ter)=pbl_tke(i,k,is_ter)
             pbl_tke_input(i,k,is_lic)=pbl_tke(i,k,is_lic)
             pbl_tke_input(i,k,is_sic)=pbl_tke(i,k,is_sic)
          ENDDO
       ENDDO
       !cc fin nrlmd le 10/04/2012

       IF (iflag_thermals>=1) THEN

! Tests Fredho, instensibilite au pas de temps -------------------------------
! A detruire en 2024 une fois les tests documentes et les choix faits        !
          if (iflag_thermals_tenv /10 == 0 ) then                            !
            do k=1,klev                                                      !
               do i=1,klon                                                   !
                  t_env(i,k)=t_seri(i,k)                                     !
                  q_env(i,k)=q_seri(i,k)                                     !
#ifdef ISO
                  do ixt=1,ntraciso
                        xt_env(ixt,i,k)=xt_seri(ixt,i,k)
                  enddo
#endif
               enddo                                                         !
            enddo                                                            !
          else if (iflag_thermals_tenv / 10 == 2 ) then                      !
            do k=1,klev                                                      !
               do i=1,klon                                                   !
                  q_env(i,k)=q_seri(i,k)                                     !
#ifdef ISO
                  do ixt=1,ntraciso
                        xt_env(ixt,i,k)=xt_seri(ixt,i,k)
                  enddo
#endif
               enddo                                                         !
            enddo                                                            !
          else if (iflag_thermals_tenv / 10 == 3 ) then                      !
            do k=1,klev                                                      !
               do i=1,klon                                                   !
                  t_env(i,k)=t(i,k)                                          !
                  q_env(i,k)=qx(i,k,1)                                       !
#ifdef ISO
                  do ixt=1,ntraciso
                        xt_env(ixt,i,k)=xt_seri(ixt,i,k)
                  enddo
#endif
               enddo                                                         !
            enddo                                                            !
          endif                                                              !
! Tests Fredho, instensibilite au pas de temps ------------------------------

          !jyg<
!!       IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
       IF (mod(iflag_pbl_split/10,10) >= 1) THEN
             !  Appel des thermiques avec les profils exterieurs aux poches
             DO k=1,klev
                DO i=1,klon
                   t_therm(i,k) = t_seri(i,k) - wake_s(i)*wake_deltat(i,k)
                   q_therm(i,k) = q_seri(i,k) - wake_s(i)*wake_deltaq(i,k)
                   t_env(i,k)   = t_env(i,k) - wake_s(i)*wake_deltat(i,k)
                   q_env(i,k)   = q_env(i,k) - wake_s(i)*wake_deltaq(i,k)
                   u_therm(i,k) = u_seri(i,k)
                   v_therm(i,k) = v_seri(i,k)
#ifdef ISO
                   do ixt=1,ntraciso
                     xt_therm(ixt,i,k) = xt_seri(ixt,i,k) - wake_s(i)*wake_deltaxt(ixt,i,k)
                     xt_env(ixt,i,k) = xt_env(ixt,i,k) - wake_s(i)*wake_deltaxt(ixt,i,k)
                   enddo !do ixt=1,ntraciso
#endif
                ENDDO
             ENDDO
          ELSE
             !  Appel des thermiques avec les profils moyens
             DO k=1,klev
                DO i=1,klon
                   t_therm(i,k) = t_seri(i,k)
                   q_therm(i,k) = q_seri(i,k)
                   u_therm(i,k) = u_seri(i,k)
                   v_therm(i,k) = v_seri(i,k)
#ifdef ISO
                   do ixt=1,ntraciso
                     xt_therm(ixt,i,k) = xt_seri(ixt,i,k)
                   enddo !do ixt=1,ntraciso
#endif
                ENDDO
             ENDDO
          ENDIF


#ifdef ISO
#ifdef ISOTRAC    
        ! ajout C Risi juillet 2020: pas sure de ce que je fais...    
        call iso_verif_traceur_jbid_pos_vect(klon,klev,xt_seri)   
        call iso_verif_traceur_jbid_pos_vect(klon,klev,xt_therm)  
#endif 
#endif
          !>jyg
          ! WARNING !!! introduction d'une subtilite avec la distinction
          ! entre deux types de profiles pour les thermiques.
          ! Ne change pas les resultats avec les isotopes tant qu'on
          ! tourne avec le defaut : iflag_thermals_tenv=0
          if ( iflag_thermals_tenv /= 0 ) then 
              abort_message ='iflag_thermals_env/=0 : non prevu avec les isotopes'
              CALL abort_physic (modname,abort_message,1)
          endif

          CALL calltherm(pdtphys &
               ,pplay,paprs,pphi,weak_inversion &
                        ! ,u_seri,v_seri,t_seri,q_seri,zqsat,debut & !jyg
               ,u_therm,v_therm,t_therm,q_therm,t_env,q_env,zqsat,debut &  !jyg
               ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs &
               ,fm_therm,entr_therm,detr_therm &
               ,zqasc,clwcon0th,lmax_th,ratqscth &
               ,ratqsdiff,zqsatth &
                                !on rajoute ale et alp, et les
                                !caracteristiques de la couche alim
               ,Ale_bl,Alp_bl,lalim_conv,wght_th, zmax0, f0, zw2,fraca &
               ,ztv,zpspsk,ztla,zthl &
                                !cc nrlmd le 10/04/2012
               ,pbl_tke_input,pctsrf,omega,cell_area &
               ,zlcl_th,fraca0,w0,w_conv,therm_tke_max0,env_tke_max0 &
               ,n2,s2,strig,zcong,ale_bl_stat &
               ,therm_tke_max,env_tke_max &
               ,alp_bl_det,alp_bl_fluct_m,alp_bl_fluct_tke &
               ,alp_bl_conv,alp_bl_stat &
                                !cc fin nrlmd le 10/04/2012
               ,zqla,ztva &
#ifdef ISO         
            ,xt_env,d_xt_ajs &
#ifdef DIAGISO         
            ,q_the,xt_the &
#endif         
#endif         
         )

          !jyg<
!!jyg          IF (mod(iflag_pbl_split/2,2) .EQ. 1) THEN
          IF (mod(iflag_pbl_split/10,10) >= 1) THEN
             !  Si les thermiques ne sont presents que hors des
             !  poches, la tendance moyenne associ\'ee doit etre
             !  multipliee par la fraction surfacique qu'ils couvrent.
             DO k=1,klev
                DO i=1,klon

                   d_deltat_the(i,k) = - d_t_ajs(i,k) 
                   d_deltaq_the(i,k) = - d_q_ajs(i,k) 

                   d_u_ajs(i,k) = d_u_ajs(i,k)*(1.-wake_s(i)) 
                   d_v_ajs(i,k) = d_v_ajs(i,k)*(1.-wake_s(i)) 
                   d_t_ajs(i,k) = d_t_ajs(i,k)*(1.-wake_s(i)) 
                   d_q_ajs(i,k) = d_q_ajs(i,k)*(1.-wake_s(i)) 
#ifdef ISO
                   do ixt=1,ntraciso
                     d_deltaxt_the(ixt,i,k) = - d_xt_ajs(ixt,i,k)
                     d_xt_ajs(ixt,i,k) = d_xt_ajs(ixt,i,k)*(1.-wake_s(i))
                   enddo
#endif

                ENDDO
             ENDDO

             IF (ok_bug_split_th) THEN
               CALL add_wake_tend &
                   (d_deltat_the, d_deltaq_the, dsig0, dsig0, ddens0, ddens0, wkoccur1, 'the', abortphy &
#ifdef ISO
                   ,d_deltaxt_the &
#endif
         )
             ELSE
               CALL add_wake_tend &
                   (d_deltat_the, d_deltaq_the, dsig0, dsig0, ddens0, ddens0, wake_k, 'the', abortphy &
#ifdef ISO
                   ,d_deltaxt_the &
#endif
         )
             ENDIF
             CALL prt_enerbil('the',itap)

          ENDIF  ! (mod(iflag_pbl_split/10,10) .GE. 1)

          CALL add_phys_tend(d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs,  &
                             dql0,dqi0,dqbs0,paprs,'thermals', abortphy,flag_inhib_tend,itap,0 &
#ifdef ISO
          ,d_xt_ajs,dxtl0,dxti0 &
#endif      
         )
          CALL prt_enerbil('thermals',itap)


          CALL alpale_th( phys_tstep, lmax_th, t_seri, cell_area,  &
                          cin, s2, n2, strig, &
                          ale_bl_trig, ale_bl_stat, ale_bl,  &
                          alp_bl, alp_bl_stat, &
                          proba_notrig, random_notrig, cv_gen)
          !>jyg

          ! ------------------------------------------------------------------
          ! Transport de la TKE par les panaches thermiques.
          ! FH : 2010/02/01
               if (iflag_thermcell_tke==1) then
               call thermcell_dtke(klon,klev,nbsrf,pdtphys,fm_therm,entr_therm,rg,paprs,pbl_tke)
               endif
          ! -------------------------------------------------------------------

          DO i=1,klon
             !           zmax_th(i)=pphi(i,lmax_th(i))/rg
             !CR:04/05/12:correction calcul zmax
             zmax_th(i)=zmax0(i) 
          ENDDO

       ENDIF

       !  Ajustement sec
       !  ==============

       ! Dans le cas o\`u on active les thermiques, on fait partir l'ajustement
       ! a partir du sommet des thermiques.
       ! Dans le cas contraire, on demarre au niveau 1.

       IF (iflag_thermals>=13.or.iflag_thermals<=0) THEN

          IF (iflag_thermals==0) THEN
             IF (prt_level>9) WRITE(lunout,*)'ajsec'
             limbas(:)=1
          ELSE
             limbas(:)=lmax_th(:)
          ENDIF

          ! Attention : le call ajsec_convV2 n'est maintenu que momentanneement
          ! pour des test de convergence numerique.
          ! Le nouveau ajsec est a priori mieux, meme pour le cas 
          ! iflag_thermals = 0 (l'ancienne version peut faire des tendances
          ! non nulles numeriquement pour des mailles non concernees.

#ifdef ISO
#ifdef ISOVERIF
      call iso_verif_noNaN_vect2D(xt_seri,'physiq 4112', &
                  ntraciso,klon,klev)
#endif         
#ifdef ISOVERIF
      write(*,*) 'physiq 3691c: avant call ajsec'
      if (iso_eau.gt.0) then
      call iso_verif_egalite_vect2D( &
                 xt_seri,q_seri, &
                 'physiq 3727, avant ajsec',ntraciso,klon,klev)
      endif
      if (iso_HDO.gt.0) then
      call iso_verif_aberrant_enc_vect2D( &
                 xt_seri,q_seri, &
                 'physiq 3732, avant ajsec',ntraciso,klon,klev)
      endif    
      if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then     
        do k = 1, klev
        do i = 1, klon 
            if (q_seri(i,k).gt.ridicule) then  
               if (iso_verif_o18_aberrant_nostop( &
                    xt_seri(iso_HDO,i,k)/q_seri(i,k), &
                    xt_seri(iso_O18,i,k)/q_seri(i,k), &
                    'physiq 4051, avant ajsec').eq.1) then
                  write(*,*) 'physiq 4367: i,k,q_seri(i,k)=',i,k,q_seri(i,k)                       
                  stop
              endif !  if (iso_verif_o18_aberrant_nostop 
            endif !if (q_seri(i,k).gt.errmax) then   
        enddo !do i = 1, klon
        enddo !do k = 1, klev
        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then      
#ifdef ISOTRAC
        call iso_verif_traceur_vect(xt_seri,klon,klev, &
                 'physiq 3600 avant ajsec')
#endif
        !#ifdef ISOTRAC
#endif
        !#ifdef ISOVERIF
#endif  
        !#ifdef ISO

          IF (iflag_thermals==0) THEN
             ! Calling adjustment alone (but not the thermal plume model)
             CALL ajsec_convV2(paprs, pplay, t_seri,q_seri &
                  , d_t_ajsb, d_q_ajsb &
#ifdef ISO
            ,xt_seri,d_xt_ajsb      &
#endif         
         )
          ELSE IF (iflag_thermals>0) THEN
             ! Calling adjustment above the top of thermal plumes
             CALL ajsec(paprs, pplay, t_seri,q_seri,limbas &
                  , d_t_ajsb, d_q_ajsb &
#ifdef ISO
            ,xt_seri,d_xt_ajsb &
#endif         
         )
          ENDIF

          !--------------------------------------------------------------------
          ! ajout des tendances de l'ajustement sec ou des thermiques
          CALL add_phys_tend(du0,dv0,d_t_ajsb,d_q_ajsb,dql0,dqi0,dqbs0,paprs, &
               'ajsb',abortphy,flag_inhib_tend,itap,0 &
#ifdef ISO
          ,d_xt_ajsb,dxtl0,dxti0 &
#endif      
         )
          CALL prt_enerbil('ajsb',itap)
          d_t_ajs(:,:)=d_t_ajs(:,:)+d_t_ajsb(:,:)
          d_q_ajs(:,:)=d_q_ajs(:,:)+d_q_ajsb(:,:)
#ifdef ISO
         d_xt_ajs(:,:,:)=d_xt_ajs(:,:,:)+d_xt_ajsb(:,:,:)
#endif

          !---------------------------------------------------------------------

       ENDIF

    ENDIF

    !===================================================================
    ! Computation of ratqs, the width (normalized) of the subrid scale 
    ! water distribution

    l_mix_ave(:,:)=0.
    wprime_ave(:,:)=0.

    DO nsrf = 1, nbsrf
       DO i = 1, klon
          l_mix_ave(i,:) = l_mix_ave(i,:) + l_mix(i,:,nsrf)*pctsrf(i,nsrf)
          wprime_ave(i,:) = wprime_ave(i,:) + wprime(i,:,nsrf)*pctsrf(i,nsrf)
       ENDDO
    ENDDO

    CALL ratqs_main(klon,klev,nbsrf,prt_level,lunout,        &
         iflag_ratqs,iflag_con,iflag_cld_th,pdtphys,  &
         ratqsbas,ratqshaut,ratqsp0, ratqsdp, &
         pctsrf,s_pblh,zstd, &
         tau_ratqs,fact_cldcon,wake_s, wake_deltaq,   &
         ptconv,ptconvth,clwcon0th, rnebcon0th,     &
         paprs,pplay,t_seri,q_seri, &
         qtc_cv, sigt_cv,detrain_cv,fm_cv,fqd,fqcomp,sigd,zqsat, &
         omega,pbl_tke(:,:,is_ave),pbl_eps(:,:,is_ave),l_mix_ave,wprime_ave, &
         t2m,q2m,fm_therm,entr_therm,detr_therm,cell_area, &
         ratqs,ratqsc,ratqs_inter_)

    ! Appeler le processus de condensation a grande echelle
    ! et le processus de precipitation
    !-------------------------------------------------------------------------
    IF (prt_level >=10) THEN
       print *,'itap, ->fisrtilp ',itap
    ENDIF

#ifdef ISO    
#ifdef ISOVERIF
      write(*,*) 'physiq 3837: verif avant ilp'
#endif         
#ifdef ISOVERIF
      if (iso_eau.gt.0) then
      call iso_verif_egalite_vect2D( &
                 xt_seri,q_seri, &
                 'physiq 3709, avant ilp',ntraciso,klon,klev)
      endif
      if (iso_HDO.gt.0) then
      call iso_verif_aberrant_enc_vect2D( &
                 xt_seri,q_seri, &
                 'physiq 3714, avant ilp',ntraciso,klon,klev)
      endif
#endif         
#ifdef ISOVERIF
       do k=1,klev
        do i=1,klon
           if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
            if ((q_seri(i,k).gt.ridicule).and.(k.lt.nlevmaxO17)) then
             call iso_verif_aberrant_o17(xt_seri(iso_o17,i,k) &
                 /q_seri(i,k),xt_seri(iso_o18,i,k) &
                 /q_seri(i,k),'physiq 3389')
            endif !if (q_seri(i,k).gt.ridicule) then
           endif !if (iso_O17.gt.0) then
           if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then    
            if (q_seri(i,k).gt.ridicule) then  
               if (iso_verif_o18_aberrant_nostop( &
                    xt_seri(iso_HDO,i,k)/q_seri(i,k), &
                    xt_seri(iso_O18,i,k)/q_seri(i,k), &
                    'physiq 4177, avant il pleut').eq.1) then
                  write(*,*) 'physic 4475: i,k,q_seri(i,k)=',i,k,q_seri(i,k)                       
                  stop
              endif !  if (iso_verif_o18_aberrant_nostop 
            endif !if (q_seri(i,k).gt.errmax) then   
        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then  
#ifdef ISOTRAC      
        call iso_verif_traceur(xt_seri(1,i,k),'physiq 3609')
        call iso_verif_traceur_pbidouille(xt_seri(1,i,k), &
                 'physiq 3609')
        if (iso_verif_tracpos_choix_nostop(xt_seri(1,i,k), &
                 'physiq 3707, avant fisrtilp',1e-5) &
                 .eq.1) then
              write(*,*) 'i,k=',i,k 
#ifdef ISOVERIF
                  stop
#endif
         endif
         if (option_tmin.eq.1) then
               call iso_verif_trac17_q_deltaD(xt_seri(1,i,k), &
                 'physiq 3905, avant ilp')
         endif
#endif
!ISOTRAC         
         enddo !do i=1,klon
        enddo !do k=1,klev        

        ! verif température
        do k=1,klev
           do i=1,klon
             call iso_verif_positif(370.0-t_seri(i,k), &
                'physiq 3535, avant il pleut')
             call iso_verif_positif(t_seri(i,k)-100.0, &
                'physiq 3537, avant il pleut')
           enddo
        enddo
      write(*,*) 'physiq 3113: appel de fisrtilp'
#endif     
!ISOVERIF
          if ((bidouille_anti_divergence).and. &
                 (iso_eau.gt.0)) then
           do k=1,klev
            do i=1,klon  
             xt_seri(iso_eau,i,k)= q_seri(i,k)
            enddo !do i=1,klon
           enddo !do k=1,klev
          endif !if ((bidouille_anti_divergence).and. &   
#endif
!ISO

    picefra(:,:)=0.

    IF (ok_new_lscp) THEN

    !--mise à jour de flight_m et flight_h2o dans leur module
    IF (ok_plane_h2o .OR. ok_plane_contrail) THEN
      CALL airplane(debut,pphis,pplay,paprs,t_seri)
    ENDIF

    CALL lscp(klon,klev,phys_tstep,missing_val,paprs,pplay, &
         t_seri, q_seri,qs_ancien,ptconv,ratqs, &
         d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, rneblsvol, rneb_seri, & 
         pfraclr, pfracld, cldfraliq, sigma2_icefracturb, mean_icefracturb,  &
         radocond, picefra, rain_lsc, snow_lsc, &
         frac_impa, frac_nucl, beta_prec_fisrt, &
         prfl, psfl, rhcl,  &
         zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
         iflag_ice_thermo, ok_ice_sursat, zqsatl, zqsats, distcltop, temp_cltop,  &
         pbl_tke(:,:,is_ave), pbl_eps(:,:,is_ave), qclr, qcld, qss, qvc, rnebclr, rnebss, gamma_ss, &
         Tcontr, qcontr, qcontr2, fcontrN, fcontrP , &
         cloudth_sth,cloudth_senv,cloudth_sigmath,cloudth_sigmaenv, &
         qraindiag, qsnowdiag, dqreva, dqssub, dqrauto, dqrcol, dqrmelt, &
         dqrfreez, dqsauto, dqsagg, dqsrim, dqsmelt, dqsfreez)


    ELSE

    ! Camille Risi mai 2024: on ne met pas à jour ici pour ne pas s'mbêter à modifier fisrtilp
    CALL fisrtilp(phys_tstep,paprs,pplay, &
         t_seri, q_seri,ptconv,ratqs, &
         d_t_lsc, d_q_lsc, d_ql_lsc, d_qi_lsc, rneb, radocond, &
         rain_lsc, snow_lsc, &
         pfrac_impa, pfrac_nucl, pfrac_1nucl, &
         frac_impa, frac_nucl, beta_prec_fisrt, &
         prfl, psfl, rhcl,  &
         zqasc, fraca,ztv,zpspsk,ztla,zthl,iflag_cld_th, &
         iflag_ice_thermo &
#ifdef ISO      
                ,xt_seri,xtrain_lsc,xtsnow_lsc &
                ,d_xt_lsc,d_xtl_lsc,d_xti_lsc,pxtrfl,pxtsfl &
#endif      
         )
    ENDIF

    WHERE (rain_lsc < 0) rain_lsc = 0.
    WHERE (snow_lsc < 0) snow_lsc = 0.
#ifdef ISO
      WHERE (xtrain_lsc < 0) xtrain_lsc = 0.
      WHERE (xtsnow_lsc < 0) xtsnow_lsc = 0.
#endif

#ifdef ISO
#ifdef ISOVERIF
      DO k = 1, klev
        do i=1,klon
        if (iso_O18.gt.0.and.iso_HDO.gt.0) then
        if (ql_seri(i,k).gt.ridicule) then
               call iso_verif_aberrant( &
                 xtl_seri(iso_HDO,i,k)/ql_seri(i,k),'physiq 4330')
               if (iso_O18.gt.0) then  
                 call iso_verif_o18_aberrant( &
                        xtl_seri(iso_HDO,i,k)/ql_seri(i,k), &
                        xtl_seri(iso_O18,i,k)/ql_seri(i,k), &
                        'physiq 4335, avant il pleut')
               endif ! if (iso_O18.gt.0) then  
             endif !if (ql_seri(i,k).gt.errmax) then  
         endif !if (iso_HDO.gt.0) then 
       ENDDO ! i=1,klon
      ENDDO !DO k = 1, klev
#endif
#endif

!+JLD
!    write(*,9000) 'phys lsc',"enerbil: bil_q, bil_e,",rain_lsc+snow_lsc &
!        & ,((rcw-rcpd)*rain_lsc + (rcs-rcpd)*snow_lsc)*t_seri(1,1)-rlvtt*rain_lsc+rlstt*snow_lsc &
!        & ,rain_lsc,snow_lsc
!    write(*,9000) "rcpv","rcw",rcpv,rcw,rcs,t_seri(1,1)
!-JLD 
    CALL add_phys_tend(du0,dv0,d_t_lsc,d_q_lsc,d_ql_lsc,d_qi_lsc,dqbs0,paprs, &
         'lsc',abortphy,flag_inhib_tend,itap,0 &
#ifdef ISO
          ,d_xt_lsc,d_xtl_lsc,d_xti_lsc &
#endif      
         )
    CALL prt_enerbil('lsc',itap)
    rain_num(:)=0.
    DO k = 1, klev
       DO i = 1, klon
          IF (ql_seri(i,k)>oliqmax) THEN
             rain_num(i)=rain_num(i)+(ql_seri(i,k)-oliqmax)*zmasse(i,k)/pdtphys
#ifdef ISO
             do ixt=1,ntraciso
                xtl_seri(ixt,i,k)=xtl_seri(ixt,i,k)/ql_seri(i,k)*oliqmax
             enddo
#endif
             ql_seri(i,k)=oliqmax
          ENDIF
       ENDDO
    ENDDO
    IF (nqo >= 3) THEN
    DO k = 1, klev
       DO i = 1, klon
          IF (qs_seri(i,k)>oicemax) THEN
             rain_num(i)=rain_num(i)+(qs_seri(i,k)-oicemax)*zmasse(i,k)/pdtphys
#ifdef ISO
             do ixt=1,ntraciso
                xts_seri(ixt,i,k)=xts_seri(ixt,i,k)/qs_seri(i,k)*oliqmax
             enddo
#endif
             qs_seri(i,k)=oicemax
          ENDIF
       ENDDO
    ENDDO
    ENDIF


!---------------------------------------------------------------------------
    DO k = 1, klev
       DO i = 1, klon
          cldfra(i,k) = rneb(i,k)
          !CR: a quoi ca sert? Faut-il ajouter qs_seri?
          !EV: en effet etrange, j'ajouterais aussi qs_seri
          !    plus largement, je nettoierais (enleverrais) ces lignes
          IF (.NOT.new_oliq) radocond(i,k) = ql_seri(i,k)
       ENDDO
    ENDDO


    ! Option to activate the radiative effect of blowing snow (ok_rad_bs)
    ! makes sense only if the new large scale condensation scheme is active
    ! with the ok_icefra_lscp flag active as well

    IF (ok_bs .AND. ok_rad_bs) THEN
       IF (ok_new_lscp .AND. ok_icefra_lscp) THEN
           DO k=1,klev
             DO i=1,klon
                radocond(i,k)=radocond(i,k)+qbs_seri(i,k)
                picefra(i,k)=(radocond(i,k)*picefra(i,k)+qbs_seri(i,k))/(radocond(i,k))
                qbsfra=min(qbs_seri(i,k)/qbst_bs,1.0) 
                cldfra(i,k)=max(cldfra(i,k),qbsfra)
             ENDDO
           ENDDO
       ELSE
          WRITE(lunout,*)"PAY ATTENTION, you try to activate the radiative effect of blowing snow"
          WRITE(lunout,*)"with ok_new_lscp=false and/or ok_icefra_lscp=false"
          abort_message='inconsistency in cloud phase for blowing snow'
          CALL abort_physic(modname,abort_message,1)
       ENDIF

    ENDIF
#ifdef ISO      
!#ifdef ISOVERIF
!      write(*,*) 'physiq 4030: verif apres ajout lsc'
!#endif      
#ifdef ISOVERIF
      call iso_verif_noNaN_vect2D(xt_seri,'physiq 4565', &
                  ntraciso,klon,klev)
#endif
#ifdef ISOVERIF
      if (iso_eau.gt.0) then
      call iso_verif_egalite_vect2D( &
                 xt_seri,q_seri, &
                 'physiq 2599, apres ajout lsc',ntraciso,klon,klev)
      endif
      if (iso_HDO.gt.0) then
      call iso_verif_aberrant_enc_vect2D( &
                 xt_seri,q_seri, &
                 'physiq 2866, apres ajout lsc',ntraciso,klon,klev)
      endif
#endif      
#ifdef ISOVERIF
      DO k = 1, klev
      DO i = 1, klon
          if (iso_eau.gt.0) then
           call iso_verif_egalite_choix( &
                 xtl_seri(iso_eau,i,k),ql_seri(i,k), &
                  'physiq 2601',errmax,errmaxrel)
          endif !if (iso_eau.gt.0) then  
          if (iso_HDO.gt.0) then    
            if (q_seri(i,k).gt.ridicule) then  
              if (iso_O18.gt.0) then  
               if (iso_verif_o18_aberrant_nostop( &
                    xt_seri(iso_HDO,i,k)/q_seri(i,k), &
                    xt_seri(iso_O18,i,k)/q_seri(i,k), &
                    'physiq 2863, after il pleut').eq.1) then
                  write(*,*) 'physic 4656: i,k,q_seri(i,k)=',i,k,q_seri(i,k)                       
                  stop
                endif
              endif ! if (iso_O18.gt.0) then  
            endif !if (q_seri(i,k).gt.errmax) then
            if (ql_seri(i,k).gt.ridicule) then
               call iso_verif_aberrant_choix(xtl_seri(iso_HDO,i,k),ql_seri(i,k), &
                        ridicule,deltalim_snow,'physiq 2871')
               if (iso_O18.gt.0) then  
                 if (iso_verif_o18_aberrant_nostop( &
                        xtl_seri(iso_HDO,i,k)/ql_seri(i,k), &
                        xtl_seri(iso_O18,i,k)/ql_seri(i,k), &
                        'physiq 2872, after il pleut').eq.1) then
                        write(*,*) 'i,k,ql_seri(i,k)=',i,k,ql_seri(i,k)
                        write(*,*) 'd_ql_lsc(i,k)=',d_ql_lsc(i,k)
                        write(*,*) 'deltaD(d_ql_lsc(i,k))=',deltaD( &
                                 d_xtl_lsc(iso_HDO,i,k)/d_ql_lsc(i,k))
                        write(*,*) 'deltaO(d_ql_lsc(i,k))=',deltaO( &
                                 d_xtl_lsc(iso_O18,i,k)/d_ql_lsc(i,k))
                        !stop
                 endif
               endif ! if (iso_O18.gt.0) then  
             endif !if (ql_seri(i,k).gt.errmax) then  
         endif !if (iso_HDO.gt.0) then 
       ENDDO ! i=1,klon
      ENDDO !DO k = 1, klev
      if ((iso_O17.gt.0).and.(iso_O18.gt.0)) then
        do i=1,klon 
          do k=1,nlev
           if ((q_seri(i,k).gt.ridicule).and.(k.lt.nlevmaxO17)) then
            call iso_verif_aberrant_o17(xt_seri(iso_o17,i,k) &
                 /q_seri(i,k),xt_seri(iso_o18,i,k) &
                 /q_seri(i,k),'physiq 3549')
           endif !if (q_seri(i,k).gt.ridicule) then
          enddo !do k=1,nlev
        enddo  !do i=1,klon        
      endif !if (iso_O17.gt.0) then
#endif  
!#ifdef ISOVERIF
#ifdef ISOTRAC
#ifdef ISOVERIF       
      call iso_verif_traceur_vect(xt_seri,klon,klev,'physiq 3794') 
      if (option_tmin.eq.1) then
      if (nzone_temp.ge.5) then
            call iso_verif_tag17_q_deltaD_vect(xt_seri,klon,klev, &
                'physiq 3385: apres ilp')
      endif ! if (nzone_temp.ge.5) then
      endif !if (option_tmin.eq.1) then
#endif   
!#ifdef ISOVERIF                
      if (bidouille_anti_divergence) then
          call iso_verif_traceur_jbid_vect(xt_seri, &
                  klon,klev)
      endif 

        ! si tag 22, on recolorise les zones très convectives dans les
        ! tropiques
        if (option_traceurs.eq.22) then
          call isotrac_recolorise_conv(xt_seri,latitude_deg,presnivs,rain_con)
        endif

#endif
!#ifdef ISOTRAC      
#endif    
!#ifdef ISO   

    IF (check) THEN
       za = qcheck(klon,klev,paprs,q_seri,ql_seri,cell_area)
       WRITE(lunout,*)"apresilp=", za
       zx_t = 0.0
       za = 0.0
       DO i = 1, klon
          za = za + cell_area(i)/REAL(klon)
          zx_t = zx_t + (rain_lsc(i) &
               + snow_lsc(i))*cell_area(i)/REAL(klon)
       ENDDO
       zx_t = zx_t/za*phys_tstep
       WRITE(lunout,*)"Precip=", zx_t
    ENDIF

    IF (mydebug) THEN
       CALL writefield_phy('u_seri',u_seri,nbp_lev)
       CALL writefield_phy('v_seri',v_seri,nbp_lev)
       CALL writefield_phy('t_seri',t_seri,nbp_lev)
       CALL writefield_phy('q_seri',q_seri,nbp_lev)
    ENDIF

    !-------------------------------------------------------------------
    !  PRESCRIPTION DES NUAGES POUR LE RAYONNEMENT
    !-------------------------------------------------------------------

    ! 1. NUAGES CONVECTIFS

    !IM cf FH
    !     IF (iflag_cld_th.eq.-1) THEN ! seulement pour Tiedtke
    IF (iflag_cld_th<=-1) THEN ! seulement pour Tiedtke
       snow_tiedtke=0.
       !     print*,'avant calcul de la pseudo precip '
       !     print*,'iflag_cld_th',iflag_cld_th
       IF (iflag_cld_th==-1) THEN
          rain_tiedtke=rain_con
       ELSE
          !       print*,'calcul de la pseudo precip '
          rain_tiedtke=0.
          !         print*,'calcul de la pseudo precip 0'
          DO k=1,klev
             DO i=1,klon
                IF (d_q_con(i,k)<0.) THEN
                   rain_tiedtke(i)=rain_tiedtke(i)-d_q_con(i,k)/pdtphys &
                        *(paprs(i,k)-paprs(i,k+1))/rg
                ENDIF
             ENDDO
          ENDDO
       ENDIF

       !     call dump2d(iim,jjm,rain_tiedtke(2:klon-1),'PSEUDO PRECIP ')

       ! Nuages diagnostiques pour Tiedtke
       CALL diagcld1(paprs,pplay, &
                                !IM cf FH. rain_con,snow_con,ibas_con,itop_con,
            rain_tiedtke,snow_tiedtke,ibas_con,itop_con, &
            diafra,dialiq)
       DO k = 1, klev
          DO i = 1, klon
             IF (diafra(i,k)>cldfra(i,k)) THEN
                radocond(i,k) = dialiq(i,k)
                cldfra(i,k) = diafra(i,k)
             ENDIF
          ENDDO
       ENDDO

    ELSE IF (iflag_cld_th>=3) THEN
       !  On prend pour les nuages convectifs le max du calcul de la
       !  convection et du calcul du pas de temps precedent diminue d'un facteur
       !  facttemps
       facteur = pdtphys *facttemps
       DO k=1,klev
          DO i=1,klon
             rnebcon(i,k)=rnebcon(i,k)*facteur
             IF (rnebcon0(i,k)*clwcon0(i,k)>rnebcon(i,k)*clwcon(i,k)) THEN
                rnebcon(i,k)=rnebcon0(i,k)
                clwcon(i,k)=clwcon0(i,k)
             ENDIF
          ENDDO
       ENDDO

       !   On prend la somme des fractions nuageuses et des contenus en eau

       IF (iflag_cld_th>=5) THEN

          DO k=1,klev
             ptconvth(:,k)=fm_therm(:,k+1)>0.
          ENDDO

          IF (iflag_coupl==4) THEN

             ! Dans le cas iflag_coupl==4, on prend la somme des convertures
             ! convectives et lsc dans la partie des thermiques
             ! Le controle par iflag_coupl est peut etre provisoire.
             DO k=1,klev
                DO i=1,klon
                   IF (ptconv(i,k).AND.ptconvth(i,k)) THEN
                      radocond(i,k)=radocond(i,k)+rnebcon(i,k)*clwcon(i,k)
                      cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
                   ELSE IF (ptconv(i,k)) THEN
                      cldfra(i,k)=rnebcon(i,k)
                      radocond(i,k)=rnebcon(i,k)*clwcon(i,k)
                   ENDIF
                ENDDO
             ENDDO

          ELSE IF (iflag_coupl==5) THEN
             DO k=1,klev
                DO i=1,klon
                   cldfra(i,k)=min(cldfra(i,k)+rnebcon(i,k),1.)
                   radocond(i,k)=radocond(i,k)+rnebcon(i,k)*clwcon(i,k)
                ENDDO
             ENDDO

          ELSE

             ! Si on est sur un point touche par la convection
             ! profonde et pas par les thermiques, on prend la
             ! couverture nuageuse et l'eau nuageuse de la convection
             ! profonde.

             !IM/FH: 2011/02/23 
             ! definition des points sur lesquels ls thermiques sont actifs

             DO k=1,klev
                DO i=1,klon
                   IF (ptconv(i,k).AND. .NOT.ptconvth(i,k)) THEN
                      cldfra(i,k)=rnebcon(i,k)
                      radocond(i,k)=rnebcon(i,k)*clwcon(i,k)
                   ENDIF
                ENDDO
             ENDDO

          ENDIF

       ELSE

          ! Ancienne version
          cldfra(:,:)=min(max(cldfra(:,:),rnebcon(:,:)),1.)
          radocond(:,:)=radocond(:,:)+rnebcon(:,:)*clwcon(:,:)
       ENDIF

    ENDIF

    !     plulsc(:)=0.
    !     do k=1,klev,-1
    !        do i=1,klon
    !              zzz=prfl(:,k)+psfl(:,k)
    !           if (.not.ptconvth.zzz.gt.0.)
    !        enddo prfl, psfl,
    !     enddo

    ! 2. NUAGES STARTIFORMES

    IF (ok_stratus) THEN
       CALL diagcld2(paprs,pplay,t_seri,q_seri, diafra,dialiq)
       DO k = 1, klev
          DO i = 1, klon
             IF (diafra(i,k)>cldfra(i,k)) THEN
                radocond(i,k) = dialiq(i,k)
                cldfra(i,k) = diafra(i,k)
             ENDIF
          ENDDO
       ENDDO
    ENDIF

    ! Precipitation totale

    DO i = 1, klon
       rain_fall(i) = rain_con(i) + rain_lsc(i)
       snow_fall(i) = snow_con(i) + snow_lsc(i)
    ENDDO



#ifdef ISO
      DO i = 1, klon
         do ixt=1,ntraciso
           xtrain_fall(ixt,i)=xtrain_con(ixt,i) + xtrain_lsc(ixt,i)
           xtsnow_fall(ixt,i)=xtsnow_con(ixt,i) + xtsnow_lsc(ixt,i)
         enddo
      ENDDO !DO i = 1, klon
#ifdef ISOVERIF
      if (iso_eau.gt.0) then
        DO i = 1, klon          
          call iso_verif_egalite_choix(xtsnow_fall(iso_eau,i), &
                 snow_fall(i),'physiq 3387', &
                 errmax,errmaxrel)
          if (iso_verif_positif_nostop(xtrain_lsc(iso_eau,i), &
                 'physiq 4298').eq.1) then
            if (rain_lsc(i).ge.0.0) then
              write(*,*) 'rain_fall(i)=',rain_lsc(i)
              stop
            endif !if (rain_con(i).ge.0.0) then
          endif  !if (iso_verif_positif_nostop
          if (iso_verif_positif_nostop(xtrain_fall(iso_eau,i), &
                 'physiq 3405').eq.1) then
            if (rain_fall(i).ge.0.0) then
              write(*,*) 'rain_fall(i)=',rain_fall(i)
              stop
            endif !if (rain_con(i).ge.0.0) then
          endif  !if (iso_verif_positif_nostop
        ENDDO !DO i = 1, klon   
      endif !if (iso_eau.gt.0) then
      if (iso_HDO.gt.0) then
          DO i = 1, klon
          call iso_verif_aberrant_choix(xtsnow_fall(iso_hdo,i), &
                 snow_fall(i),ridicule_snow, &
                 deltalim_snow,'physiq 3856')
          enddo !DO i = 1, klon
      endif
#ifdef ISOTRAC  
        DO i = 1, klon    
          call iso_verif_traceur(xtrain_fall(1,i),'physiq 4012')
          call iso_verif_traceur(xtsnow_fall(1,i),'physiq 4013')
        enddo
#endif      
#endif
#ifdef ISOVERIF   
       do i=1,klon   
         do ixt=1,ntraciso           
           call iso_verif_noNaN(xtsnow_con(ixt,i), &
                   'physiq 4942')
           call iso_verif_noNaN(xtsnow_lsc(ixt,i), &
                   'physiq 4942')
           call iso_verif_noNaN(xtsnow_fall(ixt,i), &
                   'physiq 4942')
         enddo  !do ixt=1,ntraciso
       enddo ! do klon
#endif      
#endif 
#ifdef ISO 
        if ((iso_eau.gt.0).and.(bidouille_anti_divergence)) then
        do i=1,klon
            xtrain_fall(iso_eau,i)=rain_fall(i)
        enddo !do i=1,klon
        endif
#endif    

    ! Calculer l'humidite relative pour diagnostique

    DO k = 1, klev
       DO i = 1, klon
          zx_t = t_seri(i,k)
          IF (thermcep) THEN
             !!           if (iflag_ice_thermo.eq.0) then                 !jyg
             zdelta = MAX(0.,SIGN(1.,rtt-zx_t))
             !!           else                                            !jyg
             !!           zdelta = MAX(0.,SIGN(1.,t_glace_min-zx_t))      !jyg
             !!           endif                                           !jyg
             zx_qs  = r2es * FOEEW(zx_t,zdelta)/pplay(i,k)
             zx_qs  = MIN(0.5,zx_qs)
             zcor   = 1./(1.-retv*zx_qs)
             zx_qs  = zx_qs*zcor
          ELSE
             !!           IF (zx_t.LT.t_coup) THEN             !jyg
             IF (zx_t<rtt) THEN                  !jyg
                zx_qs = qsats(zx_t)/pplay(i,k)
             ELSE
                zx_qs = qsatl(zx_t)/pplay(i,k)
             ENDIF
          ENDIF
          zx_rh(i,k) = q_seri(i,k)/zx_qs
            IF (iflag_ice_thermo > 0) THEN
          zx_rhl(i,k) = q_seri(i,k)/(qsatl(zx_t)/pplay(i,k))
          zx_rhi(i,k) = q_seri(i,k)/(qsats(zx_t)/pplay(i,k))
            ENDIF
          zqsat(i,k)=zx_qs
       ENDDO
    ENDDO

    !IM Calcul temp.potentielle a 2m (tpot) et temp. potentielle 
    !   equivalente a 2m (tpote) pour diagnostique

    DO i = 1, klon
       tpot(i)=zt2m(i)*(100000./paprs(i,1))**RKAPPA
       IF (thermcep) THEN
          IF(zt2m(i)<RTT) then
             Lheat=RLSTT
          ELSE
             Lheat=RLVTT
          ENDIF
       ELSE
          IF (zt2m(i)<RTT) THEN
             Lheat=RLSTT
          ELSE
             Lheat=RLVTT
          ENDIF
       ENDIF
       tpote(i) = tpot(i)*      &
            EXP((Lheat *qsat2m(i))/(RCPD*zt2m(i)))
    ENDDO

    IF (ANY(type_trac == ['inca','inco'])) THEN ! ModThL
IF (CPPKEY_INCA) THEN
       CALL VTe(VTphysiq)
       CALL VTb(VTinca)
       calday = REAL(days_elapsed + 1) + jH_cur

       CALL chemtime(itap+itau_phy-1, date0, phys_tstep, itap)
       CALL AEROSOL_METEO_CALC( &
            calday,pdtphys,pplay,paprs,t,pmflxr,pmflxs, &
            prfl,psfl,pctsrf,cell_area, &
            latitude_deg,longitude_deg,u10m,v10m)

       zxsnow_dummy(:) = 0.0

       CALL chemhook_begin (calday, &
            days_elapsed+1, &
            jH_cur, &
            pctsrf(1,1), &
            latitude_deg, &
            longitude_deg, &
            cell_area, &
            paprs, &
            pplay, &
            coefh(1:klon,1:klev,is_ave), &
            pphi, &
            t_seri, &
            u, &
            v, &
            rot, &
            wo(:, :, 1), &
            q_seri, &
            zxtsol, &
            zt2m, &
            zxsnow_dummy, &
            solsw, &
            albsol1, &
            rain_fall, &
            snow_fall, &
            itop_con, &
            ibas_con, &
            cldfra, &
            nbp_lon, &
            nbp_lat-1, &
            tr_seri(:,:,1+nqCO2:nbtr), &
            ftsol, &
            paprs, &
            cdragh, &
            cdragm, &
            pctsrf, &
            pdtphys, &
            itap)

       CALL VTe(VTinca)
       CALL VTb(VTphysiq)
END IF
    ENDIF !type_trac = inca or inco
    IF (type_trac == 'repr') THEN
#ifdef REPROBUS
    !CALL chemtime_rep(itap+itau_phy-1, date0, dtime, itap)
    CALL chemtime_rep(itap+itau_phy-1, date0, phys_tstep, itap) 
#endif
    ENDIF

    ! Appeler le rayonnement mais calculer tout d'abord l'albedo du sol.

    IF (MOD(itaprad,radpas)==0) THEN

       !jq - introduce the aerosol direct and first indirect radiative forcings
       !jq - Johannes Quaas, 27/11/2003 (quaas@lmd.jussieu.fr)
       IF (flag_aerosol > 0) THEN
          IF (iflag_rrtm == 0) THEN !--old radiation
             IF (.NOT. aerosol_couple) THEN

                CALL readaerosol_optic( &
                     debut, flag_aerosol, itap, jD_cur-jD_ref, &
                     pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
                     mass_solu_aero, mass_solu_aero_pi,  &
                     tau_aero, piz_aero, cg_aero,  &
                     tausum_aero, tau3d_aero)
             ENDIF
          ELSE IF (iflag_rrtm ==1) THEN  ! RRTM radiation
             IF (aerosol_couple .AND. config_inca == 'aero' ) THEN
                abort_message='config_inca=aero et rrtm=1 impossible'
                CALL abort_physic(modname,abort_message,1)
             ELSE

#ifdef CPP_RRTM
                IF (NSW.EQ.6) THEN
                   !--new aerosol properties SW and LW

IF (CPPKEY_DUST) THEN
                   !--SPL aerosol model
                   CALL splaerosol_optic_rrtm( ok_alw, pplay, paprs, t_seri, rhcl, &
                        tr_seri, mass_solu_aero, mass_solu_aero_pi,  &
                        tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,  &
                        tausum_aero, tau3d_aero)
ELSE
                   !--climatologies or INCA aerosols
                   CALL readaerosol_optic_rrtm( debut, aerosol_couple, ok_alw, ok_volcan, &
                        flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, &
                        pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
                        tr_seri, mass_solu_aero, mass_solu_aero_pi,  &
                        tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm,  &
                        tausum_aero, drytausum_aero, tau3d_aero)
END IF

                   IF (flag_aerosol .EQ. 7) THEN
                      CALL MACv2SP(pphis,pplay,paprs,longitude_deg,latitude_deg,  &
                                   tau_aero_sw_rrtm,piz_aero_sw_rrtm,cg_aero_sw_rrtm)
                   ENDIF

                ELSE IF (NSW.EQ.2) THEN 
                   !--for now we use the old aerosol properties

                   CALL readaerosol_optic( &
                        debut, flag_aerosol, itap, jD_cur-jD_ref, &
                        pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
                        mass_solu_aero, mass_solu_aero_pi,  &
                        tau_aero, piz_aero, cg_aero,  &
                        tausum_aero, tau3d_aero)

                   !--natural aerosols
                   tau_aero_sw_rrtm(:,:,1,:)=tau_aero(:,:,3,:)
                   piz_aero_sw_rrtm(:,:,1,:)=piz_aero(:,:,3,:)
                   cg_aero_sw_rrtm (:,:,1,:)=cg_aero (:,:,3,:)
                   !--all aerosols
                   tau_aero_sw_rrtm(:,:,2,:)=tau_aero(:,:,2,:)
                   piz_aero_sw_rrtm(:,:,2,:)=piz_aero(:,:,2,:)
                   cg_aero_sw_rrtm (:,:,2,:)=cg_aero (:,:,2,:)

                   !--no LW optics
                   tau_aero_lw_rrtm(:,:,:,:) = 1.e-15

                ELSE
                   abort_message='Only NSW=2 or 6 are possible with ' &
                        // 'aerosols and iflag_rrtm=1'
                   CALL abort_physic(modname,abort_message,1)
                ENDIF
#else
                abort_message='You should compile with -rrtm if running ' &
                     // 'with iflag_rrtm=1'
                CALL abort_physic(modname,abort_message,1)
#endif

             ENDIF
          ELSE IF (iflag_rrtm ==2) THEN    ! ecrad RADIATION
#ifdef CPP_ECRAD
             !--climatologies or INCA aerosols
             CALL readaerosol_optic_ecrad( debut, aerosol_couple, ok_alw, ok_volcan, &
                  flag_aerosol, flag_bc_internal_mixture, itap, jD_cur-jD_ref, &
                  pdtphys, pplay, paprs, t_seri, rhcl, presnivs,  &
                  tr_seri, mass_solu_aero, mass_solu_aero_pi, m_allaer)
#else
                abort_message='You should compile with -rad ecrad if running with iflag_rrtm=2'
                CALL abort_physic(modname,abort_message,1)
#endif
          ENDIF
       ELSE   !--flag_aerosol = 0 
          tausum_aero(:,:,:) = 0.
          drytausum_aero(:,:) = 0.
          mass_solu_aero(:,:) = 0.
          mass_solu_aero_pi(:,:) = 0.
          IF (iflag_rrtm == 0) THEN !--old radiation
             tau_aero(:,:,:,:) = 1.e-15
             piz_aero(:,:,:,:) = 1.
             cg_aero(:,:,:,:)  = 0.
          ELSE
             tau_aero_sw_rrtm(:,:,:,:) = 1.e-15
             tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
             piz_aero_sw_rrtm(:,:,:,:) = 1.0
             cg_aero_sw_rrtm(:,:,:,:)  = 0.0
          ENDIF
       ENDIF

       !--WMO criterion to determine tropopause
       CALL stratosphere_mask(missing_val, pphis, t_seri, pplay, latitude_deg)

       !--STRAT AEROSOL
       !--updates tausum_aero,tau_aero,piz_aero,cg_aero
       IF (flag_aerosol_strat>0) THEN
          IF (prt_level >=10) THEN
             PRINT *,'appel a readaerosolstrat', mth_cur
          ENDIF
          IF (iflag_rrtm==0) THEN
           IF (flag_aerosol_strat==1) THEN
             CALL readaerosolstrato(debut)
           ELSE
             abort_message='flag_aerosol_strat must equal 1 for rrtm=0'
             CALL abort_physic(modname,abort_message,1)
           ENDIF
          ELSE
#ifdef CPP_RRTM
IF (.NOT. CPPKEY_STRATAER) THEN
          !--prescribed strat aerosols 
          !--only in the case of non-interactive strat aerosols
            IF (flag_aerosol_strat.EQ.1) THEN
             CALL readaerosolstrato1_rrtm(debut)
            ELSEIF (flag_aerosol_strat.EQ.2) THEN
             CALL readaerosolstrato2_rrtm(debut, ok_volcan)
            ELSE
             abort_message='flag_aerosol_strat must equal 1 or 2 for rrtm=1'
             CALL abort_physic(modname,abort_message,1)
            ENDIF
END IF
#else
             abort_message='You should compile with -rrtm if running ' &
                  // 'with iflag_rrtm=1'
             CALL abort_physic(modname,abort_message,1)
#endif
          ENDIF
       ELSE
          tausum_aero(:,:,id_STRAT_phy) = 0. 
       ENDIF

#ifdef CPP_RRTM
IF (CPPKEY_STRATER) THEN
       !--compute stratospheric mask
       CALL stratosphere_mask(missing_val, pphis, t_seri, pplay, latitude_deg)
       !--interactive strat aerosols
       CALL calcaerosolstrato_rrtm(pplay,t_seri,paprs,debut)
END IF
#endif
       !--fin STRAT AEROSOL

       ! Calculer les parametres optiques des nuages et quelques
       ! parametres pour diagnostiques:

       IF (aerosol_couple.AND.config_inca=='aero') THEN 
          mass_solu_aero(:,:)    = ccm(:,:,1) 
          mass_solu_aero_pi(:,:) = ccm(:,:,2) 
       ENDIF

       !Rajout appel a interface calcul proprietes optiques des nuages
       CALL call_cloud_optics_prop(klon, klev, ok_newmicro, &
               paprs, pplay, t_seri, radocond, picefra, cldfra, &
               cldtau, cldemi, cldh, cldl, cldm, cldt, cldq, &
               flwp, fiwp, flwc, fiwc, ok_aie, &
               mass_solu_aero, mass_solu_aero_pi, &
               cldtaupi, distcltop, temp_cltop, re, fl, ref_liq, ref_ice, &
               ref_liq_pi, ref_ice_pi, scdnc, cldncl, reffclwtop, lcc, reffclws, &
               reffclwc, cldnvi, lcc3d, lcc3dcon, lcc3dstra, icc3dcon, icc3dstra,  & 
               zfice, dNovrN, ptconv, rnebcon, clwcon)

       !IM betaCRF

       cldtaurad   = cldtau
       cldtaupirad = cldtaupi
       cldemirad   = cldemi
       cldfrarad   = cldfra

       IF (lon1_beta==-180..AND.lon2_beta==180..AND. &
           lat1_beta==90..AND.lat2_beta==-90.) THEN

          ! global

!IM 251017 begin
!               print*,'physiq betaCRF global zdtime=',zdtime
!IM 251017 end
          DO k=1, klev
             DO i=1, klon
                IF (pplay(i,k)>=pfree) THEN
                   beta(i,k) = beta_pbl
                ELSE
                   beta(i,k) = beta_free
                ENDIF
                IF (mskocean_beta) THEN
                   beta(i,k) = beta(i,k) * pctsrf(i,is_oce)
                ENDIF
                cldtaurad(i,k)   = cldtau(i,k) * beta(i,k)
                cldtaupirad(i,k) = cldtaupi(i,k) * beta(i,k)
                cldemirad(i,k)   = cldemi(i,k) * beta(i,k)
                cldfrarad(i,k)   = cldfra(i,k) * beta(i,k)
             ENDDO
          ENDDO

       ELSE

          ! regional

          DO k=1, klev
             DO i=1,klon

                IF (longitude_deg(i)>=lon1_beta.AND. &
                    longitude_deg(i)<=lon2_beta.AND. &
                    latitude_deg(i)<=lat1_beta.AND.  &
                    latitude_deg(i)>=lat2_beta) THEN
                   IF (pplay(i,k)>=pfree) THEN
                      beta(i,k) = beta_pbl
                   ELSE
                      beta(i,k) = beta_free
                   ENDIF
                   IF (mskocean_beta) THEN
                      beta(i,k) = beta(i,k) * pctsrf(i,is_oce)
                   ENDIF
                   cldtaurad(i,k)   = cldtau(i,k) * beta(i,k)
                   cldtaupirad(i,k) = cldtaupi(i,k) * beta(i,k)
                   cldemirad(i,k)   = cldemi(i,k) * beta(i,k)
                   cldfrarad(i,k)   = cldfra(i,k) * beta(i,k)
                ENDIF

             ENDDO
          ENDDO

       ENDIF

       !lecture de la chlorophylle pour le nouvel albedo de Sunghye Baek 
       IF (ok_chlorophyll) THEN
          print*,"-- reading chlorophyll"
          CALL readchlorophyll(debut)
       ENDIF

!--if ok_suntime_rrtm we use ancillay data for RSUN 
!--previous values are therefore overwritten
!--this is needed for CMIP6 runs
!--and only possible for new radiation scheme
       IF (iflag_rrtm==1.AND.ok_suntime_rrtm) THEN
#ifdef CPP_RRTM
         CALL read_rsun_rrtm(debut)
#endif
       ENDIF

       IF (mydebug) THEN
          CALL writefield_phy('u_seri',u_seri,nbp_lev)
          CALL writefield_phy('v_seri',v_seri,nbp_lev)
          CALL writefield_phy('t_seri',t_seri,nbp_lev)
          CALL writefield_phy('q_seri',q_seri,nbp_lev)
       ENDIF

       !sonia : If Iflag_radia >=2, pertubation of some variables
       !input to radiation (DICE)

       IF (iflag_radia >= 2) THEN
          zsav_tsol (:) = zxtsol(:)
          CALL perturb_radlwsw(zxtsol,iflag_radia)
       ENDIF

       IF (aerosol_couple.AND.config_inca=='aero') THEN 
IF (CPPKEY_INCA) THEN
          CALL radlwsw_inca  &
               (chemistry_couple, kdlon,kflev,dist, rmu0, fract, solaire, &
               paprs, pplay,zxtsol,albsol1, albsol2, t_seri,q_seri, &
               size(wo,3), wo, &
               cldfrarad, cldemirad, cldtaurad, &
               heat,heat0,cool,cool0,albpla, &
               topsw,toplw,solsw,sollw, &
               sollwdown, &
               topsw0,toplw0,solsw0,sollw0, &
               lwdn0, lwdn, lwup0, lwup,  &
               swdn0, swdn, swup0, swup, &
               ok_ade, ok_aie, &
               tau_aero, piz_aero, cg_aero, &
               topswad_aero, solswad_aero, &
               topswad0_aero, solswad0_aero, &
               topsw_aero, topsw0_aero, &
               solsw_aero, solsw0_aero, &
               cldtaupirad, &
               topswai_aero, solswai_aero)
END IF
       ELSE

          !IM calcul radiatif pour le cas actuel

          RCO2 = RCO2_act
          RCH4 = RCH4_act
          RN2O = RN2O_act
          RCFC11 = RCFC11_act
          RCFC12 = RCFC12_act

          !--interactive CO2 in ppm from carbon cycle
          IF (carbon_cycle_rad) RCO2=RCO2_glo

          IF (prt_level >=10) THEN
             print *,' ->radlwsw, number 1 '
          ENDIF

          ! AI namelist utilise pour l appel principal de radlwsw (ecrad)
          namelist_ecrad_file='namelist_ecrad'

          CALL radlwsw &
               (debut, dist, rmu0, fract,  &
                                !albedo SB >>>
                                !      paprs, pplay,zxtsol,albsol1, albsol2,  &
               paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif,  &
                                !albedo SB <<<
               t_seri,q_seri,wo, &
               cldfrarad, cldemirad, cldtaurad, &
               ok_ade.OR.flag_aerosol_strat>0, ok_aie,  ok_volcan, flag_volc_surfstrat, &
               flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
               tau_aero, piz_aero, cg_aero, &
               tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, & 
               ! Rajoute par OB pour RRTM
               tau_aero_lw_rrtm, & 
               cldtaupirad, m_allaer, &
!              zqsat, flwcrad, fiwcrad, &
               zqsat, flwc, fiwc, &
               ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
               namelist_ecrad_file, &
               heat,heat0,cool,cool0,albpla, &
               heat_volc,cool_volc, &
               topsw,toplw,solsw,solswfdiff,sollw, &
               sollwdown, &
               topsw0,toplw0,solsw0,sollw0, &
               lwdnc0, lwdn0, lwdn, lwupc0, lwup0, lwup,  &
               swdnc0, swdn0, swdn, swupc0, swup0, swup, &
               topswad_aero, solswad_aero, &
               topswai_aero, solswai_aero, &
               topswad0_aero, solswad0_aero, &
               topsw_aero, topsw0_aero, &
               solsw_aero, solsw0_aero, &
               topswcf_aero, solswcf_aero, &
                                !-C. Kleinschmitt for LW diagnostics
               toplwad_aero, sollwad_aero,&
               toplwai_aero, sollwai_aero, &
               toplwad0_aero, sollwad0_aero,&
                                !-end
               ZLWFT0_i, ZFLDN0, ZFLUP0, &
               ZSWFT0_i, ZFSDN0, ZFSUP0, &
               cloud_cover_sw)

          !lwoff=y, betalwoff=1. : offset LW CRE for radiation code and other
          !schemes
          toplw = toplw + betalwoff * (toplw0 - toplw)
          sollw = sollw + betalwoff * (sollw0 - sollw)
          lwdn = lwdn + betalwoff * (lwdn0 - lwdn)
          lwup = lwup + betalwoff * (lwup0 - lwup)
          sollwdown(:)= sollwdown(:) + betalwoff *(-1.*ZFLDN0(:,1) - &
                        sollwdown(:))
          cool = cool + betalwoff * (cool0 - cool)
 
          IF (.NOT. using_xios) THEN

            !IM 2eme calcul radiatif pour le cas perturbe ou au moins un
            !IM des taux doit etre different du taux actuel
            !IM Par defaut on a les taux perturbes egaux aux taux actuels

            IF (RCO2_per/=RCO2_act.OR. &
                RCH4_per/=RCH4_act.OR. &
                RN2O_per/=RN2O_act.OR. &
                RCFC11_per/=RCFC11_act.OR. &
                RCFC12_per/=RCFC12_act) ok_4xCO2atm =.TRUE.
          ENDIF

          IF (ok_4xCO2atm) THEN

                RCO2 = RCO2_per
                RCH4 = RCH4_per
                RN2O = RN2O_per
                RCFC11 = RCFC11_per
                RCFC12 = RCFC12_per

                IF (prt_level >=10) THEN
                   print *,' ->radlwsw, number 2 '
                ENDIF

                ! AI namelist utilise pour l appel principal de radlwsw (ecrad)
                namelist_ecrad_file='namelist_ecrad'

                CALL radlwsw &
                     (debut, dist, rmu0, fract,  &
                                !albedo SB >>>
                                !      paprs, pplay,zxtsol,albsol1, albsol2,  &
                     paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, & 
                                !albedo SB <<<
                     t_seri,q_seri,wo, &
                     cldfrarad, cldemirad, cldtaurad, &
                     ok_ade.OR.flag_aerosol_strat>0, ok_aie,  ok_volcan, flag_volc_surfstrat, &
                     flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
                     tau_aero, piz_aero, cg_aero, &
                     tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
                                ! Rajoute par OB pour RRTM
                     tau_aero_lw_rrtm, &
                     cldtaupi, m_allaer, &
!                    zqsat, flwcrad, fiwcrad, &
                     zqsat, flwc, fiwc, &
                     ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
                     namelist_ecrad_file, &
                     heatp,heat0p,coolp,cool0p,albplap, &
                     heat_volc,cool_volc, &
                     topswp,toplwp,solswp,solswfdiffp,sollwp, &
                     sollwdownp, &
                     topsw0p,toplw0p,solsw0p,sollw0p, &
                     lwdnc0p, lwdn0p, lwdnp, lwupc0p, lwup0p, lwupp,  &
                     swdnc0p, swdn0p, swdnp, swupc0p, swup0p, swupp, &
                     topswad_aerop, solswad_aerop, &
                     topswai_aerop, solswai_aerop, &
                     topswad0_aerop, solswad0_aerop, &
                     topsw_aerop, topsw0_aerop, &
                     solsw_aerop, solsw0_aerop, &
                     topswcf_aerop, solswcf_aerop, &
                                !-C. Kleinschmitt for LW diagnostics
                     toplwad_aerop, sollwad_aerop,&
                     toplwai_aerop, sollwai_aerop, &
                     toplwad0_aerop, sollwad0_aerop,&
                                !-end
                     ZLWFT0_i, ZFLDN0, ZFLUP0, &
                     ZSWFT0_i, ZFSDN0, ZFSUP0, &
                     cloud_cover_sw)
          ENDIF !ok_4xCO2atm

! A.I aout 2023
! Effet 3D des nuages Ecrad
! a passer : nom du ficher namelist et cles ok_3Deffect
! a declarer comme iflag_rrtm et a lire dans physiq.def
#ifdef CPP_ECRAD
          IF (ok_3Deffect) then
!                print*,'ok_3Deffect = ',ok_3Deffect  
                namelist_ecrad_file='namelist_ecrad_s2'
                CALL radlwsw &
                     (debut, dist, rmu0, fract,  &
                     paprs, pplay,zxtsol,SFRWL,albsol_dir, albsol_dif, &
                     t_seri,q_seri,wo, &
                     cldfrarad, cldemirad, cldtaurad, &
                     ok_ade.OR.flag_aerosol_strat.GT.0, ok_aie,  ok_volcan, flag_volc_surfstrat, &
                     flag_aerosol, flag_aerosol_strat, flag_aer_feedback, &
                     tau_aero, piz_aero, cg_aero, &
                     tau_aero_sw_rrtm, piz_aero_sw_rrtm, cg_aero_sw_rrtm, &
                     tau_aero_lw_rrtm, &
                     cldtaupi, &
                     zqsat, flwc, fiwc, &
                     ref_liq, ref_ice, ref_liq_pi, ref_ice_pi, &
                     namelist_ecrad_file, &
! A modifier              
                     heat_s2,heat0_s2,cool_s2,cool0_s2,albpla_s2, &
                     heat_volc,cool_volc, &
                     topsw_s2,toplw_s2,solsw_s2,solswfdiff_s2,sollw_s2, &
                     sollwdown_s2, &
                     topsw0_s2,toplw0_s2,solsw0_s2,sollw0_s2, &
                     lwdnc0_s2, lwdn0_s2, lwdn_s2, lwupc0_s2, lwup0_s2, lwup_s2,  &
                     swdnc0_s2, swdn0_s2, swdn_s2, swupc0_s2, swup0_s2, swup_s2, &
                     topswad_aero_s2, solswad_aero_s2, &
                     topswai_aero_s2, solswai_aero_s2, &
                     topswad0_aero_s2, solswad0_aero_s2, &
                     topsw_aero_s2, topsw0_aero_s2, &
                     solsw_aero_s2, solsw0_aero_s2, &
                     topswcf_aero_s2, solswcf_aero_s2, &
                                !-C. Kleinschmitt for LW diagnostics
                     toplwad_aero_s2, sollwad_aero_s2,&
                     toplwai_aero_s2, sollwai_aero_s2, &
                     toplwad0_aero_s2, sollwad0_aero_s2,&
                                !-end
                     ZLWFT0_i, ZFLDN0, ZFLUP0, &
                     ZSWFT0_i, ZFSDN0, ZFSUP0, &
                     cloud_cover_sw_s2)
          ENDIF ! ok_3Deffect
#endif

       ENDIF ! aerosol_couple
       itaprad = 0

       !  If Iflag_radia >=2, reset pertubed variables

       IF (iflag_radia >= 2) THEN
          zxtsol(:) = zsav_tsol (:)
       ENDIF
    ENDIF ! MOD(itaprad,radpas)
    itaprad = itaprad + 1

    IF (iflag_radia==0) THEN
       IF (prt_level>=9) THEN
          PRINT *,'--------------------------------------------------'
          PRINT *,'>>>> ATTENTION rayonnement desactive pour ce cas'
          PRINT *,'>>>>           heat et cool mis a zero '
          PRINT *,'--------------------------------------------------'
       ENDIF
       heat=0.
       cool=0.
       sollw=0.   ! MPL 01032011
       solsw=0.
       radsol=0.
       swup=0.    ! MPL 27102011 pour les fichiers AMMA_profiles et AMMA_scalars
       swup0=0.
       lwup=0.
       lwup0=0.
       lwdn=0.
       lwdn0=0.
    ENDIF

    ! Calculer radsol a l'exterieur de radlwsw
    ! pour prendre en compte le cycle diurne
    ! recode par Olivier Boucher en sept 2015

    radsol=solsw*swradcorr+sollw

    IF (ok_4xCO2atm) THEN
       radsolp=solswp*swradcorr+sollwp
    ENDIF

    ! Ajouter la tendance des rayonnements (tous les pas)
    ! avec une correction pour le cycle diurne dans le SW

    DO k=1, klev
       d_t_swr(:,k)=swradcorr(:)*heat(:,k)*phys_tstep/RDAY
       d_t_sw0(:,k)=swradcorr(:)*heat0(:,k)*phys_tstep/RDAY
       d_t_lwr(:,k)=-cool(:,k)*phys_tstep/RDAY
       d_t_lw0(:,k)=-cool0(:,k)*phys_tstep/RDAY
    ENDDO

    CALL add_phys_tend(du0,dv0,d_t_swr,dq0,dql0,dqi0,dqbs0,paprs,'SW',abortphy,flag_inhib_tend,itap,0 &
#ifdef ISO
          ,dxt0,dxtl0,dxti0 &
#endif      
        )
    CALL prt_enerbil('SW',itap)
    CALL add_phys_tend(du0,dv0,d_t_lwr,dq0,dql0,dqi0,dqbs0,paprs,'LW',abortphy,flag_inhib_tend,itap,0 &
#ifdef ISO
          ,dxt0,dxtl0,dxti0 &
#endif      
        )
    CALL prt_enerbil('LW',itap)

    IF (mydebug) THEN
       CALL writefield_phy('u_seri',u_seri,nbp_lev)
       CALL writefield_phy('v_seri',v_seri,nbp_lev)
       CALL writefield_phy('t_seri',t_seri,nbp_lev)
       CALL writefield_phy('q_seri',q_seri,nbp_lev)
    ENDIF

    ! Calculer l'hydrologie de la surface

    !      CALL hydrol(dtime,pctsrf,rain_fall, snow_fall, zxevap,
    !     .            agesno, ftsol,fqsurf,fsnow, ruis)

    ! Calculer le bilan du sol et la derive de temperature (couplage)

    DO i = 1, klon
       !         bils(i) = radsol(i) - sens(i) - evap(i)*RLVTT
       ! a la demande de JLD
       bils(i) = radsol(i) - sens(i) + zxfluxlat(i)
    ENDDO

    !moddeblott(jan95)
    ! Appeler le programme de parametrisation de l'orographie
    ! a l'echelle sous-maille:

    IF (prt_level >=10) THEN
       print *,' call orography ? ', ok_orodr
    ENDIF

    IF (ok_orodr) THEN

       !  selection des points pour lesquels le shema est actif:
       igwd=0
       DO i=1,klon
          itest(i)=0
          zrel_oro(i)=zstd(i)/(max(zsig(i),1.E-8)*sqrt(cell_area(i)))
          !zrel_oro: relative mountain height wrt relief explained by mean slope
          ! -> condition on zrel_oro can deactivate the drag on tilted planar terrains
          !    such as ice sheets (work by V. Wiener)
          ! zpmm_orodr_t and zstd_orodr_t are activation thresholds set by F. Lott to
          ! earn computation time but they are not physical.
          IF (((zpic(i)-zmea(i))>zpmm_orodr_t).AND.(zstd(i)>zstd_orodr_t).AND.(zrel_oro(i)<=zrel_oro_t)) THEN
             itest(i)=1
             igwd=igwd+1
             idx(igwd)=i
          ENDIF
       ENDDO
       !        igwdim=MAX(1,igwd)

       IF (ok_strato) THEN

          CALL drag_noro_strato(0,klon,klev,phys_tstep,paprs,pplay, &
               zmea,zstd, zsig, zgam, zthe,zpic,zval, &
               igwd,idx,itest, &
               t_seri, u_seri, v_seri, &
               zulow, zvlow, zustrdr, zvstrdr, &
               d_t_oro, d_u_oro, d_v_oro)

       ELSE
          CALL drag_noro(klon,klev,phys_tstep,paprs,pplay, &
               zmea,zstd, zsig, zgam, zthe,zpic,zval, &
               igwd,idx,itest, &
               t_seri, u_seri, v_seri, &
               zulow, zvlow, zustrdr, zvstrdr, &
               d_t_oro, d_u_oro, d_v_oro)
       ENDIF

       !  ajout des tendances
       !-----------------------------------------------------------------------
       ! ajout des tendances de la trainee de l'orographie
       CALL add_phys_tend(d_u_oro,d_v_oro,d_t_oro,dq0,dql0,dqi0,dqbs0,paprs,'oro', &
            abortphy,flag_inhib_tend,itap,0 &
#ifdef ISO
          ,dxt0,dxtl0,dxti0 &
#endif      
         )
       CALL prt_enerbil('oro',itap)
       !----------------------------------------------------------------------

    ENDIF ! fin de test sur ok_orodr

    IF (mydebug) THEN
       CALL writefield_phy('u_seri',u_seri,nbp_lev)
       CALL writefield_phy('v_seri',v_seri,nbp_lev)
       CALL writefield_phy('t_seri',t_seri,nbp_lev)
       CALL writefield_phy('q_seri',q_seri,nbp_lev)
    ENDIF

    IF (ok_orolf) THEN

       !  selection des points pour lesquels le shema est actif:
       igwd=0
       DO i=1,klon
          itest(i)=0
          !zrel_oro: relative mountain height wrt relief explained by mean slope
          ! -> condition on zrel_oro can deactivate the lifting on tilted planar terrains
          !    such as ice sheets (work by V. Wiener)
          zrel_oro(i)=zstd(i)/(max(zsig(i),1.E-8)*sqrt(cell_area(i)))
          IF (((zpic(i)-zmea(i))>zpmm_orolf_t).AND.(zrel_oro(i)<=zrel_oro_t)) THEN
             itest(i)=1
             igwd=igwd+1
             idx(igwd)=i
          ENDIF
       ENDDO
       !        igwdim=MAX(1,igwd)

       IF (ok_strato) THEN

          CALL lift_noro_strato(klon,klev,phys_tstep,paprs,pplay, &
               latitude_deg,zmea,zstd,zpic,zgam,zthe,zpic,zval, &
               igwd,idx,itest, &
               t_seri, u_seri, v_seri, &
               zulow, zvlow, zustrli, zvstrli, &
               d_t_lif, d_u_lif, d_v_lif               )

       ELSE
          CALL lift_noro(klon,klev,phys_tstep,paprs,pplay, &
               latitude_deg,zmea,zstd,zpic, &
               itest, &
               t_seri, u_seri, v_seri, &
               zulow, zvlow, zustrli, zvstrli, &
               d_t_lif, d_u_lif, d_v_lif)
       ENDIF

       ! ajout des tendances de la portance de l'orographie
       CALL add_phys_tend(d_u_lif, d_v_lif, d_t_lif, dq0, dql0, dqi0, dqbs0,paprs, &
            'lif', abortphy,flag_inhib_tend,itap,0 &
#ifdef ISO
          ,dxt0,dxtl0,dxti0 &
#endif      
         )
       CALL prt_enerbil('lif',itap)
    ENDIF ! fin de test sur ok_orolf

    IF (ok_hines) then
       !  HINES GWD PARAMETRIZATION
       east_gwstress=0.
       west_gwstress=0.
       du_gwd_hines=0.
       dv_gwd_hines=0.
       CALL hines_gwd(klon, klev, phys_tstep, paprs, pplay, latitude_deg, t_seri, &
            u_seri, v_seri, zustr_gwd_hines, zvstr_gwd_hines, d_t_hin, &
            du_gwd_hines, dv_gwd_hines)
       zustr_gwd_hines=0.
       zvstr_gwd_hines=0.
       DO k = 1, klev
          zustr_gwd_hines(:)=zustr_gwd_hines(:)+ du_gwd_hines(:, k)/phys_tstep &
               * (paprs(:, k)-paprs(:, k+1))/rg
          zvstr_gwd_hines(:)=zvstr_gwd_hines(:)+ dv_gwd_hines(:, k)/phys_tstep &
               * (paprs(:, k)-paprs(:, k+1))/rg
       ENDDO

       d_t_hin(:, :)=0.
       CALL add_phys_tend(du_gwd_hines, dv_gwd_hines, d_t_hin, dq0, dql0, &
            dqi0, dqbs0, paprs, 'hin', abortphy,flag_inhib_tend,itap,0 &
#ifdef ISO
          ,dxt0,dxtl0,dxti0 &
#endif      
         )
       CALL prt_enerbil('hin',itap)
    ENDIF

    IF (.not. ok_hines .and. ok_gwd_rando) then
       ! ym missing init for east_gwstress & west_gwstress -> added in phys_local_var_mod
       CALL acama_GWD_rando(PHYS_TSTEP, pplay, latitude_deg, t_seri, u_seri, &
            v_seri, rot, zustr_gwd_front, zvstr_gwd_front, du_gwd_front, &
            dv_gwd_front, east_gwstress, west_gwstress)
       zustr_gwd_front=0.
       zvstr_gwd_front=0.
       DO k = 1, klev
          zustr_gwd_front(:)=zustr_gwd_front(:)+ du_gwd_front(:, k)/phys_tstep &
               * (paprs(:, k)-paprs(:, k+1))/rg
          zvstr_gwd_front(:)=zvstr_gwd_front(:)+ dv_gwd_front(:, k)/phys_tstep &
               * (paprs(:, k)-paprs(:, k+1))/rg
       ENDDO

       CALL add_phys_tend(du_gwd_front, dv_gwd_front, dt0, dq0, dql0, dqi0, dqbs0, &
            paprs, 'front_gwd_rando', abortphy,flag_inhib_tend,itap,0 &
#ifdef ISO
          ,dxt0,dxtl0,dxti0 &
#endif      
         )
       CALL prt_enerbil('front_gwd_rando',itap)
    ENDIF

    IF (ok_gwd_rando) THEN
       CALL FLOTT_GWD_rando(PHYS_TSTEP, pplay, t_seri, u_seri, v_seri, &
            rain_fall + snow_fall, zustr_gwd_rando, zvstr_gwd_rando, &
            du_gwd_rando, dv_gwd_rando, east_gwstress, west_gwstress)
       CALL add_phys_tend(du_gwd_rando, dv_gwd_rando, dt0, dq0, dql0, dqi0, dqbs0, &
            paprs, 'flott_gwd_rando', abortphy,flag_inhib_tend,itap,0 &
#ifdef ISO
          ,dxt0,dxtl0,dxti0 &
#endif      
        )
       CALL prt_enerbil('flott_gwd_rando',itap)
       zustr_gwd_rando=0.
       zvstr_gwd_rando=0.
       DO k = 1, klev
          zustr_gwd_rando(:)=zustr_gwd_rando(:)+ du_gwd_rando(:, k)/phys_tstep &
               * (paprs(:, k)-paprs(:, k+1))/rg
          zvstr_gwd_rando(:)=zvstr_gwd_rando(:)+ dv_gwd_rando(:, k)/phys_tstep &
               * (paprs(:, k)-paprs(:, k+1))/rg
       ENDDO
    ENDIF

    ! STRESS NECESSAIRES: TOUTE LA PHYSIQUE

    IF (mydebug) THEN
       CALL writefield_phy('u_seri',u_seri,nbp_lev)
       CALL writefield_phy('v_seri',v_seri,nbp_lev)
       CALL writefield_phy('t_seri',t_seri,nbp_lev)
       CALL writefield_phy('q_seri',q_seri,nbp_lev)
    ENDIF

    DO i = 1, klon
       zustrph(i)=0.
       zvstrph(i)=0.
    ENDDO
    DO k = 1, klev
       DO i = 1, klon
          zustrph(i)=zustrph(i)+(u_seri(i,k)-u(i,k))/phys_tstep* &
               (paprs(i,k)-paprs(i,k+1))/rg
          zvstrph(i)=zvstrph(i)+(v_seri(i,k)-v(i,k))/phys_tstep* &
               (paprs(i,k)-paprs(i,k+1))/rg
       ENDDO
    ENDDO

    !IM calcul composantes axiales du moment angulaire et couple des montagnes

    IF (is_sequential .and. ok_orodr) THEN 
       CALL aaam_bud (27,klon,klev,jD_cur-jD_ref,jH_cur, &
            ra,rg,romega, &
            latitude_deg,longitude_deg,pphis, &
            zustrdr,zustrli,zustrph, &
            zvstrdr,zvstrli,zvstrph, &
            paprs,u,v, &
            aam, torsfc)
    ENDIF
    !IM cf. FLott END
    !DC Calcul de la tendance due au methane
    IF (ok_qch4) THEN
!      d_q_ch4: H2O source from CH4 in MMR/s (mass mixing ratio/s or kg H2O/kg air/s)
IF (CPPKEY_STRATER) THEN
       CALL stratH2O_methox(debut,paprs,d_q_ch4)
ELSE
!      ECMWF routine METHOX
       CALL METHOX(1,klon,klon,klev,q_seri,d_q_ch4,pplay)
END IF
       ! add humidity tendency due to methane
       d_q_ch4_dtime(:,:) = d_q_ch4(:,:)*phys_tstep
#ifdef ISO
       d_xt_ch4_dtime(:,:,:) = d_xt_ch4(:,:,:)*phys_tstep
#endif
       CALL add_phys_tend(du0, dv0, dt0, d_q_ch4_dtime, dql0, dqi0, dqbs0, paprs, &
            'q_ch4', abortphy,flag_inhib_tend,itap,0 &
#ifdef ISO
          ,d_xt_ch4_dtime,dxtl0,dxti0 &
#endif      
         )
       d_q_ch4(:,:) = d_q_ch4_dtime(:,:)/phys_tstep ! update with H2O conserv done in add_phys_tend
#ifdef ISO
       d_xt_ch4(:,:,:) = d_xt_ch4_dtime(:,:,:)/phys_tstep ! update with H2O conserv done in add_phys_tend
#endif
    ENDIF


IF (CPPKEY_STRATER) THEN
    IF (ok_qemiss) THEN
       flh2o=1
       IF(flag_verbose_strataer) THEN
          print *,'IN physiq_mod: ok_qemiss =yes (',ok_qemiss,'), flh2o=',flh2o
          print *,'IN physiq_mod: flag_emit=',flag_emit,', nErupt=',nErupt
          print *,'IN physiq_mod: nAerErupt=',nAerErupt
       ENDIF
       
       SELECT CASE(flag_emit)
       CASE(1) ! emission volc H2O in LMDZ
          DO ieru=1, nErupt
             IF (year_cur==year_emit_vol(ieru).AND.&
                  mth_cur==mth_emit_vol(ieru).AND.&
                  day_cur>=day_emit_vol(ieru).AND.&
                  day_cur<(day_emit_vol(ieru)+injdur)) THEN
                
                IF(flag_verbose_strataer) print *,'IN physiq_mod: date=',year_cur,mth_cur,day_cur
                ! initialisation of q tendency emission
                d_q_emiss(:,:)=0.
                ! daily injection mass emission - NL
                m_H2O_emiss_vol_daily = m_H2O_emiss_vol(ieru)/(REAL(injdur)&
                     *REAL(ponde_lonlat_vol(ieru)))

                CALL STRATEMIT(pdtphys,pdtphys,latitude_deg,longitude_deg,t_seri,&
                    pplay,paprs,tr_seri,&
                    m_H2O_emiss_vol_daily,&
                    xlat_min_vol(ieru),xlat_max_vol(ieru),&
                    xlon_min_vol(ieru),xlon_max_vol(ieru),&
                    altemiss_vol(ieru),sigma_alt_vol(ieru),1,1.,&
                    nAerErupt+1,0)
                
                IF(flag_verbose_strataer) print *,'IN physiq_mod: min max d_q_emiss=',&
                     minval(d_q_emiss),maxval(d_q_emiss)
                
                CALL add_phys_tend(du0, dv0, dt0, d_q_emiss, dql0, dqi0, dqbs0, paprs, &
                     'q_emiss',abortphy,flag_inhib_tend,itap,0)
                IF (abortphy==1) Print*,'ERROR ABORT TEND EMISS'
             ENDIF
          ENDDO
          flh2o=0
       END SELECT ! emission scenario (flag_emit)
    ENDIF
END IF

!===============================================================
!            Additional tendency of TKE due to orography
!===============================================================

! Inititialization
!------------------

       addtkeoro=0   
       CALL getin_p('addtkeoro',addtkeoro) 
      
       IF (prt_level>=5) &
            print*,'addtkeoro', addtkeoro
            
       alphatkeoro=1.   
       CALL getin_p('alphatkeoro',alphatkeoro)
       alphatkeoro=min(max(0.,alphatkeoro),1.)

       smallscales_tkeoro=.FALSE.   
       CALL getin_p('smallscales_tkeoro',smallscales_tkeoro) 


       dtadd(:,:)=0.
       duadd(:,:)=0.
       dvadd(:,:)=0.

! Choices for addtkeoro:
!      ** 0 no TKE tendency from orography    
!      ** 1 we include a fraction alphatkeoro of the whole tendency duoro
!      ** 2 we include a fraction alphatkeoro of the gravity wave part of duoro

       IF (addtkeoro > 0 .AND. ok_orodr ) THEN
!      -------------------------------------------


       !  selection des points pour lesquels le schema est actif:


  IF (addtkeoro == 1 ) THEN

            duadd(:,:)=alphatkeoro*d_u_oro(:,:)
            dvadd(:,:)=alphatkeoro*d_v_oro(:,:)

  ELSE IF (addtkeoro == 2) THEN

     IF (smallscales_tkeoro) THEN
       igwd=0
       DO i=1,klon
          itest(i)=0
! Etienne: ici je prends en compte plus de relief que la routine drag_noro_strato
! car on peut s'attendre a ce que les petites echelles produisent aussi de la TKE
! Mais attention, cela ne va pas dans le sens de la conservation de l'energie! 
          IF ((zstd(i)>1.0) .AND.(zrel_oro(i)<=zrel_oro_t)) THEN
             itest(i)=1
             igwd=igwd+1
             idx(igwd)=i
          ENDIF
       ENDDO

     ELSE 

       igwd=0
       DO i=1,klon
          itest(i)=0
        IF (((zpic(i)-zmea(i))>zpmm_orodr_t).AND.(zstd(i)>zstd_orodr_t).AND.(zrel_oro(i)<=zrel_oro_t)) THEN
             itest(i)=1
             igwd=igwd+1
             idx(igwd)=i
        ENDIF
       ENDDO

     ENDIF

     CALL drag_noro_strato(addtkeoro,klon,klev,phys_tstep,paprs,pplay, &
               zmea,zstd, zsig, zgam, zthe,zpic,zval, &
               igwd,idx,itest, &
               t_seri, u_seri, v_seri, &
               zulow, zvlow, zustrdr, zvstrdr, &
               d_t_oro_gw, d_u_oro_gw, d_v_oro_gw)

     zustrdr(:)=0.
     zvstrdr(:)=0.
     zulow(:)=0.
     zvlow(:)=0.

     duadd(:,:)=alphatkeoro*d_u_oro_gw(:,:)
     dvadd(:,:)=alphatkeoro*d_v_oro_gw(:,:)
  ENDIF


   ! TKE update from subgrid temperature and wind tendencies
   !----------------------------------------------------------
    forall (k=1: nbp_lev) exner(:, k) = (pplay(:, k)/paprs(:,1))**RKAPPA


    CALL tend_to_tke(pdtphys,paprs,exner,t_seri,u_seri,v_seri,dtadd,duadd,dvadd,pctsrf,pbl_tke)

   ! Prevent pbl_tke_w from becoming negative
    wake_delta_pbl_tke(:,:,:) = max(wake_delta_pbl_tke(:,:,:), -pbl_tke(:,:,:))

       ENDIF
!      -----
!===============================================================

#ifdef ISO
#ifdef ISOVERIF
if (iso_HDO.gt.0) then
      call iso_verif_aberrant_enc_vect2D( &
                 xt_seri,q_seri, &
                 'physiq 5924, juste apres methox',ntraciso,klon,klev)
endif      
      if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then  
        do i=1,klon 
         do k=1,klev 
            if (q_seri(i,k).gt.ridicule) then  
               if (iso_verif_o18_aberrant_nostop( &
                    xt_seri(iso_HDO,i,k)/q_seri(i,k), &
                    xt_seri(iso_O18,i,k)/q_seri(i,k), &
                    'physiq 5937a, juste apres methox, qv').eq.1) then
                  write(*,*) 'physic 2444: i,k,q_seri(i,k)=',i,k,q_seri(i,k) 
                  write(*,*) 'xt_seri(:,i,k)=',xt_seri(:,i,k)
                  stop
              endif !  if (iso_verif_o18_aberrant_nostop 
            endif !if (q_seri(i,k).gt.errmax) then  
            if (ql_seri(i,k).gt.ridicule) then  
               if (iso_verif_o18_aberrant_nostop( &
                    xtl_seri(iso_HDO,i,k)/ql_seri(i,k), &
                    xtl_seri(iso_O18,i,k)/ql_seri(i,k), &
                    'physiq 5937b, juste apres methox, ql').eq.1) then
                  write(*,*) 'i,k,ql_seri(i,k)=',i,k,ql_seri(i,k) 
                  !stop
              endif !  if (iso_verif_o18_aberrant_nostop 
            endif !if (q_seri(i,k).gt.errmax) then  
            if (qs_seri(i,k).gt.ridicule) then  
               if (iso_verif_o18_aberrant_nostop( &
                    xts_seri(iso_HDO,i,k)/qs_seri(i,k), &
                    xts_seri(iso_O18,i,k)/qs_seri(i,k), &
                    'physiq 5937c, juste apres methox, qs').eq.1) then
                  write(*,*) 'i,k,qs_seri(i,k)=',i,k,qs_seri(i,k) 
                  !stop
              endif !  if (iso_verif_o18_aberrant_nostop 
            endif !if (q_seri(i,k).gt.errmax) then
          enddo !k=1,klev
         enddo  !i=1,klon
        endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then
#endif
#endif

    !====================================================================
    ! Interface Simulateur COSP (Calipso, ISCCP, MISR, ..)
    !====================================================================
    ! Abderrahmane 24.08.09

    IF (ok_cosp) THEN
       ! adeclarer 
#ifdef CPP_COSP
       IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN

          IF (prt_level .GE.10) THEN
             print*,'freq_cosp',freq_cosp
          ENDIF
          mr_ozone=wo(:, :, 1) * dobson_u * 1e3 / zmasse
          !       print*,'Dans physiq.F avant appel cosp ref_liq,ref_ice=',
          !     s        ref_liq,ref_ice
          CALL phys_cosp(itap,phys_tstep,freq_cosp, &
               ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
               ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
               klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
               JrNt,ref_liq,ref_ice, &
               pctsrf(:,is_ter)+pctsrf(:,is_lic), &
               zu10m,zv10m,pphis, &
               zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, &
               qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
               prfl(:,1:klev),psfl(:,1:klev), &
               pmflxr(:,1:klev),pmflxs(:,1:klev), &
               mr_ozone,cldtau, cldemi)

          !     L         calipso2D,calipso3D,cfadlidar,parasolrefl,atb,betamol,
          !     L          cfaddbze,clcalipso2,dbze,cltlidarradar,
          !     M          clMISR,
          !     R          clisccp2,boxtauisccp,boxptopisccp,tclisccp,ctpisccp,
          !     I          tauisccp,albisccp,meantbisccp,meantbclrisccp)

       ENDIF
#endif

#ifdef CPP_COSP2
       IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN

          IF (prt_level .GE.10) THEN
             print*,'freq_cosp',freq_cosp
          ENDIF
          mr_ozone=wo(:, :, 1) * dobson_u * 1e3 / zmasse
                 print*,'Dans physiq.F avant appel '
          !     s        ref_liq,ref_ice
          CALL phys_cosp2(itap,phys_tstep,freq_cosp, &
               ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
               ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
               klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
               JrNt,ref_liq,ref_ice, &
               pctsrf(:,is_ter)+pctsrf(:,is_lic), &
               zu10m,zv10m,pphis, &
               zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, &
               qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
               prfl(:,1:klev),psfl(:,1:klev), &
               pmflxr(:,1:klev),pmflxs(:,1:klev), &
               mr_ozone,cldtau, cldemi)
       ENDIF
#endif

#ifdef CPP_COSPV2
       IF (itap.eq.1.or.MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN
!        IF (MOD(itap,NINT(freq_cosp/phys_tstep)).EQ.0) THEN

          IF (prt_level .GE.10) THEN
             print*,'freq_cosp',freq_cosp
          ENDIF
           DO k = 1, klev
             DO i = 1, klon
               phicosp(i,k) = pphi(i,k) + pphis(i)
             ENDDO
           ENDDO
          mr_ozone=wo(:, :, 1) * dobson_u * 1e3 / zmasse
                 print*,'Dans physiq.F avant appel '
          !     s        ref_liq,ref_ice
          CALL lmdz_cosp_interface(itap,phys_tstep,freq_cosp, &
               ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP, &
               ecrit_mth,ecrit_day,ecrit_hf, ok_all_xml, missing_val, &
               klon,klev,longitude_deg,latitude_deg,presnivs,overlap, &
               JrNt,ref_liq,ref_ice, &
               pctsrf(:,is_ter)+pctsrf(:,is_lic), &
               zu10m,zv10m,pphis, &
               zphi,paprs(:,1:klev),pplay,zxtsol,t_seri, &
               qx(:,:,ivap),zx_rh,cldfra,rnebcon,flwc,fiwc, &
               prfl(:,1:klev),psfl(:,1:klev), &
               pmflxr(:,1:klev),pmflxs(:,1:klev), &
               mr_ozone,cldtau, cldemi)
       ENDIF
#endif

    ENDIF  !ok_cosp

!c====================================================================
!c   Ajout de la production de tritium (naturelle et essais nucléaires)
!c====================================================================
!C
#ifdef ISO
#ifdef ISOVERIF
      call iso_verif_noNaN_vect2D(xt_seri, &
           'physiq 5595: avant appel tritium',ntraciso,klon,klev)
#endif
        call iso_tritium(paprs,pplay, &
                 zphi,phys_tstep, &
                 d_xt_prod_nucl, &
                 d_xt_cosmo, &
                 d_xt_decroiss, &
                 xt_seri)
#ifdef ISOVERIF
      call iso_verif_noNaN_vect2D(xt_seri, &
           'physiq 5607: apres appel tritium',ntraciso,klon,klev)
       if (iso_HTO.gt.0) then ! Tritium
       ixt=iso_HTO
       do i=1,klon
       do k=1,klev
          if (iso_verif_positif_strict_nostop(xt_seri(ixt,i,k), &
            'physiq 5620 : xt_seri(HTO) nul ou negatif').eq.1) then
          write(*,*) 'ixt,i,klon,k,klev=',ixt,i,klon,k,klev
          write(*,*) 'xt_seri(iso_HTO,i,k)=',xt_seri(ixt,i,k)
          stop
          endif
       enddo
       enddo
       endif
#endif
!      write(*,*)'itap=',itap
!      write(*,*)'itau_phy=',itau_phy
!      write(*,*)'jD_cur=',jD_cur
#endif
!ifdef ISO


! Marine

  IF (ok_airs) then

  IF (itap==1.or.MOD(itap,NINT(freq_airs/phys_tstep))==0) THEN
     write(*,*) 'je vais appeler simu_airs, ok_airs, freq_airs=', ok_airs, freq_airs
     CALL simu_airs(itap,rneb, t_seri, cldemi, fiwc, ref_ice, pphi, pplay, paprs,&
          map_prop_hc,map_prop_hist,&
          map_emis_hc,map_iwp_hc,map_deltaz_hc,map_pcld_hc,map_tcld_hc,&
          map_emis_Cb,map_pcld_Cb,map_tcld_Cb,&
          map_emis_ThCi,map_pcld_ThCi,map_tcld_ThCi,&
          map_emis_Anv,map_pcld_Anv,map_tcld_Anv,&
          map_emis_hist,map_iwp_hist,map_deltaz_hist,map_rad_hist,&
          map_ntot,map_hc,map_hist,&
          map_Cb,map_ThCi,map_Anv,&
          alt_tropo )
  ENDIF

  ENDIF  ! ok_airs


    ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    !AA
    !AA Installation de l'interface online-offline pour traceurs
    !AA
    !====================================================================
    !   Calcul  des tendances traceurs
    !====================================================================

    IF (type_trac == 'repr') THEN
!MM pas d'impact, car on recupere q_seri,tr_seri,t_seri via phys_local_var_mod
!MM                               dans Reprobus
       sh_in(:,:) = q_seri(:,:)
#ifdef REPROBUS
       d_q_rep(:,:) = 0.
       d_ql_rep(:,:) = 0.
       d_qi_rep(:,:) = 0.
#endif
    ELSE
       sh_in(:,:) = qx(:,:,ivap)
       IF (nqo >= 3) THEN 
          ch_in(:,:) = qx(:,:,iliq) + qx(:,:,isol)
       ELSE 
          ch_in(:,:) = qx(:,:,iliq)
       ENDIF
    ENDIF

IF (CPPKEY_DUST) THEN
    !  Avec SPLA, iflag_phytrac est forcé =1 
    CALL       phytracr_spl ( debut,lafin , jD_cur,jH_cur,iflag_con,       &  ! I
                      pdtphys,ftsol,                                   &  ! I
                      t,q_seri,paprs,pplay,RHcl,                  &  ! I
                      pmfu, pmfd, pen_u, pde_u, pen_d, pde_d,          &  ! I
                      coefh(1:klon,1:klev,is_ave), cdragh, cdragm, u1, v1,                 &  ! I
                      u_seri, v_seri, latitude_deg, longitude_deg,  &
                      pphis,pctsrf,pmflxr,pmflxs,prfl,psfl,            &  ! I
                      da,phi,phi2,d1a,dam,mp,ep,sigd,sij,clw,elij,     &  ! I
                      epmlmMm,eplaMm,upwd,dnwd,itop_con,ibas_con,      &  ! I
                      ev,wdtrainA,  wdtrainM,wght_cvfd,              &  ! I
                      fm_therm, entr_therm, rneb,                      &  ! I
                      beta_prec_fisrt,beta_prec, & !I
                      zu10m,zv10m,wstar,ale_bl,ale_wake,               &  ! I
                      d_tr_dyn,tr_seri)

ELSE
    IF (iflag_phytrac == 1 ) THEN
      CALL phytrac ( &
         itap,     days_elapsed+1,    jH_cur,   debut, &
         lafin,    phys_tstep,     u, v,     t, &
         paprs,    pplay,     pmfu,     pmfd, &
         pen_u,    pde_u,     pen_d,    pde_d, &
         cdragh,   coefh(1:klon,1:klev,is_ave),   fm_therm, entr_therm, &
         u1,       v1,        ftsol,    pctsrf, &
         zustar,   zu10m,     zv10m, &
         wstar(:,is_ave),    ale_bl,         ale_wake, &
         latitude_deg, longitude_deg, &
         frac_impa,frac_nucl, beta_prec_fisrt,beta_prec, &
         presnivs, pphis,     pphi,     albsol1, &
         sh_in,   ch_in,    rhcl,      cldfra,   rneb, &
         diafra,   radocond,    itop_con, ibas_con, &
         pmflxr,   pmflxs,    prfl,     psfl, &
         da,       phi,       mp,       upwd, &
         phi2,     d1a,       dam,      sij, wght_cvfd, &        !<<RomP+RL
         wdtrainA, wdtrainM,  sigd,     clw,elij, &   !<<RomP
         ev,       ep,        epmlmMm,  eplaMm, &     !<<RomP
         dnwd,     aerosol_couple,      flxmass_w, &
         tau_aero, piz_aero,  cg_aero,  ccm, &
         rfname, &
         d_tr_dyn, &                                 !<<RomP
         tr_seri, init_source)
#ifdef REPROBUS


          print*,'avt add phys rep',abortphy

     CALL add_phys_tend &
            (du0,dv0,dt0,d_q_rep,d_ql_rep,d_qi_rep,dqbs0,paprs,&
             'rep',abortphy,flag_inhib_tend,itap,0)
        IF (abortphy==1) Print*,'ERROR ABORT REP'

          print*,'apr add phys rep',abortphy

#endif
    ENDIF    ! (iflag_phytrac=1)

END IF
    !ENDIF    ! (iflag_phytrac=1)

    IF (offline) THEN

       IF (prt_level>=9) &
            print*,'Attention on met a 0 les thermiques pour phystoke'
       CALL phystokenc ( &
            nlon,klev,pdtphys,longitude_deg,latitude_deg, &
            t,pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, &
            fm_therm,entr_therm, &
            cdragh,coefh(1:klon,1:klev,is_ave),u1,v1,ftsol,pctsrf, &
            frac_impa, frac_nucl, &
            pphis,cell_area,phys_tstep,itap, &
            qx(:,:,ivap),da,phi,mp,upwd,dnwd)


    ENDIF

    ! Calculer le transport de l'eau et de l'energie (diagnostique)

    CALL transp (paprs,zxtsol, t_seri, q_seri, ql_seri, qs_seri, u_seri, v_seri, zphi, &
                 ue, ve, uq, vq, uwat, vwat)

    !IM global posePB BEG
    IF(1==0) THEN

       CALL transp_lay (paprs,zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, &
            ve_lay, vq_lay, ue_lay, uq_lay)

    ENDIF !(1.EQ.0) THEN
    !IM global posePB END

    ! Accumuler les variables a stocker dans les fichiers histoire:

    !================================================================
    ! Conversion of kinetic and potential energy into heat, for
    ! parameterisation of subgrid-scale motions
    !================================================================

    d_t_ec(:,:)=0.
    forall (k=1: nbp_lev) exner(:, k) = (pplay(:, k)/paprs(:,1))**RKAPPA
    CALL ener_conserv(klon,klev,pdtphys,u,v,t,qx,ivap,iliq,isol, &
         u_seri,v_seri,t_seri,q_seri,ql_seri,qs_seri,pbl_tke(:,:,is_ave)-tke0(:,:), &
         zmasse,exner,d_t_ec)
    t_seri(:,:)=t_seri(:,:)+d_t_ec(:,:)

    !==================================================================
    !--OB water mass fixer for the physics
    !--water profiles are corrected to force mass conservation of water
    !--currently flag is turned off
    !==================================================================
    IF (mass_fixer) THEN
#ifdef ISO
      CALL abort_gcm('physiq 6936','isos pas prevus dans le mass fixer',1)
      ! Camille Risi mai 2024: on attend d'avoir la 4e dimension qui rendra tout plus simple.
#endif
    qql2(:)=0.0
    DO k = 1, klev
      qql2(:)=qql2(:)+(q_seri(:,k)+ql_seri(:,k))*zmasse(:,k)
      IF (nqo >= 3) THEN
        qql2(:)=qql2(:)+qs_seri(:,k)*zmasse(:,k)
      ENDIF
      IF (ok_bs) THEN
        qql2(:)=qql2(:)+qbs_seri(:,k)*zmasse(:,k)
      ENDIF
    ENDDO

IF (CPPKEY_STRATER) THEN
    IF (ok_qemiss) THEN
       DO k = 1, klev
          qql1(:) = qql1(:)+d_q_emiss(:,k)*zmasse(:,k)
       ENDDO
    ENDIF
END IF
    IF (ok_qch4) THEN
       DO k = 1, klev
          qql1(:) = qql1(:)+d_q_ch4_dtime(:,k)*zmasse(:,k)
       ENDDO
    ENDIF
    
    DO i = 1, klon
      !--compute ratio of what q+ql should be with conservation to what it is
      IF (ok_bs) THEN
        corrqql=(qql1(i)+(evap(i)-rain_fall(i)-snow_fall(i)-bs_fall(i))*pdtphys)/qql2(i)
      ELSE
        corrqql=(qql1(i)+(evap(i)-rain_fall(i)-snow_fall(i))*pdtphys)/qql2(i)
      ENDIF
      DO k = 1, klev
        q_seri(i,k) =q_seri(i,k)*corrqql
        ql_seri(i,k)=ql_seri(i,k)*corrqql
        IF (nqo >= 3) THEN
          qs_seri(i,k)=qs_seri(i,k)*corrqql
        ENDIF
        IF (ok_bs) THEN
          qbs_seri(i,k)=qbs_seri(i,k)*corrqql
        ENDIF
      ENDDO
    ENDDO
    ENDIF
    !--fin mass fixer

    !cc prw  = eau precipitable
    !   prlw = colonne eau liquide 
    !   prlw = colonne eau solide
    !   prbsw = colonne neige soufflee
    !   water_budget = non-conservation residual from the LMDZ physics
    !                  (should be equal to machine precision if mass fixer is activated)
    prw(:) = 0.
    prlw(:) = 0.
    prsw(:) = 0.
    prbsw(:) = 0.
    water_budget(:) = 0.0
    DO k = 1, klev
       prw(:)  = prw(:)  + q_seri(:,k)*zmasse(:,k)
       prlw(:) = prlw(:) + ql_seri(:,k)*zmasse(:,k)
       water_budget(:) = water_budget(:) + (q_seri(:,k)-qx(:,k,ivap)+ql_seri(:,k)-qx(:,k,iliq))*zmasse(:,k)
       IF (nqo >= 3) THEN
         prsw(:) = prsw(:) + qs_seri(:,k)*zmasse(:,k)
         water_budget(:) = water_budget(:) + (qs_seri(:,k)-qx(:,k,isol))*zmasse(:,k)
       ENDIF
       IF (nqo >= 4 .AND. ok_bs) THEN
         prbsw(:)= prbsw(:) + qbs_seri(:,k)*zmasse(:,k)
         water_budget(:) = water_budget(:) + (qbs_seri(:,k)-qx(:,k,ibs))*zmasse(:,k)
       ENDIF
    ENDDO
    water_budget(:)=water_budget(:)+(rain_fall(:)+snow_fall(:)-evap(:))*pdtphys
    IF (ok_bs) THEN
      water_budget(:)=water_budget(:)+bs_fall(:)*pdtphys
    ENDIF
    ! Camille Risi mai 2024: pour les isotopes, on attend d'avoir la 4e dimension, ça rendra tout plus facile
    ! ces variables sont diagnostiques, donc pas indispensables

    !=======================================================================
    !   SORTIES
    !=======================================================================

    !IM initialisation + calculs divers diag AMIP2

    include "calcul_divers.h"

    !IM Interpolation sur les niveaux de pression du NMC
    !   -------------------------------------------------

    include "calcul_STDlev.h"

    ! slp sea level pressure derived from Arpege-IFS : CALL ctstar + CALL pppmer
    CALL diag_slp(klon,t_seri,paprs,pplay,pphis,ptstar,pt0,slp)


    IF (ANY(type_trac == ['inca','inco'])) THEN
IF (CPPKEY_INCA) THEN
       CALL VTe(VTphysiq)
       CALL VTb(VTinca)

       CALL chemhook_end ( &
            phys_tstep, &
            pplay, &
            t_seri, &
            tr_seri(:,:,1+nqCO2:nbtr), &
            nbtr, &
            paprs, &
            q_seri, &
            cell_area, &
            pphi, &
            pphis, &
            zx_rh, &
            aps, bps, ap, bp, lafin)

       CALL VTe(VTinca)
       CALL VTb(VTphysiq)
END IF
    ENDIF

    IF (type_trac == 'repr') THEN
#ifdef REPROBUS
        CALL coord_hyb_rep(paprs, pplay, aps, bps, ap, bp, cell_area)
#endif
    ENDIF

    ! Convertir les incrementations en tendances

    IF (prt_level >=10) THEN
       print *,'Convertir les incrementations en tendances '
    ENDIF

    IF (mydebug) THEN
       CALL writefield_phy('u_seri',u_seri,nbp_lev)
       CALL writefield_phy('v_seri',v_seri,nbp_lev)
       CALL writefield_phy('t_seri',t_seri,nbp_lev)
       CALL writefield_phy('q_seri',q_seri,nbp_lev)
    ENDIF

    DO k = 1, klev
       DO i = 1, klon
          d_u(i,k) = ( u_seri(i,k) - u(i,k) ) / phys_tstep
          d_v(i,k) = ( v_seri(i,k) - v(i,k) ) / phys_tstep
          d_t(i,k) = ( t_seri(i,k)-t(i,k) ) / phys_tstep
          d_qx(i,k,ivap) = ( q_seri(i,k) - qx(i,k,ivap) ) / phys_tstep
          d_qx(i,k,iliq) = ( ql_seri(i,k) - qx(i,k,iliq) ) / phys_tstep
          !CR: on ajoute le contenu en glace
          IF (nqo >= 3) THEN
             d_qx(i,k,isol) = ( qs_seri(i,k) - qx(i,k,isol) ) / phys_tstep
          ENDIF
          !--ice_sursat: nqo=4, on ajoute rneb
          IF (nqo>=4 .and. ok_ice_sursat) THEN
             d_qx(i,k,irneb) = ( rneb_seri(i,k) - qx(i,k,irneb) ) / phys_tstep
          ENDIF

           IF (nqo>=4 .and. ok_bs) THEN
             d_qx(i,k,ibs) = ( qbs_seri(i,k) - qx(i,k,ibs) ) / phys_tstep
          ENDIF


       ENDDO
    ENDDO

    ! C Risi: dispatcher les isotopes dans les xt_seri
#ifdef ISO
    do ixt=1,ntraciso
      DO k = 1, klev
       DO i = 1, klon
          iq=iqIsoPha(ixt,ivap)
          d_qx(i,k,iq) = ( xt_seri(ixt,i,k) - qx(i,k,iq) ) / phys_tstep
          iq=iqIsoPha(ixt,iliq)
          d_qx(i,k,iq) = ( xtl_seri(ixt,i,k) - qx(i,k,iq) ) / phys_tstep
          if (nqo.eq.3) then
             iq=iqIsoPha(ixt,isol)
             d_qx(i,k,iq) = ( xts_seri(ixt,i,k) - qx(i,k,iq) ) / phys_tstep
          endif
       enddo !DO i = 1, klon
      enddo ! DO k = 1, klev
    enddo !do ixt=1,ntraciso
#endif
    ! DC: All iterations are cycled if nqtot==nqo, so no nqtot>nqo condition required
    itr = 0
    DO iq = 1, nqtot
       IF(.NOT.tracers(iq)%isInPhysics) CYCLE
       itr = itr+1
       DO  k = 1, klev
          DO  i = 1, klon
             d_qx(i,k,iq) = ( tr_seri(i,k,itr) - qx(i,k,iq) ) / phys_tstep
          ENDDO
       ENDDO
    ENDDO

    !IM rajout diagnostiques bilan KP pour analyse MJO par Jun-Ichi Yano
    !IM global posePB      include "write_bilKP_ins.h"
    !IM global posePB      include "write_bilKP_ave.h"

    ! Sauvegarder les valeurs de t et q a la fin de la physique:

    u_ancien(:,:)  = u_seri(:,:)
    v_ancien(:,:)  = v_seri(:,:)
    t_ancien(:,:)  = t_seri(:,:)
    q_ancien(:,:)  = q_seri(:,:)
    ql_ancien(:,:) = ql_seri(:,:)
    qs_ancien(:,:) = qs_seri(:,:)
    qbs_ancien(:,:) = qbs_seri(:,:)
    rneb_ancien(:,:) = rneb_seri(:,:)
#ifdef ISO
    xt_ancien(:,:,:)=xt_seri(:,:,:)
    xtl_ancien(:,:,:)=xtl_seri(:,:,:)
    xts_ancien(:,:,:)=xts_seri(:,:,:)
    xtbs_ancien(:,:,:)=xtbs_seri(:,:,:)
#endif
    CALL water_int(klon,klev,q_ancien,zmasse,prw_ancien)
    CALL water_int(klon,klev,ql_ancien,zmasse,prlw_ancien)
    CALL water_int(klon,klev,qs_ancien,zmasse,prsw_ancien)
    CALL water_int(klon,klev,qbs_ancien,zmasse,prbsw_ancien)
    ! !! RomP >>>
    IF (nqtot > nqo) tr_ancien(:,:,:) = tr_seri(:,:,:)
    ! !! RomP <<<
    !==========================================================================
    ! Sorties des tendances pour un point particulier
    ! a utiliser en 1D, avec igout=1 ou en 3D sur un point particulier
    ! pour le debug
    ! La valeur de igout est attribuee plus haut dans le programme
    !==========================================================================

    IF (prt_level>=1) THEN
       write(lunout,*) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
       write(lunout,*) &
            'nlon,klev,nqtot,debut,lafin,jD_cur, jH_cur, pdtphys pct tlos'
       write(lunout,*) &
            nlon,klev,nqtot,debut,lafin, jD_cur, jH_cur ,pdtphys, &
            pctsrf(igout,is_ter), pctsrf(igout,is_lic),pctsrf(igout,is_oce), &
            pctsrf(igout,is_sic)
       write(lunout,*) 'd_t_dyn,d_t_con,d_t_lsc,d_t_ajsb,d_t_ajs,d_t_eva'
       DO k=1,klev
          write(lunout,*) d_t_dyn(igout,k),d_t_con(igout,k), &
               d_t_lsc(igout,k),d_t_ajsb(igout,k),d_t_ajs(igout,k), &
               d_t_eva(igout,k)
       ENDDO
       write(lunout,*) 'cool,heat'
       DO k=1,klev
          write(lunout,*) cool(igout,k),heat(igout,k)
       ENDDO

       !jyg<     (En attendant de statuer sur le sort de d_t_oli)
       !jyg!     write(lunout,*) 'd_t_oli,d_t_vdf,d_t_oro,d_t_lif,d_t_ec'
       !jyg!     do k=1,klev
       !jyg!        write(lunout,*) d_t_oli(igout,k),d_t_vdf(igout,k), &
       !jyg!             d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
       !jyg!     enddo
       write(lunout,*) 'd_t_vdf,d_t_oro,d_t_lif,d_t_ec'
       DO k=1,klev
          write(lunout,*) d_t_vdf(igout,k), &
               d_t_oro(igout,k),d_t_lif(igout,k),d_t_ec(igout,k)
       ENDDO
       !>jyg

       write(lunout,*) 'd_ps ',d_ps(igout)
       write(lunout,*) 'd_u, d_v, d_t, d_qx1, d_qx2 '
       DO k=1,klev
          write(lunout,*) d_u(igout,k),d_v(igout,k),d_t(igout,k), &
               d_qx(igout,k,1),d_qx(igout,k,2)
       ENDDO
    ENDIF

    !============================================================
    !   Calcul de la temperature potentielle
    !============================================================
    DO k = 1, klev
       DO i = 1, klon
          !JYG/IM theta en debut du pas de temps
          !JYG/IM       theta(i,k)=t(i,k)*(100000./pplay(i,k))**(RD/RCPD)
          !JYG/IM theta en fin de pas de temps de physique
          theta(i,k)=t_seri(i,k)*(100000./pplay(i,k))**(RD/RCPD)
          ! thetal: 2 lignes suivantes a decommenter si vous avez les fichiers
          !     MPL 20130625
          ! fth_fonctions.F90 et parkind1.F90
          ! sinon thetal=theta
          !       thetal(i,k)=fth_thetal(pplay(i,k),t_seri(i,k),q_seri(i,k),
          !    :         ql_seri(i,k))
          thetal(i,k)=theta(i,k)
       ENDDO
    ENDDO

    ! 22.03.04 BEG
    !=============================================================
    !   Ecriture des sorties
    !=============================================================
#ifdef CPP_IOIPSL

    ! Recupere des varibles calcule dans differents modules
    ! pour ecriture dans histxxx.nc 

    ! Get some variables from module fonte_neige_mod
    CALL fonte_neige_get_vars(pctsrf,  &
         zxfqcalving, zxfqfonte, zxffonte, zxrunofflic &
#ifdef ISO     
        ,zxfxtcalving, zxfxtfonte,zxxtrunofflic &
#endif     
        )


    !=============================================================
    ! Separation entre thermiques et non thermiques dans les sorties
    ! de fisrtilp
    !=============================================================

    IF (iflag_thermals>=1) THEN
       d_t_lscth=0.
       d_t_lscst=0.
       d_q_lscth=0.
       d_q_lscst=0.
       DO k=1,klev
          DO i=1,klon
             IF (ptconvth(i,k)) THEN
                d_t_lscth(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
                d_q_lscth(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
             ELSE
                d_t_lscst(i,k)=d_t_eva(i,k)+d_t_lsc(i,k)
                d_q_lscst(i,k)=d_q_eva(i,k)+d_q_lsc(i,k)
             ENDIF
          ENDDO
       ENDDO

       DO i=1,klon
          plul_st(i)=prfl(i,lmax_th(i)+1)+psfl(i,lmax_th(i)+1)
          plul_th(i)=prfl(i,1)+psfl(i,1)
       ENDDO
    ENDIF

    !On effectue les sorties:

IF (CPPKEY_DUST) THEN
  CALL phys_output_write_spl(itap, pdtphys, paprs, pphis,  &
       pplay, lmax_th, aerosol_couple,                 &
       ok_ade, ok_aie, ivap, ok_sync,                  &
       ptconv, read_climoz, clevSTD,                   &
       ptconvth, d_t, qx, d_qx, d_tr_dyn, zmasse,      &
       flag_aerosol, flag_aerosol_strat, ok_cdnc)
ELSE
    CALL phys_output_write(itap, pdtphys, paprs, pphis,  &
         pplay, lmax_th, aerosol_couple,                 &
         ok_ade, ok_aie, ok_volcan, ivap, iliq, isol, ibs,   & 
         ok_sync, ptconv, read_climoz, clevSTD,          &
         ptconvth, d_u, d_t, qx, d_qx, zmasse,           &
         flag_aerosol, flag_aerosol_strat, ok_cdnc,t, u1, v1)
END IF

    IF (.NOT. using_xios) THEN
      CALL write_paramLMDZ_phy(itap,nid_ctesGCM,ok_sync)
END IF

#endif
    ! Petit appelle de sorties pour accompagner le travail sur phyex
    if ( iflag_physiq == 1 ) then
        call output_physiqex(debut,jD_eq,pdtphys,presnivs,paprs,u,v,t,qx,cldfra,0.*t,0.*t,0.*t,pbl_tke,theta)
    endif

    !====================================================================
    ! Arret du modele apres hgardfou en cas de detection d'un
    ! plantage par hgardfou
    !====================================================================

    IF (abortphy==1) THEN
       abort_message ='Plantage hgardfou'
       CALL abort_physic (modname,abort_message,1)
    ENDIF

    ! 22.03.04 END

    !====================================================================
    ! Si c'est la fin, il faut conserver l'etat de redemarrage
    !====================================================================

#ifdef ISO   
#ifdef ISOVERIF
if (iso_HDO.gt.0) then
      call iso_verif_aberrant_enc_vect2D( &
                 xt_ancien,q_ancien, &
                 'physiq 6577',ntraciso,klon,klev)
endif
         write(*,*) 'physiq 3731: verif avant phyisoredem'    
         do k=1,klev
          do i=1,klon
            if (iso_eau.gt.0) then
               call iso_verif_egalite_choix(xt_ancien(iso_eau,i,k), &
                 q_ancien(i,k),'physiq 3728: avant phyisoredem', &
                 errmax,errmaxrel)
            endif ! if (iso_eau.gt.0) then
#ifdef ISOTRAC
            IF(nzone > 0) CALL iso_verif_traceur(xt_ancien(1,i,k),'physiq 4802')
#endif          
          enddo
         enddo !do k=1,klev
#endif         
#endif
! ISO

    ! Disabling calls to the prt_alerte function
    alert_first_call = .FALSE.

    
    IF (lafin) THEN
       itau_phy = itau_phy + itap
       CALL phyredem ("restartphy.nc")
       !         open(97,form="unformatted",file="finbin")
       !         write(97) u_seri,v_seri,t_seri,q_seri
       !         close(97)
      
       IF (is_omp_master) THEN
       
         IF (read_climoz >= 1) THEN
           IF (is_mpi_root) CALL nf95_close(ncid_climoz)
            DEALLOCATE(press_edg_climoz)
            DEALLOCATE(press_cen_climoz)
         ENDIF
       
       ENDIF

       IF (using_xios) THEN

IF (CPPKEY_INCA) THEN
          IF (type_trac == 'inca') THEN 
             IF (is_omp_master .AND. grid_type==unstructured) THEN 
                CALL finalize_inca
             ENDIF
          ENDIF
END IF

          IF (is_omp_master .and. grid_type==unstructured) CALL xios_context_finalize
       ENDIF

       WRITE(lunout,*) ' physiq fin, nombre de steps ou cvpas = 1 : ', Ncvpaseq1
       
    ENDIF

    !      first=.false.

  END SUBROUTINE physiq

END MODULE physiq_mod
