Type | Intent | Optional | Attributes | Name | |||||||||||||||||||||||
---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
function model_func(x, a)Arguments
Return Value real(kind=8), dimension(size(x)) |
|||||||||||||||||||||||||||
real(kind=8), | dimension(:) | :: | a | ||||||||||||||||||||||||
real(kind=8), | dimension(:) | :: | xdata | ||||||||||||||||||||||||
real(kind=8), | dimension(size(xdata)) | :: | ydata | ||||||||||||||||||||||||
real(kind=8), | optional | :: | tol | ||||||||||||||||||||||||
integer, | optional | :: | info |
subroutine curvefit_lmdif_func(model_func,a,xdata,ydata,tol,info) interface function model_func(x,a) real(8),dimension(:) :: x real(8),dimension(:) :: a real(8),dimension(size(x)) :: model_func end function model_func end interface real(8),dimension(:) :: a real(8),dimension(:) :: xdata real(8),dimension(size(xdata)) :: ydata integer :: m real(8),optional :: tol integer,optional :: info real(8) :: tol_ integer :: info_ integer :: n real(8),dimension(size(xdata)) :: fvec ! tol_ = 1.d-15;if(present(tol))tol_=tol ! n=size(a) m=size(xdata) ! call lmdif1(curvefit_lmdif_func2sub,m,n,a,fvec,tol_,info_) ! if(present(info))info=info_ contains subroutine curvefit_lmdif_func2sub(m,n,a,fvec,iflag) integer :: m integer :: n real(8) :: a(n) real(8) :: fvec(m) integer :: iflag fvec = model_func(xdata,a) - ydata if(iflag<0)stop "CURVEFIT_LMDIF_func2sub ERROR: iflag < 0 " end subroutine curvefit_lmdif_func2sub end subroutine curvefit_lmdif_func