fcn Subroutine

public 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.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: n
integer, intent(in) :: m
integer, intent(in) :: q
integer, intent(in) :: np
integer, intent(in) :: ldifx
real(kind=dp), intent(in) :: beta(np)
real(kind=dp), intent(in) :: xplusd(n,m)
integer, intent(in) :: ifixb(np)
integer, intent(in) :: ifixx(ldifx,m)
integer, intent(in) :: ideval
real(kind=dp), intent(out) :: f(n,q)
real(kind=dp), intent(out) :: fjacb(n,np,q)
real(kind=dp), intent(out) :: fjacd(n,m,q)
integer, intent(out) :: istop
type(c_ptr), intent(in), value :: data

Source Code

   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

      istop = 0

      ! Calculate model
      if (mod(ideval, 10) > 0) then
         f(:, 1) = beta(1)*exp(beta(2)*xplusd(:, 1))
      end if

      ! Calculate model partials with respect to `beta`
      if (mod(ideval/10, 10) > 0) then
         fjacb(:, 1, 1) = exp(beta(2)*xplusd(:, 1))
         fjacb(:, 2, 1) = beta(1)*xplusd(:, 1)*exp(beta(2)*xplusd(:, 1))
      end if

      ! Calculate model partials with respect to `delta`
      if (mod(ideval/100, 10) > 0) then
         fjacd(:, 1, 1) = beta(1)*beta(2)*exp(beta(2)*xplusd(:, 1))
      end if

   end subroutine fcn