* D02GAF Example Program Text * Mark 14 Revised. NAG Copyright 1989. * .. Parameters .. INTEGER N, MNP, LW, LIW PARAMETER (N=3,MNP=40,LW=MNP*(3*N*N+6*N+2)+4*N*N+4*N, + LIW=MNP*(2*N+1)+N*N+4*N+2) INTEGER NOUT PARAMETER (NOUT=6) * .. Scalars in Common .. DOUBLE PRECISION BETA * .. Local Scalars .. DOUBLE PRECISION A, B, TOL INTEGER I, IFAIL, J, K, NP * .. Local Arrays .. DOUBLE PRECISION U(N,2), V(N,2), W(LW), X(MNP), Y(N,MNP) INTEGER IW(LIW) * .. External Subroutines .. EXTERNAL D02GAF, FCN, X04ABF * .. Intrinsic Functions .. INTRINSIC DBLE * .. Common blocks .. COMMON BETA * .. Executable Statements .. WRITE (NOUT,*) 'D02GAF Example Program Results' TOL = 1.0D-3 NP = 26 A = 0.0D0 B = 10.0D0 CALL X04ABF(1,NOUT) BETA = 0.0D0 DO 40 I = 1, N DO 20 J = 1, 2 U(I,J) = 0.0D0 V(I,J) = 0.0D0 20 CONTINUE 40 CONTINUE V(3,1) = 1.0D0 V(1,2) = 1.0D0 V(3,2) = 1.0D0 U(2,2) = 1.0D0 U(1,2) = B X(1) = A DO 60 I = 2, NP - 1 X(I) = (DBLE(NP-I)*A+DBLE(I-1)*B)/DBLE(NP-1) 60 CONTINUE X(NP) = B DO 80 K = 1, 2 WRITE (NOUT,*) WRITE (NOUT,99999) 'Problem with BETA = ', BETA * * Set IFAIL to 111 to obtain monitoring information * IFAIL = 11 * CALL D02GAF(U,V,N,A,B,TOL,FCN,MNP,X,Y,NP,W,LW,IW,LIW,IFAIL) * IF (IFAIL.EQ.0 .OR. IFAIL.EQ.3) THEN WRITE (NOUT,*) IF (IFAIL.EQ.3) WRITE (NOUT,99996) ' IFAIL = ', IFAIL WRITE (NOUT,99998) 'Solution on final mesh of ', NP, + ' points' WRITE (NOUT,*) + ' X(I) Y1(I) Y2(I) Y3(I)' WRITE (NOUT,99997) (X(I),(Y(J,I),J=1,N),I=1,NP) BETA = BETA + 0.2D0 ELSE STOP END IF 80 CONTINUE STOP * 99999 FORMAT (1X,A,F7.2) 99998 FORMAT (1X,A,I2,A) 99997 FORMAT (1X,F11.3,3F13.4) 99996 FORMAT (1X,A,I3) END * SUBROUTINE FCN(X,Y,F) * .. Parameters .. INTEGER N PARAMETER (N=3) * .. Scalar Arguments .. DOUBLE PRECISION X * .. Array Arguments .. DOUBLE PRECISION F(N), Y(N) * .. Scalars in Common .. DOUBLE PRECISION BETA * .. Common blocks .. COMMON BETA * .. Executable Statements .. F(1) = Y(2) F(2) = Y(3) F(3) = -Y(1)*Y(3) - BETA*(1.0D0-Y(2)*Y(2)) RETURN END