@@ -25,7 +25,7 @@ subroutine func(n,x,fvec,iflag)
2525 ! ! interface for user-supplied subroutine.
2626 import :: wp
2727 implicit none
28- integer ,intent (in ) :: n
28+ integer ,intent (in ) :: n ! ! the number of variables.
2929 real (wp),intent (in ) :: x(n) ! ! independant variable vector
3030 real (wp),intent (out ) :: fvec(n) ! ! value of function at `x`
3131 integer ,intent (inout ) :: iflag ! ! set to <0 to terminate execution
@@ -35,8 +35,8 @@ subroutine func2(m,n,x,fvec,iflag)
3535 ! ! interface for user-supplied subroutine.
3636 import :: wp
3737 implicit none
38- integer ,intent (in ) :: n
39- integer ,intent (in ) :: m
38+ integer ,intent (in ) :: m ! ! the number of functions.
39+ integer ,intent (in ) :: n ! ! the number of variables.
4040 real (wp),intent (in ) :: x(n) ! ! independant variable vector
4141 real (wp),intent (out ) :: fvec(m) ! ! value of function at `x`
4242 integer ,intent (inout ) :: iflag ! ! the value of iflag should not be changed unless
@@ -48,21 +48,28 @@ subroutine fcn_hybrj(n,x,fvec,fjac,ldfjac,iflag)
4848 ! ! function for [[hybrj]]
4949 import :: wp
5050 implicit none
51- integer ,intent (in ) :: n
51+ integer ,intent (in ) :: n ! ! the number of variables.
5252 real (wp),dimension (n),intent (in ) :: x ! ! independant variable vector
53- integer ,intent (in ) :: ldfjac
53+ integer ,intent (in ) :: ldfjac ! ! leading dimension of the array fjac.
5454 real (wp),dimension (n),intent (out ) :: fvec ! ! value of function at `x`
55- real (wp),dimension (ldfjac,n),intent (out ) :: fjac
56- integer ,intent (inout ) :: iflag
55+ real (wp),dimension (ldfjac,n),intent (out ) :: fjac ! ! jacobian matrix at `x`
56+ integer ,intent (inout ) :: iflag ! ! if iflag = 1 calculate the functions at x and
57+ ! ! return this vector in fvec. do not alter fjac.
58+ ! ! if iflag = 2 calculate the jacobian at x and
59+ ! ! return this matrix in fjac. do not alter fvec.
60+ ! !
61+ ! ! the value of iflag should not be changed by fcn unless
62+ ! ! the user wants to terminate execution of hybrj.
63+ ! ! in this case set iflag to a negative integer.
5764 end subroutine fcn_hybrj
5865
5966 subroutine fcn_lmder (m ,n ,x ,fvec ,fjac ,ldfjac ,iflag )
6067 ! ! function for [[lmder]]
6168 import :: wp
6269 implicit none
63- integer ,intent (in ) :: m
64- integer ,intent (in ) :: n
65- integer ,intent (in ) :: ldfjac
70+ integer ,intent (in ) :: m ! ! the number of functions.
71+ integer ,intent (in ) :: n ! ! the number of variables.
72+ integer ,intent (in ) :: ldfjac ! ! leading dimension of the array fjac.
6673 integer ,intent (inout ) :: iflag ! ! if iflag = 1 calculate the functions at x and
6774 ! ! return this vector in fvec. do not alter fjac.
6875 ! ! if iflag = 2 calculate the jacobian at x and
@@ -73,14 +80,14 @@ subroutine fcn_lmder(m,n,x,fvec,fjac,ldfjac,iflag)
7380 ! ! in this case set iflag to a negative integer.
7481 real (wp),intent (in ) :: x(n) ! ! independant variable vector
7582 real (wp),intent (inout ) :: fvec(m) ! ! value of function at `x`
76- real (wp),intent (inout ) :: fjac(ldfjac,n)
83+ real (wp),intent (inout ) :: fjac(ldfjac,n) ! ! jacobian matrix at `x`
7784 end subroutine fcn_lmder
7885
7986 subroutine fcn_lmstr (m ,n ,x ,fvec ,fjrow ,iflag )
8087 import :: wp
8188 implicit none
82- integer ,intent (in ) :: m
83- integer ,intent (in ) :: n
89+ integer ,intent (in ) :: m ! ! the number of functions.
90+ integer ,intent (in ) :: n ! ! the number of variables.
8491 integer ,intent (inout ) :: iflag ! ! if iflag = 1 calculate the functions at x and
8592 ! ! return this vector in fvec.
8693 ! ! if iflag = i calculate the (i-1)-st row of the
@@ -91,7 +98,7 @@ subroutine fcn_lmstr(m,n,x,fvec,fjrow,iflag)
9198 ! ! in this case set iflag to a negative integer.
9299 real (wp) :: x(n) ! ! independant variable vector
93100 real (wp) :: fvec(m) ! ! value of function at `x`
94- real (wp) :: fjrow(n)
101+ real (wp) :: fjrow(n) ! ! jacobian row
95102 end subroutine fcn_lmstr
96103
97104 end interface
@@ -2491,8 +2498,7 @@ subroutine lmpar(n, r, Ldr, Ipvt, Diag, Qtb, Delta, Par, x, Sdiag, Wa1, Wa2)
24912498 real (wp),intent (inout ) :: Wa2(n) ! ! work array of length n.
24922499
24932500 integer :: i, iter, j, jm1, jp1, k, l, nsing
2494- real (wp) :: dxnorm, fp, gnorm, parc, parl, &
2495- paru, sum, temp
2501+ real (wp) :: dxnorm, fp, gnorm, parc, parl, paru, sum, temp
24962502
24972503 real (wp),parameter :: p1 = 1.0e-1_wp
24982504 real (wp),parameter :: p001 = 1.0e-3_wp
0 commit comments