Mercurial > octave-nkf

comparison libcruft/arpack/util/ivout.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 C-----------------------------------------------------------------------
2 C Routine: IVOUT
3 C
4 C Purpose: Integer vector output routine.
5 C
6 C Usage: CALL IVOUT (LOUT, N, IX, IDIGIT, IFMT)
7 C
8 C Arguments
9 C N - Length of array IX. (Input)
10 C IX - Integer array to be printed. (Input)
11 C IFMT - Format to be used in printing array IX. (Input)
12 C IDIGIT - Print up to ABS(IDIGIT) decimal digits / number. (Input)
13 C If IDIGIT .LT. 0, printing is done with 72 columns.
14 C If IDIGIT .GT. 0, printing is done with 132 columns.
15 C
16 C-----------------------------------------------------------------------
17 C
18 SUBROUTINE IVOUT (LOUT, N, IX, IDIGIT, IFMT)
19 C ...
20 C ... SPECIFICATIONS FOR ARGUMENTS
21 INTEGER IX(*), N, IDIGIT, LOUT
22 CHARACTER IFMT*(*)
23 C ...
24 C ... SPECIFICATIONS FOR LOCAL VARIABLES
25 INTEGER I, NDIGIT, K1, K2, LLL
26 CHARACTER*80 LINE
27 * ...
28 * ... SPECIFICATIONS INTRINSICS
29 INTRINSIC MIN
30 *
31 C
32 LLL = MIN ( LEN ( IFMT ), 80 )
33 DO 1 I = 1, LLL
34 LINE(I:I) = '-'
35 1 CONTINUE
36 C
37 DO 2 I = LLL+1, 80
38 LINE(I:I) = ' '
39 2 CONTINUE
40 C
41 WRITE ( LOUT, 2000 ) IFMT, LINE(1:LLL)
42 2000 FORMAT ( /1X, A /1X, A )
43 C
44 IF (N .LE. 0) RETURN
45 NDIGIT = IDIGIT
46 IF (IDIGIT .EQ. 0) NDIGIT = 4
47 C
48 C=======================================================================
49 C CODE FOR OUTPUT USING 72 COLUMNS FORMAT
50 C=======================================================================
51 C
52 IF (IDIGIT .LT. 0) THEN
53 C
54 NDIGIT = -IDIGIT
55 IF (NDIGIT .LE. 4) THEN
56 DO 10 K1 = 1, N, 10
57 K2 = MIN0(N,K1+9)
58 WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2)
59 10 CONTINUE
60 C
61 ELSE IF (NDIGIT .LE. 6) THEN
62 DO 30 K1 = 1, N, 7
63 K2 = MIN0(N,K1+6)
64 WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2)
65 30 CONTINUE
66 C
67 ELSE IF (NDIGIT .LE. 10) THEN
68 DO 50 K1 = 1, N, 5
69 K2 = MIN0(N,K1+4)
70 WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2)
71 50 CONTINUE
72 C
73 ELSE
74 DO 70 K1 = 1, N, 3
75 K2 = MIN0(N,K1+2)
76 WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2)
77 70 CONTINUE
78 END IF
79 C
80 C=======================================================================
81 C CODE FOR OUTPUT USING 132 COLUMNS FORMAT
82 C=======================================================================
83 C
84 ELSE
85 C
86 IF (NDIGIT .LE. 4) THEN
87 DO 90 K1 = 1, N, 20
88 K2 = MIN0(N,K1+19)
89 WRITE(LOUT,1000) K1,K2,(IX(I),I=K1,K2)
90 90 CONTINUE
91 C
92 ELSE IF (NDIGIT .LE. 6) THEN
93 DO 110 K1 = 1, N, 15
94 K2 = MIN0(N,K1+14)
95 WRITE(LOUT,1001) K1,K2,(IX(I),I=K1,K2)
96 110 CONTINUE
97 C
98 ELSE IF (NDIGIT .LE. 10) THEN
99 DO 130 K1 = 1, N, 10
100 K2 = MIN0(N,K1+9)
101 WRITE(LOUT,1002) K1,K2,(IX(I),I=K1,K2)
102 130 CONTINUE
103 C
104 ELSE
105 DO 150 K1 = 1, N, 7
106 K2 = MIN0(N,K1+6)
107 WRITE(LOUT,1003) K1,K2,(IX(I),I=K1,K2)
108 150 CONTINUE
109 END IF
110 END IF
111 WRITE (LOUT,1004)
112 C
113 1000 FORMAT(1X,I4,' - ',I4,':',20(1X,I5))
114 1001 FORMAT(1X,I4,' - ',I4,':',15(1X,I7))
115 1002 FORMAT(1X,I4,' - ',I4,':',10(1X,I11))
116 1003 FORMAT(1X,I4,' - ',I4,':',7(1X,I15))
117 1004 FORMAT(1X,' ')
118 C
119 RETURN
120 END