fcn Subroutine

public pure subroutine fcn(beta, xplusd, ifixb, ifixx, ideval, f, fjacb, fjacd, istop)

User-supplied subroutine for evaluating the model.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in) :: beta(:)
real(kind=wp), intent(in) :: xplusd(:,:)
integer, intent(in) :: ifixb(:)
integer, intent(in) :: ifixx(:,:)
integer, intent(in) :: ideval
real(kind=wp), intent(out) :: f(:,:)
real(kind=wp), intent(out) :: fjacb(:,:,:)
real(kind=wp), intent(out) :: fjacd(:,:,:)
integer, intent(out) :: istop

Variables

Type Visibility Attributes Name Initial
integer, public :: i

Source Code

   pure subroutine fcn(beta, xplusd, ifixb, ifixx, ideval, f, fjacb, fjacd, istop)
   !! User-supplied subroutine for evaluating the model.

      integer, intent(in) :: ideval, ifixb(:), ifixx(:, :)
      real(kind=wp), intent(in) :: beta(:), xplusd(:, :)
      real(kind=wp), intent(out) :: f(:, :), fjacb(:, :, :), fjacd(:, :, :)
      integer, intent(out) :: istop

      ! Local variables
      integer :: i

      ! Check for unacceptable values for this problem
      if (beta(1) < zero) then
         istop = 1
         return
      else
         istop = 0
      end if

      ! Compute predicted values
      if (mod(ideval, 10) >= 1) then
         do i = 1, ubound(f, 2)
            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) >= 1) then
         do i = 1, ubound(f, 2)
            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) >= 1) then
      do i = 1, ubound(f, 2)
         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