* D05ABF Example Program Text * Mark 14 Revised. NAG Copyright 1989. * .. Parameters .. INTEGER LDCM, NT2P1 PARAMETER (LDCM=10,NT2P1=2*LDCM+1) INTEGER NOUT PARAMETER (NOUT=6) * .. Scalars in Common .. DOUBLE PRECISION ALPHA, W * .. Local Scalars .. DOUBLE PRECISION A, A1, B, CHEBR, D, E, LAMBDA, S, X INTEGER I, IFAIL, N, SS LOGICAL EV, ODOREV * .. Local Arrays .. DOUBLE PRECISION C(LDCM), CM(LDCM,LDCM), F(LDCM), F1(LDCM,1), + WK(2,NT2P1) * .. External Functions .. DOUBLE PRECISION C06DBF, G, K EXTERNAL C06DBF, G, K * .. External Subroutines .. EXTERNAL D05ABF * .. Common blocks .. COMMON /AFRED2/ALPHA, W * .. Executable Statements .. WRITE (NOUT,*) 'D05ABF Example Program Results' WRITE (NOUT,*) ODOREV = .TRUE. EV = .TRUE. LAMBDA = -0.3183D0 A = -1.0D0 B = 1.0D0 ALPHA = 1.0D0 W = ALPHA*ALPHA IF (ODOREV .AND. EV) THEN WRITE (NOUT,*) 'Solution is even' ELSE IF (ODOREV) WRITE (NOUT,*) 'Solution is odd' END IF DO 60 N = 5, LDCM, 5 IFAIL = 1 * CALL D05ABF(K,G,LAMBDA,A,B,ODOREV,EV,N,CM,F1,WK,LDCM,NT2P1,F,C, + IFAIL) * IF (IFAIL.EQ.0) THEN WRITE (NOUT,*) WRITE (NOUT,99999) 'Results for N =', N WRITE (NOUT,*) WRITE (NOUT,*) ' I F(I) C(I)' DO 20 I = 1, N WRITE (NOUT,99998) I, F(I), C(I) 20 CONTINUE WRITE (NOUT,*) WRITE (NOUT,*) ' X F(X)' IF (ODOREV) THEN IF (EV) THEN SS = 2 ELSE SS = 3 END IF ELSE SS = 1 END IF A1 = 0.5D0*(A+B) S = 0.5D0*(B-A) X = A1 IF ( .NOT. ODOREV) THEN X = X - 5 ELSE X = A1 END IF D = 1.0D0/S S = 0.25D0*S E = B + 0.1D0*S 40 CHEBR = C06DBF((X-A1)*D,C,N,SS) WRITE (NOUT,99997) X, CHEBR X = X + S IF (X.LT.E) GO TO 40 ELSE IF (IFAIL.EQ.1) THEN WRITE (NOUT,*) WRITE (NOUT,*) 'Failure in D05ABF -' WRITE (NOUT,*) 'error in integration limits' ELSE IF (IFAIL.EQ.2) THEN WRITE (NOUT,*) WRITE (NOUT,*) 'Failure in D05ABF -' WRITE (NOUT,*) 'LAMBDA near eigenvalue' ELSE WRITE (NOUT,*) WRITE (NOUT,*) ' ** D05ABF returned with IFAIL = ', IFAIL GO TO 80 END IF END IF 60 CONTINUE 80 CONTINUE * 99999 FORMAT (1X,A,I3) 99998 FORMAT (1X,I3,F15.5,E15.5) 99997 FORMAT (1X,F8.4,F15.5) END * DOUBLE PRECISION FUNCTION K(X,S) * .. Scalar Arguments .. DOUBLE PRECISION S, X * .. Scalars in Common .. DOUBLE PRECISION ALPHA, W * .. Common blocks .. COMMON /AFRED2/ALPHA, W * .. Executable Statements .. K = ALPHA/(W+(X-S)*(X-S)) RETURN END * DOUBLE PRECISION FUNCTION G(X) * .. Scalar Arguments .. DOUBLE PRECISION X * .. Executable Statements .. G = 1.0D0 RETURN END