Type | Intent | Optional | Attributes | Name | ||||||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
function funcv(x)Arguments
Return Value complex(kind=8) |
||||||||||||||||||||
real(kind=8) | :: | x(:) | ||||||||||||||||||
complex(kind=8) | :: | fjac(size(x)) | ||||||||||||||||||
real(kind=8), | optional | :: | epsfcn |
subroutine c_fdjac_1n_func(funcv,x,fjac,epsfcn) implicit none interface function funcv(x) real(8),dimension(:),intent(in) :: x complex(8) :: funcv end function funcv end interface integer :: n real(8) :: x(:) complex(8) :: fvec complex(8) :: fjac(size(x)) real(8),optional :: epsfcn real(8) :: eps,eps_ real(8) :: epsmch real(8) :: h,temp complex(8) :: wa1 complex(8) :: wa2 integer :: i,j,k n=size(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 c_fdjac_1n_func