* F07ATF 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, CJ, COLCND, ROWCND, SMALL INTEGER I, IFAIL, INFO, J, N * .. Local Arrays .. COMPLEX *16 A(LDA,NMAX) DOUBLE PRECISION C(NMAX), R(NMAX) CHARACTER CLABS(1), RLABS(1) * .. External Functions .. DOUBLE PRECISION X02AJF, X02AMF INTEGER X02BHF EXTERNAL X02AJF, X02AMF, X02BHF * .. External Subroutines .. EXTERNAL X04DBF, ZGEEQU * .. Executable Statements .. WRITE (NOUT,*) 'F07ATF Example Program Results' WRITE (NOUT,*) * Skip heading in data file READ (NIN,*) READ (NIN,*) N IF (N.LE.NMAX) THEN * * Read the N by N matrix A from data file * READ (NIN,*) ((A(I,J),J=1,N),I=1,N) * * Print the matrix A * IFAIL = 0 CALL X04DBF('General',' ',N,N,A,LDA,'Bracketed','1P,E10.2', + 'Matrix A','Integer',RLABS,'Integer',CLABS,80,0, + IFAIL) WRITE (NOUT,*) * * Compute row and column scaling factors * CALL ZGEEQU(N,N,A,LDA,R,C,ROWCND,COLCND,AMAX,INFO) * IF (INFO.GT.0) THEN IF (INFO.LE.N) THEN WRITE (NOUT,99999) 'Row ', INFO, ' of A is exactly zero' ELSE WRITE (NOUT,99999) 'Column ', INFO - N, + ' of A is exactly zero' END IF ELSE * * Print ROWCND, COLCND, AMAX and the scale factors * WRITE (NOUT,99998) 'ROWCND = ', ROWCND, ', COLCND = ', + COLCND, ', AMAX = ', AMAX WRITE (NOUT,*) WRITE (NOUT,*) 'Row scale factors' WRITE (NOUT,99997) (R(I),I=1,N) WRITE (NOUT,*) WRITE (NOUT,*) 'Column scale factors' WRITE (NOUT,99997) (C(I),I=1,N) WRITE (NOUT,*) * * Compute values close to underflow and overflow * SMALL = X02AMF()/(X02AJF()*X02BHF()) BIG = 1.0D0/SMALL IF ((ROWCND.GE.0.1D0) .AND. (AMAX.GE.SMALL) + .AND. (AMAX.LE.BIG)) THEN IF (COLCND.LT.0.1D0) THEN * * Just column scale A * DO 40 J = 1, N CJ = C(J) DO 20 I = 1, N A(I,J) = A(I,J)*CJ 20 CONTINUE 40 CONTINUE * * Print the column scaled matrix * IFAIL = 0 CALL X04DBF('General',' ',N,N,A,LDA,'Bracketed',' ', + 'Scaled matrix','Integer',RLABS,'Integer', + CLABS,80,0,IFAIL) * END IF ELSE IF (COLCND.GE.0.1D0) THEN * * Just row scale A * DO 80 J = 1, N DO 60 I = 1, N A(I,J) = R(I)*A(I,J) 60 CONTINUE 80 CONTINUE * * Print the row scaled matrix * IFAIL = 0 CALL X04DBF('General',' ',N,N,A,LDA,'Bracketed',' ', + 'Scaled matrix','Integer',RLABS,'Integer', + CLABS,80,0,IFAIL) * ELSE * * Row and column scale A * DO 120 J = 1, N CJ = C(J) DO 100 I = 1, N A(I,J) = R(I)*A(I,J)*CJ 100 CONTINUE 120 CONTINUE * * Print the row and column scaled matrix * IFAIL = 0 CALL X04DBF('General',' ',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,3(A,1P,E7.1)) 99997 FORMAT ((1X,1P,7E11.1)) END