! D05BDF Example Program Text ! Mark 23 Release. NAG Copyright 2011. MODULE d05bdfe_mod ! D05BDF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. USE nag_library, ONLY : nag_wp ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: iorder = 4 INTEGER, PARAMETER :: nmesh = 2**6 + 2*iorder - 1 INTEGER, PARAMETER :: nout = 6 INTEGER, PARAMETER :: lct = nmesh/32 + 1 INTEGER, PARAMETER :: & lwk = (2*iorder+6)*nmesh + 8*iorder*iorder - 16*iorder + 1 CONTAINS FUNCTION ck1(t) ! .. Use Statements .. USE nag_library, ONLY : x01aaf ! .. Implicit None Statement .. IMPLICIT NONE ! .. Function Return Value .. REAL (KIND=nag_wp) :: ck1 ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: t ! .. Local Scalars .. REAL (KIND=nag_wp) :: pi ! .. Intrinsic Functions .. INTRINSIC sqrt ! .. Executable Statements .. ck1 = -sqrt(x01aaf(pi)) RETURN END FUNCTION ck1 FUNCTION cf1(t) ! .. Use Statements .. USE nag_library, ONLY : x01aaf ! .. Implicit None Statement .. IMPLICIT NONE ! .. Function Return Value .. REAL (KIND=nag_wp) :: cf1 ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: t ! .. Local Scalars .. REAL (KIND=nag_wp) :: pi ! .. Intrinsic Functions .. INTRINSIC sqrt ! .. Executable Statements .. cf1 = sqrt(t) + (3.0_nag_wp/8.0_nag_wp)*t*t*x01aaf(pi) RETURN END FUNCTION cf1 FUNCTION cg1(s,y) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Function Return Value .. REAL (KIND=nag_wp) :: cg1 ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: s, y ! .. Executable Statements .. cg1 = y*y*y RETURN END FUNCTION cg1 FUNCTION ck2(t) ! .. Use Statements .. USE nag_library, ONLY : x01aaf ! .. Implicit None Statement .. IMPLICIT NONE ! .. Function Return Value .. REAL (KIND=nag_wp) :: ck2 ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: t ! .. Local Scalars .. REAL (KIND=nag_wp) :: pi ! .. Intrinsic Functions .. INTRINSIC sqrt ! .. Executable Statements .. ck2 = -sqrt(x01aaf(pi)) RETURN END FUNCTION ck2 FUNCTION cf2(t) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Function Return Value .. REAL (KIND=nag_wp) :: cf2 ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: t ! .. Intrinsic Functions .. INTRINSIC sqrt ! .. Executable Statements .. cf2 = (3.0_nag_wp-t)*sqrt(t) RETURN END FUNCTION cf2 FUNCTION cg2(s,y) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Function Return Value .. REAL (KIND=nag_wp) :: cg2 ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: s, y ! .. Intrinsic Functions .. INTRINSIC exp ! .. Executable Statements .. cg2 = exp(s*(1.0_nag_wp-s)*(1.0_nag_wp-s)-y*y) RETURN END FUNCTION cg2 END MODULE d05bdfe_mod PROGRAM d05bdfe ! D05BDF Example Main Program ! .. Use Statements .. USE nag_library, ONLY : d05bdf, x02ajf USE d05bdfe_mod, ONLY : cf1, cf2, cg1, cg2, ck1, ck2, iorder, lct, lwk, & nag_wp, nmesh, nout ! .. Implicit None Statement .. IMPLICIT NONE ! .. Local Scalars .. REAL (KIND=nag_wp) :: h, t, tlim, tolnl INTEGER :: i, ifail ! .. Local Arrays .. REAL (KIND=nag_wp) :: work(lwk), yn(nmesh) INTEGER :: nct(lct) ! .. Intrinsic Functions .. INTRINSIC mod, real, sqrt ! .. Executable Statements .. WRITE (nout,*) 'D05BDF Example Program Results' tlim = 7.0_nag_wp tolnl = sqrt(x02ajf()) h = tlim/real(nmesh-1,kind=nag_wp) ifail = 0 CALL d05bdf(ck1,cf1,cg1,'Initial',iorder,tlim,tolnl,nmesh,yn,work,lwk, & nct,ifail) WRITE (nout,*) WRITE (nout,*) 'Example 1' WRITE (nout,*) WRITE (nout,99998) h WRITE (nout,*) WRITE (nout,*) ' T Approximate' WRITE (nout,*) ' Solution ' WRITE (nout,*) DO i = 1, nmesh t = real(i-1,kind=nag_wp)*h IF (mod(i,5)==1) THEN WRITE (nout,99999) t, yn(i) END IF END DO tlim = 5.0_nag_wp h = tlim/real(nmesh-1,kind=nag_wp) ifail = 0 CALL d05bdf(ck2,cf2,cg2,'Subsequent',iorder,tlim,tolnl,nmesh,yn,work, & lwk,nct,ifail) WRITE (nout,*) WRITE (nout,*) 'Example 2' WRITE (nout,*) WRITE (nout,99998) h WRITE (nout,*) WRITE (nout,*) ' T Approximate' WRITE (nout,*) ' Solution ' WRITE (nout,*) DO i = 1, nmesh t = real(i-1,kind=nag_wp)*h IF (mod(i,7)==1) THEN WRITE (nout,99999) t, yn(i) END IF END DO 99999 FORMAT (1X,F8.4,F15.4) 99998 FORMAT (' The stepsize h = ',F8.4) END PROGRAM d05bdfe