Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
class(nlsolver), | intent(inout) | :: | this | |||
procedure(Fun13) | :: | F | ||||
real(kind=rk), | intent(in), | dimension(:) | :: | x0 | ||
real(kind=rk), | intent(out), | dimension(size(x0)) | :: | x_sol |
impure subroutine modified_quasi_fd_newton_method_T1(this, F, x0, x_sol) interface impure function Fun13(x) result(res) import rk real(rk), dimension(:), intent(in) :: x real(rk), dimension(:), allocatable :: res end function Fun13 end interface procedure(Fun13) :: F class(nlsolver), intent(inout) :: this real(rk), dimension(:), intent(in) :: x0 real(rk), dimension(size(x0)), intent(out) :: x_sol real(rk), dimension(size(x0)) :: xk real(rk), dimension(:), allocatable :: F_val real(rk), dimension(:,:), allocatable :: dFdx_val real(rk) :: criteriaFun integer :: k logical :: convergenz real(rk), dimension(size(x0)) :: dk real(rk) :: alphak k = 0 xk = x0 convergenz = .false. do while (.not. convergenz .and. k < this%maxit) F_val = F(xk) if ((mod(k, this%nmp) == 0)) dFdx_val = derivative(f=F, x=xk, h=this%fdm_tol, method=this%fdm_method) criteriaFun = norm2(F_val) if (this%verbosity == 1) then print '(g0, e12.4)', k, criteriaFun end if if (criteriaFun <= this%TolFun) then convergenz = .true. x_sol = xk return else dk = - solve(dFdx_val, F_val, this%lin_method) alphak = 1.0_rk xk = xk + alphak*dk k = k + 1 end if end do end subroutine modified_quasi_fd_newton_method_T1