* F01LEF Example Program Text * Mark 14 Revised. NAG Copyright 1989. * .. Parameters .. INTEGER NMAX PARAMETER (NMAX=50) INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) * .. Local Scalars .. DOUBLE PRECISION LAMBDA, TOL INTEGER I, IFAIL, JOB, N * .. Local Arrays .. DOUBLE PRECISION A(NMAX), B(NMAX), C(NMAX), D(NMAX), Y(NMAX) INTEGER IPIV(NMAX) * .. External Subroutines .. EXTERNAL F01LEF, F04LEF * .. Executable Statements .. WRITE (NOUT,*) 'F01LEF Example Program Results' * Skip heading in data file READ (NIN,*) READ (NIN,*) N WRITE (NOUT,*) IF (N.LT.1 .OR. N.GT.NMAX) THEN WRITE (NOUT,99999) 'N is out of range. N = ', N ELSE READ (NIN,*) (A(I),I=1,N) READ (NIN,*) (B(I),I=2,N) READ (NIN,*) (C(I),I=2,N) TOL = 0.00005D0 LAMBDA = 0.0D0 IFAIL = 1 * CALL F01LEF(N,A,LAMBDA,B,C,TOL,D,IPIV,IFAIL) * IF (IFAIL.EQ.0) THEN IF (IPIV(N).NE.0) THEN WRITE (NOUT,*) 'Matrix is singular or nearly singular' WRITE (NOUT,99999) 'Diagonal element', IPIV(N), + 'is small' ELSE WRITE (NOUT,*) 'Details of factorization' WRITE (NOUT,*) WRITE (NOUT,*) ' Main diagonal of U' WRITE (NOUT,99998) (A(I),I=1,N) WRITE (NOUT,*) WRITE (NOUT,*) ' First super-diagonal of U' WRITE (NOUT,99998) (B(I),I=2,N) WRITE (NOUT,*) WRITE (NOUT,*) ' Second super-diagonal of U' WRITE (NOUT,99998) (D(I),I=3,N) WRITE (NOUT,*) WRITE (NOUT,*) ' Multipliers' WRITE (NOUT,99998) (C(I),I=2,N) WRITE (NOUT,*) WRITE (NOUT,*) ' Vector of interchanges' WRITE (NOUT,99997) (IPIV(I-1),I=2,N) * READ (NIN,*) (Y(I),I=1,N) JOB = 1 IFAIL = 1 * CALL F04LEF(JOB,N,A,B,C,D,IPIV,Y,TOL,IFAIL) * IF (IFAIL.EQ.0) THEN WRITE (NOUT,*) WRITE (NOUT,*) ' Solution vector' WRITE (NOUT,99998) (Y(I),I=1,N) ELSE WRITE (NOUT,99996) IFAIL END IF END IF ELSE WRITE (NOUT,99995) IFAIL END IF END IF * 99999 FORMAT (1X,A,I4,A) 99998 FORMAT (1X,8F9.4) 99997 FORMAT (1X,5I9) 99996 FORMAT (1X,/1X,' ** F04LEF returned with IFAIL = ',I5) 99995 FORMAT (1X,/1X,' ** F01LEF returned with IFAIL = ',I5) END