Mercurial > octave-nkf

comparison libcruft/arpack/util/smout.f @ 12274:9f5d2ef078e8 release-3-4-x

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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
comparison
equal deleted inserted replaced
12273:83133b5bf392 12274:9f5d2ef078e8
1 *-----------------------------------------------------------------------
2 * Routine: SMOUT
3 *
4 * Purpose: Real matrix output routine.
5 *
6 * Usage: CALL SMOUT (LOUT, M, N, A, LDA, IDIGIT, IFMT)
7 *
8 * Arguments
9 * M - Number of rows of A. (Input)
10 * N - Number of columns of A. (Input)
11 * A - Real M by N matrix to be printed. (Input)
12 * LDA - Leading dimension of A exactly as specified in the
13 * dimension statement of the calling program. (Input)
14 * IFMT - Format to be used in printing matrix A. (Input)
15 * IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
16 * If IDIGIT .LT. 0, printing is done with 72 columns.
17 * If IDIGIT .GT. 0, printing is done with 132 columns.
18 *
19 *-----------------------------------------------------------------------
20 *
21 SUBROUTINE SMOUT( LOUT, M, N, A, LDA, IDIGIT, IFMT )
22 * ...
23 * ... SPECIFICATIONS FOR ARGUMENTS
24 INTEGER M, N, IDIGIT, LDA, LOUT
25 REAL A( LDA, * )
26 CHARACTER IFMT*( * )
27 * ...
28 * ... SPECIFICATIONS FOR LOCAL VARIABLES
29 INTEGER I, J, NDIGIT, K1, K2, LLL
30 CHARACTER*1 ICOL( 3 )
31 CHARACTER*80 LINE
32 * ...
33 * ... SPECIFICATIONS INTRINSICS
34 INTRINSIC MIN
35 *
36 DATA ICOL( 1 ), ICOL( 2 ), ICOL( 3 ) / 'C', 'o',
37 $ 'l' /
38 * ...
39 * ... FIRST EXECUTABLE STATEMENT
40 *
41 LLL = MIN( LEN( IFMT ), 80 )
42 DO 10 I = 1, LLL
43 LINE( I: I ) = '-'
44 10 CONTINUE
45 *
46 DO 20 I = LLL + 1, 80
47 LINE( I: I ) = ' '
48 20 CONTINUE
49 *
50 WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL )
51 9999 FORMAT( / 1X, A / 1X, A )
52 *
53 IF( M.LE.0 .OR. N.LE.0 .OR. LDA.LE.0 )
54 $ RETURN
55 NDIGIT = IDIGIT
56 IF( IDIGIT.EQ.0 )
57 $ NDIGIT = 4
58 *
59 *=======================================================================
60 * CODE FOR OUTPUT USING 72 COLUMNS FORMAT
61 *=======================================================================
62 *
63 IF( IDIGIT.LT.0 ) THEN
64 NDIGIT = -IDIGIT
65 IF( NDIGIT.LE.4 ) THEN
66 DO 40 K1 = 1, N, 5
67 K2 = MIN0( N, K1+4 )
68 WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
69 DO 30 I = 1, M
70 WRITE( LOUT, 9994 )I, ( A( I, J ), J = K1, K2 )
71 30 CONTINUE
72 40 CONTINUE
73 *
74 ELSE IF( NDIGIT.LE.6 ) THEN
75 DO 60 K1 = 1, N, 4
76 K2 = MIN0( N, K1+3 )
77 WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
78 DO 50 I = 1, M
79 WRITE( LOUT, 9993 )I, ( A( I, J ), J = K1, K2 )
80 50 CONTINUE
81 60 CONTINUE
82 *
83 ELSE IF( NDIGIT.LE.10 ) THEN
84 DO 80 K1 = 1, N, 3
85 K2 = MIN0( N, K1+2 )
86 WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
87 DO 70 I = 1, M
88 WRITE( LOUT, 9992 )I, ( A( I, J ), J = K1, K2 )
89 70 CONTINUE
90 80 CONTINUE
91 *
92 ELSE
93 DO 100 K1 = 1, N, 2
94 K2 = MIN0( N, K1+1 )
95 WRITE( LOUT, 9995 )( ICOL, I, I = K1, K2 )
96 DO 90 I = 1, M
97 WRITE( LOUT, 9991 )I, ( A( I, J ), J = K1, K2 )
98 90 CONTINUE
99 100 CONTINUE
100 END IF
101 *
102 *=======================================================================
103 * CODE FOR OUTPUT USING 132 COLUMNS FORMAT
104 *=======================================================================
105 *
106 ELSE
107 IF( NDIGIT.LE.4 ) THEN
108 DO 120 K1 = 1, N, 10
109 K2 = MIN0( N, K1+9 )
110 WRITE( LOUT, 9998 )( ICOL, I, I = K1, K2 )
111 DO 110 I = 1, M
112 WRITE( LOUT, 9994 )I, ( A( I, J ), J = K1, K2 )
113 110 CONTINUE
114 120 CONTINUE
115 *
116 ELSE IF( NDIGIT.LE.6 ) THEN
117 DO 140 K1 = 1, N, 8
118 K2 = MIN0( N, K1+7 )
119 WRITE( LOUT, 9997 )( ICOL, I, I = K1, K2 )
120 DO 130 I = 1, M
121 WRITE( LOUT, 9993 )I, ( A( I, J ), J = K1, K2 )
122 130 CONTINUE
123 140 CONTINUE
124 *
125 ELSE IF( NDIGIT.LE.10 ) THEN
126 DO 160 K1 = 1, N, 6
127 K2 = MIN0( N, K1+5 )
128 WRITE( LOUT, 9996 )( ICOL, I, I = K1, K2 )
129 DO 150 I = 1, M
130 WRITE( LOUT, 9992 )I, ( A( I, J ), J = K1, K2 )
131 150 CONTINUE
132 160 CONTINUE
133 *
134 ELSE
135 DO 180 K1 = 1, N, 5
136 K2 = MIN0( N, K1+4 )
137 WRITE( LOUT, 9995 )( ICOL, I, I = K1, K2 )
138 DO 170 I = 1, M
139 WRITE( LOUT, 9991 )I, ( A( I, J ), J = K1, K2 )
140 170 CONTINUE
141 180 CONTINUE
142 END IF
143 END IF
144 WRITE( LOUT, 9990 )
145 *
146 9998 FORMAT( 10X, 10( 4X, 3A1, I4, 1X ) )
147 9997 FORMAT( 10X, 8( 5X, 3A1, I4, 2X ) )
148 9996 FORMAT( 10X, 6( 7X, 3A1, I4, 4X ) )
149 9995 FORMAT( 10X, 5( 9X, 3A1, I4, 6X ) )
150 9994 FORMAT( 1X, ' Row', I4, ':', 1X, 1P10E12.3 )
151 9993 FORMAT( 1X, ' Row', I4, ':', 1X, 1P8E14.5 )
152 9992 FORMAT( 1X, ' Row', I4, ':', 1X, 1P6E18.9 )
153 9991 FORMAT( 1X, ' Row', I4, ':', 1X, 1P5E22.13 )
154 9990 FORMAT( 1X, ' ' )
155 *
156 RETURN
157 END