!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!MNH_LIC for details. version 1.
!-----------------------------------------------------------------
!     ###########################
      MODULE MODI_ADVECTION_METSV
!     ###########################
!
INTERFACE
      SUBROUTINE ADVECTION_METSV (HLUOUT, HFMFILE, OCLOSE_OUT,HUVW_ADV_SCHEME, &
                            HMET_ADV_SCHEME,HSV_ADV_SCHEME, HCLOUD, KSPLIT,    &
                            OSPLIT_CFL, PSPLIT_CFL, OCFL_WRIT,                 &
                            HLBCX, HLBCY, KRR, KSV, KTCOUNT, PTSTEP,           &
                            PUT, PVT, PWT, PTHT, PRT, PTKET, PSVT, PPABST,     &
                            PTHVREF, PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY,     &
                            PRTHS, PRRS, PRTKES, PRSVS,                        &
                            PRTHS_CLD, PRRS_CLD, PRSVS_CLD, PRTKES_ADV,PRKE_IBM)
!
LOGICAL,                INTENT(IN)   ::  OCLOSE_OUT   ! switch for syncronous
                                                      ! file opening
CHARACTER(LEN=*),       INTENT(IN)   ::  HFMFILE      ! Name of the output
                                                      ! FM-file
CHARACTER(LEN=*),       INTENT(IN)   ::  HLUOUT       ! Output-listing name for
                                                      ! model n
CHARACTER(LEN=6),       INTENT(IN)   :: HMET_ADV_SCHEME, & ! Control of the 
                                        HSV_ADV_SCHEME, &  ! scheme applied 
                                        HUVW_ADV_SCHEME
CHARACTER (LEN=4),      INTENT(IN)   :: HCLOUD      ! Kind of cloud parameterization
!
INTEGER,                INTENT(INOUT):: KSPLIT       ! Number of time splitting
                                                     ! for PPM advection
LOGICAL,                INTENT(IN)   :: OSPLIT_CFL   ! flag to automatically chose number of iterations
REAL,                   INTENT(IN)   :: PSPLIT_CFL   ! maximum CFL to automatically chose number of iterations
LOGICAL,                INTENT(IN)   :: OCFL_WRIT    ! flag to write CFL fields in output files            
!
CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY  ! X- and Y-direc LBC
!
INTEGER,                  INTENT(IN)    :: KRR  ! Number of moist variables
INTEGER,                  INTENT(IN)    :: KSV  ! Number of Scalar Variables
!
INTEGER,                  INTENT(IN)    :: KTCOUNT
REAL,                     INTENT(IN)    :: PTSTEP
!
REAL, DIMENSION(:,:,:),   INTENT(IN)    :: PUT , PVT  , PWT
REAL, DIMENSION(:,:,:),   INTENT(IN)    :: PTHT, PTKET, PRHODJ
REAL, DIMENSION(:,:,:,:), INTENT(IN)    :: PRT , PSVT
REAL, DIMENSION(:,:,:),   INTENT(IN)    :: PPABST 
                                                  ! Variables at t
REAL, DIMENSION(:,:,:),   INTENT(IN)    :: PTHVREF   ! Virtual Temperature
                                          ! of the reference state
REAL, DIMENSION(:,:,:),   INTENT(IN)    :: PDXX,PDYY,PDZZ,PDZX,PDZY
                                                  !  metric coefficients
REAL, DIMENSION(:,:,:),   INTENT(INOUT) :: PRTHS, PRTKES
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS , PRSVS
                                                  ! Sources terms 
REAL, DIMENSION(:,:,:),   INTENT(IN)    :: PRTHS_CLD, PRKE_IBM
REAL, DIMENSION(:,:,:,:), INTENT(IN)    :: PRRS_CLD,PRSVS_CLD
REAL, DIMENSION(:,:,:),   INTENT(OUT)   :: PRTKES_ADV  ! Advection TKE source term 
!
END SUBROUTINE ADVECTION_METSV
!
END INTERFACE
!
END MODULE MODI_ADVECTION_METSV
!     ##########################################################################
      SUBROUTINE ADVECTION_METSV (HLUOUT, HFMFILE, OCLOSE_OUT,HUVW_ADV_SCHEME, &
                            HMET_ADV_SCHEME,HSV_ADV_SCHEME, HCLOUD,KSPLIT,     &
                            OSPLIT_CFL, PSPLIT_CFL, OCFL_WRIT,                 &
                            HLBCX, HLBCY, KRR, KSV, KTCOUNT, PTSTEP,           &
                            PUT, PVT, PWT, PTHT, PRT, PTKET, PSVT, PPABST,     &
                            PTHVREF, PRHODJ, PDXX, PDYY, PDZZ, PDZX, PDZY,     &
                            PRTHS, PRRS, PRTKES, PRSVS,                        &
                            PRTHS_CLD, PRRS_CLD, PRSVS_CLD, PRTKES_ADV,PRKE_IBM)
!     ##########################################################################
!
!!****  *ADVECTION_METSV * - routine to call the specialized advection routines
!!
!!    PURPOSE
!!    -------
!!      The purpose of this routine is to control the advection routines.
!!    For that, it is first necessary to compute the metric coefficients
!!    and the contravariant components of the momentum.
!!
!!**  METHOD
!!    ------
!!      Once the scheme is selected, it is applied to the following group of
!!    variables: METeorologicals (temperature, water substances, TKE,
!!    dissipation TKE) and Scalar Variables. It is possible to select different
!!    advection schemes for each group of variables.
!!
!!    EXTERNAL
!!    --------
!!      CONTRAV              : computes the contravariant components.
!!      ADVECUVW             : computes the advection terms for momentum.
!!      ADVECSCALAR          : computes the advection terms for scalar fields.
!!      ADD3DFIELD_ll        : add a field to 3D-list
!!      ADVEC_4TH_ORDER      : 4th order advection scheme
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      NONE
!!
!!    REFERENCE
!!    ---------
!!      Book1 and book2 ( routine ADVECTION )
!!
!!    AUTHOR
!!    ------
!!	J.-P. Pinty      * Laboratoire d'Aerologie*
!!	J.-P. Lafore     * Meteo France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    06/07/94 
!!                  01/04/95 (Ph. Hereil J. Nicolau) add the model number
!!                  23/10/95 (J. Vila and JP Lafore) advection schemes scalar
!!                  16/01/97 (JP Pinty)              change presentation 
!!                  30/04/98 (J. Stein P Jabouille)  extrapolation for the cyclic
!!                                                   case and parallelisation
!!                  24/06/99 (P Jabouille)           case of NHALO>1
!!                  25/10/05 (JP Pinty)              4th order scheme
!!                  24/04/06 (C.Lac)                 Split scalar and passive
!!                                                   tracer routines
!!                  08/06    (T.Maric)               PPM scheme
!!                  04/2011  (V.Masson & C. Lac)     splits the routine and add time splitting
!!                  04/2014  (C.Lac)                 adaptation of time
!!                                                   splitting for L1D and L2D
!!                  09/2014  (G.Delautier)              close OUTPUT_LISTING before STOP
!!                  04/2015  (J.Escobar) remove/commente some NHALO=1 test
!!                  J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 
!!                  J.Escobar : 01/10/2015 : add computation of CFL for L1D case
!!
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_IBM_PARAM_n                                                                               !===> FA
!
USE MODE_FM
USE MODE_ll
USE MODE_IO_ll
USE MODD_PARAM_n
USE MODD_CONF,  ONLY : LNEUTRAL,NHALO,L1D, L2D,CCONF
USE MODD_CTURB, ONLY : XTKEMIN
USE MODD_BUDGET
!
USE MODI_CONTRAV
USE MODI_PPM_RHODJ
USE MODI_PPM_MET
USE MODI_PPM_SCALAR
USE MODI_ADV_BOUNDARIES
USE MODI_BUDGET
!
USE MODE_FMWRIT
USE MODD_REF_n,           ONLY: XRHODJ,XRHODREF
USE MODD_CST 
USE MODI_GET_HALO
!-------------------------------------------------------------------------------
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
LOGICAL,                INTENT(IN)   ::  OCLOSE_OUT   ! switch for syncronous
                                                      ! file opening
CHARACTER(LEN=*),       INTENT(IN)   ::  HFMFILE      ! Name of the output
                                                      ! FM-file
CHARACTER(LEN=*),       INTENT(IN)   ::  HLUOUT       ! Output-listing name for
                                                      ! model n
CHARACTER(LEN=6),       INTENT(IN)   :: HMET_ADV_SCHEME, & ! Control of the 
                                        HSV_ADV_SCHEME, &  ! scheme applied 
                                        HUVW_ADV_SCHEME
CHARACTER (LEN=4),      INTENT(IN)   :: HCLOUD      ! Kind of cloud parameterization
!
INTEGER,                INTENT(INOUT):: KSPLIT       ! Number of time splitting
                                                     ! for PPM advection
LOGICAL,                INTENT(IN)   :: OSPLIT_CFL   ! flag to automatically chose number of iterations
REAL,                   INTENT(IN)   :: PSPLIT_CFL   ! maximum CFL to automatically chose number of iterations
LOGICAL,                INTENT(IN)   :: OCFL_WRIT    ! flag to write CFL fields in output files            
!
CHARACTER(LEN=4),DIMENSION(2),INTENT(IN):: HLBCX, HLBCY  ! X- and Y-direc LBC
!
INTEGER,                  INTENT(IN)    :: KRR  ! Number of moist variables
INTEGER,                  INTENT(IN)    :: KSV  ! Number of Scalar Variables
!
INTEGER,                  INTENT(IN)    :: KTCOUNT
REAL,                     INTENT(IN)    :: PTSTEP
!
REAL, DIMENSION(:,:,:),   INTENT(IN)    :: PUT , PVT  , PWT
REAL, DIMENSION(:,:,:),   INTENT(IN)    :: PTHT, PTKET, PRHODJ
REAL, DIMENSION(:,:,:,:), INTENT(IN)    :: PRT , PSVT
REAL, DIMENSION(:,:,:),   INTENT(IN)    :: PPABST 
                                                  ! Variables at t
REAL, DIMENSION(:,:,:),   INTENT(IN)    :: PTHVREF   ! Virtual Temperature
                                          ! of the reference state
REAL, DIMENSION(:,:,:),   INTENT(IN)    :: PDXX,PDYY,PDZZ,PDZX,PDZY
                                                  !  metric coefficients
REAL, DIMENSION(:,:,:),   INTENT(INOUT) :: PRTHS, PRTKES
REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRRS , PRSVS
                                                  ! Sources terms 
REAL, DIMENSION(:,:,:),   INTENT(IN)    :: PRTHS_CLD, PRKE_IBM
REAL, DIMENSION(:,:,:,:), INTENT(IN)    :: PRRS_CLD, PRSVS_CLD
REAL, DIMENSION(:,:,:),   INTENT(OUT)   :: PRTKES_ADV  ! Advection TKE source term 
!
!
!*       0.2   declarations of local variables
!
!
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRUCPPM!,ZRUCPP2
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRVCPPM!,ZRVCPP2
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRWCPPM!,ZRWCPP2
                                                  ! contravariant
                                                  ! components
                                                  ! of momentum
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCFLU
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCFLV
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCFLW
!                                                 ! CFL numbers on each direction
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZCFL
!                                                 ! CFL number
!
REAL :: ZCFLU_MAX, ZCFLV_MAX, ZCFLW_MAX, ZCFL_MAX ! maximum CFL numbers
!
REAL, DIMENSION(SIZE(PTHT,1), SIZE(PTHT,2), SIZE(PTHT,3) ) :: ZTH
REAL, DIMENSION(SIZE(PTKET,1),SIZE(PTKET,2),SIZE(PTKET,3)) :: ZTKE
REAL, DIMENSION(SIZE(PTHT,1), SIZE(PTHT,2), SIZE(PTHT,3) ) :: ZRTHS_OTHER
REAL, DIMENSION(SIZE(PTKET,1),SIZE(PTKET,2),SIZE(PTKET,3)) :: ZRTKES_OTHER
REAL, DIMENSION(SIZE(PTHT,1), SIZE(PTHT,2), SIZE(PTHT,3) ) :: ZRTHS_PPM
REAL, DIMENSION(SIZE(PTKET,1),SIZE(PTKET,2),SIZE(PTKET,3)) :: ZRTKES_PPM
REAL, DIMENSION(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3), SIZE(PRT,4) ) :: ZR
REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)) :: ZSV
! Guess at the sub time step
REAL, DIMENSION(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3), SIZE(PRT,4) ) :: ZRRS_OTHER
REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)) :: ZRSVS_OTHER
! Tendencie since the beginning of the time step
REAL, DIMENSION(SIZE(PRT,1), SIZE(PRT,2), SIZE(PRT,3), SIZE(PRT,4) ) :: ZRRS_PPM
REAL, DIMENSION(SIZE(PSVT,1),SIZE(PSVT,2),SIZE(PSVT,3),SIZE(PSVT,4)) :: ZRSVS_PPM
! Guess at the end of the sub time step
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRHOX1
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRHOY1
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)) :: ZRHOZ1
REAL, DIMENSION(SIZE(PUT,1),SIZE(PUT,2),SIZE(PUT,3)):: ZT,ZEXN,ZLV,ZLS,ZCPH
! Temporary advected rhodj for PPM routines
!
INTEGER :: JS,JR,JSV,JSPL  ! Loop index
REAL    :: ZTSTEP_PPM ! Sub Time step 
LOGICAL :: GTKE
!
INTEGER                     :: IINFO_ll    ! return code of parallel routine
TYPE(LIST_ll), POINTER      :: TZFIELDS0_ll ! list of fields to exchange
TYPE(LIST_ll), POINTER      :: TZFIELDS1_ll ! list of fields to exchange
!
!
INTEGER             :: IRESP        ! Return code of FM routines
INTEGER             :: IGRID        ! C-grid indicator in LFIFM file
INTEGER             :: ILENCH       ! Length of comment string in LFIFM file
CHARACTER (LEN=100) :: YCOMMENT     ! comment string in LFIFM file
CHARACTER (LEN=16)  :: YRECFM       ! Name of the desired field in LFIFM file
INTEGER             :: ILUOUT       ! logical unit
INTEGER             :: ISPLIT_PPM   ! temporal time splitting 
INTEGER         :: IIB, IIE, IJB, IJE, IKU
!-------------------------------------------------------------------------------
!
!*       0.     INITIALIZATION                        
!	        --------------
!
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
!
GTKE=(SIZE(PTKET)/=0)
!
!-------------------------------------------------------------------------------
!
!*       2.     COMPUTES THE CONTRAVARIANT COMPONENTS (FOR PPM ONLY)
!	        --------------------------------------
!
!*       2.1 computes contravariant components
!
IF (HUVW_ADV_SCHEME=='CEN2ND' ) THEN
 CALL CONTRAV (HLBCX,HLBCY,PUT,PVT,PWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCPPM,ZRVCPPM,ZRWCPPM,2)
ELSE
 CALL CONTRAV (HLBCX,HLBCY,PUT,PVT,PWT,PDXX,PDYY,PDZZ,PDZX,PDZY,ZRUCPPM,ZRVCPPM,ZRWCPPM,4)
END IF
!
!
!*       2.2 computes CFL numbers
!

IF (.NOT. L1D) THEN
  ZCFLU = 0.0 ; ZCFLV = 0.0 ;  ZCFLW = 0.0
  ZCFLU(IIB:IIE,IJB:IJE,:) = ABS(ZRUCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
  ZCFLV(IIB:IIE,IJB:IJE,:) = ABS(ZRVCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
  ZCFLW(IIB:IIE,IJB:IJE,:) = ABS(ZRWCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
  IF (LIBM) THEN
    ZCFLU(IIB:IIE,IJB:IJE,:) = ZCFLU(IIB:IIE,IJB:IJE,:)*(1.-exp(-(XIBM_LS(IIB:IIE,IJB:IJE,:,2)/(XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:))**(1./3.))**2.))
    ZCFLV(IIB:IIE,IJB:IJE,:) = ZCFLV(IIB:IIE,IJB:IJE,:)*(1.-exp(-(XIBM_LS(IIB:IIE,IJB:IJE,:,3)/(XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:))**(1./3.))**2.))
    ZCFLW(IIB:IIE,IJB:IJE,:) = ZCFLW(IIB:IIE,IJB:IJE,:)*(1.-exp(-(XIBM_LS(IIB:IIE,IJB:IJE,:,4)/(XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:))**(1./3.))**2.))
    WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,2).GT.(-0.00*(XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:))**(1./3.))) ZCFLU(IIB:IIE,IJB:IJE,:)=0.
    WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,3).GT.(-0.00*(XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:))**(1./3.))) ZCFLV(IIB:IIE,IJB:IJE,:)=0.
    WHERE (XIBM_LS(IIB:IIE,IJB:IJE,:,4).GT.(-0.00*(XRHODJ(IIB:IIE,IJB:IJE,:)/XRHODREF(IIB:IIE,IJB:IJE,:))**(1./3.))) ZCFLW(IIB:IIE,IJB:IJE,:)=0.
  ENDIF
  IF (.NOT. L2D) THEN
    ZCFL  = SQRT(ZCFLU**2+ZCFLV**2+ZCFLW**2)
  ELSE
    ZCFL  = SQRT(ZCFLU**2+ZCFLW**2)
  END IF
ELSE
   ZCFLU = 0.0 ; ZCFLV = 0.0 ;  ZCFLW = 0.0 
   ZCFLW(IIB:IIE,IJB:IJE,:) = ABS(ZRWCPPM(IIB:IIE,IJB:IJE,:) * PTSTEP)
   ZCFL = SQRT(ZCFLW**2)
END IF
!
!* prints in the file the 3D Courant numbers (one should flag this)
!
IF (OCLOSE_OUT .AND. OCFL_WRIT .AND. (.NOT. L1D)) THEN
    YRECFM  ='CFLU'
    YCOMMENT='X_Y_Z_CFLU (-)'
    IGRID   = 1
    ILENCH=LEN(YCOMMENT)
    CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZCFLU,IGRID,ILENCH,YCOMMENT,IRESP)

    YRECFM  ='CFLV'
    YCOMMENT='X_Y_Z_CFLV (-)'
    IGRID   = 1
    ILENCH=LEN(YCOMMENT)
    CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZCFLV,IGRID,ILENCH,YCOMMENT,IRESP)

    YRECFM  ='CFLW'
    YCOMMENT='X_Y_Z_CFLW (-)'
    IGRID   = 1
    ILENCH=LEN(YCOMMENT)
    CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZCFLW,IGRID,ILENCH,YCOMMENT,IRESP)

    YRECFM  ='CFL'
    YCOMMENT='X_Y_Z_CFL  (-)'
    IGRID   = 1
    ILENCH=LEN(YCOMMENT)
    CALL FMWRIT(HFMFILE,YRECFM,HLUOUT,'XY',ZCFL,IGRID,ILENCH,YCOMMENT,IRESP)
END IF
!
!* prints in the output file the maximum CFL
!
CALL FMLOOK_ll(HLUOUT,HLUOUT,ILUOUT,IRESP)
!
ZCFLU_MAX = MAX_ll(ZCFLU,IINFO_ll)
ZCFLV_MAX = MAX_ll(ZCFLV,IINFO_ll)
ZCFLW_MAX = MAX_ll(ZCFLW,IINFO_ll)
ZCFL_MAX  = MAX_ll(ZCFL,IINFO_ll)
IF (LIBM) THEN
  XIBM_CFL = ZCFL_MAX
  !IF (CCONF=='START'.AND.KTCOUNT<20) XIBM_CFL = -1.
  !for a local use of wen3 if cfl>1.2
ENDIF
! 
IF (ZCFL_MAX>1.2.OR.mod(KTCOUNT-1,25)==0) THEN
WRITE(ILUOUT,FMT='(A24,F10.2,A5,F10.2,A5,F10.2,A9,F10.2)') &
                'Max. CFL number for U : ',ZCFLU_MAX,  &
                '  V : ',ZCFLV_MAX,'  W : ', ZCFLW_MAX,&
                'global : ',ZCFL_MAX
ENDIF
!
!
!*       2.3 updates time step splitting loop
!
IF (OSPLIT_CFL .AND. (.NOT.L1D)  ) THEN
!
ISPLIT_PPM = 1
IF (XIBM_CFL>1.4) ISPLIT_PPM  = 2
IF (XIBM_CFL>2.4) ISPLIT_PPM  = 3
IF (XIBM_CFL>3.3) ISPLIT_PPM  = 4

 IF ( KSPLIT /= ISPLIT_PPM )                                    &
 WRITE(ILUOUT,FMT='(A37,I2,A4,I2,A11)')                         &
                  'PPM  time spliting loop changed from ',      &
                  KSPLIT,' to ',ISPLIT_PPM, ' iterations'
!
 KSPLIT =     ISPLIT_PPM                      
!
END IF
! ---------------------------------------------------------------
IF (( (ZCFLU_MAX>=10.) .AND. (.NOT.L1D) ) .OR. &
    ( (ZCFLV_MAX>=10.) .AND. (.NOT.L1D) .AND. (.NOT.L2D) ) .OR. &
    ( (ZCFLW_MAX>=10.) .AND. (.NOT.L1D) ) ) THEN
  WRITE(ILUOUT,*) ' '
  WRITE(ILUOUT,*) ' +---------------------------------------------------+'
  WRITE(ILUOUT,*) ' |                   MODEL ERROR                     |'
  WRITE(ILUOUT,*) ' +---------------------------------------------------+'
  WRITE(ILUOUT,*) ' |                                                   |'
  WRITE(ILUOUT,*) ' |       The model wind speed becomes too high       |'
  WRITE(ILUOUT,*) ' |                                                   |'
  IF ( ZCFLU_MAX>=10. .OR. ZCFLV_MAX>=10. ) &
  WRITE(ILUOUT,*) '     The  horizontal CFL value reaches 10 or more   |'
  IF ( ZCFLW_MAX>=10.                    ) &
  WRITE(ILUOUT,*) ' |    The  vertical  CFL value reaches 10 or more   |'
  WRITE(ILUOUT,*) ' |                                                   |'
  WRITE(ILUOUT,*) ' |    This can be due either to :                    |'
  WRITE(ILUOUT,*) ' |     - a numerical explosion of the model          |'
  WRITE(ILUOUT,*) ' |     - or a too high wind speed for an             |'
  WRITE(ILUOUT,*) ' |       acceptable accuracy of the advection        |'
  WRITE(ILUOUT,*) ' |                                                   |'
  WRITE(ILUOUT,*) ' |        Please decrease your time-step             |'
  WRITE(ILUOUT,*) ' |                                                   |'
  WRITE(ILUOUT,*) ' +---------------------------------------------------+'
  WRITE(ILUOUT,*) ' '
  WRITE(ILUOUT,*) ' +---------------------------------------------------+'
  WRITE(ILUOUT,*) ' |                   MODEL STOPS                     |'
  WRITE(ILUOUT,*) ' +---------------------------------------------------+'
  CALL CLOSE_ll(HLUOUT,IOSTAT=IRESP)
  CALL ABORT
  STOP
END IF
!
ZTSTEP_PPM = PTSTEP / REAL(KSPLIT)
!
!
!*      2.4 normalized contravariant components for splitted PPM time-step
!
ZRUCPPM = ZRUCPPM*ZTSTEP_PPM
ZRVCPPM = ZRVCPPM*ZTSTEP_PPM
ZRWCPPM = ZRWCPPM*ZTSTEP_PPM
!
!
!-------------------------------------------------------------------------------
!
!
!*       3.     COMPUTES THE TENDENCIES SINCE THE BEGINNING OF THE TIME STEP
!	        ------------------------------------------------------------
!
!* This represent the effects of all OTHER processes
!  Clouds    related processes from previous time-step are     taken into account in PRTHS_CLD
!  Advection related processes from previous time-step will be taken into account in ZRTHS_PPM
!
ZRTHS_OTHER = PRTHS - PTHT * PRHODJ / PTSTEP                      
IF (GTKE) ZRTKES_OTHER = PRTKES - PTKET * PRHODJ / PTSTEP                      
DO JR = 1, KRR
 ZRRS_OTHER(:,:,:,JR) = PRRS(:,:,:,JR) - PRT(:,:,:,JR) * PRHODJ(:,:,:) / PTSTEP
END DO
DO JSV = 1, KSV
 ZRSVS_OTHER(:,:,:,JSV) = PRSVS(:,:,:,JSV) - PSVT(:,:,:,JSV) * PRHODJ / PTSTEP                 
END DO
!
! Top and bottom Boundaries 
!
CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRTHS_OTHER)
IF (GTKE) CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRTKES_OTHER)
DO JR = 1, KRR
  CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRRS_OTHER(:,:,:,JR))
END DO
DO JSV = 1, KSV
  CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZRSVS_OTHER(:,:,:,JSV))
END DO
!
! Exchanges on processors
!
NULLIFY(TZFIELDS0_ll)
!!$IF(NHALO == 1) THEN
  CALL ADD3DFIELD_ll(TZFIELDS0_ll, ZRTHS_OTHER)
  IF (GTKE) CALL ADD3DFIELD_ll(TZFIELDS0_ll, ZRTKES_OTHER)
  DO JR=1,KRR
    CALL ADD3DFIELD_ll(TZFIELDS0_ll, ZRRS_OTHER(:,:,:,JR))
  END DO
  DO JSV=1,KSV
    CALL ADD3DFIELD_ll(TZFIELDS0_ll, ZRSVS_OTHER(:,:,:,JSV))
  END DO
  CALL UPDATE_HALO_ll(TZFIELDS0_ll,IINFO_ll)
  CALL CLEANLIST_ll(TZFIELDS0_ll)
!!$END IF
!
!

!-------------------------------------------------------------------------------
!
!*       4.     CALLS THE PPM ADVECTION INSIDE A TIME SPLITTING         
!	        --------------------------------------
!
CALL PPM_RHODJ(HLBCX,HLBCY, ZRUCPPM, ZRVCPPM, ZRWCPPM,              &
               ZTSTEP_PPM, PRHODJ, ZRHOX1, ZRHOY1, ZRHOZ1, KTCOUNT)
!
!* valuesw of the fields at the beginning of the time splitting loop
ZTH   = PTHT
ZTKE   = PTKET
IF (KRR /=0 ) ZR    = PRT
IF (KSV /=0 ) ZSV   = PSVT
!
IF (GTKE)    PRTKES_ADV(:,:,:)  = 0.              
!
!* time splitting loop
DO JSPL=1,KSPLIT
!
   ZRTHS_PPM(:,:,:)   = 0.              
   ZRTKES_PPM(:,:,:)   = 0.              
   IF (KRR /=0) ZRRS_PPM(:,:,:,:)   = 0.              
   IF (KSV /=0) ZRSVS_PPM(:,:,:,:)   = 0.              
!
   IF (LNEUTRAL) ZTH=ZTH-PTHVREF  !* To be removed with the new PPM scheme ?
   CALL PPM_MET (HLBCX,HLBCY, KRR, KTCOUNT, ZRUCPPM, ZRVCPPM, ZRWCPPM, ZTSTEP_PPM,    &
              PRHODJ,  ZRHOX1, ZRHOY1, ZRHOZ1,                &
              ZTH, ZTKE, ZR, ZRTHS_PPM, ZRTKES_PPM, ZRRS_PPM, HMET_ADV_SCHEME)
   IF (LNEUTRAL) ZTH=ZTH+PTHVREF  !* To be removed with the new PPM scheme ?
!
   CALL PPM_SCALAR (HLBCX,HLBCY, KSV, KTCOUNT, ZRUCPPM, ZRVCPPM, ZRWCPPM,             &
                 ZTSTEP_PPM, PRHODJ, ZRHOX1, ZRHOY1, ZRHOZ1,  &
                 ZSV, ZRSVS_PPM, HSV_ADV_SCHEME                                       )
!
! Tendencies of PPM
!
!IF (LIBM.AND.JSPL>1) THEN
!    WHERE(XIBM_LS(:,:,:,1).GT.XIBM_EPSI) ZRTHS_PPM(:,:,:)    = 0.
!  IF (GTKE) THEN
!    WHERE(XIBM_LS(:,:,:,1).GT.XIBM_EPSI) ZRTKES_PPM(:,:,:)   = 0.
!  ENDIF
!  DO JR = 1, KRR
!    WHERE(XIBM_LS(:,:,:,1).GT.XIBM_EPSI) ZRRS_PPM(:,:,:,JR)  = 0.
!  ENDDO
!  DO JSV = 1, KSV
!    WHERE(XIBM_LS(:,:,:,1).GT.XIBM_EPSI) ZRSVS_PPM(:,:,:,JSV)= 0.
!  ENDDO
!ENDIF

   PRTHS(:,:,:)                      = PRTHS     (:,:,:)   + ZRTHS_PPM (:,:,:)   / KSPLIT
   IF (GTKE)     PRTKES_ADV(:,:,:)   = PRTKES_ADV(:,:,:)   + ZRTKES_PPM(:,:,:)   / KSPLIT
   IF (KRR /=0)  PRRS      (:,:,:,:) = PRRS      (:,:,:,:) + ZRRS_PPM  (:,:,:,:) / KSPLIT
   IF (KSV /=0 ) PRSVS     (:,:,:,:) = PRSVS     (:,:,:,:) + ZRSVS_PPM (:,:,:,:) / KSPLIT
!
!
!  Guesses of the field inside the time splitting loop
!
   ZTH = ZTH + ( ZRTHS_PPM(:,:,:) + ZRTHS_OTHER(:,:,:) + PRTHS_CLD(:,:,:)) * &
           ZTSTEP_PPM / PRHODJ(:,:,:)
   IF (GTKE) ZTKE = ZTKE + ( ZRTKES_PPM(:,:,:) + ZRTKES_OTHER(:,:,:)+ PRKE_IBM(:,:,:) ) * ZTSTEP_PPM / PRHODJ(:,:,:)
   DO JR = 1, KRR
    ZR(:,:,:,JR) = ZR(:,:,:,JR) + ( ZRRS_PPM(:,:,:,JR) + ZRRS_OTHER(:,:,:,JR) + PRRS_CLD(:,:,:,JR) ) &
                    * ZTSTEP_PPM / PRHODJ(:,:,:)
   END DO
   DO JSV = 1, KSV
    ZSV(:,:,:,JSV) = ZSV(:,:,:,JSV) + ( ZRSVS_PPM(:,:,:,JSV) + ZRSVS_OTHER(:,:,:,JSV) +  &
                     PRSVS_CLD(:,:,:,JSV) ) * ZTSTEP_PPM / PRHODJ(:,:,:)
   END DO
!
! Top and bottom Boundaries and LBC for the guesses
!
   CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZTH, PTHT )    
   CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZTKE, PTKET)
   DO JR = 1, KRR
     CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZR(:,:,:,JR), PRT(:,:,:,JR))
   END DO
   DO JSV = 1, KSV
     CALL ADV_BOUNDARIES (HLBCX, HLBCY, ZSV(:,:,:,JSV), PSVT(:,:,:,JSV))
   END DO
!
!  Exchanges fields between processors
!
   NULLIFY(TZFIELDS1_ll)
!!$   IF(NHALO == 1) THEN
    CALL ADD3DFIELD_ll(TZFIELDS1_ll, ZTH)
    IF (GTKE) CALL ADD3DFIELD_ll(TZFIELDS1_ll, ZTKE)
    DO JR=1,KRR
      CALL ADD3DFIELD_ll(TZFIELDS1_ll, ZR(:,:,:,JR))
    END DO
    DO JSV=1,KSV
      CALL ADD3DFIELD_ll(TZFIELDS1_ll, ZSV(:,:,:,JSV))
    END DO
    CALL UPDATE_HALO_ll(TZFIELDS1_ll,IINFO_ll)
    CALL CLEANLIST_ll(TZFIELDS1_ll)
!!$   END IF
!
END DO
!
!-------------------------------------------------------------------------------
!
!  TKE special case: advection is the last process for TKE
!
! TKE must be greater than its minimum value
! (previously done in tke_eps_sources)
!
IF (GTKE) THEN
   PRTKES(:,:,:)  = PRTKES(:,:,:) + PRTKES_ADV(:,:,:)
   PRTKES(:,:,:) = MAX (PRTKES(:,:,:) , XTKEMIN * PRHODJ(:,:,:) / PTSTEP )
END IF
!
!-------------------------------------------------------------------------------
!
!*       5.     BUDGETS                                                 
!	        -------
!
IF (LBUDGET_TH)  CALL BUDGET (PRTHS,4,'ADV_BU_RTH')
IF (LBUDGET_TKE) CALL BUDGET (PRTKES,5,'ADV_BU_RTKE')
IF (KRR>=1.AND.LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1),6,'ADV_BU_RRV') 
IF (KRR>=2.AND.LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2),7,'ADV_BU_RRC') 
IF (KRR>=3.AND.LBUDGET_RR) CALL BUDGET (PRRS(:,:,:,3),8,'ADV_BU_RRR') 
IF (KRR>=4.AND.LBUDGET_RI) CALL BUDGET (PRRS(:,:,:,4),9,'ADV_BU_RRI') 
IF (KRR>=5.AND.LBUDGET_RS) CALL BUDGET (PRRS(:,:,:,5),10,'ADV_BU_RRS') 
IF (KRR>=6.AND.LBUDGET_RG) CALL BUDGET (PRRS(:,:,:,6),11,'ADV_BU_RRG') 
IF (KRR>=7.AND.LBUDGET_RH) CALL BUDGET (PRRS(:,:,:,7),12,'ADV_BU_RRH')
DO JSV=1,KSV
  IF (LBUDGET_SV) CALL BUDGET (PRSVS(:,:,:,JSV),JSV+12,'ADV_BU_RSV')
END DO

IF ((HCLOUD == 'KHKO') .OR. (HCLOUD == 'C2R2')) THEN
  ZEXN(:,:,:)= (PPABST(:,:,:)/XP00)**(XRD/XCPD)
  ZT(:,:,:)= PTHT(:,:,:)*ZEXN(:,:,:)
  ZLV(:,:,:)=XLVTT +(XCPV-XCL) *(ZT(:,:,:)-XTT)
  ZLS(:,:,:)=XLSTT +(XCPV-XCI) *(ZT(:,:,:)-XTT)
  ZCPH(:,:,:)=XCPD +XCPV*PRT(:,:,:,1)
!  CALL GET_HALO(PRRS(:,:,:,2))
!  CALL GET_HALO(PRSVS(:,:,:,2))
!  CALL GET_HALO(PRSVS(:,:,:,3))
  WHERE (PRRS(:,:,:,2) < 0. .OR. PRSVS(:,:,:,2) < 0.)
      PRSVS(:,:,:,1) = 0.0
  END WHERE
  DO JSV = 2, 3
    WHERE (PRRS(:,:,:,JSV) < 0. .OR. PRSVS(:,:,:,JSV) < 0.)
      PRRS(:,:,:,1) = PRRS(:,:,:,1) + PRRS(:,:,:,JSV)
      PRTHS(:,:,:) = PRTHS(:,:,:) - PRRS(:,:,:,JSV) * ZLV(:,:,:) /  &
             ZCPH(:,:,:) / ZEXN(:,:,:)
      PRRS(:,:,:,JSV)  = 0.0
      PRSVS(:,:,:,JSV) = 0.0
    END WHERE
  END DO
!
  IF (LBUDGET_TH) CALL BUDGET (PRTHS(:,:,:) , 4,'NEADV_BU_RTH')
  IF (LBUDGET_RV) CALL BUDGET (PRRS(:,:,:,1), 6,'NEADV_BU_RRV')
  IF (LBUDGET_RC) CALL BUDGET (PRRS(:,:,:,2), 7,'NEADV_BU_RRC')

END IF

!-------------------------------------------------------------------------------
!
END SUBROUTINE ADVECTION_METSV