! D02QZF Example Program Text ! Mark 23 Release. NAG Copyright 2011. 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) ! .. Implicit None Statement .. IMPLICIT NONE ! .. 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 USE d02qzfe_mod, ONLY : fcn, latol, liwork, lrtol, lrwork, nag_wp, & 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