Obtaining information about a Safe Array and mapping Safe Arrays into Fortran Arrays (SafeArrayGetInfo)

This is a simple example illustrating how easily you obtain information about a Safe Array. Also note how we use a Fortran array (FArray) as a template to create and initialize a Safe Array, and how we map another Fortran array into the Safe Array to print its content. These two points are also illustrated in the example for Safe Array creation.

program SafeArrayGetInformation

!Demonstrates several functions and subroutines
!that are used to obtain information about the
!characteristics of a Safe Array
!Copyright 1999-2000, Canaima Software
!All rights reserved

use f90VBDefs
use f90VBSafeArrays
implicit none

integer(SAFEARRAY_KIND)::SAHndl
real(DOUBLE_KIND),dimension(:,:),allocatable::FArray
integer(LONG_KIND)::i,j
integer(HRESULT_KIND)::iRet
real(DOUBLE_KIND),dimension(:,:),pointer::MapArray
integer(POINTER_KIND)::DataPtr

!Create a Fortran array of the given dimensions
print *,'Enter dimensions of the array (i,j):'
read (*,*) i,j
allocate(FArray(i,j))

!Fill out the Fortran array with random values
call random_seed
do i=1,ubound(FArray,1)
    do j=1,ubound(Farray,2)
        call random_number(FArray(i,j))
    enddo
enddo

!Create a new Safe Array using FArray as a base
call SafeArrayCreate(SAHndl, VT_R8, FArray)

!print information about the created safe array
print *,''
print *,'Information about Safe Array SAHndl:'
print *,'Safe Array Hndle:',SAHndl
call SafeArrayAccessData(SAHndl,DataPtr,iRet)
print *,'Data Pointer:',DataPtr
call SafeArrayUnAccessData(SAHndl,iRet)
print *,'Dimensions:',SafeArrayGetDim(SAHndl)
print *,'Element type:', SafeArrayVarType(SAHndl)
print *,'Element size:',SafeArrayGetElementSize(SAHndl)
print *,'Current Locks:', SafeArrayGetLocks(SAHndl)
print *,'Feature flags:', SafeArrayGetFeatures(SAHndl)

print *,''
print *,'First Dimension:'
print *,'Lower bound:',SafeArrayLowerBound(SAHndl,1)
print *,'Upper bound:',SafeArrayUpperBound(SAHndl,1)
print *,'Number of elements:', SafeArrayNElements(SAHndl,1)

print *,'Second Dimension:'
print *,'Lower bound:',SafeArrayLowerBound(SAHndl,2)
print *,'Upper bound:',SafeArrayUpperBound(SAHndl,2)
print *,'Number of elements:', SafeArrayNElements(SAHndl,2)

!Map array and print the first 5 rows and columns
print *,''
print *,'First 4 rows and columns of Safe Array SAHndl:'
call SafeArrayAccessData(SAHndl,MapArray,iRet)
do i=lbound(MapArray,1),min(lbound(MapArray,1)+3,ubound(MapArray,1))
    write(*,'(4f10.5)') (MapArray(i,j), j=lbound(MapArray,2), &
                        min(lbound(MapArray,2)+3,ubound(MapArray,2)))
enddo
!Destroy mapping
call SafeArrayUnAccessData(SAHndl,iRet)

!Destory the safe array
call SafeArrayDestroy(SAHndl)

stop
end