! (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