MODULE MPL_TOUR_TABLE_MOD

USE PARKIND1  ,ONLY : JPIM     ,JPRB

USE MPL_DATA_MODULE, ONLY : MPL_NUMPROC, MPL_RANK, MPL_ERRUNIT
USE MPL_MESSAGE_MOD

IMPLICIT NONE

PRIVATE
PUBLIC MPL_TOUR_TABLE

CONTAINS
SUBROUTINE MPL_TOUR_TABLE(KOPPONENT, KEVEN)
INTEGER(KIND=JPIM),INTENT(OUT)::KOPPONENT(:)
INTEGER(KIND=JPIM),INTENT(OUT),OPTIONAL::KEVEN

INTEGER(KIND=JPIM) :: ICIRCULAR(MPL_NUMPROC+1)
INTEGER(KIND=JPIM) :: IEVEN,IMYPOS,ITMP,JK,JI
LOGICAL :: LLABORT=.TRUE.

IEVEN = ((MPL_NUMPROC+1)/2)*2
IF(SIZE(KOPPONENT)  < IEVEN) THEN
  WRITE(MPL_ERRUNIT,*)'MPL_TOUR_TABLE: ERROR KOPPONENT dimension=',&
   & SIZE(KOPPONENT),'. MUST BE AT LEAST=',IEVEN
  CALL MPL_MESSAGE(CDMESSAGE='MPL_TOUR_TABLE: ERROR KOPPONENT dimension wrong',&
   & LDABORT=LLABORT)
ENDIF

DO JK = 1,IEVEN
  ICIRCULAR(JK) = JK
ENDDO
KOPPONENT(:) = -1
IMYPOS = MPL_RANK
DO JK=1,IEVEN-1
  KOPPONENT(JK) = ICIRCULAR(IEVEN-IMYPOS+1)
  ITMP = ICIRCULAR(IEVEN-1)
  DO JI=IEVEN-2,1,-1
    ICIRCULAR(JI+1) = ICIRCULAR(JI)
  ENDDO
  ICIRCULAR(1) = ITMP
  IF(MPL_RANK < IEVEN) IMYPOS = MOD(IMYPOS,IEVEN-1)+1
ENDDO

KOPPONENT(IEVEN) = MPL_RANK

if (present(KEVEN)) KEVEN = IEVEN

END SUBROUTINE MPL_TOUR_TABLE
END MODULE MPL_TOUR_TABLE_MOD
