!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_RECYCL_AFFE2
!       #####################
!
INTERFACE
!
SUBROUTINE RECYCL_AFFE2(PPTAB0,PPTAB1,PPTAB2,KSAV_RECYCL1,KSAV_RECYCL2,PDIST,PALP)

  REAL, DIMENSION(:,:,:)         ,INTENT(IN)    :: PPTAB0,PPTAB1
  REAL, DIMENSION(:,:,:)         ,INTENT(INOUT) :: PPTAB2
  INTEGER, DIMENSION(:,:)        ,INTENT(IN)    :: KSAV_RECYCL1,KSAV_RECYCL2
  REAL                           ,INTENT(IN)    :: PDIST,PALP


END SUBROUTINE RECYCL_AFFE2
!
END INTERFACE
!
END MODULE MODI_RECYCL_AFFE2
!
!
!
!       ####################################
        SUBROUTINE RECYCL_AFFE2(PPTAB0,PPTAB1,PPTAB2,KSAV_RECYCL1,KSAV_RECYCL2,PDIST,PALP)
!       ####################################
!
!!****     *RECYCL_AFFE2*  - routine to genererate turbulence 
!!
!!      PURPOSE
!!      -------
!         SIMPLE RECYCLING METHOD
!
!!      METHOD
!!      ------
!!!
!!      EXTERNAL
!!      --------
!!        NONE
!!
!!      IMPLICIT ARGUMENTS
!!      ------------------
!!
!!      REFERENCE
!!      ---------
!!
!!      AUTHOR
!!      ------
!!        Franck Auguste       * CERFACS(AE) *
!!
!!      MODIFICATIONS
!!      -------------
!!        Original          01/01/2015
!!
!------------------------------------------------------------------------------
!       
!**** 0. DECLARATIONS
!     ---------------
!
! module
!USE MODE_SUM_ll, ONLY : EXTRACT_ll
USE MODE_POS
USE MODE_ll
USE MODE_IO_ll
!
! declaration
USE MODD_VAR_ll,          ONLY: IP, NPROC
USE MODD_CONF,            ONLY: NHALO
!
! interface
USE MODI_GATHER_ll
USE MODD_IBM_PARAM_n
!
IMPLICIT NONE
!
!------------------------------------------------------------------------------
!
!       0.1  declarations of arguments
  REAL, DIMENSION(:,:,:)         ,INTENT(IN)    :: PPTAB0,PPTAB1
  REAL, DIMENSION(:,:,:)         ,INTENT(INOUT)  :: PPTAB2
  INTEGER, DIMENSION(:,:)        ,INTENT(IN)       :: KSAV_RECYCL1,KSAV_RECYCL2
  REAL                           ,INTENT(IN)       :: PDIST,PALP
!
!------------------------------------------------------------------------------
!
!       0.2  declaration of local variables
INTEGER                                       :: IIU,IJU,IKU, IIP                                   
REAL,DIMENSION(:,:,:)         ,ALLOCATABLE  :: ZTMP,ZTMP2
INTEGER                                       :: IRESP,IINFO_ll
INTEGER :: JIMIN_RECYCL1,JJMIN_RECYCL1,JIMAX_RECYCL1,JJMAX_RECYCL1
INTEGER :: JIMIN_RECYCL2,JJMIN_RECYCL2,JIMAX_RECYCL2,JJMAX_RECYCL2
INTEGER :: JIMIN_RECYCL3,JJMIN_RECYCL3,JIMAX_RECYCL3,JJMAX_RECYCL3
!------------------------------------------------------------------------------

!
! Allocation and dimension
!
IKU = SIZE(PPTAB1,3)

!
! Proc loop
!

DO IIP = 1,NPROC

  !
  ! potential index of emission/recpetion surfaces
  !

  JIMIN_RECYCL1 = KSAV_RECYCL2(1,IIP)
  JJMIN_RECYCL1 = KSAV_RECYCL2(2,IIP)
  JIMAX_RECYCL1 = KSAV_RECYCL2(3,IIP)
  JJMAX_RECYCL1 = KSAV_RECYCL2(4,IIP)
  JIMIN_RECYCL2 = KSAV_RECYCL2(5,IIP)
  JJMIN_RECYCL2 = KSAV_RECYCL2(6,IIP)
  JIMAX_RECYCL2 = KSAV_RECYCL2(7,IIP)
  JJMAX_RECYCL2 = KSAV_RECYCL2(8,IIP)
  JIMIN_RECYCL3 = KSAV_RECYCL1(1,IIP)
  JJMIN_RECYCL3 = KSAV_RECYCL1(2,IIP)
  JIMAX_RECYCL3 = KSAV_RECYCL1(3,IIP)
  JJMAX_RECYCL3 = KSAV_RECYCL1(4,IIP)

!CALL REDUCESUM_ll(JIMIN_RECYCL1,IINFO_ll)

  !
  ! if proc IIP is not a reception surface : no computation
  !

  IF (JIMIN_RECYCL1==0.AND.JJMIN_RECYCL1==0.AND.JIMAX_RECYCL1==0.AND.JJMAX_RECYCL1==0) GOTO 111

!WRITE(*,*)'IJB1',JIMIN_RECYCL1,JJMIN_RECYCL1,IIP
!WRITE(*,*)'IJB2',JIMIN_RECYCL2,JJMIN_RECYCL2,IIP
!WRITE(*,*)'IJE1',JIMAX_RECYCL1,JJMAX_RECYCL1,IIP
!WRITE(*,*)'IJE2',JIMAX_RECYCL2,JJMAX_RECYCL2,IIP


!WRITE(*,*)'EXTRACT_INI',IIP

!CALL REDUCESUM_ll(JIMIN_RECYCL2,IINFO_ll)
!CALL REDUCESUM_ll(JJMIN_RECYCL2,IINFO_ll)
!CALL REDUCESUM_ll(JIMAX_RECYCL2,IINFO_ll)
!CALL REDUCESUM_ll(JJMAX_RECYCL2,IINFO_ll)

  ALLOCATE(ZTMP (JIMAX_RECYCL2-JIMIN_RECYCL2+1,JJMAX_RECYCL2-JJMIN_RECYCL2+1,IKU-2))
!  ALLOCATE(ZTMP2(JIMAX_RECYCL2-JIMIN_RECYCL2+1,JJMAX_RECYCL2-JJMIN_RECYCL2+1,IKU-2))
  ZTMP =0.
  ZTMP(:,:,:)  = EXTRACT_ll(PPTAB1,IINFO_ll,JIMIN_RECYCL2,JJMIN_RECYCL2,2,JIMAX_RECYCL2,JJMAX_RECYCL2,IKU-1)
!  ZTMP2=0.
!  ZTMP2(:,:,:) = EXTRACT_ll(PPTAB0,IINFO_ll,JIMIN_RECYCL2,JJMIN_RECYCL2,2,JIMAX_RECYCL2,JJMAX_RECYCL2,IKU-1)

!WRITE(*,*)'EXTRACT_FIN',IIP

  !
  ! if IP is the IIP proc : affectation
  !

  IF ( JIMIN_RECYCL1 == JIMIN_RECYCL3 .AND. &
       JJMIN_RECYCL1 == JJMIN_RECYCL3 .AND. &
       JIMAX_RECYCL1 == JIMAX_RECYCL3 .AND. &
       JJMAX_RECYCL1 == JJMAX_RECYCL3 ) THEN

         PPTAB2(JIMIN_RECYCL1:JIMAX_RECYCL1,JJMIN_RECYCL1:JJMAX_RECYCL1,2:IKU-1)=      &
    +0.*PPTAB2(JIMIN_RECYCL1:JIMAX_RECYCL1,JJMIN_RECYCL1:JJMAX_RECYCL1,2:IKU-1)       &
    +1.*ZTMP(1:JIMAX_RECYCL2-JIMIN_RECYCL2+1,1:JJMAX_RECYCL2-JJMIN_RECYCL2+1,1:IKU-2) 
!    +0.0*ZTMP2(1:JIMAX_RECYCL2-JIMIN_RECYCL2+1,1:JJMAX_RECYCL2-JJMIN_RECYCL2+1,1:IKU-2) 

  ENDIF

  DEALLOCATE(ZTMP)
!  DEALLOCATE(ZTMP2)


111 CONTINUE

ENDDO

!
! end
!

RETURN

END SUBROUTINE RECYCL_AFFE2