*-----------------------------------------------------------------------
* Routine: SMOUT
*
* Purpose: Real matrix output routine.
*
* Usage: CALL SMOUT (LOUT, M, N, A, LDA, IDIGIT, IFMT)
*
* Arguments
* M - Number of rows of A. (Input)
* N - Number of columns of A. (Input)
* A - Real 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.
*
*-----------------------------------------------------------------------
*
SUBROUTINE SMOUT( LOUT, M, N, A, LDA, IDIGIT, IFMT )
* ...
* ... SPECIFICATIONS FOR ARGUMENTS
INTEGER M, N, IDIGIT, LDA, LOUT
REAL 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, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
DO 30 I = 1, M
WRITE( LOUT, 9994 )I, ( A( I, J ), J = K1, K2 )
30 CONTINUE
40 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 60 K1 = 1, N, 4
K2 = MIN0( N, K1+3 )
WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
DO 50 I = 1, M
WRITE( LOUT, 9993 )I, ( A( I, J ), J = K1, K2 )
50 CONTINUE
60 CONTINUE
*
ELSE IF( NDIGIT.LE.10 ) THEN
DO 80 K1 = 1, N, 3
K2 = MIN0( N, K1+2 )
WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
DO 70 I = 1, M
WRITE( LOUT, 9992 )I, ( A( I, J ), J = K1, K2 )
70 CONTINUE
80 CONTINUE
*
ELSE
DO 100 K1 = 1, N, 2
K2 = MIN0( N, K1+1 )
WRITE( LOUT, 9995 )( ICOL, I, I = K1, K2 )
DO 90 I = 1, M
WRITE( LOUT, 9991 )I, ( A( I, J ), J = K1, K2 )
90 CONTINUE
100 CONTINUE
END IF
*
*=======================================================================
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
*=======================================================================
*
ELSE
IF( NDIGIT.LE.4 ) THEN
DO 120 K1 = 1, N, 10
K2 = MIN0( N, K1+9 )
WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
DO 110 I = 1, M
WRITE( LOUT, 9994 )I, ( A( I, J ), J = K1, K2 )
110 CONTINUE
120 CONTINUE
*
ELSE IF( NDIGIT.LE.6 ) THEN
DO 140 K1 = 1, N, 8
K2 = MIN0( N, K1+7 )
WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
DO 130 I = 1, M
WRITE( LOUT, 9993 )I, ( A( I, J ), J = K1, K2 )
130 CONTINUE
140 CONTINUE
*
ELSE IF( NDIGIT.LE.10 ) THEN
DO 160 K1 = 1, N, 6
K2 = MIN0( N, K1+5 )
WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
DO 150 I = 1, M
WRITE( LOUT, 9992 )I, ( A( I, J ), J = K1, K2 )
150 CONTINUE
160 CONTINUE
*
ELSE
DO 180 K1 = 1, N, 5
K2 = MIN0( N, K1+4 )
WRITE( LOUT, 9995 )( ICOL, I, I = K1, K2 )
DO 170 I = 1, M
WRITE( LOUT, 9991 )I, ( A( I, J ), J = K1, K2 )
170 CONTINUE
180 CONTINUE
END IF
END IF
WRITE( LOUT, 9990 )
*
9998 FORMAT( 10X, 10( 4X, 3A1, I4, 1X ) )
9997 FORMAT( 10X, 8( 5X, 3A1, I4, 2X ) )
9996 FORMAT( 10X, 6( 7X, 3A1, I4, 4X ) )
9995 FORMAT( 10X, 5( 9X, 3A1, I4, 6X ) )
9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P10E12.3 )
9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P8E14.5 )
9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P6E18.9 )
9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P5E22.13 )
9990 FORMAT( 1X, ' ' )
*
RETURN
END
