hinit Function

private function hinit(me, x, y, posneg, f0, iord, hmax, atol, rtol, itol)

computation of an initial step size guess

Arguments

Type IntentOptional Attributes Name
class(dop853_class), intent(inout) :: me
real(kind=wp), intent(in) :: x
real(kind=wp), intent(in), dimension(:) :: y

dimension(n)

real(kind=wp), intent(in) :: posneg
real(kind=wp), intent(in), dimension(:) :: f0

dimension(n)

integer, intent(in) :: iord
real(kind=wp), intent(in) :: hmax
real(kind=wp), intent(in), dimension(:) :: atol
real(kind=wp), intent(in), dimension(:) :: rtol
integer, intent(in) :: itol

Return Value real(kind=wp)


Contents

Source Code


Source Code

    function hinit(me,x,y,posneg,f0,iord,hmax,atol,rtol,itol)

    implicit none

    class(dop853_class),intent(inout) :: me
    real(wp),intent(in)               :: x
    real(wp),dimension(:),intent(in)  :: y       !! dimension(n)
    real(wp),intent(in)               :: posneg
    real(wp),dimension(:),intent(in)  :: f0      !! dimension(n)
    integer,intent(in)                :: iord
    real(wp),intent(in)               :: hmax
    real(wp),dimension(:),intent(in)  :: atol
    real(wp),dimension(:),intent(in)  :: rtol
    integer,intent(in)                :: itol

    real(wp) :: atoli,der12,der2,dnf,dny,h,h1,hinit,rtoli,sk
    integer :: i
    real(wp),dimension(me%n)  :: f1,y1

    ! compute a first guess for explicit euler as
    !   h = 0.01 * norm (y0) / norm (f0)
    ! the increment for explicit euler is small
    ! compared to the solution
    dnf = 0.0_wp
    dny = 0.0_wp
    atoli = atol(1)
    rtoli = rtol(1)
    if ( itol==0 ) then
        do i = 1 , me%n
            sk = atoli + rtoli*abs(y(i))
            dnf = dnf + (f0(i)/sk)**2
            dny = dny + (y(i)/sk)**2
        end do
    else
        do i = 1 , me%n
            sk = atol(i) + rtol(i)*abs(y(i))
            dnf = dnf + (f0(i)/sk)**2
            dny = dny + (y(i)/sk)**2
        end do
    end if
    if ( dnf<=1.0e-10_wp .or. dny<=1.0e-10_wp ) then
        h = 1.0e-6_wp
    else
        h = sqrt(dny/dnf)*0.01_wp
    end if
    h = min(h,hmax)
    h = sign(h,posneg)
    ! perform an explicit euler step
    do i = 1 , me%n
        y1(i) = y(i) + h*f0(i)
    end do
    call me%fcn(x+h,y1,f1)
    ! estimate the second derivative of the solution
    der2 = 0.0_wp
    if ( itol==0 ) then
        do i = 1 , me%n
            sk = atoli + rtoli*abs(y(i))
            der2 = der2 + ((f1(i)-f0(i))/sk)**2
        end do
    else
        do i = 1 , me%n
            sk = atol(i) + rtol(i)*abs(y(i))
            der2 = der2 + ((f1(i)-f0(i))/sk)**2
        end do
    end if
    der2 = sqrt(der2)/h
    ! step size is computed such that
    !  h**iord * max ( norm (f0), norm (der2)) = 0.01
    der12 = max(abs(der2),sqrt(dnf))
    if ( der12<=1.0e-15_wp ) then
        h1 = max(1.0e-6_wp,abs(h)*1.0e-3_wp)
    else
        h1 = (0.01_wp/der12)**(1.0_wp/iord)
    end if

    h = min(100.0_wp*abs(h),h1,hmax)
    hinit = sign(h,posneg)

    end function hinit