fdjac_1n_func Subroutine

subroutine fdjac_1n_func(funcv, x, fjac, epsfcn)

Arguments

Type IntentOptional Attributes Name
function funcv(x)
Arguments
Type IntentOptional Attributes Name
real(kind=8), intent(in), dimension(:) :: x
Return Value real(kind=8)
real(kind=8), intent(in) :: x(:)
real(kind=8) :: fjac(size(x))
real(kind=8), optional :: epsfcn

Source Code

subroutine fdjac_1n_func(funcv,x,fjac,epsfcn)
  implicit none
  interface 
     function funcv(x)
       implicit none
       real(8),dimension(:),intent(in) :: x
       real(8)                         :: funcv
     end function funcv
  end interface
  integer          ::  n
  real(8),intent(in) ::  x(:)
  real(8)            ::  x_(size(x))
  real(8)          ::  fvec
  real(8)          ::  fjac(size(x))
  real(8),optional ::  epsfcn
  real(8)          ::  eps,eps_
  real(8)          ::  epsmch
  real(8)          ::  h,temp
  real(8)          ::  wa1
  real(8)          ::  wa2
  integer          :: i,j,k
  n=size(x)
  x_ = x
  eps_= 0.d0; if(present(epsfcn))eps_=epsfcn
  epsmch = epsilon(epsmch)
  eps  = sqrt(max(eps_,epsmch))
  !  Evaluate the function
  fvec = funcv(x_)
  do j=1,n
     temp = x_(j)
     h    = eps*abs(temp)
     if(h==0.d0) h = eps
     x_(j) = temp + h
     wa1  = funcv(x_)
     x_(j) = temp
     fjac(j) = (wa1 - fvec)/h
  enddo
end subroutine fdjac_1n_func