mpl_testsome_mod.F90

Go to the documentation of this file.

MODULE mpl_testsome_mod

USE mpl_mpif
USE parkind1, ONLY : jpim
USE mpl_message_mod
IMPLICIT NONE

! P. Marguinaud : 01-Jan-2011 

! KARRAY_OF_REQUESTS  (see MPI_TESTSOME)
! KARRAY_OF_INDICES   (see MPI_TESTSOME)
! KARRAY_OF_INDICES1  pending requests
! KOUTCOUNT1          number of pending requests

PRIVATE
PUBLIC :: mpl_testsome

CONTAINS

SUBROUTINE mpl_testsome (KARRAY_OF_REQUESTS, KARRAY_OF_INDICES,      &
                       & KARRAY_OF_INDICES1, KOUTCOUNT, KOUTCOUNT1,  &
                       & KERROR, CDSTRING, LDWAIT)
INTEGER(KIND=JPIM), INTENT (IN)  :: KARRAY_OF_REQUESTS (:)
INTEGER(KIND=JPIM), INTENT (OUT) :: KARRAY_OF_INDICES (:)
INTEGER(KIND=JPIM), INTENT (OUT), OPTIONAL :: KARRAY_OF_INDICES1 (:)
INTEGER(KIND=JPIM), INTENT (OUT), OPTIONAL :: KOUTCOUNT
INTEGER(KIND=JPIM), INTENT (OUT), OPTIONAL :: KOUTCOUNT1
INTEGER(KIND=JPIM), INTENT (OUT), OPTIONAL :: KERROR
CHARACTER*(*),      INTENT(IN),   OPTIONAL :: CDSTRING
LOGICAL,            INTENT(IN),   OPTIONAL :: LDWAIT

INTEGER(KIND=JPIM) :: IERROR
INTEGER(KIND=JPIM) :: IINCOUNT
INTEGER(KIND=JPIM) :: IOUTCOUNT
INTEGER(KIND=JPIM) :: IARRAY_OF_STATUSES (mpi_status_size, size (karray_of_requests))
INTEGER(KIND=JPIM) :: II, IJ, IK
LOGICAL :: LLWAIT
LOGICAL :: LLABORT=.true.



iincount = SIZE (karray_of_requests)
karray_of_indices = -1

llwait = .false.
IF (PRESENT (ldwait)) llwait = ldwait

IF (llwait) THEN
  CALL mpi_waitsome(iincount, karray_of_requests, ioutcount, &
                    karray_of_indices, iarray_of_statuses, ierror)
ELSE
  CALL mpi_testsome(iincount, karray_of_requests, ioutcount, &
                    karray_of_indices, iarray_of_statuses, ierror)
ENDIF

IF (PRESENT (koutcount)) THEN
  koutcount = ioutcount
ENDIF

IF (PRESENT (koutcount1)) THEN
  koutcount1 = iincount - ioutcount
ENDIF

IF (PRESENT (karray_of_indices1)) THEN
  karray_of_indices1 = -1
  ij = 1
  ik = 1
  DO ii = 1, iincount
    IF (ii .EQ. karray_of_indices(ij)) THEN
      ij = ij + 1
    ELSE
      karray_of_indices1(ik) = ii
      ik = ik + 1
    ENDIF
  ENDDO
ENDIF

IF (PRESENT (kerror)) THEN
  kerror = ierror
ELSE
  IF(ierror /= 0) CALL mpl_message(ierror,'MPL_TESTSOME',cdstring,ldabort=llabort)
ENDIF

END SUBROUTINE mpl_testsome

END MODULE mpl_testsome_mod