xtest.f95 4.89 KiB
program main
use adjac
implicit none
integer, parameter :: n = 35
type(adjac_complexan), dimension(:,:,:,:,:), allocatable :: Q
double complex, dimension(:,:,:,:,:), allocatable :: U
type(adjac_complexan), dimension(1) :: res
double complex, dimension(:, :), allocatable ::jac
double complex :: v
double complex, dimension(:), allocatable :: hess_v
integer, dimension(:), allocatable :: hess_i
integer, dimension(:), allocatable :: hess_j
integer :: nnz
integer i1, i2, i3, i4, i5, p, p2
allocate(Q(n,n,2,2,2))
allocate(U(n,n,4,4,4))
allocate(jac(1, n*n*2*2*2))
call adjac_reset()
p = 1
p2 = 1
do i1 = 1, size(Q,1)
do i2 = 1, size(Q,2)
do i3 = 1, size(Q,3)
do i4 = 1, size(Q,4)
do i5 = 1, size(Q,5)
v = p - 1
call adjac_set_independent(Q(i1,i2,i3,i4,i5), v, p)
p = p + 1
end do
end do
end do
do i3 = 1, size(U,3)
do i4 = 1, size(U,4)
do i5 = 1, size(U,5)
U(i1,i2,i3,i4,i5) = p2 - 1
p2 = p2 + 1
end do
end do
end do
end do
end do
res(1) = S_2(Q, U, 0.1d0)
call adjac_get_dense_jacobian(res, jac)
do i1 = 1, 10
write(*,*) '->', jac(1,i1)
end do
call adjac_get_coo_hessian(res(1), nnz, hess_v, hess_i, hess_j)
do i1 = 1, nnz
write(*,*) hess_i(i1), hess_j(i1), '->>', hess_v(i1)
end do
call adjac_reset(.false.)
return
contains
function inverse(M) result(W)
use adjac