NAG Library Manual, Mark 30.1
Interfaces:  FL   CL   CPP   AD 

NAG FL Interface Introduction
Example description
!   D02QZF Example Program Text
!   Mark 30.1 Release. NAG Copyright 2024.

    Module d02qzfe_mod

!     D02QZF Example Program Module:
!            Parameters and User-defined Routines

!     .. Use Statements ..
      Use nag_library, Only: nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Accessibility Statements ..
      Private
      Public                           :: fcn
!     .. Parameters ..
      Integer, Parameter, Public       :: neqf = 2, neqg = 0, nin = 5,         &
                                          nout = 6
      Integer, Parameter, Public       :: latol = neqf
      Integer, Parameter, Public       :: liwork = 21 + 4*neqg
      Integer, Parameter, Public       :: lrtol = neqf
      Integer, Parameter, Public       :: lrwork = 23 + 23*neqf + 14*neqg
    Contains
      Subroutine fcn(neqf,x,y,f)

!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (In) :: x
        Integer, Intent (In)           :: neqf
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Out) :: f(neqf)
        Real (Kind=nag_wp), Intent (In) :: y(neqf)
!       .. Executable Statements ..
        f(1) = y(2)
        f(2) = -y(1)
        Return
      End Subroutine fcn
    End Module d02qzfe_mod

    Program d02qzfe

!     D02QZF Example Main Program

!     .. Use Statements ..
      Use d02qzfe_mod, Only: fcn, latol, liwork, lrtol, lrwork, neqf, neqg,    &
                             nin, nout
      Use nag_library, Only: d02qff, d02qfz, d02qwf, d02qzf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: hmax, t, tcrit, tinc, tout, tstart,  &
                                          twant
      Integer                          :: ifail, maxstp, nwant
      Logical                          :: alterg, crit, onestp, root, sophst,  &
                                          vectol
      Character (1)                    :: statef
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: atol(:), rtol(:), rwork(:), y(:),    &
                                          ypwant(:), ywant(:)
      Integer, Allocatable             :: iwork(:)
!     .. Executable Statements ..
      Write (nout,*) 'D02QZF Example Program Results'
!     Skip heading in data file
      Read (nin,*)
      Allocate (atol(latol),rtol(lrtol),rwork(lrwork),y(neqf),ypwant(neqf),    &
        ywant(neqf),iwork(liwork))

      Read (nin,*) hmax, tstart
      Read (nin,*) tcrit, tinc
      Read (nin,*) statef
      Read (nin,*) vectol, onestp, crit
      Read (nin,*) maxstp
      Read (nin,*) rtol(1:neqf)
      Read (nin,*) atol(1:neqf)
      Read (nin,*) y(1:neqf)
      tout = tcrit
      t = tstart
      twant = tstart + tinc
      nwant = neqf

!     Set up integration.
      ifail = 0
      Call d02qwf(statef,neqf,vectol,atol,latol,rtol,lrtol,onestp,crit,tcrit,  &
        hmax,maxstp,neqg,alterg,sophst,rwork,lrwork,iwork,liwork,ifail)

      Write (nout,*)
      Write (nout,*) '  T         Y(1)     Y(2)'
      Write (nout,99999) t, y(1), y(2)

integ: Do While (t<tout)
        ifail = -1
        Call d02qff(fcn,neqf,t,y,tout,d02qfz,neqg,root,rwork,lrwork,iwork,     &
          liwork,ifail)

        If (ifail/=0) Then
          Exit integ
        End If

!       Interpolate at wanted time values up to time = t.
        Do While (twant<=t)
          ifail = 0
          Call d02qzf(neqf,twant,nwant,ywant,ypwant,rwork,lrwork,iwork,liwork, &
            ifail)
          Write (nout,99999) twant, ywant(1), ywant(2)
          twant = twant + tinc
        End Do
      End Do integ

99999 Format (1X,F7.4,2X,2(F7.4,2X))
    End Program d02qzfe