sharedmem_mod.F90

Go to the documentation of this file.

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
USE parkind1  ,ONLY : jpim, jprb ,jprd


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=JPIM), POINTER, INTENT(OUT) :: 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(OUT) :: 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(OUT) :: 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(OUT) :: 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(OUT) :: 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(OUT) :: 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