* F07FTF Example Program Text * Mark 21 Release. NAG Copyright 2004. * .. Parameters .. INTEGER NIN, NOUT PARAMETER (NIN=5,NOUT=6) INTEGER NMAX PARAMETER (NMAX=8) INTEGER LDA PARAMETER (LDA=NMAX) * .. Local Scalars .. DOUBLE PRECISION AMAX, BIG, SCOND, SJ, SMALL INTEGER I, IFAIL, INFO, J, N * .. Local Arrays .. COMPLEX *16 A(LDA,NMAX) DOUBLE PRECISION S(NMAX) CHARACTER CLABS(1), RLABS(1) * .. External Functions .. DOUBLE PRECISION X02AJF, X02AMF INTEGER X02BHF EXTERNAL X02AJF, X02AMF, X02BHF * .. External Subroutines .. EXTERNAL X04DBF, ZPOEQU * .. Executable Statements .. WRITE (NOUT,*) 'F07FTF Example Program Results' WRITE (NOUT,*) * Skip heading in data file READ (NIN,*) READ (NIN,*) N IF (N.LE.NMAX) THEN * * Read the upper triangular part of the matrix A from data file * READ (NIN,*) ((A(I,J),J=I,N),I=1,N) * * Print the matrix A * IFAIL = 0 CALL X04DBF('Upper','Non-unit',N,N,A,LDA,'Bracketed', + '1P,E10.2','Matrix A','Integer',RLABS,'Integer', + CLABS,80,0,IFAIL) WRITE (NOUT,*) * * Compute diagonal scaling factors * CALL ZPOEQU(N,A,LDA,S,SCOND,AMAX,INFO) * IF (INFO.GT.0) THEN WRITE (NOUT,99999) 'Diagonal element', INFO, + ' of A is non positive' ELSE * * Print SCOND, AMAX and the scale factors * WRITE (NOUT,99998) 'SCOND = ', SCOND, ', AMAX = ', AMAX WRITE (NOUT,*) WRITE (NOUT,*) 'Diagonal scaling factors' WRITE (NOUT,99997) (S(I),I=1,N) WRITE (NOUT,*) * * Compute values close to underflow and overflow * SMALL = X02AMF()/(X02AJF()*X02BHF()) BIG = 1.0D0/SMALL IF ((SCOND.LT.0.1D0) .OR. (AMAX.LT.SMALL) .OR. (AMAX.GT.BIG) + ) THEN * * Scale A * DO 40 J = 1, N SJ = S(J) DO 20 I = 1, J A(I,J) = S(I)*A(I,J)*SJ 20 CONTINUE 40 CONTINUE * * Print the scaled matrix * IFAIL = 0 CALL X04DBF('Upper','Non-unit',N,N,A,LDA,'Bracketed',' ', + 'Scaled matrix','Integer',RLABS,'Integer', + CLABS,80,0,IFAIL) * END IF END IF ELSE WRITE (NOUT,*) 'NMAX too small' END IF STOP * 99999 FORMAT (1X,A,I4,A) 99998 FORMAT (1X,2(A,1P,E7.1)) 99997 FORMAT ((1X,1P,7E11.1)) END