c_fdjac_mn_sub Subroutine

subroutine c_fdjac_mn_sub(funcv, n, x, m, fjac, epsfcn)

Arguments

Type IntentOptional Attributes Name
subroutine funcv(n, x, m, y)
Arguments
Type IntentOptional Attributes Name
integer :: n
real(kind=8), intent(in), dimension(n) :: x
integer :: m
complex(kind=8), dimension(m) :: y
integer :: n
real(kind=8) :: x(n)
integer :: m
complex(kind=8) :: fjac(m,n)
real(kind=8), optional :: epsfcn

Source Code

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