test sparse added

Nicholaswogan · Apr 1, 2024 · 301a9b2 · 301a9b2
1 parent bbf1f0d
commit 301a9b2
Show file tree

Hide file tree

Showing 4 changed files with 39 additions and 56 deletions.
diff --git 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
@@ -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
@@ -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
@@ -1,22 +1,24 @@
 
-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()
 
 contains
 
   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