Cosmetic changes to tests+examples

  * Added `options%print_level` to tests+examples (where appropiate)
    to reflect new print level scheme
  * Removed from tests and examples unused local variables
  * Added post-fix `_dummy` to unused interface parameters

libRALFit/example/C/nlls_example.c

@@ -73,6 +73,7 @@ int main(void) {
    // Initialize options values
    struct ral_nlls_options options;
    ral_nlls_default_options(&options);
+   options.print_level=0;
 
    // Call fitting routine
    double x[2] = { 2.5, 0.25 }; // Initial guess

libRALFit/example/C/nlls_example2.c

@@ -73,6 +73,7 @@ int main(void) {
    // Initialize options values
    struct ral_nlls_options options;
    ral_nlls_default_options(&options);
+   options.print_level=0;
    // options.model = 4;
    // options.exact_second_derivatives = true;
 

libRALFit/example/Fortran/Lanczos.f90

@@ -28,7 +28,7 @@ subroutine eval_r(status, n, m, x, r, params)
        r(1:m) = params%y(:) &
             - x(1)*exp(-x(2)*params%t(:)) &
             - x(3)*exp(-x(4)*params%t(:)) &
-            - x(5)*exp(-x(6)*params%t(:)) 
+            - x(5)*exp(-x(n)*params%t(:))
     end select
 
     status = 0 ! success
@@ -50,7 +50,7 @@ subroutine eval_J(status, n, m, x, J, params)
          J(2*m+1:3*m) = -exp(-x(4)*params%t(1:m))                     ! J_i3
          J(3*m+1:4*m) = +params%t(1:m) * x(3) * exp(-x(4)*params%t(1:m))! J_i4
          J(4*m+1:5*m) = -exp(-x(6)*params%t(1:m))                     ! J_i5
-         J(5*m+1:6*m) = +params%t(1:m) * x(5) * exp(-x(6)*params%t(1:m))! J_i6
+         J(5*m+1:6*m) = +params%t(1:m) * x(5) * exp(-x(n)*params%t(1:m))! J_i6
     end select
 
 
@@ -93,7 +93,7 @@ subroutine eval_HP(status, n, m, x, y, HP, params)
       class(params_base_type), intent(inout) :: params
 
       integer :: i
-
+      status = 0
       HP(1:n*m) = 0.0
       select type(params)
       type is (params_type)
@@ -130,7 +130,6 @@ program lanczos
   integer :: m,n
   real(wp), allocatable :: x(:)
   type(params_type) :: params
-  integer :: inner_method
   real(wp) :: tic, toc
 
   ! data to be fitted
@@ -191,7 +190,7 @@ program lanczos
   allocate(x(n))
   x = (/ 1.2, 0.3, 5.6, 5.5, 6.5, 7.6 /) ! SP 1
 
-  options%print_level = 1
+  options%print_level = 4
   options%exact_second_derivatives = .true.
   options%model = 4
   options%nlls_method = 3

libRALFit/example/Fortran/nlls_example.f90

@@ -26,7 +26,7 @@ subroutine eval_r(status, n, m, x, r, params)
       real(wp) :: x1, x2
 
       x1 = x(1)
-      x2 = x(2)
+      x2 = x(n)
       select type(params)
       type is(params_type)
          r(1:m) = x1 * exp(x2*params%t(:)) - params%y(:)
@@ -48,7 +48,7 @@ subroutine eval_J(status, n, m, x, J, params)
       real(wp) :: x1, x2
 
       x1 = x(1)
-      x2 = x(2)
+      x2 = x(n)
       select type(params)
       type is(params_type)
          J(  1:  m) = exp(x2*params%t(1:m))                     ! J_i1
@@ -98,6 +98,7 @@ program nlls_example
    real(wp), allocatable :: x(:)
    type(params_type) :: params
 
+   options%print_level = 0
    ! Data to be fitted
    m = 5
    allocate(params%t(m), params%y(m))

libRALFit/example/Fortran/nlls_example2.f90

@@ -26,7 +26,7 @@ subroutine eval_r(status, n, m, x, r, params)
       real(wp) :: x1, x2
 
       x1 = x(1)
-      x2 = x(2)
+      x2 = x(n)
       select type(params)
       type is(params_type)
          r(1:m) = x1 * exp(x2*params%t(:)) - params%y(:)
@@ -48,7 +48,7 @@ subroutine eval_J(status, n, m, x, J, params)
       real(wp) :: x1, x2
 
       x1 = x(1)
-      x2 = x(2)
+      x2 = x(n)
       select type(params)
       type is(params_type)
          J(  1:  m) = exp(x2*params%t(1:m))                     ! J_i1
@@ -125,7 +125,7 @@ program nlls_example2
    real(wp), allocatable :: x(:)
    type(params_type) :: params
    integer :: inner_method
-
+   options%print_level = 0
    ! Data to be fitted
    m = 5
    allocate(params%t(m), params%y(m))
@@ -141,8 +141,7 @@ program nlls_example2
    options%nlls_method = 4
    options%exact_second_derivatives = .true. 
    options%maxit = 50
-
-   options%print_level = 1
+   options%print_level = 4
 
    do inner_method = 1,3
 

libRALFit/test/example_module.f90

@@ -14,7 +14,7 @@ module example_module
 contains
 
 
-SUBROUTINE eval_F( status, n, m, X, f, params)
+SUBROUTINE eval_F( status, n_dummy, m, X, f, params)
 
 !  -------------------------------------------------------------------
 !  eval_F, a subroutine for evaluating the function f at a point X
@@ -24,7 +24,7 @@ SUBROUTINE eval_F( status, n, m, X, f, params)
 
        INTEGER, PARAMETER :: wp = KIND( 1.0D+0 )
        INTEGER, INTENT( OUT ) :: status
-       INTEGER, INTENT( IN ) :: n, m 
+       INTEGER, INTENT( IN ) :: n_dummy, m
        REAL ( wp ), DIMENSION( * ),INTENT( OUT ) :: f
        REAL ( wp ), DIMENSION( * ),INTENT( IN )  :: X
        class( params_base_type ), intent(inout) :: params
@@ -56,22 +56,22 @@ SUBROUTINE eval_F( status, n, m, X, f, params)
 
      END SUBROUTINE eval_F
 
-     subroutine eval_F_error( status, n, m, X, f, params)
+     subroutine eval_F_error( status, n_dummy, m_dummy, X_dummy, f_dummy, params_dummy)
        ! a fake eval_f to flag an error 
        USE ISO_FORTRAN_ENV
 
        INTEGER, PARAMETER :: wp = KIND( 1.0D+0 )
        INTEGER, INTENT( OUT ) :: status
-       INTEGER, INTENT( IN ) :: n, m 
-       REAL ( wp ), DIMENSION( * ),INTENT( OUT ) :: f
-       REAL ( wp ), DIMENSION( * ),INTENT( IN )  :: X
-       class( params_base_type ), intent(inout) :: params
+       INTEGER, INTENT( IN ) :: n_dummy, m_dummy
+       REAL ( wp ), DIMENSION( * ),INTENT( OUT ) :: f_dummy
+       REAL ( wp ), DIMENSION( * ),INTENT( IN )  :: X_dummy
+       class( params_base_type ), intent(inout) :: params_dummy
 
        status = -1
 
      end subroutine eval_F_error
 
-     SUBROUTINE eval_J( status, n, m, X, J, params)
+     SUBROUTINE eval_J( status, n_dummy, m, X, J, params)
 
 !  -------------------------------------------------------------------
 !  eval_J, a subroutine for evaluating the Jacobian J at a point X
@@ -81,7 +81,7 @@ SUBROUTINE eval_J( status, n, m, X, J, params)
 
        INTEGER, PARAMETER :: wp = KIND( 1.0D+0 )
        INTEGER, INTENT( OUT ) :: status
-       INTEGER, INTENT( IN ) :: n, m 
+       INTEGER, INTENT( IN ) :: n_dummy, m
        REAL ( wp ), DIMENSION( * ),INTENT( OUT ) :: J
        REAL ( wp ), DIMENSION( * ),INTENT( IN ) :: X
        class( params_base_type ), intent(inout) :: params
@@ -121,7 +121,7 @@ SUBROUTINE eval_J( status, n, m, X, J, params)
 
      END SUBROUTINE eval_J
 
-     SUBROUTINE eval_J_c( status, n, m, X, J, params)
+     SUBROUTINE eval_J_c( status, n_dummy, m, X, J, params)
 
 !  -------------------------------------------------------------------
 !  eval_J, a subroutine for evaluating the Jacobian J at a point X
@@ -131,7 +131,7 @@ SUBROUTINE eval_J_c( status, n, m, X, J, params)
 
        INTEGER, PARAMETER :: wp = KIND( 1.0D+0 )
        INTEGER, INTENT( OUT ) :: status
-       INTEGER, INTENT( IN ) :: n, m 
+       INTEGER, INTENT( IN ) :: n_dummy, m
        REAL ( wp ), DIMENSION( * ),INTENT( OUT ) :: J
        REAL ( wp ), DIMENSION( * ),INTENT( IN ) :: X
        class( params_base_type ), intent(inout) :: params
@@ -176,22 +176,22 @@ END SUBROUTINE eval_J_c
 
 
 
-     subroutine eval_J_error( status, n, m, X, J, params)
+     subroutine eval_J_error( status, n_dummy, m_dummy, X_dummy, J_dummy, params_dummy)
        ! a fake eval_J to flag an error 
        USE ISO_FORTRAN_ENV
 
        INTEGER, PARAMETER :: wp = KIND( 1.0D+0 )
        INTEGER, INTENT( OUT ) :: status
-       INTEGER, INTENT( IN ) :: n, m 
-       REAL ( wp ), DIMENSION( * ),INTENT( OUT ) :: J
-       REAL ( wp ), DIMENSION( * ),INTENT( IN )  :: X
-       class( params_base_type ), intent(inout) :: params
+       INTEGER, INTENT( IN ) :: n_dummy, m_dummy
+       REAL ( wp ), DIMENSION( * ),INTENT( OUT ) :: J_dummy
+       REAL ( wp ), DIMENSION( * ),INTENT( IN )  :: X_dummy
+       class( params_base_type ), intent(inout) :: params_dummy
 
        status = -1
 
      end subroutine eval_J_error
 
-     SUBROUTINE eval_H( status, n, m, X, f, h, params)
+     SUBROUTINE eval_H( status, n_dummy, m, X, f, h, params)
 
 !  -------------------------------------------------------------------
 !  eval_H, a subroutine for evaluating the second derivative hessian terms
@@ -201,7 +201,7 @@ SUBROUTINE eval_H( status, n, m, X, f, h, params)
 
        INTEGER, PARAMETER :: wp = KIND( 1.0D+0 )
        INTEGER, INTENT( OUT ) :: status
-       INTEGER, INTENT( IN ) :: n, m 
+       INTEGER, INTENT( IN ) :: n_dummy, m
        REAL ( wp ), DIMENSION( * ),INTENT( IN )  :: f
        REAL ( wp ), DIMENSION( * ),INTENT( OUT ) :: h
        REAL ( wp ), DIMENSION( * ),INTENT( IN )  :: X
@@ -248,7 +248,7 @@ SUBROUTINE eval_H( status, n, m, X, f, h, params)
 
      END SUBROUTINE eval_H
 
-     subroutine eval_H_error( status, n, m, X, f, h, params)
+     subroutine eval_H_error( status, n_dummy, m_dummy, X_dummy, f_dummy, h_dummy, params_dummy)
 
 !  -------------------------------------------------------------------
 !  a fake eval_H for flagging an error
@@ -258,11 +258,11 @@ subroutine eval_H_error( status, n, m, X, f, h, params)
 
        INTEGER, PARAMETER :: wp = KIND( 1.0D+0 )
        INTEGER, INTENT( OUT ) :: status
-       INTEGER, INTENT( IN ) :: n, m 
-       REAL ( wp ), DIMENSION( * ),INTENT( IN )  :: f
-       REAL ( wp ), DIMENSION( * ),INTENT( OUT ) :: h
-       REAL ( wp ), DIMENSION( * ),INTENT( IN )  :: X
-       class( params_base_type ), intent(inout) :: params
+       INTEGER, INTENT( IN ) :: n_dummy, m_dummy
+       REAL ( wp ), DIMENSION( * ),INTENT( IN )  :: f_dummy
+       REAL ( wp ), DIMENSION( * ),INTENT( OUT ) :: h_dummy
+       REAL ( wp ), DIMENSION( * ),INTENT( IN )  :: X_dummy
+       class( params_base_type ), intent(inout) :: params_dummy
 
        status = -1
 

libRALFit/test/nlls_c_test.c

@@ -80,6 +80,7 @@ int generic_test(int model, int method){
 
   options.model = model;
   options.nlls_method = method;
+  options.print_level = 0;
 
   // Call fitting routine
   double x[2] = { 2.5, 0.25 }; // Initial guess

libRALFit/test/nlls_test.f90

@@ -12,24 +12,20 @@ program nlls_test
   type( NLLS_inform )  :: status
   type( NLLS_options ) :: options
   type( user_type ), target :: params
-  real(wp), allocatable :: v(:),w(:),x(:),y(:),z(:)
-  real(wp), allocatable :: A(:,:), B(:,:), C(:,:)
-  real(wp), allocatable :: results(:), resvec(:)
+  real(wp), allocatable :: w(:),x(:)
+  real(wp), allocatable :: resvec(:)
   real(wp) :: resvec_error
-  real(wp) :: alpha, beta, gamma, delta
-  integer :: m, n, i, no_errors_helpers, no_errors_main, info
+  integer :: m, n, i, no_errors_helpers, no_errors_main
   integer :: nlls_method, model, tr_update, inner_method
   logical :: test_all, test_subs
-  character (len = 80) :: expected_string
   integer :: fails
 
   integer :: number_of_models
   integer, allocatable :: model_to_test(:)
 
-  type( NLLS_workspace ) :: work
-
   options%error = 18
-  options%out   = 17 
+  options%out   = 17
+  options%print_level = 0
   open(unit = options%out, file="nlls_test.out")
   open(unit = options%error, file="nlls_test_error.out")