Type | Intent | Optional | Attributes | Name | ||||||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
function funcv(x)Arguments
Return Value real(kind=8) |
||||||||||||||||||||
real(kind=8), | intent(in) | :: | x(:) | |||||||||||||||||
real(kind=8) | :: | fjac(size(x)) | ||||||||||||||||||
real(kind=8), | optional | :: | epsfcn |
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