LocalMemReference.F90 Source File

#include "MAPL_ErrLog.h"
#include "unused_dummy.H"

module pFIO_LocalMemReferenceMod
   use, intrinsic :: iso_c_binding, only: C_NULL_PTR, c_associated
   use, intrinsic :: iso_c_binding, only: c_loc
   use, intrinsic :: iso_c_binding, only: c_f_pointer
   use, intrinsic :: iso_fortran_env, only: INT32
   use, intrinsic :: iso_fortran_env, only: INT64
   use, intrinsic :: iso_fortran_env, only: REAL32
   use, intrinsic :: iso_fortran_env, only: REAL64
   use MAPL_ExceptionHandling
   use pFIO_UtilitiesMod, only: word_size
   use pFIO_ConstantsMod
   use pFIO_AbstractDataReferenceMod

   implicit none
   private

   public :: LocalMemReference

   type,extends(AbstractDataReference) :: LocalMemReference
      integer, pointer :: i_ptr(:)
   contains
      procedure :: get_length
      procedure :: serialize
      procedure :: deserialize

      procedure :: allocate
      procedure :: deallocate
   end type LocalMemReference

   interface LocalMemReference
      module procedure new_LocalMemReference
      module procedure new_LocalMemReference_0d
      module procedure new_LocalMemReference_1d
      module procedure new_LocalMemReference_2d
      module procedure new_LocalMemReference_3d
      module procedure new_LocalMemReference_4d
      module procedure new_LocalMemReference_5d
   end interface LocalMemReference

contains


   function new_LocalMemReference(type_kind, shp, rc) result(reference)
      type (LocalMemReference) :: reference
      integer, intent(in) :: type_kind
      integer, intent(in) :: shp(:)
      integer, optional, intent(out) :: rc
      integer :: status

      reference%shape = shp
      reference%type_kind = type_kind
      call reference%allocate(rc=status)
      _VERIFY(status)
      _RETURN(_SUCCESS)
   end function new_LocalMemReference


   function new_LocalMemReference_0d(scalar, rc) result(reference)
      type (LocalMemReference) :: reference
      class(*), target, intent(in) :: scalar
      integer, optional, intent(out) :: rc
      integer (kind=INT32), pointer :: int32Ptr
      integer (kind=INT64), pointer :: int64Ptr
      real (kind=REAL32)  , pointer :: real32Ptr
      real (kind=REAL64)  , pointer :: real64Ptr
      integer :: status
 
      select type (scalar)
      type is (integer(kind=INT32))
         reference = LocalMemReference(pFIO_INT32, shape(scalar), rc=status)
         _VERIFY(status)
         call c_f_pointer(reference%base_address, int32Ptr)
         int32Ptr = scalar
      type is (integer(kind=INT64))
         reference = LocalMemReference(pFIO_INT64, shape(scalar), rc=status)
         _VERIFY(status)
         call c_f_pointer(reference%base_address, int64Ptr)
         int64Ptr = scalar
      type is (real(kind=REAL32))
         reference = LocalMemReference(pFIO_REAL32, shape(scalar), rc=status)
         _VERIFY(status)
         call c_f_pointer(reference%base_address, real32Ptr)
         real32Ptr = scalar
      type is (real(kind=REAL64))
         reference = LocalMemReference(pFIO_REAL64, shape(scalar), rc=status)
         _VERIFY(status)
         call c_f_pointer(reference%base_address, real64Ptr)
         real64Ptr = scalar
      class default
         _FAIL( "LocalMemRef does not support this type")
      end select

      _RETURN(_SUCCESS)
   end function new_LocalMemReference_0d

   function new_LocalMemReference_1d(array, rc) result(reference)
      type (LocalMemReference) :: reference
      class(*), target, intent(in) :: array(:)
      integer, optional, intent(out) :: rc
      integer (kind=INT32), pointer :: int32Ptr(:)
      integer (kind=INT64), pointer :: int64Ptr(:)
      real (kind=REAL32)  , pointer :: real32Ptr(:)
      real (kind=REAL64)  , pointer :: real64Ptr(:)
      integer :: status

      select type (array)
      type is (integer(kind=INT32))
         reference = LocalMemReference( pFIO_INT32, shape(array), rc=status)
         _VERIFY(status)
         if (.not. c_associated(reference%base_address)) then
            _RETURN(_SUCCESS)
         endif
         call c_f_pointer(reference%base_address, int32Ptr, shape=shape(array))
         int32Ptr = array
      type is (integer(kind=INT64))
         reference = LocalMemReference( pFIO_INT64, shape(array), rc=status)
         _VERIFY(status)
         if (.not. c_associated(reference%base_address)) then
            _RETURN(_SUCCESS)
         endif
         call c_f_pointer(reference%base_address, int64Ptr, shape=shape(array))
         int64Ptr = array
      type is (real(kind=REAL32))
         reference = LocalMemReference( pFIO_REAL32, shape(array), rc=status)
         _VERIFY(status)
         if (.not. c_associated(reference%base_address)) then
            _RETURN(_SUCCESS)
         endif
         call c_f_pointer(reference%base_address, real32Ptr, shape=shape(array))
         real32Ptr = array
      type is (real(kind=REAL64))
         reference = LocalMemReference( pFIO_REAL64, shape(array), rc=status)
         _VERIFY(status)
         if (.not. c_associated(reference%base_address)) then
            _RETURN(_SUCCESS)
         endif
         call c_f_pointer(reference%base_address, real64Ptr, shape=shape(array))
         real64Ptr = array
      class default
         _FAIL( "LocalMemRef does not support this type")
      end select

      _RETURN(_SUCCESS)

   end function new_LocalMemReference_1d

   function new_LocalMemReference_2d(array, rc) result(reference)
      type (LocalMemReference) :: reference
      class(*), target, intent(in) :: array(:,:)
      integer, optional, intent(out) :: rc
      integer (kind=INT32), pointer :: int32Ptr(:,:)
      integer (kind=INT64), pointer :: int64Ptr(:,:)
      real (kind=REAL32)  , pointer :: real32Ptr(:,:)
      real (kind=REAL64)  , pointer :: real64Ptr(:,:)
      integer :: status

      select type (array)
      type is (integer(kind=INT32))
         reference = LocalMemReference( pFIO_INT32, shape(array), rc=status)
         _VERIFY(status)
         if (.not. c_associated(reference%base_address)) then
            _RETURN(_SUCCESS)
         endif
         call c_f_pointer(reference%base_address, int32Ptr, shape=shape(array))
         int32Ptr = array
      type is (integer(kind=INT64))
         reference = LocalMemReference( pFIO_INT64, shape(array), rc=status)
         _VERIFY(status)
         if (.not. c_associated(reference%base_address)) then
            _RETURN(_SUCCESS)
         endif
         call c_f_pointer(reference%base_address, int64Ptr, shape=shape(array))
         int64Ptr = array
      type is (real(kind=REAL32))
         reference = LocalMemReference( pFIO_REAL32, shape(array), rc=status)
         _VERIFY(status)
         if (.not. c_associated(reference%base_address)) then
            _RETURN(_SUCCESS)
         endif
         call c_f_pointer(reference%base_address, real32Ptr, shape=shape(array))
         real32Ptr = array
      type is (real(kind=REAL64))
         reference = LocalMemReference( pFIO_REAL64, shape(array), rc=status)
         _VERIFY(status)
         if (.not. c_associated(reference%base_address)) then
            _RETURN(_SUCCESS)
         endif
         call c_f_pointer(reference%base_address, real64Ptr, shape=shape(array))
         real64Ptr = array
      class default
         _FAIL( "LocalMemRef does not support this type")
      end select

      _RETURN(_SUCCESS)

   end function new_LocalMemReference_2d

   function new_LocalMemReference_3d(array, rc) result(reference)
      type (LocalMemReference) :: reference
      class(*), target, intent(in) :: array(:,:,:)
      integer, optional, intent(out) :: rc
      integer (kind=INT32), pointer :: int32Ptr(:,:,:)
      integer (kind=INT64), pointer :: int64Ptr(:,:,:)
      real (kind=REAL32)  , pointer :: real32Ptr(:,:,:)
      real (kind=REAL64)  , pointer :: real64Ptr(:,:,:)
      integer :: status

      select type (array)
      type is (integer(kind=INT32))
         reference = LocalMemReference( pFIO_INT32, shape(array), rc=status)
         _VERIFY(status)
         if (.not. c_associated(reference%base_address)) then
            _RETURN(_SUCCESS)
         endif
         call c_f_pointer(reference%base_address, int32Ptr, shape=shape(array))
         int32Ptr = array
      type is (integer(kind=INT64))
         reference = LocalMemReference( pFIO_INT64, shape(array), rc=status)
         _VERIFY(status)
         if (.not. c_associated(reference%base_address)) then
            _RETURN(_SUCCESS)
         endif
         call c_f_pointer(reference%base_address, int64Ptr, shape=shape(array))
         int64Ptr = array
      type is (real(kind=REAL32))
         reference = LocalMemReference( pFIO_REAL32, shape(array), rc=status)
         _VERIFY(status)
         if (.not. c_associated(reference%base_address)) then
            _RETURN(_SUCCESS)
         endif
         call c_f_pointer(reference%base_address, real32Ptr, shape=shape(array))
         real32Ptr = array
      type is (real(kind=REAL64))
         reference = LocalMemReference( pFIO_REAL64, shape(array), rc=status)
         _VERIFY(status)
         if (.not. c_associated(reference%base_address)) then
            _RETURN(_SUCCESS)
         endif
         call c_f_pointer(reference%base_address, real64Ptr, shape=shape(array))
         real64Ptr = array
      class default
         _FAIL( "LocalMemRef does not support this type")
      end select

      _RETURN(_SUCCESS)

   end function new_LocalMemReference_3d

   function new_LocalMemReference_4d(array, rc) result(reference)
      type (LocalMemReference) :: reference
      class(*), target, intent(in) :: array(:,:,:,:)
      integer, optional, intent(out) :: rc
      integer (kind=INT32), pointer :: int32Ptr(:,:,:,:)
      integer (kind=INT64), pointer :: int64Ptr(:,:,:,:)
      real (kind=REAL32)  , pointer :: real32Ptr(:,:,:,:)
      real (kind=REAL64)  , pointer :: real64Ptr(:,:,:,:)
      integer :: status

      select type (array)
      type is (integer(kind=INT32))
         reference = LocalMemReference( pFIO_INT32, shape(array), rc=status)
         _VERIFY(status)
         if (.not. c_associated(reference%base_address)) then
            _RETURN(_SUCCESS)
         endif
         call c_f_pointer(reference%base_address, int32Ptr, shape=shape(array))
         int32Ptr = array
      type is (integer(kind=INT64))
         reference = LocalMemReference( pFIO_INT64, shape(array), rc=status)
         _VERIFY(status)
         if (.not. c_associated(reference%base_address)) then
            _RETURN(_SUCCESS)
         endif
         call c_f_pointer(reference%base_address, int64Ptr, shape=shape(array))
         int64Ptr = array
      type is (real(kind=REAL32))
         reference = LocalMemReference( pFIO_REAL32, shape(array), rc=status)
         _VERIFY(status)
         if (.not. c_associated(reference%base_address)) then
            _RETURN(_SUCCESS)
         endif
         call c_f_pointer(reference%base_address, real32Ptr, shape=shape(array))
         real32Ptr = array
      type is (real(kind=REAL64))
         reference = LocalMemReference( pFIO_REAL64, shape(array), rc=status)
         _VERIFY(status)
         if (.not. c_associated(reference%base_address)) then
            _RETURN(_SUCCESS)
         endif
         call c_f_pointer(reference%base_address, real64Ptr, shape=shape(array))
         real64Ptr = array
      class default
         _FAIL( "LocalMemRef does not support this type")
      end select

      _RETURN(_SUCCESS)

   end function new_LocalMemReference_4d

   function new_LocalMemReference_5d(array, rc) result(reference)
      type (LocalMemReference) :: reference
      class(*), target, intent(in) :: array(:,:,:,:,:)
      integer, optional, intent(out) :: rc
      integer (kind=INT32), pointer :: int32Ptr(:,:,:,:,:)
      integer (kind=INT64), pointer :: int64Ptr(:,:,:,:,:)
      real (kind=REAL32)  , pointer :: real32Ptr(:,:,:,:,:)
      real (kind=REAL64)  , pointer :: real64Ptr(:,:,:,:,:)
      integer :: status

      select type (array)
      type is (integer(kind=INT32))
         reference = LocalMemReference( pFIO_INT32, shape(array), rc=status)
         _VERIFY(status)
         if (.not. c_associated(reference%base_address)) then
            _RETURN(_SUCCESS)
         endif
         call c_f_pointer(reference%base_address, int32Ptr, shape=shape(array))
         int32Ptr = array
      type is (integer(kind=INT64))
         reference = LocalMemReference( pFIO_INT64, shape(array), rc=status)
         _VERIFY(status)
         if (.not. c_associated(reference%base_address)) then
            _RETURN(_SUCCESS)
         endif
         call c_f_pointer(reference%base_address, int64Ptr, shape=shape(array))
         int64Ptr = array
      type is (real(kind=REAL32))
         reference = LocalMemReference( pFIO_REAL32, shape(array), rc=status)
         _VERIFY(status)
         if (.not. c_associated(reference%base_address)) then
            _RETURN(_SUCCESS)
         endif
         call c_f_pointer(reference%base_address, real32Ptr, shape=shape(array))
         real32Ptr = array
      type is (real(kind=REAL64))
         reference = LocalMemReference( pFIO_REAL64, shape(array), rc=status)
         _VERIFY(status)
         if (.not. c_associated(reference%base_address)) then
            _RETURN(_SUCCESS)
         endif
         call c_f_pointer(reference%base_address, real64Ptr, shape=shape(array))
         real64Ptr = array
      class default
         _FAIL( "LocalMemRef does not support this type")
      end select

      _RETURN(_SUCCESS)

   end function new_LocalMemReference_5d

   subroutine allocate(this, rc)
      class (LocalMemReference), intent(inout) :: this
      integer, optional, intent(out) :: rc
      integer(kind=INT64) :: n_words
      integer(kind=INT64) :: n
      integer :: status

      n = product(int(this%shape,INT64))
      n_words = n * word_size(this%type_kind)
      allocate(this%i_ptr(n_words), stat=status)
      _VERIFY(status)

#ifdef __NAG_COMPILER_BUILD
      if (n > 0) then
         this%base_address = c_loc(this%i_ptr)
      else
         this%base_address =  C_NULL_PTR 
      endif
#else 
      this%base_address = c_loc(this%i_ptr)
#endif
      _RETURN(_SUCCESS)

   end subroutine allocate

   subroutine deallocate(this, rc)
      class (LocalMemReference), intent(inout) :: this
      integer, optional, intent(out) :: rc

      if (associated(this%i_ptr)) deallocate(this%i_ptr)
      this%base_address = C_NULL_PTR
      _RETURN(_SUCCESS)

   end subroutine deallocate

   integer function get_length(this) result(length)
      class (LocalMemReference), intent(in) :: this

      length = this%get_length_base()

   end function get_length


   subroutine serialize(this, buffer, rc)
      class (LocalMemReference), intent(in) :: this
      integer, optional, intent(out) :: rc

      integer, allocatable :: buffer(:)
      integer :: status
      call this%serialize_base(buffer, rc=status)
      _VERIFY(status)
      _RETURN(_SUCCESS)
   end subroutine serialize

   subroutine deserialize(this, buffer, rc)
      class (LocalMemReference), intent(inout) :: this
      integer, optional, intent(out) :: rc
      integer, intent(in) :: buffer(:)
      integer :: status
      call this%deserialize_base(buffer, rc=status)
      _VERIFY(status)
      _RETURN(_SUCCESS)
   end subroutine deserialize

end module pFIO_LocalMemReferenceMod