Mercurial > octave-nkf

comparison libcruft/arpack/util/svout.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: SVOUT
3 *
4 * Purpose: Real vector output routine.
5 *
6 * Usage: CALL SVOUT (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 SVOUT( LOUT, N, SX, IDIGIT, IFMT )
19 * ...
20 * ... SPECIFICATIONS FOR ARGUMENTS
21 INTEGER N, IDIGIT, LOUT
22 REAL SX( * )
23 CHARACTER IFMT*( * )
24 * ...
25 * ... SPECIFICATIONS FOR LOCAL VARIABLES
26 INTEGER I, NDIGIT, K1, K2, LLL
27 CHARACTER*80 LINE
28 * ...
29 * ... FIRST EXECUTABLE STATEMENT
30 *
31 *
32 LLL = MIN( LEN( IFMT ), 80 )
33 DO 10 I = 1, LLL
34 LINE( I: I ) = '-'
35 10 CONTINUE
36 *
37 DO 20 I = LLL + 1, 80
38 LINE( I: I ) = ' '
39 20 CONTINUE
40 *
41 WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL )
42 9999 FORMAT( / 1X, A / 1X, A )
43 *
44 IF( N.LE.0 )
45 $ RETURN
46 NDIGIT = IDIGIT
47 IF( IDIGIT.EQ.0 )
48 $ NDIGIT = 4
49 *
50 *=======================================================================
51 * CODE FOR OUTPUT USING 72 COLUMNS FORMAT
52 *=======================================================================
53 *
54 IF( IDIGIT.LT.0 ) THEN
55 NDIGIT = -IDIGIT
56 IF( NDIGIT.LE.4 ) THEN
57 DO 30 K1 = 1, N, 5
58 K2 = MIN0( N, K1+4 )
59 WRITE( LOUT, 9998 )K1, K2, ( SX( I ), I = K1, K2 )
60 30 CONTINUE
61 ELSE IF( NDIGIT.LE.6 ) THEN
62 DO 40 K1 = 1, N, 4
63 K2 = MIN0( N, K1+3 )
64 WRITE( LOUT, 9997 )K1, K2, ( SX( I ), I = K1, K2 )
65 40 CONTINUE
66 ELSE IF( NDIGIT.LE.10 ) THEN
67 DO 50 K1 = 1, N, 3
68 K2 = MIN0( N, K1+2 )
69 WRITE( LOUT, 9996 )K1, K2, ( SX( I ), I = K1, K2 )
70 50 CONTINUE
71 ELSE
72 DO 60 K1 = 1, N, 2
73 K2 = MIN0( N, K1+1 )
74 WRITE( LOUT, 9995 )K1, K2, ( SX( I ), I = K1, K2 )
75 60 CONTINUE
76 END IF
77 *
78 *=======================================================================
79 * CODE FOR OUTPUT USING 132 COLUMNS FORMAT
80 *=======================================================================
81 *
82 ELSE
83 IF( NDIGIT.LE.4 ) THEN
84 DO 70 K1 = 1, N, 10
85 K2 = MIN0( N, K1+9 )
86 WRITE( LOUT, 9998 )K1, K2, ( SX( I ), I = K1, K2 )
87 70 CONTINUE
88 ELSE IF( NDIGIT.LE.6 ) THEN
89 DO 80 K1 = 1, N, 8
90 K2 = MIN0( N, K1+7 )
91 WRITE( LOUT, 9997 )K1, K2, ( SX( I ), I = K1, K2 )
92 80 CONTINUE
93 ELSE IF( NDIGIT.LE.10 ) THEN
94 DO 90 K1 = 1, N, 6
95 K2 = MIN0( N, K1+5 )
96 WRITE( LOUT, 9996 )K1, K2, ( SX( I ), I = K1, K2 )
97 90 CONTINUE
98 ELSE
99 DO 100 K1 = 1, N, 5
100 K2 = MIN0( N, K1+4 )
101 WRITE( LOUT, 9995 )K1, K2, ( SX( I ), I = K1, K2 )
102 100 CONTINUE
103 END IF
104 END IF
105 WRITE( LOUT, 9994 )
106 RETURN
107 9998 FORMAT( 1X, I4, ' - ', I4, ':', 1P10E12.3 )
108 9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P8E14.5 )
109 9996 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P6E18.9 )
110 9995 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P5E24.13 )
111 9994 FORMAT( 1X, ' ' )
112 END