!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.
!-----------------------------------------------------------------
!--------------- special set of characters for RCS information
!-----------------------------------------------------------------
! $Source: /srv/cvsroot/MNH-VX-Y-Z/src/MNH/ini_cturb.f90,v $ $Revision: 1.2.4.1.2.2.2.1.2.2 $ $Date: 2014/01/09 15:01:55 $
!-----------------------------------------------------------------
!-----------------------------------------------------------------
!       #######################
        MODULE MODI_IBM_FORCING_SURFEX
!       #######################
!
INTERFACE
!
SUBROUTINE IBM_FORCING_SURFEX(PRUS,PRVS,PRWS,PTHS,PABS,PRHO,POLD,PHEI,ICOE)
!
REAL, DIMENSION(:,:,:)     ,INTENT(INOUT) :: PRUS,PRVS,PRWS
REAL, DIMENSION(:,:,:)     ,INTENT(INOUT) :: PTHS
!REAL, DIMENSION(:,:,:)     ,INTENT(INOUT) :: PRRS
REAL, DIMENSION(:,:,:)     ,INTENT(INOUT) :: PABS
REAL, DIMENSION(:,:,:)     ,INTENT(INOUT) :: PRHO
REAL, DIMENSION(:,:,:,:)   ,INTENT(INOUT) :: POLD
REAL, DIMENSION(:,:,:)        ,INTENT(IN) :: PHEI
INTEGER                       ,INTENT(IN) :: ICOE

!
END SUBROUTINE IBM_FORCING_SURFEX
!
END INTERFACE
!
END MODULE MODI_IBM_FORCING_SURFEX
!
!
!
!       ################################################################################
        SUBROUTINE IBM_FORCING_SURFEX(PRUS,PRVS,PRWS,PTHS,PABS,PRHO,POLD,PHEI,ICOE)
!       ################################################################################
!
!!****     *IBM_FORCING_SURFEX*  - routine to force all desired fields localized
!                                  on the IB roof to go to ground (currently dry
!                                  case)
!!
!!      PURPOSE
!!      -------
!
!!      METHOD
!!      ------
!!
!!      EXTERNAL
!!      --------
!!        NONE
!!
!!      IMPLICIT ARGUMENTS
!!      ------------------
!!
!!      REFERENCE
!!      ---------
!!
!!      AUTHOR
!!      ------
!!        Franck Auguste       * CERFACS(AE) *
!!
!!      MODIFICATIONS
!!      -------------
!!        Original          01/01/2018
!!
!------------------------------------------------------------------------------
!       
!**** 0. DECLARATIONS
!     ---------------
!
! module
USE MODE_POS
USE MODE_ll
USE MODE_IO_ll
USE MODD_ARGSLIST_ll,     ONLY : LIST_ll
!
! declaration
USE MODD_GRID_n,          ONLY: XZZ
USE MODD_REF_n,           ONLY: XRHODJ,XRHODREF,XTHVREF
USE MODD_PARAMETERS,      ONLY: JPVEXT,JPHEXT
USE MODD_IBM_PARAM_n
USE MODD_LBC_n
USE MODD_CONF
USE MODD_CONF_n
USE MODD_NSV
USE MODD_CTURB
USE MODD_PARAM_n
!
! interface
!
IMPLICIT NONE
!
!------------------------------------------------------------------------------
!
!       0.1  declarations of arguments       
REAL, DIMENSION(:,:,:)     ,INTENT(INOUT) :: PRUS,PRVS,PRWS
REAL, DIMENSION(:,:,:)     ,INTENT(INOUT) :: PTHS
!REAL, DIMENSION(:,:,:)     ,INTENT(INOUT) :: PRRS
REAL, DIMENSION(:,:,:)     ,INTENT(INOUT) :: PABS
REAL, DIMENSION(:,:,:)     ,INTENT(INOUT) :: PRHO
REAL, DIMENSION(:,:,:,:)   ,INTENT(INOUT) :: POLD
REAL, DIMENSION(:,:,:)        ,INTENT(IN) :: PHEI
INTEGER                       ,INTENT(IN) :: ICOE

!
!------------------------------------------------------------------------------
!
!       0.2  declaration of local variables
REAL, DIMENSION(:,:,:)   ,ALLOCATABLE     :: ZTMP
INTEGER                                   :: IIE,IJE,IIB,IJB,IKB,IKE
INTEGER                                   :: JI,JJ,JN,JM,JK,JNN
INTEGER                                   :: JKMAX,IIMAX,IJMAX,KHEI
!
!------------------------------------------------------------------------------
!
!**** 0. ALLOCATIONS
!     --------------
CALL GET_INDICE_ll(IIB,IJB,IIE,IJE)
IKB =   1 + JPVEXT
IKE = SIZE(PRWS,3) - JPVEXT
ALLOCATE(ZTMP(SIZE(PRUS,1),SIZE(PRVS,2),SIZE(PRWS,3)))
JKMAX = IKB
DO JK=IKB,IKE-3
  IF (XZZ(IIB,IJB,JK).LT.XIBM_SOLAR_MAX) JKMAX=JK+1
ENDDO

!
!------------------------------------------------------------------------------
! 
!**** 1. EXECUTIONS
!     -------------
! 
! roof to ground
  IF (ICOE==0) THEN

    DO JN = 1,6

      JM = 1
      IF (JN==1) JM=2
      IF (JN==2) JM=3
      IF (JN==3) JM=4

      IIMAX=IIE
      IJMAX=IJE     
      IF (JN==1) IIMAX=IIMAX+1
      IF (JN==2) IJMAX=IJMAX+1

      IF (JN==1) ZTMP = PRUS
      IF (JN==2) ZTMP = PRVS
      IF (JN==3) ZTMP = PRWS
      IF (JN==4) ZTMP = PTHS
!      IF (JN==5) ZTMP = PRRS
      IF (JN==5) ZTMP = PABS
      IF (JN==6) ZTMP = PRHO

      POLD(:,:,:,JN)  = ZTMP(:,:,:)

      DO JI=IIB,IIMAX
        DO JJ=IJB,IJMAX
          IF (ABS(PHEI(JI,JJ,JM)-2.).GT.XIBM_EPSI) THEN
            KHEI = INT(PHEI(JI,JJ,JM)+XIBM_EPSI)
            ZTMP(JI,JJ,IKB) = POLD(JI,JJ,KHEI,JN)
          ENDIF 
        ENDDO
      ENDDO
      ZTMP(:,:,IKB-1) = ZTMP(:,:,IKB)

      IF (JN==1) PRUS= ZTMP
      IF (JN==2) PRVS= ZTMP
      IF (JN==3) PRWS= ZTMP
      IF (JN==4) PTHS= ZTMP
!      IF (JN==5) PRRS= ZTMP
      IF (JN==5) PABS= ZTMP
      IF (JN==6) PRHO= ZTMP

    ENDDO

  ENDIF

! ground to roof
  IF (ICOE==1) THEN

    DO JN = 1,6

      ZTMP(:,:,:) = POLD(:,:,:,JN)
      IF (JN==1) PRUS= ZTMP
      IF (JN==2) PRVS= ZTMP
      IF (JN==3) PRWS= ZTMP
      IF (JN==4) PTHS= ZTMP
!      IF (JN==5) PRRS= ZTMP
      IF (JN==5) PABS= ZTMP
      IF (JN==6) PRHO= ZTMP

    ENDDO

  ENDIF
!
!------------------------------------------------------------------------------
! 
!**** 2. END
!     ------ 
DEALLOCATE(ZTMP)
!
RETURN
! 
END SUBROUTINE IBM_FORCING_SURFEX