test_4d Subroutine

public subroutine test_4d()

Arguments

None

Calls

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

Source Code

   subroutine test_4d()
      type (LocalMemReference) :: a
      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,3))
      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,3))
      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,2))
      r = 100.0
      a = LocalMemReference(r)
      call c_f_pointer(a%base_address, rptr,shape(r))
      @assertTrue(nearlyEqual(rptr(:,1,2,1), r(:,1,2,1)))
      call a%deallocate()
      @assertTrue(.not. associated(a%i_ptr))

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

      deallocate(i)
      allocate(i(0,2,1,0))
      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_4d