mpl_buffer_method_mod.F90

Go to the documentation of this file.

MODULE mpl_buffer_method_mod

!**** MPL_BUFFER_METHOD Establish message passing default method

!     Purpose.
!     --------
!     Setup the message passing buffering 
!     by allocating an attached buffer if required.

!**   Interface.
!     ----------
!        CALL MPL_BUFFER_METHOD

!        Input required arguments :
!        -------------------------
!           KMP_TYPE -  buffering type
!                       possible values are :
!                       JP_BLOCKING_STANDARD, JP_BLOCKING_BUFFERED
!                       defined as parameters in MPL_DATA_MODULE

!        Input optional arguments :
!        -------------------------
!           KMBX_SIZE - Size (in bytes) of attached buffer 
!                       if KMP_TYPE=JP_BLOCKING_BUFFERED
!           KPROCIDS  - array of processor ids
!           LDINFO   -  = .TRUE.  : Print informative msgs from MPL_INIT (default) 
!                       = .FALSE. : Do not print

!        Output required arguments :
!        -------------------------
!           none

!        Output optional arguments :
!        -------------------------
!           KERROR   -  return error code.     If not supplied, 
!                       MPL_BUFFER_METHOD aborts when an error is detected.
!     Author.
!     -------
!        D.Dent, M.Hamrud     ECMWF

!     Modifications.
!     --------------
!        Original: 2000-09-01

!     ------------------------------------------------------------------

USE mpl_data_module
USE mpl_message_mod

IMPLICIT NONE

PRIVATE
PUBLIC mpl_buffer_method

CONTAINS 

SUBROUTINE mpl_buffer_method(KMP_TYPE,KMBX_SIZE,KERROR,KPROCIDS,LDINFO)


#ifdef USE_8_BYTE_WORDS
  USE mpi4to8, ONLY : &
    mpi_buffer_detach => mpi_buffer_detach8, mpi_buffer_attach => mpi_buffer_attach8
#endif


USE parkind1  ,ONLY : jpim     ,jprb

INTEGER(KIND=JPIM),INTENT(IN) ::  KMP_TYPE
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)  :: KMBX_SIZE
INTEGER(KIND=JPIM),OPTIONAL,INTENT(IN)  :: KPROCIDS(:)
INTEGER(KIND=JPIM),OPTIONAL,INTENT(OUT) :: KERROR
LOGICAL,INTENT(IN),OPTIONAL :: LDINFO
INTEGER(KIND=JPIM) :: IMBX_DEFAULT_SIZE = 1000000
INTEGER(KIND=JPIM) :: IBUFFMPI,IERROR,ILEN
LOGICAL :: LLABORT=.true., llinfo

IF(mpl_numproc < 1) CALL mpl_message( &
  & cdmessage='MPL_BUFFER_METHOD: MPL NOT INITIALISED ',ldabort=llabort) 

IF (ALLOCATED(mpl_attached_buffer)) THEN
  CALL mpi_buffer_detach(mpl_attached_buffer,mpl_mbx_size,ierror)
  DEALLOCATE(mpl_attached_buffer)
ENDIF

IF(PRESENT(ldinfo)) THEN
  llinfo = ldinfo
ELSE
  llinfo = .true.
ENDIF

IF(kmp_type == jp_blocking_standard) THEN
  ibuffmpi=mpl_mbx_size
ELSE IF(kmp_type == jp_blocking_buffered) THEN
  ibuffmpi=kmbx_size
  IF(ibuffmpi == 0) ibuffmpi=imbx_default_size
!    convert to bytes
  ilen = (ibuffmpi-1)/jp_attached_buffer_bytes+1
  ALLOCATE(mpl_attached_buffer(ilen))
#ifdef OPS_COMPILE
  ierror = 0
#else
  CALL mpi_buffer_attach(mpl_attached_buffer,ibuffmpi,ierror)
#endif
  IF(PRESENT(kerror)) THEN
    kerror=ierror
  ELSE
    IF( ierror /= 0 )THEN
      CALL mpl_message(ierror,'MPL_BUFFER_METHOD ','MPI_BUFFER_ATTACH ERROR',ldabort=llabort)
    ENDIF
  ENDIF
ELSE
!    invalid type
  IF(PRESENT(kerror)) THEN
    kerror=1
  ELSE
    CALL mpl_message(kmp_type,'MPL_BUFFER_METHOD','INVALID KMP_TYPE=',ldabort=llabort)
  ENDIF
ENDIF

mpl_mbx_size=ibuffmpi
mpl_method=kmp_type

IF (mpl_rank == 1) THEN
  IF (llinfo) WRITE(mpl_unit,'(A,I2,I12)') 'MPL_BUFFER_METHOD: ',mpl_method,mpl_mbx_size
ENDIF

IF(PRESENT(kprocids)) THEN
  IF(SIZE(kprocids) < mpl_numproc) THEN
    CALL mpl_message(cdmessage='MPL_BUFFER_METHOD: KPROCIDS NOT CORRECT',ldabort=llabort)
  ELSE
    mpl_ids=kprocids
  ENDIF
ENDIF

RETURN
END SUBROUTINE mpl_buffer_method

END MODULE mpl_buffer_method_mod