diff --git a/.github/workflows/test.yaml b/.github/workflows/test.yaml index 2162b4f..0bf7e31 100644 --- a/.github/workflows/test.yaml +++ b/.github/workflows/test.yaml @@ -42,3 +42,5 @@ jobs: ./test/test_forwarddiff valgrind --error-exitcode=1 --leak-check=full ./test/test_forwarddiff python ../test/test_jax.py + ./test/test_sparse + valgrind --error-exitcode=1 --leak-check=full ./test/test_sparse diff --git a/src/forwarddiff_derivative.f90 b/src/forwarddiff_derivative.f90 index 1290f5b..87dd584 100644 --- a/src/forwarddiff_derivative.f90 +++ b/src/forwarddiff_derivative.f90 @@ -5,7 +5,7 @@ module forwarddiff_derivative private public :: derivative, derivative_sig - public :: grad, grad_sig + public :: gradient, gradient_sig public :: jacobian, jacobian_sig abstract interface @@ -15,7 +15,7 @@ function derivative_sig(x) result(res) type(dual) :: res end function - function grad_sig(x) result(res) + function gradient_sig(x) result(res) import :: dual type(dual), intent(in) :: x(:) type(dual) :: res @@ -41,8 +41,8 @@ subroutine derivative(fcn, x, f, dfdx) dfdx = ff%der(1) end subroutine - subroutine grad(fcn, x, f, dfdx, err) - procedure(grad_sig) :: fcn + subroutine gradient(fcn, x, f, dfdx, err) + procedure(gradient_sig) :: fcn real(wp), intent(in) :: x(:) real(wp), intent(out) :: f real(wp), intent(out) :: dfdx(:) diff --git a/test/test_forwarddiff.f90 b/test/test_forwarddiff.f90 index fb12b87..4ee4bf2 100644 --- a/test/test_forwarddiff.f90 +++ b/test/test_forwarddiff.f90 @@ -1,5 +1,5 @@ program test_forwarddiff - use forwarddiff, only: wp, derivative, grad, jacobian + use forwarddiff, only: wp, derivative, gradient, jacobian implicit none call test_dual() @@ -30,12 +30,12 @@ subroutine test_dual() write(2) f, dfdx xx = [1.0_wp, 2.0_wp] - call grad(func_grad1, xx, f, dfdx1, err) + call gradient(func_grad1, xx, f, dfdx1, err) print*,f, dfdx1 write(2) f, dfdx1 xx = [3.0_wp, 4.0_wp] - call grad(func_grad2, xx, f, dfdx1, err) + call gradient(func_grad2, xx, f, dfdx1, err) print*,f, dfdx1 write(2) f, dfdx1 diff --git a/test/test_sparse.f90 b/test/test_sparse.f90 index a3d1ce5..a3b2f02 100644 --- a/test/test_sparse.f90 +++ b/test/test_sparse.f90 @@ -1,10 +1,9 @@ -program main +program test_sparse use forwarddiff, only: wp, jacobian implicit none - integer, parameter :: nz = 6 - ! call test_banded() + call test_banded() call test_blockdiagonal1() call test_blockdiagonal2() @@ -12,11 +11,14 @@ program main subroutine test_banded() use forwarddiff, only: BandedJacobian + integer, parameter :: nz = 6 integer, parameter :: bandwidth = 3 real(wp) :: u(nz), f(nz), dfdu(bandwidth,nz) real(wp) :: f1(nz), dfdu1(nz,nz) character(:), allocatable :: err integer :: i + + print*,'test_banded' do i = 1,nz u(i) = i @@ -27,17 +29,21 @@ subroutine test_banded() stop endif - call rhs_banded(u, f1) - call jac_banded(u, dfdu1) - do i = 1,bandwidth print*,dfdu(i,:) enddo print*,'' + call jacobian(rhs_banded_dual, u, f1, dfdu1, err=err) + if (allocated(err)) then + print*,err + stop 1 + endif + do i = 1,nz print*,dfdu1(i,:) enddo + print*,'' end subroutine @@ -47,53 +53,25 @@ subroutine rhs_banded_dual(u, du) type(dual), intent(out) :: du(:) integer :: i - du(1) = 3*u(2) - u(1) - do i = 2,nz-1 - du(i) = 3*u(i+1) - 2.0_wp*u(i) + u(i-1) + du(1) = 3.0_wp*u(2) - u(1) + do i = 2,size(u)-1 + du(i) = 3.0_wp*u(i+1) - 2.0_wp*u(i) + u(i-1) enddo - du(nz) = - u(nz) + u(nz-1) + du(size(u)) = - u(size(u)) + u(size(u)-1) end subroutine - subroutine rhs_banded(u, du) - real(wp), intent(in) :: u(:) - real(wp), intent(out) :: du(:) - integer :: i - - du(1) = 3*u(2) - u(1) - do i = 2,nz-1 - du(i) = 3*u(i+1) - 2.0_wp*u(i) + u(i-1) - enddo - du(nz) = - u(nz) + u(nz-1) - - end subroutine - - subroutine jac_banded(u, pd) - real(wp), intent(in) :: u(:) - real(wp), intent(out) :: pd(:,:) - integer :: i - - pd = 0.0_wp - pd(1,1) = -1.0_wp - pd(2,1) = 1.0_wp - do i = 2,nz-1 - pd(i,i) = -2.0_wp - pd(i+1,i) = 1.0_wp - pd(i-1,i) = 3.0_wp - enddo - pd(nz,nz) = -1.0_wp - pd(nz-1,nz) = 3.0_wp - - end subroutine - subroutine test_blockdiagonal1() use forwarddiff, only: BlockDiagonalJacobian + integer, parameter :: nz = 6 integer, parameter :: blocksize = 2 real(wp) :: u(nz), f(nz), dfdu(blocksize,nz) - real(wp) :: dfdu1(nz,nz) + real(wp) :: f1(nz), dfdu1(nz,nz) character(:), allocatable :: err integer :: i + print*,'test_blockdiagonal1' + do i = 1,nz u(i) = i enddo @@ -103,32 +81,35 @@ subroutine test_blockdiagonal1() stop 1 endif - print*,'' do i = 1,blocksize print*,dfdu(i,:) enddo + print*,'' - call jacobian(rhs_blocked1_dual, u, f, dfdu1, err=err) + call jacobian(rhs_blocked1_dual, u, f1, dfdu1, err=err) if (allocated(err)) then print*,err stop 1 endif - print*,'' do i = 1,nz print*,dfdu1(i,:) enddo + print*,'' end subroutine subroutine test_blockdiagonal2() use forwarddiff, only: BlockDiagonalJacobian + integer, parameter :: nz = 6 integer, parameter :: blocksize = 3 real(wp) :: u(nz), f(nz), dfdu(blocksize,nz) - real(wp) :: dfdu1(nz,nz) + real(wp) :: f1(nz), dfdu1(nz,nz) character(:), allocatable :: err integer :: i + print*,'test_blockdiagonal2' + do i = 1,nz u(i) = i enddo @@ -138,21 +119,21 @@ subroutine test_blockdiagonal2() stop 1 endif - print*,'' do i = 1,blocksize print*,dfdu(i,:) enddo + print*,'' - call jacobian(rhs_blocked2_dual, u, f, dfdu1, err=err) + call jacobian(rhs_blocked2_dual, u, f1, dfdu1, err=err) if (allocated(err)) then print*,err stop 1 endif - print*,'' do i = 1,nz print*,dfdu1(i,:) enddo + print*,'' end subroutine