    MODULE ivp_ode_rk_ex02_mod

      ! .. Implicit None Statement ..
      IMPLICIT NONE
      ! .. Default Accessibility ..
      PUBLIC
      ! .. Intrinsic Functions ..
      INTRINSIC KIND
      ! .. Parameters ..
      INTEGER, PARAMETER :: wp = KIND(1.0D0)

    CONTAINS

      FUNCTION f(t,y)

        ! .. Implicit None Statement ..
        IMPLICIT NONE
        ! .. Intrinsic Functions ..
        INTRINSIC SIZE
        ! .. Scalar Arguments ..
        REAL (wp), INTENT (IN) :: t
        ! .. Array Arguments ..
        REAL (wp), INTENT (IN) :: y(:)
        ! .. Function Return Value ..
        REAL (wp) :: f(SIZE(y))
        ! .. Executable Statements ..
        f(1) = y(2)
        f(2) = -y(1)

      END FUNCTION f

    END MODULE ivp_ode_rk_ex02_mod

    PROGRAM nag_ivp_ode_rk_ex02

      ! Example Program Text for nag_ivp_ode_rk
      ! NAG fl90, Release 4. NAG Copyright 2000.

      ! .. Use Statements ..
      USE nag_ivp_ode_rk, ONLY : nag_rk_comm_wp => nag_rk_comm_dp, &
       nag_rk_setup, nag_rk_step, nag_rk_info, nag_rk_interp, &
       nag_rk_global_err, nag_deallocate, nag_error, nag_set_error
      USE nag_math_constants, ONLY : nag_pi
      USE nag_examples_io, ONLY : nag_std_out
      USE ivp_ode_rk_ex02_mod, ONLY : wp, f
      ! .. Implicit None Statement ..
      IMPLICIT NONE
      ! .. Parameters ..
      INTEGER, PARAMETER :: n = 2
      ! .. Local Scalars ..
      INTEGER :: i, j, nout, num_fun_eval
      REAL (wp) :: err_max, pi, tinc, tol, t_end, t_err_max, t_now, t_start, &
       t_want
      LOGICAL :: call_step, global_err
      TYPE (nag_rk_comm_wp) :: comm
      TYPE (nag_error) :: error_rec
      ! .. Local Arrays ..
      REAL (wp) :: rms_err(n), thresh(n), yp_now(n), yp_want(1), y_now(n), &
       y_start(n), y_want(1)
      ! .. Executable Statements ..
      WRITE (nag_std_out,*) 'Example Program Results for nag_ivp_ode_rk_ex02'

      CALL nag_set_error(error_rec)

      pi = nag_pi(0.0_wp)

      t_start = 0.0_wp
      t_end = 2.0_wp*pi
      y_start = (/ 0.0_wp, 1.0_wp/)
      thresh = 1.0E-8_wp
      call_step = .TRUE.
      global_err = .TRUE.

      nout = 16
      tinc = (t_end-t_start)/nout

      DO i = 1, 2
        IF (i==1) tol = 1.0E-3_wp
        IF (i==2) tol = 1.0E-4_wp

        CALL nag_rk_setup(t_start,y_start,t_end,tol,thresh,comm, &
         call_step=call_step,global_err=global_err)

        WRITE (nag_std_out,'(/1X,A,1PE8.1)') 'Calculation with tol = ', tol
        WRITE (nag_std_out,*) '    t         y1        y2'
        WRITE (nag_std_out,'(1X,F7.4,2(3X,F7.4))') t_start, y_start(:)

        j = nout - 1
        t_want = t_end - j*tinc

inner:  DO

          CALL nag_rk_step(f,t_now,y_now,yp_now,comm,error=error_rec)

          IF (error_rec%code==0) THEN

interp:     DO
              IF (t_want>t_now) EXIT interp

              CALL nag_rk_interp(f,t_want,comm,y_want=y_want,yp_want=yp_want)

              WRITE (nag_std_out,'(1X,F7.4,2(3X,F7.4))') t_want, y_want(1), &
               yp_want(1)
              j = j - 1
              t_want = t_end - j*tinc
            END DO interp

            IF (t_now>=t_end) EXIT inner

          END IF

        END DO inner

        CALL nag_rk_global_err(comm,rms_err=rms_err,err_max=err_max, &
         t_err_max=t_err_max)

        WRITE (nag_std_out,*)
        WRITE (nag_std_out,'(1X,A/1X,2(2X,E9.2))') &
         'Componentwise error assessment:', rms_err(:)
        WRITE (nag_std_out,'(1X,A,E9.2,A,F7.4)') &
         'Worst global error observed was ', err_max, &
         ' - it occurred at  t = ', t_err_max

        CALL nag_rk_info(comm,num_fun_eval=num_fun_eval)

        WRITE (nag_std_out,*)
        WRITE (nag_std_out,'(1X,A,I10)') &
         'The cost of integration in evaluations of f = ', num_fun_eval
      END DO

      CALL nag_deallocate(comm)    ! Free structure allocated by NAG fl90

    END PROGRAM nag_ivp_ode_rk_ex02
