* F11MHF Example Program Text * Mark 21 Release. NAG Copyright 2004. * .. Parameters .. INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) INTEGER LA, NMAX, MMAX, LDB, LDX PARAMETER (LA=10000,NMAX=1000,MMAX=10,LDB=NMAX,LDX=NMAX) DOUBLE PRECISION ONE PARAMETER (ONE=1.D0) * .. Local Scalars .. DOUBLE PRECISION FLOP, THRESH INTEGER I, IFAIL, J, N, NNZ, NNZL, NNZU, NRHS, NZLMX, + NZLUMX, NZUMX CHARACTER SPEC, TRANS * .. Local Arrays .. DOUBLE PRECISION A(LA), B(LDB,MMAX), BERR(MMAX), FERR(MMAX), + LVAL(8*LA), UVAL(8*LA), X(LDX,MMAX) INTEGER ICOLZP(NMAX+1), IL(7*NMAX+8*LA+4), IPRM(7*NMAX), + IROWIX(LA), IU(2*NMAX+8*LA+1) CHARACTER CLABS(1), RLABS(1) * .. External Subroutines .. EXTERNAL F11MDF, F11MEF, F11MFF, F11MHF, X04CAF, X04CBF * .. Executable Statements .. WRITE (NOUT,*) 'F11MHF Example Program Results' * Skip heading in data file READ (NIN,*) * * Read order of matrix and number of right hand sides * READ (NIN,*) N, NRHS IF (N.LE.NMAX .AND. NRHS.LE.MMAX) THEN * * Read the matrix A * DO 20 I = 1, N + 1 READ (NIN,*) ICOLZP(I) 20 CONTINUE NNZ = ICOLZP(N+1) - 1 DO 40 I = 1, NNZ READ (NIN,*) A(I), IROWIX(I) 40 CONTINUE * * Read the right hand sides * DO 80 J = 1, NRHS READ (NIN,*) (X(I,J),I=1,N) DO 60 I = 1, N B(I,J) = X(I,J) 60 CONTINUE 80 CONTINUE * * Calculate COLAMD permutation * SPEC = 'M' IFAIL = 1 CALL F11MDF(SPEC,N,ICOLZP,IROWIX,IPRM,IFAIL) IF (IFAIL.EQ.0) THEN * * Factorise * THRESH = ONE IFAIL = 0 NZLMX = 8*NNZ NZLUMX = 8*NNZ NZUMX = 8*NNZ CALL F11MEF(N,IROWIX,A,IPRM,THRESH,NZLMX,NZLUMX,NZUMX,IL, + LVAL,IU,UVAL,NNZL,NNZU,FLOP,IFAIL) * * Compute solution in array X * TRANS = 'N' IFAIL = 0 CALL F11MFF(TRANS,N,IPRM,IL,LVAL,IU,UVAL,NRHS,X,LDX,IFAIL) * * Improve solution, and compute backward errors and estimated * bounds on the forward errors * CALL F11MHF(TRANS,N,ICOLZP,IROWIX,A,IPRM,IL,LVAL,IU,UVAL, + NRHS,B,LDB,X,LDX,FERR,BERR,IFAIL) * * Print solution * WRITE (NOUT,*) CALL X04CAF('G',' ',N,NRHS,X,LDX,'Solutions',IFAIL) CALL X04CBF('G','X',NRHS,1,FERR,NRHS,'1PE8.1', + 'Estimated Forward Error','N',RLABS,'N',CLABS, + 80,0,IFAIL) CALL X04CBF('G','X',NRHS,1,BERR,NRHS,'1PE8.1', + 'Backward Error','N',RLABS,'N',CLABS,80,0,IFAIL) ELSE WRITE (NOUT,99999) IFAIL END IF * END IF * 99999 FORMAT (1X,/1X,' ** F11MDF returned with IFAIL = ',I5) END