Type | Intent | Optional | Attributes | Name | |||||||||||||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
subroutine funcv(x, y)Arguments
|
|||||||||||||||||||||||||||
real(kind=8), | intent(in) | :: | x(:) | ||||||||||||||||||||||||
real(kind=8) | :: | fjac(size(x)) | |||||||||||||||||||||||||
real(kind=8), | optional | :: | epsfcn |
subroutine fdjac_1n_sub(funcv,x,fjac,epsfcn) interface subroutine funcv(x,y) real(8),dimension(:),intent(in) :: x real(8) :: y end subroutine 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 call funcv(x_,fvec) ! Computation of dense approximate jacobian. do j=1,n temp = x_(j) h = eps*abs(temp) if(h==0.d0) h = eps x_(j) = temp + h call funcv(x_,wa1) x_(j) = temp fjac(j) = (wa1-fvec)/h enddo return end subroutine fdjac_1n_sub