!  dfadn.f90 
!

!  FUNCTIONS/SUBROUTINES exported from dfadn.dll:
!  dfnr8 - subroutine 
!
subroutine dfnr8(SA)
use ifcom
use ISO_C_BINDING
  implicit none
  INTERFACE
   SUBROUTINE  S2DSA(LB1,UB1,LB2,UB2,A2)
      INTEGER, INTENT(IN) :: LB1,UB1,LB2,UB2
      real(8), INTENT(INOUT), pointer :: a2(:, : )
   END SUBROUTINE  S2DSA
   SUBROUTINE  S3DSA(LB1,UB1,LB2,UB2,LB3,UB3,A3)
      INTEGER, INTENT(IN) :: LB1,UB1,LB2,UB2,LB3,UB3
      real(8), INTENT(INOUT), pointer :: a3(:, : , :)
   END SUBROUTINE  S3DSA
END INTERFACE
  ! Expose subroutine dfnr8 to users of this DLL
  !dec$ attributes dllexport, stdcall, reference, alias : "DFNR8" :: dfnr8
  ! Variables
REAL(8),PARAMETER :: PI  = 4 * atan (1.0_8)  
integer(int_ptr_kind()), intent(inout) :: SA  !Pointer to a SafeArray structure
integer idim
type bounds_type
    integer lb  ! Lower Bound
    integer ub  ! Upper Bound
end type bounds_type
integer ibounds  ! Number of bounds
type(bounds_type), allocatable :: bounds(:)
integer, allocatable :: indexes(:)  ! Array to hold current element indexes
integer, allocatable :: aidimn(:)
integer :: i, iRes,isize,ivart,ilen
integer(C_INTPTR_T):: adptr
type(c_ptr) cptr;
real(8), pointer :: array_data(:), array_data1(:)
real(8), pointer :: a2d( : , : )
real(8), pointer :: a3d( : , : , : )
real(8), pointer :: a4d( : , : , : , : ) 
real(8), pointer :: a5d( : , : , : , : , : )
  ! Body of dfadn
ires=SafeArrayLock(SA)
isize=SafeArrayGetElemsize(SA)
!ires=SafeArrayGetVartype(SA,ivart) ! would be nice to be in ifcon to xlat types
!This routine for real(8)
idim = SafeArrayGetDim (SA)
if (idim>5) Then 
    return
end if
allocate (bounds(idim), indexes(idim),aidimn(idim))
ilen=1
do i=1,idim
    ires = SafeArrayGetLbound (SA, i, bounds(i)%lb)
    ires = SafeArrayGetUbound (SA, i, bounds(i)%ub)
    aidimn(i)=bounds(i)%ub-bounds(i)%lb + 1
    ilen=ilen*aidimn(i)
end do
!

ires=SafeArrayAccessData(SA,adptr)
cptr=transfer(adptr,c_null_ptr)
call c_f_pointer(cptr,array_data,[ilen])  
call c_f_pointer(cptr,array_data1,[ilen])
array_data(0:) => array_data1
!case 1 
if (idim==1) then
! Done, use array_data
! manipulate 1d test
! end manipulate 1d   
!
!case 2
else if( idim==2 ) then
    a2d(bounds(1)%lb:bounds(1)%ub,bounds(2)%lb:bounds(2)%ub)=>array_data
    !a2d(0:aidimn(1)-1, 0:aidimn(2)-1)=>array_data
    ! manipulate a2d test
    call S2DSA(bounds(1)%lb,bounds(1)%ub,bounds(2)%lb,bounds(2)%ub,a2d)
    !do i=0,2
    !   a2d(i,3)=PI*a2d(i,0)*a2d(i,0)*a2d(i,1)*a2d(i,2)/4
    !end do
    
    ! end manipulate a2d
!end case 2
!case 3
else if (idim==3) then
    a3d(bounds(1)%lb:bounds(1)%ub,bounds(2)%lb:bounds(2)%ub,bounds(3)%lb:bounds(3)%ub)=>array_data
    !a3d(0:aidimn(1)-1, 0:aidimn(2)-1,0:aidimn(3)-1)=>array_data
    ! manipulate a3d test
    call S3DSA(bounds(1)%lb,bounds(1)%ub,bounds(2)%lb,bounds(2)%ub,bounds(3)%lb,bounds(3)%ub,a3d)
    !do i=0,2
    !  a3d(0,i,3)=PI*a3d(0,i,0)*a3d(0,i,0)*a3d(0,i,1)*a3d(0,i,2)/4
    !  a3d(1,i,3)=a3d(1,i,0)*a3d(1,i,0)*a3d(1,i,1)*a3d(1,i,2)
    !end do
    ! end manipulate a3d
!end case3
!case 4
else if (idim==4) then
    a4d(bounds(1)%lb:bounds(1)%ub,bounds(2)%lb:bounds(2)%ub,bounds(3)%lb:bounds(3)%ub,bounds(4)%lb:bounds(4)%ub)=>array_data
    ! manipulate a4d test
    ! end manipulate a4d test
!end case 4
!case 5
else if (idim==5) then
    a5d(bounds(1)%lb:bounds(1)%ub,bounds(2)%lb:bounds(2)%ub,bounds(3)%lb:bounds(3)%ub,bounds(4)%lb:bounds(4)%ub,bounds(5)%lb:bounds(5)%ub)=>array_data
    ! manipulate a5d test
    ! end manipulate a5d test
!end case 5
end if
iRes=SafeArrayUnlock(SA)
  ! 
deallocate (bounds)
deallocate (indexes)
deallocate (aidimn)
!
    end subroutine dfnr8
subroutine S2DSA(lb1,ub1,lb2,ub2,a2)
REAL(8),PARAMETER :: PI  = 4 * atan (1.0_8)
integer, intent(in) :: lb1,ub1,lb2,ub2
real(8), dimension(:,:),pointer,intent(inout) :: a2
do i=0,2
  a2(i,3)=PI*a2(i,0)*a2(i,0)*a2(i,1)*a2(i,2)/4
end do
    end subroutine S2DSA 
subroutine S3DSA(lb1,ub1,lb2,ub2,lb3, ub3,a3)
REAL(8),PARAMETER :: PI  = 4 * atan (1.0_8)
integer, intent(in) :: lb1,ub1,lb2,ub2,lb3,ub3
real(8), dimension(:,:,:),pointer,intent(inout) :: a3
 do i=0,2
      a3(0,i,3)=PI*a3(0,i,0)*a3(0,i,0)*a3(0,i,1)*a3(0,i,2)/4
      a3(1,i,3)=a3(1,i,0)*a3(1,i,0)*a3(1,i,1)*a3(1,i,2)
    end do
end subroutine S3DSA   

