! D02QZF Example Program Text ! Mark 24 Release. NAG Copyright 2012. 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 ! .. Parameters .. Integer, Parameter :: neqf = 2, neqg = 0, nin = 5, & nout = 6 Integer, Parameter :: latol = neqf Integer, Parameter :: liwork = 21 + 4*neqg Integer, Parameter :: lrtol = neqf Integer, Parameter :: 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 nag_library, Only: d02qff, d02qfz, d02qwf, d02qzf, nag_wp Use d02qzfe_mod, Only: fcn, latol, liwork, lrtol, lrwork, neqf, neqg, & nin, nout ! .. 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