mpi4to8_s.F90

Go to the documentation of this file.

MODULE mpi4to8_s
#ifdef USE_8_BYTE_WORDS

USE parkind1, ONLY : jpim
USE mpl_mpif

IMPLICIT NONE

PRIVATE :: status8
  INTEGER(KIND=8), DIMENSION(MPI_STATUS_SIZE) :: status8

INTERFACE mpi_get_count8
  MODULE PROCEDURE mpi_get_count8_i4, mpi_get_count8_i4_1
END INTERFACE mpi_get_count8

INTERFACE mpi_waitall8
  MODULE PROCEDURE mpi_waitall8_i4, mpi_waitall8_i4_1
END INTERFACE mpi_waitall8

INTERFACE mpi_wait8
  MODULE PROCEDURE mpi_wait8_i4, mpi_wait8_i4_1
END INTERFACE mpi_wait8

PUBLIC

CONTAINS

! ---------------------------------------------------------
SUBROUTINE mpi_abort8(COMM, ERRORCODE, IERROR)

  INTEGER(KIND=JPIM), INTENT(IN) :: &
    COMM, ERRORCODE
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    IERROR

  INTEGER(KIND=8) :: &
    COMM8, ERRORCODE8, IERROR8

  comm8 = comm
  errorcode8 = errorcode

  CALL mpi_abort(comm8, errorcode8, ierror8)

  ierror = ierror8

END SUBROUTINE mpi_abort8

! ---------------------------------------------------------
SUBROUTINE mpi_barrier8(COMM, IERROR)

  INTEGER(KIND=JPIM), INTENT(IN) :: &
    COMM
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    IERROR

  INTEGER(KIND=8) :: &
    COMM8, IERROR8

  comm8 = comm

  CALL mpi_barrier(comm8, ierror8)

  ierror = ierror8

END SUBROUTINE mpi_barrier8

! ---------------------------------------------------------
SUBROUTINE mpi_buffer_detach8(BUFFER_ADDR, SZ, IERROR)

  INTEGER(KIND=JPIM), DIMENSION(:), INTENT(OUT) :: &
    BUFFER_ADDR
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    SZ, IERROR

  INTEGER(KIND=8), DIMENSION(:), ALLOCATABLE :: &
    BUFFER_ADDR8
  INTEGER(KIND=8) :: &
    SZ8, IERROR8

  ALLOCATE(buffer_addr8(SIZE(buffer_addr)))

  CALL mpi_buffer_detach(buffer_addr8, sz8, ierror8)

  buffer_addr = buffer_addr8
  sz = sz8
  ierror = ierror8

  DEALLOCATE(buffer_addr8)

END SUBROUTINE mpi_buffer_detach8

! ---------------------------------------------------------
SUBROUTINE mpi_buffer_attach8(BUFFER_ADDR, SZ, IERROR)

  INTEGER(KIND=JPIM), DIMENSION(:), INTENT(IN) :: &
    BUFFER_ADDR
  INTEGER(KIND=JPIM), INTENT(IN) :: &
    SZ
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    IERROR

  INTEGER(KIND=8), DIMENSION(:), ALLOCATABLE :: &
    BUFFER_ADDR8
  INTEGER(KIND=8) :: &
    SZ8, IERROR8

  ALLOCATE(buffer_addr8(SIZE(buffer_addr)))

  buffer_addr8 = buffer_addr
  sz8 = sz

  CALL mpi_buffer_attach(buffer_addr8, sz8, ierror8)

  ierror = ierror8

  DEALLOCATE(buffer_addr8)

END SUBROUTINE mpi_buffer_attach8

! ---------------------------------------------------------
SUBROUTINE mpi_cart_coords8(COMM, RANK, MAXDIMS, COORDS, IERROR)

  INTEGER(KIND=JPIM), INTENT(IN) :: &
    COMM, RANK, MAXDIMS
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    IERROR
  INTEGER(KIND=JPIM), DIMENSION(:), INTENT(OUT) :: COORDS

  INTEGER(KIND=8), DIMENSION(:), ALLOCATABLE :: COORDS8
  INTEGER(KIND=8) :: &
    COMM8, RANK8, MAXDIMS8, IERROR8

  ALLOCATE(coords8(SIZE(coords)))

  comm8 = comm
  rank8 = rank
  maxdims8 = maxdims

  CALL mpi_cart_coords(comm8, rank8, maxdims8, coords8, ierror8)

  coords = coords8
  ierror = ierror8

  DEALLOCATE(coords8)

END SUBROUTINE mpi_cart_coords8

! ---------------------------------------------------------
SUBROUTINE mpi_cart_create8(COMM_OLD, NDIMS, DIMS, PERIODS, REORDER, COMM_CART, IERROR)

  INTEGER(KIND=JPIM), INTENT(IN) :: &
    COMM_OLD, NDIMS, DIMS(:)
  LOGICAL(KIND=JPIM), INTENT(IN) :: &
    PERIODS(:), REORDER
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    COMM_CART, IERROR

  INTEGER(KIND=8), DIMENSION(:), ALLOCATABLE :: &
    DIMS8
  INTEGER(KIND=8) :: &
    COMM_OLD8, NDIMS8, COMM_CART8, IERROR8
  LOGICAL(KIND=8), DIMENSION(:), ALLOCATABLE :: &
    PERIODS8
  LOGICAL(KIND=8) :: &
    REORDER8

  ALLOCATE(dims8(SIZE(dims)))
  ALLOCATE(periods8(SIZE(periods)))

  comm_old8 = comm_old
  ndims8 = ndims
  dims8 = dims
  periods8 = periods
  reorder8 = reorder

  CALL mpi_cart_create(comm_old8, ndims8, dims8, periods8, reorder8, comm_cart8, ierror8)

  comm_cart =  comm_cart8
  ierror  = ierror8

  DEALLOCATE(dims8)
  DEALLOCATE(periods8)

END SUBROUTINE mpi_cart_create8

! ---------------------------------------------------------
SUBROUTINE mpi_cart_rank8(COMM, COORDS, RANK, IERROR)

  INTEGER(KIND=JPIM), INTENT(IN) :: &
    COMM
  INTEGER(KIND=JPIM), INTENT(IN), DIMENSION(:) :: COORDS
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    RANK, IERROR

  INTEGER(KIND=8), DIMENSION(:), ALLOCATABLE :: COORDS8
  INTEGER(KIND=8) :: &
    COMM8, RANK8, IERROR8

  ALLOCATE(coords8(SIZE(coords)))

  comm8 = comm
  coords8 = coords

  CALL mpi_cart_rank(comm8, coords8, rank8, ierror8)

  rank = rank8
  ierror = ierror8

  DEALLOCATE(coords8)

END SUBROUTINE mpi_cart_rank8

! ---------------------------------------------------------
SUBROUTINE mpi_cart_sub8(COMM, REMAIN_DIMS, NEWCOMM, IERROR)

  INTEGER(KIND=JPIM), INTENT(IN) :: &
    COMM
  LOGICAL(KIND=JPIM), INTENT(IN), DIMENSION(:) :: &
    REMAIN_DIMS
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    NEWCOMM, IERROR

  INTEGER(KIND=8) :: &
    COMM8, NEWCOMM8, IERROR8
  LOGICAL(KIND=8), DIMENSION(:), ALLOCATABLE :: &
    REMAIN_DIMS8

  ALLOCATE(remain_dims8(SIZE(remain_dims)))

  comm8 = comm
  remain_dims8 = remain_dims

  CALL mpi_cart_sub(comm8, remain_dims8, newcomm8, ierror8)

  newcomm = newcomm8
  ierror = ierror8

  DEALLOCATE(remain_dims8)

END SUBROUTINE mpi_cart_sub8

! ---------------------------------------------------------
SUBROUTINE mpi_comm_create8(COMM, GROUP, NEWCOMM, IERROR)

  INTEGER(KIND=JPIM), INTENT(IN) :: &
    COMM, GROUP
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    NEWCOMM, IERROR

  INTEGER(KIND=8) :: &
    COMM8, GROUP8, NEWCOMM8, IERROR8

  comm8 = comm
  group8 = group

  CALL mpi_comm_create(comm8, group8, newcomm8, ierror8)

  newcomm = newcomm8
  ierror = ierror8

END SUBROUTINE mpi_comm_create8

! ---------------------------------------------------------
SUBROUTINE mpi_comm_group8(COMM, GROUP, IERROR)

  INTEGER(KIND=JPIM), INTENT(IN) :: &
    COMM
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    GROUP, IERROR

  INTEGER(KIND=8) :: &
    COMM8, GROUP8, IERROR8

  comm8 = comm

  CALL mpi_comm_group(comm8, group8, ierror8)

  group = group8
  ierror = ierror8

END SUBROUTINE mpi_comm_group8

! ---------------------------------------------------------
SUBROUTINE mpi_comm_rank8(COMM, RANK, IERROR)

  INTEGER(KIND=JPIM), INTENT(IN) :: &
    COMM
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    RANK, IERROR

  INTEGER(KIND=8) :: &
    COMM8, RANK8, IERROR8

  comm8 = comm

  CALL mpi_comm_rank(comm8, rank8, ierror8)

  rank = rank8
  ierror = ierror8

END SUBROUTINE mpi_comm_rank8

! ---------------------------------------------------------
SUBROUTINE mpi_comm_size8(COMM, SIZE, IERROR)

  INTEGER(KIND=JPIM), INTENT(IN) :: &
    COMM
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    SIZE, IERROR

  INTEGER(KIND=8) :: &
    COMM8, SIZE8, IERROR8

  comm8 = comm

  CALL mpi_comm_size(comm8, size8, ierror8)

  SIZE = size8
  ierror = ierror8

END SUBROUTINE mpi_comm_size8

! ---------------------------------------------------------
SUBROUTINE mpi_comm_split8(COMM, COLOR, KEY, NEWCOMM, IERROR)

  INTEGER(KIND=JPIM), INTENT(IN) :: &
    COMM, COLOR, KEY
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    NEWCOMM, IERROR

  INTEGER(KIND=8) :: &
    COMM8, COLOR8, KEY8, NEWCOMM8, IERROR8

  comm8 = comm
  color8 = color
  key8 = key

  CALL mpi_comm_split(comm8, color8, key8, newcomm8, ierror8)

  newcomm = newcomm8
  ierror = ierror8

END SUBROUTINE mpi_comm_split8

! ---------------------------------------------------------
SUBROUTINE mpi_error_string8(ERRORCODE, STRING, RESULTLEN, IERROR)

  INTEGER(KIND=JPIM), INTENT(IN) :: &
    ERRORCODE
  CHARACTER(LEN=*), INTENT(OUT) :: &
    STRING
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    RESULTLEN, IERROR

  INTEGER(KIND=8) :: &
    ERRORCODE8, RESULTLEN8, IERROR8

  errorcode8 = errorcode

  CALL mpi_error_string(errorcode8, string, resultlen8, ierror8)

  resultlen = resultlen8
  ierror = ierror8

END SUBROUTINE mpi_error_string8

! ---------------------------------------------------------
SUBROUTINE mpi_file_close8(FH, IERROR)

  INTEGER(KIND=JPIM), INTENT(IN) :: &
    FH
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    IERROR

  INTEGER(KIND=8) :: &
    FH8, IERROR8

  fh8 = fh

  CALL mpi_file_close(fh8, ierror8)

  ierror = ierror8

END SUBROUTINE mpi_file_close8

! ---------------------------------------------------------
SUBROUTINE mpi_file_open8(COMM, FILENAME, AMODE, INFO, FH, IERROR)

  INTEGER(KIND=JPIM), INTENT(IN) :: &
    COMM, AMODE, INFO
  CHARACTER(LEN=*), INTENT(IN) :: &
    FILENAME
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    FH, IERROR

  INTEGER(KIND=8) :: &
    COMM8, AMODE8, INFO8, FH8, IERROR8

  comm8 = comm
  amode8 = amode
  info8 = info

  CALL mpi_file_open(comm8, filename, amode8, info8, fh8, ierror8)

  fh = fh8
  ierror = ierror8

END SUBROUTINE mpi_file_open8

! ---------------------------------------------------------
SUBROUTINE mpi_finalize8(IERROR)

  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    IERROR

  INTEGER(KIND=8) :: &
    IERROR8

  CALL mpi_finalize(ierror8)

  ierror = ierror8

END SUBROUTINE mpi_finalize8

! ---------------------------------------------------------
SUBROUTINE mpi_get_count8_i4(STATUS, DATATYPE, COUNT, IERROR)

  INTEGER(KIND=JPIM), INTENT(IN) :: &
    STATUS(:), DATATYPE
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    COUNT, IERROR

  INTEGER(KIND=8) :: &
    DATATYPE8, COUNT8, IERROR8

  status8 = status
  datatype8 = datatype

  CALL mpi_get_count(status8, datatype8, count8, ierror8)

  count = count8
  ierror = ierror8

END SUBROUTINE mpi_get_count8_i4

! ---------------------------------------------------------
SUBROUTINE mpi_get_count8_i4_1(STATUS, DATATYPE, COUNT, IERROR)

  INTEGER(KIND=JPIM), INTENT(IN) :: &
    STATUS, DATATYPE
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    COUNT, IERROR

  INTEGER(KIND=8) :: &
    DATATYPE8, COUNT8, IERROR8, STATUS8

  status8 = status
  datatype8 = datatype

  CALL mpi_get_count(status8, datatype8, count8, ierror8)

  count = count8
  ierror = ierror8

END SUBROUTINE mpi_get_count8_i4_1

! ---------------------------------------------------------
SUBROUTINE mpi_group_incl8(GROUP1, N, RANKS, NEWGROUP, IERROR)

  INTEGER(KIND=JPIM), INTENT(IN) :: &
    GROUP1, N, RANKS(:)
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    NEWGROUP, IERROR

  INTEGER(KIND=8), DIMENSION(:), ALLOCATABLE :: &
    RANKS8
  INTEGER(KIND=8) :: &
    GROUP18, N8, NEWGROUP8, IERROR8

  ALLOCATE(ranks8(SIZE(ranks)))

  group18 = group1
  n8 = n
  ranks8 = ranks

  CALL mpi_group_incl(group18, n8, ranks8, newgroup8, ierror8)

  newgroup = newgroup8
  ierror = ierror8

  DEALLOCATE(ranks8)

END SUBROUTINE mpi_group_incl8

! ---------------------------------------------------------
SUBROUTINE mpi_init8(IERROR)

  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    IERROR

  INTEGER(KIND=8) :: &
    IERROR8

  CALL mpi_init(ierror8)

  ierror = ierror8

END SUBROUTINE mpi_init8

! ---------------------------------------------------------
SUBROUTINE mpi_initialized8(FLAG, IERROR)

  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    FLAG
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    IERROR

  INTEGER(KIND=8) :: &
    FLAG8
  INTEGER(KIND=8) :: &
    IERROR8


  CALL mpi_initialized(flag8, ierror8)

  flag = flag8
  ierror = ierror8

END SUBROUTINE mpi_initialized8

! ---------------------------------------------------------
SUBROUTINE mpi_iprobe8(SOURCE, TAG, COMM, FLAG, STATUS, IERROR)

  INTEGER(KIND=JPIM), INTENT(IN) :: &
    SOURCE, TAG, COMM
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    FLAG
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    STATUS(:), IERROR

  INTEGER(KIND=8) :: &
    SOURCE8, TAG8, COMM8, IERROR8
  INTEGER(KIND=8) :: &
    FLAG8

  source8 = source
  tag8 = tag
  comm8 = comm

  CALL mpi_iprobe(source8, tag8, comm8, flag8, status8, ierror8)

  flag = flag8
  status = status8
  ierror = ierror8

END SUBROUTINE mpi_iprobe8

! ---------------------------------------------------------
SUBROUTINE mpi_probe8(SOURCE, TAG, COMM, STATUS, IERROR)

  INTEGER(KIND=JPIM), INTENT(IN) :: &
    SOURCE, TAG, COMM
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    STATUS(:), IERROR

  INTEGER(KIND=8) :: &
    SOURCE8, TAG8, COMM8, IERROR8

  source8 = source
  tag8 = tag
  comm8 = comm

  CALL mpi_probe(source8, tag8, comm8, status8, ierror8)

  status = status8
  ierror = ierror8

END SUBROUTINE mpi_probe8

! ---------------------------------------------------------
SUBROUTINE mpi_wait8_i4(REQUEST, STATUS, IERROR)

  INTEGER(KIND=JPIM), INTENT(INOUT) :: &
    REQUEST
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    STATUS(:), IERROR

  INTEGER(KIND=8) :: &
    REQUEST8, IERROR8
  INTEGER(KIND=8), DIMENSION(:), ALLOCATABLE :: STATUS8

  ALLOCATE(status8(SIZE(status)))

  request8 = request

  CALL mpi_wait(request8, status8, ierror8)

  request = request8
  status = status8
  ierror = ierror8

  DEALLOCATE(status8)

END SUBROUTINE mpi_wait8_i4

! ---------------------------------------------------------
SUBROUTINE mpi_wait8_i4_1(REQUEST, STATUS, IERROR)

  INTEGER(KIND=JPIM) :: &
    REQUEST
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    STATUS, IERROR

  INTEGER(KIND=8) :: &
    REQUEST8, IERROR8, STATUS8

  request8 = request

  CALL mpi_wait(request8, status8, ierror8)

  request = request8
  status = status8
  ierror = ierror8

END SUBROUTINE mpi_wait8_i4_1

! ---------------------------------------------------------
SUBROUTINE mpi_waitall8_i4(COUNT, ARRAY_OF_REQUESTS, ARRAY_OF_STATUSES, IERROR)

  INTEGER(KIND=JPIM), INTENT(IN) :: &
    COUNT
  INTEGER(KIND=JPIM), DIMENSION(:), INTENT(INOUT) :: &
    ARRAY_OF_REQUESTS
  INTEGER(KIND=JPIM), DIMENSION(:,:), INTENT(OUT) :: &
    ARRAY_OF_STATUSES
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    IERROR

  INTEGER(KIND=8), DIMENSION(:), ALLOCATABLE :: &
    ARRAY_OF_REQUESTS8
  INTEGER(KIND=8), DIMENSION(:,:), ALLOCATABLE :: &
    ARRAY_OF_STATUSES8
  INTEGER(KIND=8) :: &
    COUNT8, IERROR8

  INTEGER :: N

  count8 = count

  ALLOCATE(array_of_requests8(SIZE(array_of_requests)))
  n = SIZE(array_of_statuses) / mpi_status_size
  ALLOCATE(array_of_statuses8(mpi_status_size,n))

  array_of_requests8 = array_of_requests

  CALL mpi_waitall(count8, array_of_requests8, array_of_statuses8, ierror8)

  array_of_requests = array_of_requests8
  array_of_statuses = array_of_statuses8

  DEALLOCATE(array_of_requests8)
  DEALLOCATE(array_of_statuses8)

  ierror = ierror8

END SUBROUTINE mpi_waitall8_i4

! ---------------------------------------------------------
SUBROUTINE mpi_waitall8_i4_1(COUNT, ARRAY_OF_REQUESTS, ARRAY_OF_STATUSES, IERROR)

  INTEGER(KIND=JPIM), INTENT(IN) :: &
    COUNT
  INTEGER(KIND=JPIM) :: &
    ARRAY_OF_REQUESTS
  INTEGER(KIND=JPIM), DIMENSION(:,:), INTENT(OUT) :: &
    ARRAY_OF_STATUSES
  INTEGER(KIND=JPIM), INTENT(OUT) :: &
    IERROR

  INTEGER(KIND=8) :: &
    ARRAY_OF_REQUESTS8
  INTEGER(KIND=8), DIMENSION(:,:), ALLOCATABLE :: &
    ARRAY_OF_STATUSES8
  INTEGER(KIND=8) :: &
    COUNT8, IERROR8

  INTEGER :: N

  count8 = count

  n = SIZE(array_of_statuses) / mpi_status_size
  ALLOCATE(array_of_statuses8(mpi_status_size,n))

  array_of_requests8 = array_of_requests

  CALL mpi_waitall(count8, array_of_requests8, array_of_statuses8, ierror8)

  array_of_requests = array_of_requests8
  array_of_statuses = array_of_statuses8

  DEALLOCATE(array_of_statuses8)

  ierror = ierror8

END SUBROUTINE mpi_waitall8_i4_1

#endif
END MODULE mpi4to8_s