Ralston Verfahren

module mysubs

contains

  function fxy(x, y)
    use kinds
    implicit none
    real(kind=REAL8) :: fxy
    real(kind=REAL8), intent(in) :: x, y

    fxy = -y
    return
  end function fxy

  subroutine init(x0, y0, xf, h)
    use kinds
    implicit none
    real(kind=REAL8), intent(out) :: x0, y0, xf, h
    
    write (*,*) 'Darstellung der Loesung einer expliziten Differentialgleichung'
    write (*,*) 'mittels des Verfahren von Ralston am Beispiel y`(x)=-y(x)'
    write (*,*)
    write (*,*) 'Geben Sie bitte die Anfangswerte ein'
    read (*,*) x0, y0
    write (*,*) 'Geben Sie nun an, bis zu welchem x-Wert y(x) berechnet &
                &werden soll.'
    read (*,*) xf
    write (*,*) 'Und in welcher Schrittweite sollen die x-Werte liegen?'
    read (*,*) h
    do
       if ( (xf - x0)*h >= 0 ) exit
       write (*, '(A, F6.3, A, F6.3, A, F6.3, A)')  'Von ', x0, &
          &  'aus koennen Sie ', xf,' in Schritten von ', h,' nicht erreichen.'
       write (*,*) 'Geben Sie noch einmal den Endwert und die Schrittweite ein.'
       read (*,*) xf, h
    end do
    write (*,*) 'x       y'
    return
  end subroutine init
  
  subroutine result(x, y)
    use kinds
    implicit none
    real(kind=REAL8), intent(in) :: x, y

    write (*,'(2F10.5)') x, y
    return
  end subroutine result

end module mysubs


program Ralston
  ! Integration der Gleichung y'(x)=-y(x) mittels des Runge-Kutta-
  ! Verfahren 2. Ordnung nach Ralston

  use kinds
  use mysubs
  implicit none

  real(kind=REAL8) :: xf                        ! Endwert
  real(kind=REAL8) :: h                         ! Schrittweite
  real(kind=REAL8) :: x, y, x1, y1, k1, k2

  call init(x, y, xf, h)
  do
     if (x >= xf) exit
     k1 = fxy(x,y)
     x1 = x + h*0.75
     y1 = y + k1*h*0.75
     k2 = fxy(x1,y1)
     y1 = y + k1*h*0.75
     y  = y + (k1/3.0 + 2.0*k2/3.0)*h
     x  = x + h
     call result(x, y)
  end do
  stop
end program Ralston