Type | Intent | Optional | Attributes | Name | |||||||||||||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
function funcv(x, m)Arguments
Return Value real(kind=8), dimension(m) |
|||||||||||||||||||||||||||
real(kind=8), | intent(in) | :: | x(:) | ||||||||||||||||||||||||
integer | :: | m | |||||||||||||||||||||||||
real(kind=8) | :: | fjac(m,size(x)) | |||||||||||||||||||||||||
real(kind=8), | optional | :: | epsfcn |
subroutine fdjac_mn_func(funcv,x,m,fjac,epsfcn) implicit none interface function funcv(x,m) real(8),dimension(:),intent(in) :: x integer :: m real(8),dimension(m) :: funcv end function funcv end interface integer :: n integer :: m real(8),intent(in) :: x(:) real(8) :: x_(size(x)) real(8) :: fvec(m) real(8) :: fjac(m,size(x)) real(8),optional :: epsfcn real(8) :: eps,eps_ real(8) :: epsmch real(8) :: h,temp real(8) :: wa1(m) real(8) :: wa2(m) 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)) fvec = funcv(x_,m) do j=1,n temp = x_(j) h = eps*abs(temp) if(h==0.d0) h = eps x_(j) = temp + h wa1 = funcv(x_,m) x_(j) = temp fjac(1:m,j) = (wa1(1:m) - fvec(1:m))/h enddo end subroutine fdjac_mn_func