mpl_tour_table_mod.F90

Go to the documentation of this file.

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