! D02QZF Example Program Text
! Mark 30.3 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