sharedmem_mod.F90 Source File

! (C) Copyright 2015- ECMWF.
! 
! 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 SHAREDMEM_MOD

! Routines to allow use of shared memery segments in Fortran


!  Willem Deconinck and Mats Hamrud  *ECMWF*
!        Original : July 2015


USE, INTRINSIC :: ISO_C_BINDING, ONLY:  C_PTR, C_INT, C_NULL_PTR,C_SIZE_T

#ifdef __NEC__
#define C_SIZEOF(x) INT(KIND(x),C_SIZE_T)
#endif

IMPLICIT NONE

PRIVATE

PUBLIC :: SHAREDMEM
PUBLIC :: SHAREDMEM_ALLOCATE
PUBLIC :: SHAREDMEM_MALLOC_BYTES
PUBLIC :: SHAREDMEM_CREATE
PUBLIC :: SHAREDMEM_ASSOCIATE
PUBLIC :: SHAREDMEM_ADVANCE
PUBLIC :: SHAREDMEM_DELETE

TYPE, BIND(C) :: SHAREDMEM
! Memory buffer
  TYPE(C_PTR), PRIVATE :: BEGIN=C_NULL_PTR
  INTEGER(C_SIZE_T), PRIVATE :: SIZE=0   ! IN BYTES
  TYPE(C_PTR), PRIVATE :: CPTR=C_NULL_PTR
  INTEGER(C_SIZE_T), PRIVATE :: OFFSET=0 ! IN BYTES
END TYPE SHAREDMEM


INTERFACE SHAREDMEM_ASSOCIATE
! Associate fortran scalars/arrays with memory segment
  MODULE PROCEDURE SHAREDMEM_ASSOCIATE0_INT32
  MODULE PROCEDURE SHAREDMEM_ASSOCIATE0_REAL32
  MODULE PROCEDURE SHAREDMEM_ASSOCIATE0_REAL64
  MODULE PROCEDURE SHAREDMEM_ASSOCIATE1_INT32
  MODULE PROCEDURE SHAREDMEM_ASSOCIATE1_REAL32
  MODULE PROCEDURE SHAREDMEM_ASSOCIATE1_REAL64
  MODULE PROCEDURE SHAREDMEM_ASSOCIATE2_INT32
  MODULE PROCEDURE SHAREDMEM_ASSOCIATE2_REAL32
  MODULE PROCEDURE SHAREDMEM_ASSOCIATE2_REAL64
END INTERFACE


INTERFACE

! EXTERNAL C FUNCTIONS USED IN THIS MODULE
! ----------------------------------------

  SUBROUTINE SHAREDMEM_ADVANCE_BYTES(CPTR,BYTES) BIND(C)
  USE, INTRINSIC :: ISO_C_BINDING, ONLY:  C_PTR, C_SIZE_T
  TYPE(C_PTR) :: CPTR
  INTEGER(C_SIZE_T), VALUE :: BYTES
  END SUBROUTINE SHAREDMEM_ADVANCE_BYTES

  SUBROUTINE SHAREDMEM_MALLOC_BYTES(PTR,BYTES) BIND(C)
  USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_PTR, C_SIZE_T
  TYPE(C_PTR) :: PTR
  INTEGER(C_SIZE_T), VALUE :: BYTES
  END SUBROUTINE SHAREDMEM_MALLOC_BYTES

  SUBROUTINE SHAREDMEM_FREE(PTR) BIND(C)
  USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_PTR
  TYPE(C_PTR), INTENT(IN) :: PTR
  END SUBROUTINE SHAREDMEM_FREE

END INTERFACE

CONTAINS
!=========================================================================
SUBROUTINE SHAREDMEM_CREATE(HANDLE,CPTR,BYTES)
! Create memory buffer object from c pointer
USE, INTRINSIC :: ISO_C_BINDING, ONLY:  C_PTR, C_SIZE_T, C_F_POINTER
TYPE(SHAREDMEM), INTENT(OUT) :: HANDLE
TYPE(C_PTR)   , INTENT(IN)  :: CPTR
INTEGER(C_SIZE_T), INTENT(IN)  :: BYTES
!------------------------------------------------------------------------
HANDLE%BEGIN  = CPTR
HANDLE%SIZE   = BYTES
HANDLE%CPTR   = HANDLE%BEGIN
HANDLE%OFFSET = 0
END SUBROUTINE SHAREDMEM_CREATE
!=========================================================================
SUBROUTINE SHAREDMEM_ALLOCATE(HANDLE,BYTES)
!  Create memory buffer object from Fortran
USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_SIZE_T
TYPE(SHAREDMEM), INTENT(OUT) :: HANDLE
INTEGER(C_SIZE_T), INTENT(IN)  :: BYTES
INTEGER(C_SIZE_T) :: SIZE
!------------------------------------------------------------------------
SIZE = BYTES
CALL SHAREDMEM_MALLOC_BYTES(HANDLE%BEGIN,SIZE)
HANDLE%SIZE = BYTES
HANDLE%CPTR = HANDLE%BEGIN
HANDLE%OFFSET = 0
END SUBROUTINE SHAREDMEM_ALLOCATE
!=========================================================================
SUBROUTINE SHAREDMEM_DELETE(HANDLE)
! Free memory buffer
TYPE(SHAREDMEM), INTENT(OUT) :: HANDLE
CALL SHAREDMEM_FREE(HANDLE%BEGIN)
END SUBROUTINE SHAREDMEM_DELETE
!=========================================================================

! PRIVATE SUBROUTINES
! -------------------

SUBROUTINE SHAREDMEM_ASSOCIATE0_INT32(HANDLE,VALUE,ADVANCE)
  USE, INTRINSIC :: ISO_C_BINDING
  TYPE(SHAREDMEM),          INTENT(INOUT) :: HANDLE
  INTEGER(C_INT),          INTENT(OUT)   :: VALUE
  LOGICAL, OPTIONAL,       INTENT(IN)    :: ADVANCE
  INTEGER(C_INT), POINTER :: FPTR(:)
  INTEGER(C_INT) :: K

  CALL C_F_POINTER ( HANDLE%CPTR , FPTR , (/1/) )
  VALUE = FPTR(1)

  IF( PRESENT(ADVANCE) ) THEN
    IF( ADVANCE ) THEN
      CALL SHAREDMEM_ADVANCE_BYTES(HANDLE%CPTR,C_SIZEOF(K))
      HANDLE%OFFSET = HANDLE%OFFSET+C_SIZEOF(K)
    ENDIF
  ENDIF

END SUBROUTINE SHAREDMEM_ASSOCIATE0_INT32

SUBROUTINE SHAREDMEM_ASSOCIATE0_REAL32(HANDLE,VALUE,ADVANCE)
  USE, INTRINSIC :: ISO_C_BINDING
  TYPE(SHAREDMEM),          INTENT(INOUT) :: HANDLE
  REAL(C_FLOAT),          INTENT(OUT)   :: VALUE
  LOGICAL, OPTIONAL,       INTENT(IN)    :: ADVANCE
  REAL(C_FLOAT), POINTER :: FPTR(:)
  REAL(C_FLOAT) :: R

  CALL C_F_POINTER ( HANDLE%CPTR , FPTR , (/1/) )
  VALUE = FPTR(1)

  IF( PRESENT(ADVANCE) ) THEN
    IF( ADVANCE ) THEN
      CALL SHAREDMEM_ADVANCE_BYTES(HANDLE%CPTR,C_SIZEOF(R))
      HANDLE%OFFSET = HANDLE%OFFSET+C_SIZEOF(R)

    ENDIF
  ENDIF

END SUBROUTINE SHAREDMEM_ASSOCIATE0_REAL32

SUBROUTINE SHAREDMEM_ASSOCIATE0_REAL64(HANDLE,VALUE,ADVANCE)
  USE, INTRINSIC :: ISO_C_BINDING
  TYPE(SHAREDMEM),          INTENT(INOUT) :: HANDLE
  REAL(C_DOUBLE),          INTENT(OUT)   :: VALUE
  LOGICAL, OPTIONAL,       INTENT(IN)    :: ADVANCE
  REAL(C_DOUBLE), POINTER :: FPTR(:)
  REAL(C_DOUBLE) :: R

  CALL C_F_POINTER ( HANDLE%CPTR , FPTR , (/1/) )
  VALUE = FPTR(1)

  IF( PRESENT(ADVANCE) ) THEN
    IF( ADVANCE ) THEN
      CALL SHAREDMEM_ADVANCE_BYTES(HANDLE%CPTR,C_SIZEOF(R))
      HANDLE%OFFSET = HANDLE%OFFSET+C_SIZEOF(R)

    ENDIF
  ENDIF

END SUBROUTINE SHAREDMEM_ASSOCIATE0_REAL64

SUBROUTINE SHAREDMEM_ASSOCIATE1_INT32(HANDLE,SIZE,FPTR,ADVANCE)
  USE, INTRINSIC :: ISO_C_BINDING
  TYPE(SHAREDMEM),          INTENT(INOUT) :: HANDLE
  INTEGER(C_INT),          INTENT(IN)  :: SIZE
  INTEGER(KIND=C_INT), POINTER, INTENT(INOUT) :: FPTR(:)
  LOGICAL, OPTIONAL,       INTENT(IN)    :: ADVANCE
  INTEGER(C_INT) :: K

  CALL C_F_POINTER ( HANDLE%CPTR , FPTR , (/SIZE/) )

  IF( PRESENT(ADVANCE) ) THEN
    IF( ADVANCE ) THEN
      CALL SHAREDMEM_ADVANCE_BYTES(HANDLE%CPTR,SIZE*C_SIZEOF(K))
      HANDLE%OFFSET = HANDLE%OFFSET+SIZE*C_SIZEOF(K)
    ENDIF
  ENDIF

END SUBROUTINE SHAREDMEM_ASSOCIATE1_INT32


SUBROUTINE SHAREDMEM_ASSOCIATE1_REAL32(HANDLE,SIZE,FPTR,ADVANCE)
  USE, INTRINSIC :: ISO_C_BINDING
  TYPE(SHAREDMEM),          INTENT(INOUT) :: HANDLE
  INTEGER(C_INT),          INTENT(IN)  :: SIZE
  REAL(C_FLOAT), POINTER, INTENT(INOUT) :: FPTR(:)
  LOGICAL, OPTIONAL,       INTENT(IN)    :: ADVANCE
  REAL(C_FLOAT) :: R

  CALL C_F_POINTER ( HANDLE%CPTR , FPTR , (/SIZE/) )

  IF( PRESENT(ADVANCE) ) THEN
    IF( ADVANCE ) THEN
      CALL SHAREDMEM_ADVANCE_BYTES(HANDLE%CPTR,SIZE*C_SIZEOF(R))
      HANDLE%OFFSET = HANDLE%OFFSET+SIZE*C_SIZEOF(R)
    ENDIF
  ENDIF

END SUBROUTINE SHAREDMEM_ASSOCIATE1_REAL32


SUBROUTINE SHAREDMEM_ASSOCIATE1_REAL64(HANDLE,SIZE,FPTR,ADVANCE)
  USE, INTRINSIC :: ISO_C_BINDING
  TYPE(SHAREDMEM),          INTENT(INOUT) :: HANDLE
  INTEGER(C_INT),          INTENT(IN)  :: SIZE
  REAL(C_DOUBLE), POINTER, INTENT(INOUT) :: FPTR(:)
  LOGICAL, OPTIONAL,       INTENT(IN)    :: ADVANCE
  REAL(C_DOUBLE) :: R

  CALL C_F_POINTER ( HANDLE%CPTR , FPTR , (/SIZE/) )

  IF( PRESENT(ADVANCE) ) THEN
    IF( ADVANCE ) THEN
      CALL SHAREDMEM_ADVANCE_BYTES(HANDLE%CPTR,SIZE*C_SIZEOF(R))
      HANDLE%OFFSET = HANDLE%OFFSET+SIZE*C_SIZEOF(R)
    ENDIF
  ENDIF

END SUBROUTINE SHAREDMEM_ASSOCIATE1_REAL64

SUBROUTINE SHAREDMEM_ASSOCIATE2_INT32(HANDLE,DIM1,DIM2,FPTR,ADVANCE)
  USE, INTRINSIC :: ISO_C_BINDING
  TYPE(SHAREDMEM),          INTENT(INOUT) :: HANDLE
  INTEGER(C_INT),          INTENT(IN)  :: DIM1,DIM2
  INTEGER(C_INT), POINTER, INTENT(INOUT) :: FPTR(:,:)
  LOGICAL, OPTIONAL,       INTENT(IN)    :: ADVANCE
  INTEGER(C_INT) :: K

  CALL C_F_POINTER ( HANDLE%CPTR , FPTR , (/DIM1,DIM2/) )

  IF( PRESENT(ADVANCE) ) THEN
    IF( ADVANCE ) THEN
      CALL SHAREDMEM_ADVANCE_BYTES(HANDLE%CPTR,DIM1*DIM2*C_SIZEOF(K))
      HANDLE%OFFSET = HANDLE%OFFSET+DIM1*DIM2*C_SIZEOF(K)
    ENDIF
  ENDIF

END SUBROUTINE SHAREDMEM_ASSOCIATE2_INT32


SUBROUTINE SHAREDMEM_ASSOCIATE2_REAL32(HANDLE,DIM1,DIM2,FPTR,ADVANCE)
  USE, INTRINSIC :: ISO_C_BINDING
  TYPE(SHAREDMEM),          INTENT(INOUT) :: HANDLE
  INTEGER(C_INT),          INTENT(IN)  :: DIM1,DIM2
  REAL(C_FLOAT), POINTER, INTENT(INOUT) :: FPTR(:,:)
  LOGICAL, OPTIONAL,       INTENT(IN)    :: ADVANCE
  REAL(C_FLOAT) :: R

  CALL C_F_POINTER ( HANDLE%CPTR , FPTR , (/DIM1,DIM2/) )

  IF( PRESENT(ADVANCE) ) THEN
    IF( ADVANCE ) THEN
      CALL SHAREDMEM_ADVANCE_BYTES(HANDLE%CPTR,DIM1*DIM2*C_SIZEOF(R))
      HANDLE%OFFSET = HANDLE%OFFSET+DIM1*DIM2*C_SIZEOF(R)
    ENDIF
  ENDIF

END SUBROUTINE SHAREDMEM_ASSOCIATE2_REAL32


SUBROUTINE SHAREDMEM_ASSOCIATE2_REAL64(HANDLE,DIM1,DIM2,FPTR,ADVANCE)
  USE, INTRINSIC :: ISO_C_BINDING
  TYPE(SHAREDMEM),          INTENT(INOUT) :: HANDLE
  INTEGER(C_INT),          INTENT(IN)  :: DIM1,DIM2
  REAL(C_DOUBLE), POINTER, INTENT(INOUT) :: FPTR(:,:)
  LOGICAL, OPTIONAL,       INTENT(IN)    :: ADVANCE
  REAL(C_DOUBLE) :: R

  CALL C_F_POINTER ( HANDLE%CPTR , FPTR , (/DIM1,DIM2/) )

  IF( PRESENT(ADVANCE) ) THEN
    IF( ADVANCE ) THEN
      CALL SHAREDMEM_ADVANCE_BYTES(HANDLE%CPTR,DIM1*DIM2*C_SIZEOF(R))
      HANDLE%OFFSET = HANDLE%OFFSET+DIM1*DIM2*C_SIZEOF(R)
    ENDIF
  ENDIF

END SUBROUTINE SHAREDMEM_ASSOCIATE2_REAL64

SUBROUTINE SHAREDMEM_ADVANCE(HANDLE,BYTES)
  USE, INTRINSIC :: ISO_C_BINDING
  TYPE(SHAREDMEM), INTENT(INOUT) :: HANDLE
  INTEGER(C_INT), INTENT(IN)    :: BYTES
  INTEGER(C_SIZE_T) :: SIZE
  SIZE = BYTES
  CALL SHAREDMEM_ADVANCE_BYTES(HANDLE%CPTR,SIZE)
  HANDLE%OFFSET = HANDLE%OFFSET+BYTES
END SUBROUTINE SHAREDMEM_ADVANCE

!============================================================================
END MODULE SHAREDMEM_MOD