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