! (C) Copyright 2005- ECMWF.
! (C) Copyright 2013- Meteo-France.
! 
! This software is licensed under the terms of the Apache Licence Version 2.0
! which can be obtained at http://www.apache.org/licenses/LICENSE-2.0.
! In applying this licence, ECMWF does not waive the privileges and immunities
! granted to it by virtue of its status as an intergovernmental organisation
! nor does it submit to any jurisdiction.
!

MODULE MPL_TOUR_TABLE_MOD

USE EC_PARKIND  ,ONLY : JPIM

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
