computation of an initial step size guess
Type | Intent | Optional | 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 |
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