pure subroutine fcn( &
n, m, q, np, ldifx, beta, xplusd, ifixb, ifixx, ideval, f, fjacb, fjacd, istop, data)
!! User-supplied subroutine for evaluating the model.
integer, intent(in) :: n, m, q, np, ldifx, ideval, ifixb(np), ifixx(ldifx, m)
real(dp), intent(in) :: beta(np), xplusd(n, m)
real(dp), intent(out) :: f(n, q), fjacb(n, np, q), fjacd(n, m, q)
integer, intent(out) :: istop
type(c_ptr), intent(in), value :: data
! Local variables
real(dp) :: freq, omega, ctheta, stheta, theta, phi, r
real(dp), parameter :: pi = 4*atan(one)
integer :: i
! Check for unacceptable values for this problem
do i = 1, ubound(xplusd, 1)
if (xplusd(i, 1) < zero) then
istop = 1
return
end if
end do
istop = 0
theta = pi/2*beta(4)
ctheta = cos(theta)
stheta = sin(theta)
! Compute predicted values
if (mod(ideval, 10) > 0) then
do i = 1, ubound(xplusd, 1)
freq = xplusd(i, 1)
omega = (2*pi*freq*exp(-beta(3)))**beta(4)
phi = atan2((omega*stheta), (1 + omega*ctheta))
r = (beta(1) - beta(2))*sqrt((1 + omega*ctheta)**2 + (omega*stheta)**2)**(-beta(5))
f(i, 1) = beta(2) + r*cos(beta(5)*phi)
f(i, 2) = r*sin(beta(5)*phi)
end do
end if
end subroutine fcn