Skip to content

Commit e26542b

Browse files
jacobwilliamsjacobwilliams
authored
Merge pull request #40 from jacobwilliams/test-refactoring
Modernize the tests
2 parents 96c279d + c4ddcc9 commit e26542b

File tree

10 files changed

+4575
-3940
lines changed

10 files changed

+4575
-3940
lines changed

‎examples/example_lmder1.f90‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -23,15 +23,15 @@ subroutine fcn(m, n, x, fvec, fjac, ldfjac, iflag)
2323
tmp1 = i
2424
tmp2 = 16 - i
2525
tmp3 = tmp1
26-
if (i .gt. 8) tmp3 = tmp2
26+
if (i > 8) tmp3 = tmp2
2727
fvec(i) = y(i) - (x(1) + tmp1/(x(2)*tmp2 + x(3)*tmp3))
2828
end do
2929
else
3030
do i = 1, 15
3131
tmp1 = i
3232
tmp2 = 16 - i
3333
tmp3 = tmp1
34-
if (i .gt. 8) tmp3 = tmp2
34+
if (i > 8) tmp3 = tmp2
3535
tmp4 = (x(2)*tmp2 + x(3)*tmp3)**2
3636
fjac(i,1) = -1.D0
3737
fjac(i,2) = tmp1*tmp2/tmp4

‎examples/example_lmdif1.f90‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,7 @@ subroutine fcn(m, n, x, fvec, iflag)
2424
tmp1 = i
2525
tmp2 = 16 - i
2626
tmp3 = tmp1
27-
if (i .gt. 8) tmp3 = tmp2
27+
if (i > 8) tmp3 = tmp2
2828
fvec(i) = y(i) - (x(1) + tmp1/(x(2)*tmp2 + x(3)*tmp3))
2929
end do
3030
end subroutine

‎src/minpack.f90‎

Lines changed: 26 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,7 @@ subroutine func(n, x, fvec, iflag)
2727
import :: wp
2828
implicit none
2929
integer, intent(in) :: n !! the number of variables.
30-
real(wp), intent(in) :: x(n) !! independant variable vector
30+
real(wp), intent(in) :: x(n) !! independent variable vector
3131
real(wp), intent(out) :: fvec(n) !! value of function at `x`
3232
integer, intent(inout) :: iflag !! set to <0 to terminate execution
3333
end subroutine func
@@ -38,7 +38,7 @@ subroutine func2(m, n, x, fvec, iflag)
3838
implicit none
3939
integer, intent(in) :: m !! the number of functions.
4040
integer, intent(in) :: n !! the number of variables.
41-
real(wp), intent(in) :: x(n) !! independant variable vector
41+
real(wp), intent(in) :: x(n) !! independent variable vector
4242
real(wp), intent(out) :: fvec(m) !! value of function at `x`
4343
integer, intent(inout) :: iflag !! the value of iflag should not be changed unless
4444
!! the user wants to terminate execution of lmdif.
@@ -49,19 +49,19 @@ subroutine fcn_hybrj(n, x, fvec, fjac, ldfjac, iflag)
4949
!! user-supplied subroutine for [[hybrj]] and [[hybrj1]]
5050
import :: wp
5151
implicit none
52-
integer, intent(in) :: n !! the number of variables.
53-
real(wp), dimension(n), intent(in) :: x !! independant variable vector
54-
integer, intent(in) :: ldfjac !! leading dimension of the array fjac.
55-
real(wp), dimension(n), intent(out) :: fvec !! value of function at `x`
56-
real(wp), dimension(ldfjac, n), intent(out) :: fjac !! jacobian matrix at `x`
57-
integer, intent(inout) :: iflag !! if iflag = 1 calculate the functions at x and
58-
!! return this vector in fvec. do not alter fjac.
59-
!! if iflag = 2 calculate the jacobian at x and
60-
!! return this matrix in fjac. do not alter fvec.
61-
!!
62-
!! the value of iflag should not be changed by fcn unless
63-
!! the user wants to terminate execution of hybrj.
64-
!! in this case set iflag to a negative integer.
52+
integer, intent(in) :: n !! the number of variables.
53+
real(wp), dimension(n), intent(in) :: x !! independent variable vector
54+
integer, intent(in) :: ldfjac !! leading dimension of the array fjac.
55+
real(wp), dimension(n), intent(inout) :: fvec !! value of function at `x`
56+
real(wp), dimension(ldfjac, n), intent(inout) :: fjac !! jacobian matrix at `x`
57+
integer, intent(inout) :: iflag !! if iflag = 1 calculate the functions at x and
58+
!! return this vector in fvec. do not alter fjac.
59+
!! if iflag = 2 calculate the jacobian at x and
60+
!! return this matrix in fjac. do not alter fvec.
61+
!!
62+
!! the value of iflag should not be changed by fcn unless
63+
!! the user wants to terminate execution of hybrj.
64+
!! in this case set iflag to a negative integer.
6565
end subroutine fcn_hybrj
6666

6767
subroutine fcn_lmder(m, n, x, fvec, fjac, ldfjac, iflag)
@@ -79,7 +79,7 @@ subroutine fcn_lmder(m, n, x, fvec, fjac, ldfjac, iflag)
7979
!! the value of iflag should not be changed by fcn unless
8080
!! the user wants to terminate execution of lmder.
8181
!! in this case set iflag to a negative integer.
82-
real(wp), intent(in) :: x(n) !! independant variable vector
82+
real(wp), intent(in) :: x(n) !! independent variable vector
8383
real(wp), intent(inout) :: fvec(m) !! value of function at `x`
8484
real(wp), intent(inout) :: fjac(ldfjac, n) !! jacobian matrix at `x`
8585
end subroutine fcn_lmder
@@ -703,7 +703,7 @@ subroutine hybrd(fcn, n, x, Fvec, Xtol, Maxfev, Ml, Mu, Epsfcn, Diag, Mode, &
703703
! determine the number of calls to fcn needed to compute
704704
! the jacobian matrix.
705705

706-
msum = min0(Ml + Mu + 1, n)
706+
msum = min(Ml + Mu + 1, n)
707707

708708
! initialize iteration counter and monitors.
709709

@@ -3125,7 +3125,7 @@ subroutine qform(m, n, q, Ldq, Wa)
31253125

31263126
! zero out upper triangle of q in the first min(m,n) columns.
31273127

3128-
minmn = min0(m, n)
3128+
minmn = min(m, n)
31293129
if (minmn >= 2) then
31303130
do j = 2, minmn
31313131
jm1 = j - 1
@@ -3240,7 +3240,7 @@ subroutine qrfac(m, n, a, Lda, Pivot, Ipvt, Lipvt, Rdiag, Acnorm, Wa)
32403240

32413241
! reduce a to r with householder transformations.
32423242

3243-
minmn = min0(m, n)
3243+
minmn = min(m, n)
32443244
do j = 1, minmn
32453245
if (Pivot) then
32463246

@@ -3515,10 +3515,13 @@ subroutine r1mpyq(m, n, a, Lda, v, w)
35153515
if (nm1 >= 1) then
35163516
do nmj = 1, nm1
35173517
j = n - nmj
3518-
if (abs(v(j)) > one) cos = one/v(j)
3519-
if (abs(v(j)) > one) sin = sqrt(one - cos**2)
3520-
if (abs(v(j)) <= one) sin = v(j)
3521-
if (abs(v(j)) <= one) cos = sqrt(one - sin**2)
3518+
if (abs(v(j)) > one) then
3519+
cos = one/v(j)
3520+
sin = sqrt(one - cos**2)
3521+
else
3522+
sin = v(j)
3523+
cos = sqrt(one - sin**2)
3524+
end if
35223525
do i = 1, m
35233526
temp = cos*a(i, j) - sin*a(i, n)
35243527
a(i, n) = sin*a(i, j) + cos*a(i, n)

‎src/minpack_capi.f90‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -187,8 +187,8 @@ subroutine wrap_fcn(n, x, fvec, fjac, ldfjac, iflag)
187187
integer, intent(in) :: n
188188
real(wp), intent(in) :: x(n)
189189
integer, intent(in) :: ldfjac
190-
real(wp), intent(out) :: fvec(n)
191-
real(wp), intent(out) :: fjac(ldfjac, n)
190+
real(wp), intent(inout) :: fvec(n)
191+
real(wp), intent(inout) :: fjac(ldfjac, n)
192192
integer, intent(inout) :: iflag
193193

194194
call fcn(n, x, fvec, fjac, ldfjac, iflag, udata)
@@ -216,8 +216,8 @@ subroutine wrap_fcn(n, x, fvec, fjac, ldfjac, iflag)
216216
integer, intent(in) :: n
217217
real(wp), intent(in) :: x(n)
218218
integer, intent(in) :: ldfjac
219-
real(wp), intent(out) :: fvec(n)
220-
real(wp), intent(out) :: fjac(ldfjac, n)
219+
real(wp), intent(inout) :: fvec(n)
220+
real(wp), intent(inout) :: fjac(ldfjac, n)
221221
integer, intent(inout) :: iflag
222222

223223
call fcn(n, x, fvec, fjac, ldfjac, iflag, udata)

0 commit comments

Comments
 (0)