!  testsafearray.f90 
!
!  FUNCTIONS/SUBROUTINES exported from testsafearray.dll:
!  testsafearray - subroutine 
!
subroutine testin (VBArray, VBArray1) bind(C)
 USE, INTRINSIC :: ISO_C_BINDING
 !DEC$ ATTRIBUTES DLLEXPORT::testin
 USE IFCOM ! Declare SafeArray and BSTR interfaces

  ! Expose subroutine testsafearray this DLL
  !
  ! Variables
  implicit none

    
  Type SAFEARRAY
   integer(kind=2)          :: cDims        ! Count of dimensions in this array.
   integer(kind=2)          :: fFeatures    ! Flags used by the SafeArray
   integer(kind=4)          :: cbElements   ! Size of an element of the array.
   integer(kind=4)          :: cLocks       ! Number of locks
   type(c_ptr)              :: pvData       ! Pointer to the data.
  End Type SAFEARRAY
  
  integer(int_ptr_kind()), intent(inout) :: VBArray, VBArray1  !Pointer to a SafeArray structure  

  
  ! Array in which we will keep track of array bounds
  type bounds_type
    integer lb  ! Lower Bound
    integer ub  ! Upper Bound
  end type bounds_type


  integer(C_INTPTR_T)               :: adptr
  type(c_ptr)                       :: cptr
  integer                           :: nbounds  ! Number of bounds
  type(bounds_type), allocatable    :: bounds(:) 
  integer, allocatable              :: indexes(:)  ! Array to hold current element indexes
  integer                           :: i, j, iRes, length, stat, cdims, vtype, iDim, iType
  real(kind=8), pointer             :: array_data(:), testptr
  real(kind=8)                      :: result(0:10), rslt


 !   VBArray1 = VBArray


 ! Body of testsafearray
  
  open (2, file="C:\Users\Rick\source\repos\testsafearray\testsafearray\x64\Debug\testout.txt", status="replace")
  
 ! write(2,*) " VBArray1 : cDims ", VBArray1%cDims
 ! write(2,*) " VBArray1 : fFeatures ", VBArray1%fFeatures
 ! write(2,*) " VBArray1 : cbElements ", VBArray1%cbElements
 ! write(2,*) " VBArray1 : clocks ", VBArray1%clocks
!  write(2,'(A,Z8)') " VBArray1 : address ", VBArray1%pvData
  
   nbounds = SafeArrayGetDim (VBArray)
   write(2, *) " No of bounds is ", nbounds
   
   allocate (bounds(nbounds) , indexes(nbounds))
  
  do i=1,nbounds
    ires = SafeArrayGetLbound (VBArray, i, bounds(i)%lb)
    ires = SafeArrayGetUbound (VBArray, i, bounds(i)%ub)
  end do
   
  write (2, *) " Shape of the array passed by VB:"  
  write (2,'("  (")',advance='no')
  do i=1,nbounds
    write (2,'(I0,":",I0)',advance='no') bounds(i)
    if (i < nbounds) write(2,'(",")',advance='no')
    end do
  write (2,'(")")')
  !
  indexes = bounds%lb  ! Initialize to all lower bounds
  
  iRes=SafeArrayAccessData(VBArray,adptr)
  iRes = SafeArrayGetElemSize(VBArray)
  write(2, *) " size of elements is ", iRes
  iDim = SafeArrayGetDim(VBArray)  
  write(2, *) " dimension is ", iDim
  iRes = SafeArrayGetVarType(VBArray, iType)
    write(2, *) " type is ", iType
  
  do j = bounds(1)%lb, bounds(1)%ub   
    iRes=SafeArrayGetElement(VBArray,j, loc(rslt))  
    result(j) = rslt
    write(2, *) " result(",j,") = ", result(j)
  end do
  
  iDim =  bounds(1)%ub -  bounds(1)%lb + 1
  call C_F_POINTER( transfer(adptr,c_null_ptr), array_data, [iDim] )
  !
    do j = 1, iDim
        write(2,*) "array_data(",j,") is ", array_data(j)
        array_data(j) = array_data(j) +15.0
    end do
  
  close (2) ! We're done with the file
  
  deallocate (bounds)
  deallocate (indexes)
  return  


end subroutine testin