test_3d Subroutine

public subroutine test_3d()

Arguments

None

Calls

proc~~test_3d~~CallsGraph proc~test_3d test_3d asserttrue asserttrue proc~test_3d->asserttrue interface~nearlyequal nearlyEqual proc~test_3d->interface~nearlyequal

Source Code

   subroutine test_3d()
      type (LocalMemReference) :: a
      class (AbstractDataReference), allocatable :: b
      integer (kind=INT32),allocatable :: i(:,:,:)
      integer (kind=INT64),allocatable :: j(:,:,:)
      real (kind=REAL32), allocatable  :: r(:,:,:)
      real (kind=REAL64), allocatable  :: d(:,:,:)

      integer ( kind=INT32), pointer :: iPtr(:,:,:)
      integer ( kind=INT64), pointer :: jPtr(:,:,:)
      real ( kind=REAL32), pointer :: rPtr(:,:,:)
      real ( kind=REAL64), pointer :: dPtr(:,:,:)

      allocate(i(10,2,2))
      i = 100
      a = LocalMemReference(i)
      call c_f_pointer(a%base_address, iptr,shape(i))
      @assertTrue(all(iptr == i))
      call a%deallocate()
      @assertTrue(.not. associated(a%i_ptr))

      allocate(j(10,5,2))
      j = 10000
      a = LocalMemReference(j)
      call c_f_pointer(a%base_address, jptr,shape(j))
      @assertTrue(all(jptr == j))
      call a%deallocate()
      @assertTrue(.not. associated(a%i_ptr))

      allocate(r(10,3,2))
      r = 100.0
      a = LocalMemReference(r)
      allocate(b, source = a)
      @assertTrue(c_associated(b%base_address, a%base_address))
      call c_f_pointer(b%base_address, rptr,shape(r))
      @assertTrue(nearlyEqual(rptr(:,1,2), r(:,1,2)))
      call a%deallocate()
      @assertTrue(.not. associated(a%i_ptr))

      allocate(d(2,3,3))
      d = 100.0d0
      a = LocalMemReference(d)
      call c_f_pointer(a%base_address, dptr,shape(d))
      @assertTrue(nearlyEqual(dptr(:,2,3), d(:,2,3)))
      call a%deallocate()
      @assertTrue(.not. associated(a%i_ptr))

      deallocate(i)
      allocate(i(0,2,1))
      a = LocalMemReference(i)
      call c_f_pointer(a%base_address, iptr,shape(i))
      !@assertFalse(associated(iptr))
      @assertTrue( size(a%i_ptr) ==0)
      call a%deallocate()
      @assertTrue(.not. associated(a%i_ptr))

   end subroutine test_3d