! D02KEF Example Program Text ! Mark 23 Release. NAG Copyright 2011. MODULE d02kefe_mod ! Data for D02KEF example program ! .. Use Statements .. USE nag_library, ONLY : nag_wp ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. REAL (KIND=nag_wp), PARAMETER :: one = 1.0_nag_wp REAL (KIND=nag_wp), PARAMETER :: two = 2.0_nag_wp REAL (KIND=nag_wp), PARAMETER :: zero = 0.0_nag_wp INTEGER, PARAMETER :: nin = 5, nout = 6 CONTAINS SUBROUTINE coeffn(p,q,dqdl,x,elam,jint) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (OUT) :: dqdl, p, q REAL (KIND=nag_wp), INTENT (IN) :: elam, x INTEGER, INTENT (IN) :: jint ! .. Executable Statements .. p = one q = elam - x - two/(x*x) dqdl = one RETURN END SUBROUTINE coeffn SUBROUTINE bdyval(xl,xr,elam,yl,yr) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: elam, xl, xr ! .. Array Arguments .. REAL (KIND=nag_wp), INTENT (OUT) :: yl(3), yr(3) ! .. Intrinsic Functions .. INTRINSIC sqrt ! .. Executable Statements .. yl(1) = xl yl(2) = two yr(1) = one yr(2) = -sqrt(xr-elam) RETURN END SUBROUTINE bdyval SUBROUTINE report(x,v,jint) ! .. Use Statements .. USE nag_library, ONLY : x02amf ! .. Implicit None Statement .. IMPLICIT NONE ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: x INTEGER, INTENT (IN) :: jint ! .. Array Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: v(3) ! .. Local Scalars .. REAL (KIND=nag_wp) :: pyp, r, sqrtb, y ! .. Intrinsic Functions .. INTRINSIC cos, exp, log, sin, sqrt ! .. Executable Statements .. IF (jint==0) THEN WRITE (nout,*) WRITE (nout,*) ' Eigenfunction values' WRITE (nout,*) ' X Y PYP' END IF sqrtb = sqrt(v(1)) ! Avoid underflow in call of EXP IF (0.5_nag_wp*v(3)>=log(x02amf())) THEN r = exp(0.5_nag_wp*v(3)) ELSE r = zero END IF pyp = r*sqrtb*cos(0.5_nag_wp*v(2)) y = r/sqrtb*sin(0.5_nag_wp*v(2)) WRITE (nout,99999) x, y, pyp RETURN 99999 FORMAT (1X,F10.3,1P,2F12.4) END SUBROUTINE report SUBROUTINE monit(nit,iflag,elam,finfo) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: elam INTEGER, INTENT (IN) :: iflag, nit ! .. Array Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: finfo(15) ! .. Executable Statements .. IF (nit==-1) THEN WRITE (nout,*) WRITE (nout,*) 'Output from MONIT' END IF WRITE (nout,99999) nit, iflag, elam, finfo(1:4) RETURN 99999 FORMAT (1X,2I4,F10.3,2E12.2,2F8.1) END SUBROUTINE monit END MODULE d02kefe_mod PROGRAM d02kefe ! D02KEF Example Main Program ! .. Use Statements .. USE nag_library, ONLY : d02kay, d02kef, nag_wp USE d02kefe_mod, ONLY : bdyval, coeffn, nin, nout, report ! .. Implicit None Statement .. IMPLICIT NONE ! .. Local Scalars .. REAL (KIND=nag_wp) :: delam, elam, tol INTEGER :: ifail, k, m, match, maxfun, maxit ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: hmax(:,:), xpoint(:) ! .. Executable Statements .. WRITE (nout,*) 'D02KEF Example Program Results' WRITE (nout,*) WRITE (nout,*) 'A singular problem' ! Skip heading in data file READ (nin,*) ! m: number of points in xpoint READ (nin,*) m ALLOCATE (hmax(2,m),xpoint(m)) ! xpoint: points where the boundary conditions are to be imposed ! and any break points, ! tol: tolerance parameter which determines the accuracy of the ! computed eigenvalue, ! k: index of the required eigenvalue, hmax: maximum step size, ! elam: initial estimate of the eigenvalue, delam: initial search step, ! maxit: number of root-finding iterations allowed, ! maxfun: number of calls to coeffn in any one root-finding iteration, ! match: index of the break point. READ (nin,*) xpoint(1:m) READ (nin,*) tol READ (nin,*) k READ (nin,*) elam, delam READ (nin,*) hmax(1,1:m-3) READ (nin,*) maxit, maxfun, match ! ifail: behaviour on error exit ! =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft ifail = 0 ! * To obtain monitoring information from the supplied ! subroutine MONIT replace the name D02KAY by MONIT in ! the next statement and USE MONIT from d02kefe_mod * CALL d02kef(xpoint,m,match,coeffn,bdyval,k,tol,elam,delam,hmax,maxit, & maxfun,d02kay,report,ifail) WRITE (nout,*) WRITE (nout,*) 'Final results' WRITE (nout,*) WRITE (nout,99999) k, elam, delam WRITE (nout,99998) hmax(1,m-1), hmax(1,m) 99999 FORMAT (1X,'K =',I3,' ELAM =',F12.3,' DELAM =',E12.2) 99998 FORMAT (1X,'HMAX(1,M-1) =',F10.3,' HMAX(1,M) =',F10.3) END PROGRAM d02kefe