! D02BGF Example Program Text ! Mark 23 Release. NAG Copyright 2011. MODULE d02bgfe_mod ! D02BGF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. USE nag_library, ONLY : nag_wp ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: n = 3, nin = 5, nout = 6 ! n: number of differential equations CONTAINS SUBROUTINE fcn(x,y,f) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: x ! .. Array Arguments .. REAL (KIND=nag_wp), INTENT (OUT) :: f(*) REAL (KIND=nag_wp), INTENT (IN) :: y(*) ! .. Intrinsic Functions .. INTRINSIC cos, tan ! .. Executable Statements .. f(1) = tan(y(3)) f(2) = -0.032E0_nag_wp*tan(y(3))/y(2) - 0.02E0_nag_wp*y(2)/cos(y(3)) f(3) = -0.032E0_nag_wp/y(2)**2 RETURN END SUBROUTINE fcn END MODULE d02bgfe_mod PROGRAM d02bgfe ! D02BGF Example Main Program ! .. Use Statements .. USE nag_library, ONLY : d02bgf USE d02bgfe_mod, ONLY : fcn, n, nag_wp, nin, nout ! .. Implicit None Statement .. IMPLICIT NONE ! .. Local Scalars .. REAL (KIND=nag_wp) :: alpha, hmax, tol, val, x, xend, & xinit INTEGER :: i, ifail, m ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: w(:,:), y(:), yinit(:) ! .. Executable Statements .. WRITE (nout,*) 'D02BGF Example Program Results' ! Skip heading in data file READ (nin,*) ! m: index of mode of solution to attain value alpha READ (nin,*) m ALLOCATE (w(n,10),y(n),yinit(n)) ! xinit: initial x value, xend : final x value. ! alpha: attain y(m) = alpha, yinit: initial solution values. READ (nin,*) alpha READ (nin,*) xinit READ (nin,*) xend READ (nin,*) yinit(1:n) hmax = 0.0E0_nag_wp val = alpha DO i = 4, 5 tol = 10.0E0_nag_wp**(-i) x = xinit y(1:n) = yinit(1:n) ! ifail: behaviour on error exit ! =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft ifail = 0 CALL d02bgf(x,xend,n,y,tol,hmax,m,val,fcn,w,ifail) WRITE (nout,*) WRITE (nout,99999) 'Calculation with TOL =', tol WRITE (nout,99998) ' Y(M) changes sign at X = ', x IF (tol<0.0E0_nag_wp) THEN WRITE (nout,*) ' Over one-third steps controlled by HMAX' END IF END DO 99999 FORMAT (1X,A,E8.1) 99998 FORMAT (1X,A,F7.4) END PROGRAM d02bgfe