* D02HAF Example Program Text * Mark 14 Revised. NAG Copyright 1989. * .. Parameters .. * N.B the definition of SDW must be changed for N.GT.11 INTEGER NOUT PARAMETER (NOUT=6) INTEGER N, SDW, M1 PARAMETER (N=3,SDW=3*N+17+11,M1=6) * .. Local Scalars .. DOUBLE PRECISION A, B, TOL INTEGER I, IFAIL, J, L, OUTCHN * .. Local Arrays .. DOUBLE PRECISION SOLN(N,M1), U(N,2), V(N,2), W(N,SDW) * .. External Subroutines .. EXTERNAL D02HAF, FCN, X04ABF * .. Executable Statements .. WRITE (NOUT,*) 'D02HAF Example Program Results' OUTCHN = NOUT CALL X04ABF(1,OUTCHN) DO 40 L = 3, 4 TOL = 5.0D0*10.0D0**(-L) WRITE (NOUT,*) U(1,1) = 0.0D0 V(1,1) = 0.0D0 U(1,2) = 0.0D0 V(1,2) = 0.0D0 U(2,1) = 0.5D0 V(2,1) = 0.0D0 U(2,2) = 0.46D0 V(2,2) = 1.0D0 U(3,1) = 1.15D0 V(3,1) = 1.0D0 U(3,2) = -1.2D0 V(3,2) = 1.0D0 A = 0.0D0 B = 5.0D0 * * Set IFAIL to 111 to obtain monitoring information * IFAIL = 1 * CALL D02HAF(U,V,N,A,B,TOL,FCN,SOLN,M1,W,SDW,IFAIL) * IF (IFAIL.GE.0) THEN WRITE (NOUT,99999) 'Results with TOL = ', TOL WRITE (NOUT,*) IF (IFAIL.EQ.0) THEN WRITE (NOUT,*) ' X-value and final solution' DO 20 I = 1, M1 WRITE (NOUT,99998) I - 1, (SOLN(J,I),J=1,N) 20 CONTINUE ELSE WRITE (NOUT,99997) ' IFAIL =', IFAIL END IF ELSE WRITE (NOUT,99996) IFAIL GO TO 60 END IF 40 CONTINUE 60 CONTINUE * 99999 FORMAT (1X,A,E10.3) 99998 FORMAT (1X,I3,3F10.4) 99997 FORMAT (1X,A,I4) 99996 FORMAT (1X,/1X,' ** D02HAF returned with IFAIL = ',I5) END * SUBROUTINE FCN(X,Z,G) * .. Parameters .. INTEGER N PARAMETER (N=3) * .. Scalar Arguments .. DOUBLE PRECISION X * .. Array Arguments .. DOUBLE PRECISION G(N), Z(N) * .. Intrinsic Functions .. INTRINSIC COS, TAN * .. Executable Statements .. G(1) = TAN(Z(3)) G(2) = -0.032D0*TAN(Z(3))/Z(2) - 0.02D0*Z(2)/COS(Z(3)) G(3) = -0.032D0/Z(2)**2 RETURN END