Mercurial > octave-nkf
diff libcruft/arpack/util/cmout.f @ 12274:9f5d2ef078e8 release-3-4-x
import ARPACK sources to libcruft from Debian package libarpack2 2.1+parpack96.dfsg-3+b1
| author | John W. Eaton <jwe@octave.org> |
|---|---|
| date | Fri, 28 Jan 2011 14:04:33 -0500 |
| parents | |
| children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/libcruft/arpack/util/cmout.f Fri Jan 28 14:04:33 2011 -0500 @@ -0,0 +1,250 @@ +* +* Routine: CMOUT +* +* Purpose: Complex matrix output routine. +* +* Usage: CALL CMOUT (LOUT, M, N, A, LDA, IDIGIT, IFMT) +* +* Arguments +* M - Number of rows of A. (Input) +* N - Number of columns of A. (Input) +* A - Complex M by N matrix to be printed. (Input) +* LDA - Leading dimension of A exactly as specified in the +* dimension statement of the calling program. (Input) +* IFMT - Format to be used in printing matrix A. (Input) +* IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In) +* If IDIGIT .LT. 0, printing is done with 72 columns. +* If IDIGIT .GT. 0, printing is done with 132 columns. +* +*\SCCS Information: @(#) +* FILE: cmout.f SID: 2.1 DATE OF SID: 11/16/95 RELEASE: 2 +* +*----------------------------------------------------------------------- +* + SUBROUTINE CMOUT( LOUT, M, N, A, LDA, IDIGIT, IFMT ) +* ... +* ... SPECIFICATIONS FOR ARGUMENTS + INTEGER M, N, IDIGIT, LDA, LOUT + Complex + & A( LDA, * ) + CHARACTER IFMT*( * ) +* ... +* ... SPECIFICATIONS FOR LOCAL VARIABLES + INTEGER I, J, NDIGIT, K1, K2, LLL + CHARACTER*1 ICOL( 3 ) + CHARACTER*80 LINE +* ... +* ... SPECIFICATIONS INTRINSICS + INTRINSIC MIN +* + DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o', + $ 'l' / +* ... +* ... FIRST EXECUTABLE STATEMENT +* + LLL = MIN( LEN( IFMT ), 80 ) + DO 10 I = 1, LLL + LINE( I: I ) = '-' + 10 CONTINUE +* + DO 20 I = LLL + 1, 80 + LINE( I: I ) = ' ' + 20 CONTINUE +* + WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL ) + 9999 FORMAT( / 1X, A / 1X, A ) +* + IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 ) + $ RETURN + NDIGIT = IDIGIT + IF( IDIGIT.EQ.0 ) + $ NDIGIT = 4 +* +*======================================================================= +* CODE FOR OUTPUT USING 72 COLUMNS FORMAT +*======================================================================= +* + IF( IDIGIT.LT.0 ) THEN + NDIGIT = -IDIGIT + IF( NDIGIT.LE.4 ) THEN + DO 40 K1 = 1, N, 2 + K2 = MIN0( N, K1+1 ) + WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 ) + DO 30 I = 1, M + IF (K1.NE.N) THEN + WRITE( LOUT, 9994 )I, ( A( I, J ), J = K1, K2 ) + ELSE + WRITE( LOUT, 9984 )I, ( A( I, J ), J = K1, K2 ) + END IF + 30 CONTINUE + 40 CONTINUE +* + ELSE IF( NDIGIT.LE.6 ) THEN + DO 60 K1 = 1, N, 2 + K2 = MIN0( N, K1+1 ) + WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 ) + DO 50 I = 1, M + IF (K1.NE.N) THEN + WRITE( LOUT, 9993 )I, ( A( I, J ), J = K1, K2 ) + ELSE + WRITE( LOUT, 9983 )I, ( A( I, J ), J = K1, K2 ) + END IF + 50 CONTINUE + 60 CONTINUE +* + ELSE IF( NDIGIT.LE.8 ) THEN + DO 80 K1 = 1, N, 2 + K2 = MIN0( N, K1+1 ) + WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 ) + DO 70 I = 1, M + IF (K1.NE.N) THEN + WRITE( LOUT, 9992 )I, ( A( I, J ), J = K1, K2 ) + ELSE + WRITE( LOUT, 9982 )I, ( A( I, J ), J = K1, K2 ) + END IF + 70 CONTINUE + 80 CONTINUE +* + ELSE + DO 100 K1 = 1, N + WRITE( LOUT, 9995 ) ICOL, K1 + DO 90 I = 1, M + WRITE( LOUT, 9991 )I, A( I, K1 ) + 90 CONTINUE + 100 CONTINUE + END IF +* +*======================================================================= +* CODE FOR OUTPUT USING 132 COLUMNS FORMAT +*======================================================================= +* + ELSE + IF( NDIGIT.LE.4 ) THEN + DO 120 K1 = 1, N, 4 + K2 = MIN0( N, K1+3 ) + WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 ) + DO 110 I = 1, M + IF ((K1+3).LE.N) THEN + WRITE( LOUT, 9974 )I, ( A( I, J ), J = K1, K2 ) + ELSE IF ((K1+3-N).EQ.1) THEN + WRITE( LOUT, 9964 )I, ( A( I, J ), J = k1, K2 ) + ELSE IF ((K1+3-N).EQ.2) THEN + WRITE( LOUT, 9954 )I, ( A( I, J ), J = K1, K2 ) + ELSE IF ((K1+3-N).EQ.3) THEN + WRITE( LOUT, 9944 )I, ( A( I, J ), J = K1, K2 ) + END IF + 110 CONTINUE + 120 CONTINUE +* + ELSE IF( NDIGIT.LE.6 ) THEN + DO 140 K1 = 1, N, 3 + K2 = MIN0( N, K1+ 2) + WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 ) + DO 130 I = 1, M + IF ((K1+2).LE.N) THEN + WRITE( LOUT, 9973 )I, ( A( I, J ), J = K1, K2 ) + ELSE IF ((K1+2-N).EQ.1) THEN + WRITE( LOUT, 9963 )I, ( A( I, J ), J = K1, K2 ) + ELSE IF ((K1+2-N).EQ.2) THEN + WRITE( LOUT, 9953 )I, ( A( I, J ), J = K1, K2 ) + END IF + 130 CONTINUE + 140 CONTINUE +* + ELSE IF( NDIGIT.LE.8 ) THEN + DO 160 K1 = 1, N, 3 + K2 = MIN0( N, K1+2 ) + WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 ) + DO 150 I = 1, M + IF ((K1+2).LE.N) THEN + WRITE( LOUT, 9972 )I, ( A( I, J ), J = K1, K2 ) + ELSE IF ((K1+2-N).EQ.1) THEN + WRITE( LOUT, 9962 )I, ( A( I, J ), J = K1, K2 ) + ELSE IF ((K1+2-N).EQ.2) THEN + WRITE( LOUT, 9952 )I, ( A( I, J ), J = K1, K2 ) + END IF + 150 CONTINUE + 160 CONTINUE +* + ELSE + DO 180 K1 = 1, N, 2 + K2 = MIN0( N, K1+1 ) + WRITE( LOUT, 9995 )( ICOL, I, I = K1, K2 ) + DO 170 I = 1, M + IF ((K1+1).LE.N) THEN + WRITE( LOUT, 9971 )I, ( A( I, J ), J = K1, K2 ) + ELSE + WRITE( LOUT, 9961 )I, ( A( I, J ), J = K1, K2 ) + END IF + 170 CONTINUE + 180 CONTINUE + END IF + END IF + WRITE( LOUT, 9990 ) +* + 9998 FORMAT( 11X, 4( 9X, 3A1, I4, 9X ) ) + 9997 FORMAT( 10X, 4( 11X, 3A1, I4, 11X ) ) + 9996 FORMAT( 10X, 3( 13X, 3A1, I4, 13X ) ) + 9995 FORMAT( 12X, 2( 18x, 3A1, I4, 18X ) ) +* +*======================================================== +* FORMAT FOR 72 COLUMN +*======================================================== +* +* DISPLAY 4 SIGNIFICANT DIGITS +* + 9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E10.3,',',E10.3,') ') ) + 9984 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E10.3,',',E10.3,') ') ) +* +* DISPLAY 6 SIGNIFICANT DIGITS +* + 9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E12.5,',',E12.5,') ') ) + 9983 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E12.5,',',E12.5,') ') ) +* +* DISPLAY 8 SIGNIFICANT DIGITS +* + 9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E14.7,',',E14.7,') ') ) + 9982 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E14.7,',',E14.7,') ') ) +* +* DISPLAY 13 SIGNIFICANT DIGITS +* + 9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E20.13,',',E20.13,')') ) + 9990 FORMAT( 1X, ' ' ) +* +* +*======================================================== +* FORMAT FOR 132 COLUMN +*======================================================== +* +* DISPLAY 4 SIGNIFICANT DIGIT +* + 9974 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,4('(',E10.3,',',E10.3,') ') ) + 9964 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',E10.3,',',E10.3,') ') ) + 9954 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E10.3,',',E10.3,') ') ) + 9944 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E10.3,',',E10.3,') ') ) +* +* DISPLAY 6 SIGNIFICANT DIGIT +* + 9973 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',E12.5,',',E12.5,') ') ) + 9963 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E12.5,',',E12.5,') ') ) + 9953 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E12.5,',',E12.5,') ') ) +* +* DISPLAY 8 SIGNIFICANT DIGIT +* + 9972 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,3('(',E14.7,',',E14.7,') ') ) + 9962 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E14.7,',',E14.7,') ') ) + 9952 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E14.7,',',E14.7,') ') ) +* +* DISPLAY 13 SIGNIFICANT DIGIT +* + 9971 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,2('(',E20.13,',',E20.13, + & ') ')) + 9961 FORMAT( 1X, ' Row', I4, ':', 1X, 1P,1('(',E20.13,',',E20.13, + & ') ')) + +* +* +* +* + RETURN + END