!------------------------------------------------------------------------------
! pmlib_particles_map.f
!   version: 2D single-core
!---------------------------------------------------------------------------
!                  __    __
!    ___  _ _     / /__ / /
!   | _ \/ ` \ _ / // // _ \
!   | ,_/_,_,_\  \_/\_/\___/
!   |_|                      Mads M. Hejlesen* and Jens H. Walther*^
!                            * Technical University of Denmark
!                            ^ ETH-Zurich
!
!---------------------------------------------------------------------------
! Copyright (c) 2014 Technical University of Denmark, 
!                    Department of Mechanical Engineering
!
! This program is free software; you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation; either version 2 of the License, or
! (at your option) any later version.
! 
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with this program; if not, see <http://www.gnu.org/licenses/>
!
! Contact: mmhej@mek.dtu.dk or jhwa@mek.dtu.dk
!---------------------------------------------------------------------------
SUBROUTINE pmlib_particles_map(patch,topo,part,dir,nvar_send,ierr)

USE pmlib_mod_communication
USE pmlib_mod_patch
USE pmlib_mod_topology

IMPLICIT NONE
!---------------------------------------------------------------------------
! Arguments
!---------------------------------------------------------------------------
  TYPE(class_patch)                         :: patch
  TYPE(class_topology)                      :: topo
  TYPE(class_particles)                     :: part
  INTEGER, INTENT(IN)                       :: dir !direction
  INTEGER, INTENT(IN)                       :: nvar_send
  INTEGER, INTENT(OUT)                      :: ierr

!---------------------------------------------------------------------------
! Local variables
!---------------------------------------------------------------------------
  CHARACTER(LEN=19)                     :: caller = 'pmlib_particles_map'
  INTEGER                               :: ncomm, icomm
  INTEGER                               :: iproc, jproc
  INTEGER                               :: i,j,k

  INTEGER, DIMENSION(0:2)               :: npart_dir

  INTEGER                               :: ineigh, neigh
  INTEGER                               :: ipart0, ipart1, ipart2
  REAL(MK), DIMENSION(pmlib_ndim)       :: xmin, xmax
  REAL(MK), DIMENSION(pmlib_ndim)       :: dx

  INTEGER                               :: npart_send, npart_recieve
  INTEGER                               :: npart_remove

!---------------------------------------------------------------------------
! Initiate subroutine
!---------------------------------------------------------------------------
  ierr = 0

!---------------------------------------------------------------------------
! Find number of particles to communicate
!   index 0 is not moved
!   index 1 is moved in the negative direction 
!   index 2 is moved in the possitive direction
!---------------------------------------------------------------------------
  xmin = topo%xmin
  xmax = topo%xmax 
  npart_dir  = 0
  npart_remove = 0

  DO i = 1,topo%npart
    
    IF( part%pos(dir,i) .LT. xmin(dir) )THEN

      IF( topo%bound_cond(2*dir-1) .NE. 0 )THEN
        npart_dir(1) = npart_dir(1) + 1
      ELSE
        npart_remove = npart_remove + 1
      END IF

    ELSEIF( part%pos(dir,i) .GE. xmax(dir) )THEN 

      IF( topo%bound_cond(2*dir) .NE. 0 )THEN
        npart_dir(2) = npart_dir(2) + 1
      ELSE
        npart_remove = npart_remove + 1
      END IF

    ELSE
      npart_dir(0) = npart_dir(0) + 1
    END IF

  END DO

!  IF(npart_dir(1) .NE. 0)THEN
!    CALL pmlib_write(mpi_rank,caller,'Communicate particles')
!  ELSEIF(npart_dir(2) .NE. 0)THEN
!    CALL pmlib_write(mpi_rank,caller,'Communicate particles')
!  END IF

!  IF(npart_remove .NE. 0)THEN
!    CALL pmlib_write(mpi_rank,caller,'Particles out of bounce! - removing')
!  END IF

!---------------------------------------------------------------------------
! Find indexes of particles to communicate
!---------------------------------------------------------------------------
  ALLOCATE( communication%ipart0(npart_dir(0)) )
  ALLOCATE( communication%ipart1(npart_dir(1)) )
  ALLOCATE( communication%ipart2(npart_dir(2)) )

  ipart0 = 0
  ipart1 = 0
  ipart2 = 0

  DO i = 1,topo%npart
    
    IF( part%pos(dir,i) .LT. xmin(dir) )THEN
      IF( topo%bound_cond(2*dir-1) .NE. 0 )THEN
        ipart1 = ipart1 + 1
        communication%ipart1(ipart1) = i
        IF( part%pos(dir,i) .LT. patch%xmin(dir) )THEN
          part%pos(dir,i) = part%pos(dir,i) &
                        & + ( patch%xmax(dir) - patch%xmin(dir) )
        END IF
      END IF

    ELSEIF( part%pos(dir,i) .GE. xmax(dir) )THEN
      IF( topo%bound_cond(2*dir) .NE. 0 )THEN
        ipart2 = ipart2 + 1
        communication%ipart2(ipart2) = i
        IF( part%pos(dir,i) .GE. patch%xmax(dir) )THEN
          part%pos(dir,i) = part%pos(dir,i) &
                        & - ( patch%xmax(dir) - patch%xmin(dir) )
        END IF
      END IF

    ELSE
      ipart0 = ipart0 + 1
      communication%ipart0(ipart0) = i
    END IF
  END DO

  IF( ipart0 .NE. npart_dir(0) .OR. &
    & ipart1 .NE. npart_dir(1) .OR. &
    & ipart2 .NE. npart_dir(2) )THEN
    ierr = -1
    CALL pmlib_write( caller, &
              & 'Number of communicated particles are not consistent' )
    GOTO 9999
  END IF

!---------------------------------------------------------------------------
! Find number of communications
!---------------------------------------------------------------------------
  icomm = 0
  DO i = 1,2
    ineigh = 2*dir - 2 + i
    neigh = topo%ineigh(ineigh)

    IF( npart_dir(i) .NE. 0 .AND. neigh .NE. -1)THEN
      icomm = icomm + 1
    END IF
  END DO !ineigh

! add self communication
  icomm = icomm + 1

!---------------------------------------------------------------------------
! Allocate communication lists
!---------------------------------------------------------------------------
  ncomm               = icomm
  communication%ncomm = ncomm
  communication%ctype = 4

  ALLOCATE( communication%npart_send(ncomm) )
  ALLOCATE( communication%npart_recieve(ncomm) )
 
  ALLOCATE( communication%comm_dir(ncomm) )

!---------------------------------------------------------------------------
! Loop through neighbours
!---------------------------------------------------------------------------
  icomm = 0
  DO i = 1,2
    ineigh = 2*dir - 2 + i

    neigh = topo%ineigh(ineigh)

    IF( npart_dir(i) .NE. 0 .AND. neigh .NE. -1 )THEN

!---------------------------------------------------------------------------
! Count communications
!---------------------------------------------------------------------------
      icomm = icomm + 1
      communication%comm_dir(icomm) = i

!---------------------------------------------------------------------------
! Store number of particles
!---------------------------------------------------------------------------
      communication%npart_send(icomm)    = npart_dir(i)
      communication%npart_recieve(icomm) = npart_dir(i)

    END IF ! send part
  END DO !ineigh

!---------------------------------------------------------------------------
! Do self communications
!---------------------------------------------------------------------------
  icomm = icomm + 1
  communication%comm_dir(icomm) = 0

! Store number of particles
  communication%npart_send(icomm)    = npart_dir(0)
  communication%npart_recieve(icomm) = npart_dir(0)

!---------------------------------------------------------------------------
! Check number of communications
!---------------------------------------------------------------------------
  IF(icomm .NE. ncomm)THEN
    ierr = -1
    CALL pmlib_write(caller,'Number of communications are inconsistent')
    GOTO 9999
  ENDIF

!---------------------------------------------------------------------------
! Allocate communication buffer
!---------------------------------------------------------------------------
  IF( ASSOCIATED(comm_buffer) ) THEN
    DEALLOCATE(comm_buffer)
    IF (ierr .NE. 0) THEN
      CALL pmlib_write(caller,'Failed to deallocate array.')
      GOTO 9999
    ENDIF
  END IF 
  ALLOCATE( comm_buffer(ncomm) )

  DO j = 1,ncomm

    npart_send = communication%npart_send(j)
 
! Allocate send array for communication j
    ALLOCATE( comm_buffer(j)%part_send(nvar_send,npart_send) )
    comm_buffer(j)%nsend = nvar_send*npart_send
    comm_buffer(j)%npart_send = npart_send

! Allocate send array for communication j
    ALLOCATE( comm_buffer(j)%part_recieve(nvar_send,npart_send) )
    comm_buffer(j)%nrecieve = nvar_send*npart_send
    comm_buffer(j)%npart_recieve = npart_send

  END DO

!---------------------------------------------------------------------------
! set counter for number of packed variables
!---------------------------------------------------------------------------
  communication%npacked = 0

!---------------------------------------------------------------------------
! Return
!---------------------------------------------------------------------------
 9999 CONTINUE
RETURN

END SUBROUTINE pmlib_particles_map
