Mercurial > octave-nkf

comparison libcruft/arpack/util/dvout.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: DVOUT
3 *
4 * Purpose: Real vector output routine.
5 *
6 * Usage: CALL DVOUT (LOUT, N, SX, IDIGIT, IFMT)
7 *
8 * Arguments
9 * N - Length of array SX. (Input)
10 * SX - Real array to be printed. (Input)
11 * IFMT - Format to be used in printing array SX. (Input)
12 * IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
13 * If IDIGIT .LT. 0, printing is done with 72 columns.
14 * If IDIGIT .GT. 0, printing is done with 132 columns.
15 *
16 *-----------------------------------------------------------------------
17 *
18 SUBROUTINE DVOUT( LOUT, N, SX, IDIGIT, IFMT )
19 * ...
20 * ... SPECIFICATIONS FOR ARGUMENTS
21 * ...
22 * ... SPECIFICATIONS FOR LOCAL VARIABLES
23 * .. Scalar Arguments ..
24 CHARACTER*( * ) IFMT
25 INTEGER IDIGIT, LOUT, N
26 * ..
27 * .. Array Arguments ..
28 DOUBLE PRECISION SX( * )
29 * ..
30 * .. Local Scalars ..
31 CHARACTER*80 LINE
32 INTEGER I, K1, K2, LLL, NDIGIT
33 * ..
34 * .. Intrinsic Functions ..
35 INTRINSIC LEN, MIN, MIN0
36 * ..
37 * .. Executable Statements ..
38 * ...
39 * ... FIRST EXECUTABLE STATEMENT
40 *
41 *
42 LLL = MIN( LEN( IFMT ), 80 )
43 DO 10 I = 1, LLL
44 LINE( I: I ) = '-'
45 10 CONTINUE
46 *
47 DO 20 I = LLL + 1, 80
48 LINE( I: I ) = ' '
49 20 CONTINUE
50 *
51 WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL )
52 9999 FORMAT( / 1X, A, / 1X, A )
53 *
54 IF( N.LE.0 )
55 $ RETURN
56 NDIGIT = IDIGIT
57 IF( IDIGIT.EQ.0 )
58 $ NDIGIT = 4
59 *
60 *=======================================================================
61 * CODE FOR OUTPUT USING 72 COLUMNS FORMAT
62 *=======================================================================
63 *
64 IF( IDIGIT.LT.0 ) THEN
65 NDIGIT = -IDIGIT
66 IF( NDIGIT.LE.4 ) THEN
67 DO 30 K1 = 1, N, 5
68 K2 = MIN0( N, K1+4 )
69 WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 )
70 30 CONTINUE
71 ELSE IF( NDIGIT.LE.6 ) THEN
72 DO 40 K1 = 1, N, 4
73 K2 = MIN0( N, K1+3 )
74 WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 )
75 40 CONTINUE
76 ELSE IF( NDIGIT.LE.10 ) THEN
77 DO 50 K1 = 1, N, 3
78 K2 = MIN0( N, K1+2 )
79 WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 )
80 50 CONTINUE
81 ELSE
82 DO 60 K1 = 1, N, 2
83 K2 = MIN0( N, K1+1 )
84 WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 )
85 60 CONTINUE
86 END IF
87 *
88 *=======================================================================
89 * CODE FOR OUTPUT USING 132 COLUMNS FORMAT
90 *=======================================================================
91 *
92 ELSE
93 IF( NDIGIT.LE.4 ) THEN
94 DO 70 K1 = 1, N, 10
95 K2 = MIN0( N, K1+9 )
96 WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 )
97 70 CONTINUE
98 ELSE IF( NDIGIT.LE.6 ) THEN
99 DO 80 K1 = 1, N, 8
100 K2 = MIN0( N, K1+7 )
101 WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 )
102 80 CONTINUE
103 ELSE IF( NDIGIT.LE.10 ) THEN
104 DO 90 K1 = 1, N, 6
105 K2 = MIN0( N, K1+5 )
106 WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 )
107 90 CONTINUE
108 ELSE
109 DO 100 K1 = 1, N, 5
110 K2 = MIN0( N, K1+4 )
111 WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 )
112 100 CONTINUE
113 END IF
114 END IF
115 WRITE( LOUT, FMT = 9994 )
116 RETURN
117 9998 FORMAT( 1X, I4, ' - ', I4, ':', 1P, 10D12.3 )
118 9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 8D14.5 )
119 9996 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 6D18.9 )
120 9995 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 5D24.13 )
121 9994 FORMAT( 1X, ' ' )
122 END