pure subroutine fcn(n, m, np, nq, ldn, ldm, ldnp, beta, xplusd, ifixb, ifixx, &
ldifx, ideval, f, fjacb, fjacd, istop)
!! User-supplied subroutine for evaluating the model.
integer, intent(in) :: ideval, ldifx, ldm, ldn, ldnp, m, n, np, nq
integer, intent(in) :: ifixb(np), ifixx(ldifx, m)
real(kind=wp), intent(in) :: beta(np), xplusd(ldn, m)
real(kind=wp), intent(out) :: f(ldn, nq), fjacb(ldn, ldnp, nq), fjacd(ldn, ldm, nq)
integer, intent(out) :: istop
! Local variables
integer :: i
! Check for unacceptable values for this problem
if (beta(1) .lt. zero) then
istop = 1
return
else
istop = 0
end if
! Compute predicted values
if (mod(ideval, 10) .ge. 1) then
do i = 1, nq
f(:, i) = beta(1) + beta(2)*(exp(beta(3)*xplusd(:, 1)) - one)**2
end do
end if
! Compute derivatives with respect to 'beta'
if (mod(ideval/10, 10) .ge. 1) then
do i = 1, nq
fjacb(:, 1, i) = one
fjacb(:, 2, i) = (exp(beta(3)*xplusd(:, 1)) - one)**2
fjacb(:, 3, i) = beta(2)*2*(exp(beta(3)*xplusd(:, 1)) - one)*exp(beta(3)*xplusd(:, 1))*xplusd(:, 1)
end do
end if
! Compute derivatives with respect to 'delta'
if (mod(ideval/100, 10) .ge. 1) then
do i = 1, nq
fjacd(:, 1, i) = beta(2)*2*(exp(beta(3)*xplusd(:, 1)) - one)*exp(beta(3)*xplusd(:, 1))*beta(3)
end do
end if
end subroutine fcn