Mercurial > hg > octave-thorsten

comparison libcruft/arpack/util/cvout.f @ 12194:470857149e61

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
12193:03c7fdee3d36 12194:470857149e61
1 c-----------------------------------------------------------------------
2 c
3 c\SCCS Information: @(#)
4 c FILE: cvout.f SID: 2.1 DATE OF SID: 11/16/95 RELEASE: 2
5 c
6 *-----------------------------------------------------------------------
7 * Routine: CVOUT
8 *
9 * Purpose: Complex vector output routine.
10 *
11 * Usage: CALL CVOUT (LOUT, N, CX, IDIGIT, IFMT)
12 *
13 * Arguments
14 * N - Length of array CX. (Input)
15 * CX - Complex array to be printed. (Input)
16 * IFMT - Format to be used in printing array CX. (Input)
17 * IDIGIT - Print up to IABS(IDIGIT) decimal digits per number. (In)
18 * If IDIGIT .LT. 0, printing is done with 72 columns.
19 * If IDIGIT .GT. 0, printing is done with 132 columns.
20 *
21 *-----------------------------------------------------------------------
22 *
23 SUBROUTINE CVOUT( LOUT, N, CX, IDIGIT, IFMT )
24 * ...
25 * ... SPECIFICATIONS FOR ARGUMENTS
26 INTEGER N, IDIGIT, LOUT
27 Complex
28 & CX( * )
29 CHARACTER IFMT*( * )
30 * ...
31 * ... SPECIFICATIONS FOR LOCAL VARIABLES
32 INTEGER I, NDIGIT, K1, K2, LLL
33 CHARACTER*80 LINE
34 * ...
35 * ... FIRST EXECUTABLE STATEMENT
36 *
37 *
38 LLL = MIN( LEN( IFMT ), 80 )
39 DO 10 I = 1, LLL
40 LINE( I: I ) = '-'
41 10 CONTINUE
42 *
43 DO 20 I = LLL + 1, 80
44 LINE( I: I ) = ' '
45 20 CONTINUE
46 *
47 WRITE( LOUT, 9999 )IFMT, LINE( 1: LLL )
48 9999 FORMAT( / 1X, A / 1X, A )
49 *
50 IF( N.LE.0 )
51 $ RETURN
52 NDIGIT = IDIGIT
53 IF( IDIGIT.EQ.0 )
54 $ NDIGIT = 4
55 *
56 *=======================================================================
57 * CODE FOR OUTPUT USING 72 COLUMNS FORMAT
58 *=======================================================================
59 *
60 IF( IDIGIT.LT.0 ) THEN
61 NDIGIT = -IDIGIT
62 IF( NDIGIT.LE.4 ) THEN
63 DO 30 K1 = 1, N, 2
64 K2 = MIN0( N, K1+1 )
65 IF (K1.NE.N) THEN
66 WRITE( LOUT, 9998 )K1, K2, ( CX( I ),
67 $ I = K1, K2 )
68 ELSE
69 WRITE( LOUT, 9997 )K1, K2, ( CX( I ),
70 $ I = K1, K2 )
71 END IF
72 30 CONTINUE
73 ELSE IF( NDIGIT.LE.6 ) THEN
74 DO 40 K1 = 1, N, 2
75 K2 = MIN0( N, K1+1 )
76 IF (K1.NE.N) THEN
77 WRITE( LOUT, 9988 )K1, K2, ( CX( I ),
78 $ I = K1, K2 )
79 ELSE
80 WRITE( LOUT, 9987 )K1, K2, ( CX( I ),
81 $ I = K1, K2 )
82 END IF
83 40 CONTINUE
84 ELSE IF( NDIGIT.LE.8 ) THEN
85 DO 50 K1 = 1, N, 2
86 K2 = MIN0( N, K1+1 )
87 IF (K1.NE.N) THEN
88 WRITE( LOUT, 9978 )K1, K2, ( CX( I ),
89 $ I = K1, K2 )
90 ELSE
91 WRITE( LOUT, 9977 )K1, K2, ( CX( I ),
92 $ I = K1, K2 )
93 END IF
94 50 CONTINUE
95 ELSE
96 DO 60 K1 = 1, N
97 WRITE( LOUT, 9968 )K1, K1, CX( I )
98 60 CONTINUE
99 END IF
100 *
101 *=======================================================================
102 * CODE FOR OUTPUT USING 132 COLUMNS FORMAT
103 *=======================================================================
104 *
105 ELSE
106 IF( NDIGIT.LE.4 ) THEN
107 DO 70 K1 = 1, N, 4
108 K2 = MIN0( N, K1+3 )
109 IF ((K1+3).LE.N) THEN
110 WRITE( LOUT, 9958 )K1, K2, ( CX( I ),
111 $ I = K1, K2 )
112 ELSE IF ((K1+3-N) .EQ. 1) THEN
113 WRITE( LOUT, 9957 )K1, K2, ( CX( I ),
114 $ I = K1, K2 )
115 ELSE IF ((K1+3-N) .EQ. 2) THEN
116 WRITE( LOUT, 9956 )K1, K2, ( CX( I ),
117 $ I = K1, K2 )
118 ELSE IF ((K1+3-N) .EQ. 1) THEN
119 WRITE( LOUT, 9955 )K1, K2, ( CX( I ),
120 $ I = K1, K2 )
121 END IF
122 70 CONTINUE
123 ELSE IF( NDIGIT.LE.6 ) THEN
124 DO 80 K1 = 1, N, 3
125 K2 = MIN0( N, K1+2 )
126 IF ((K1+2).LE.N) THEN
127 WRITE( LOUT, 9948 )K1, K2, ( CX( I ),
128 $ I = K1, K2 )
129 ELSE IF ((K1+2-N) .EQ. 1) THEN
130 WRITE( LOUT, 9947 )K1, K2, ( CX( I ),
131 $ I = K1, K2 )
132 ELSE IF ((K1+2-N) .EQ. 2) THEN
133 WRITE( LOUT, 9946 )K1, K2, ( CX( I ),
134 $ I = K1, K2 )
135 END IF
136 80 CONTINUE
137 ELSE IF( NDIGIT.LE.8 ) THEN
138 DO 90 K1 = 1, N, 3
139 K2 = MIN0( N, K1+2 )
140 IF ((K1+2).LE.N) THEN
141 WRITE( LOUT, 9938 )K1, K2, ( CX( I ),
142 $ I = K1, K2 )
143 ELSE IF ((K1+2-N) .EQ. 1) THEN
144 WRITE( LOUT, 9937 )K1, K2, ( CX( I ),
145 $ I = K1, K2 )
146 ELSE IF ((K1+2-N) .EQ. 2) THEN
147 WRITE( LOUT, 9936 )K1, K2, ( CX( I ),
148 $ I = K1, K2 )
149 END IF
150 90 CONTINUE
151 ELSE
152 DO 100 K1 = 1, N, 2
153 K2 = MIN0( N, K1+1 )
154 IF ((K1+2).LE.N) THEN
155 WRITE( LOUT, 9928 )K1, K2, ( CX( I ),
156 $ I = K1, K2 )
157 ELSE IF ((K1+2-N) .EQ. 1) THEN
158 WRITE( LOUT, 9927 )K1, K2, ( CX( I ),
159 $ I = K1, K2 )
160 END IF
161 100 CONTINUE
162 END IF
163 END IF
164 WRITE( LOUT, 9994 )
165 RETURN
166 *
167 *=======================================================================
168 * FORMAT FOR 72 COLUMNS
169 *=======================================================================
170 *
171 * DISPLAY 4 SIGNIFICANT DIGITS
172 *
173 9998 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
174 $ 1P,2('(',E10.3,',',E10.3,') ') )
175 9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
176 $ 1P,1('(',E10.3,',',E10.3,') ') )
177 *
178 * DISPLAY 6 SIGNIFICANT DIGITS
179 *
180 9988 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
181 $ 1P,2('(',E12.5,',',E12.5,') ') )
182 9987 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
183 $ 1P,1('(',E12.5,',',E12.5,') ') )
184 *
185 * DISPLAY 8 SIGNIFICANT DIGITS
186 *
187 9978 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
188 $ 1P,2('(',E14.7,',',E14.7,') ') )
189 9977 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
190 $ 1P,1('(',E14.7,',',E14.7,') ') )
191 *
192 * DISPLAY 13 SIGNIFICANT DIGITS
193 *
194 9968 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
195 $ 1P,1('(',E20.13,',',E20.13,') ') )
196 *
197 *=========================================================================
198 * FORMAT FOR 132 COLUMNS
199 *=========================================================================
200 *
201 * DISPLAY 4 SIGNIFICANT DIGITS
202 *
203 9958 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
204 $ 1P,4('(',E10.3,',',E10.3,') ') )
205 9957 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
206 $ 1P,3('(',E10.3,',',E10.3,') ') )
207 9956 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
208 $ 1P,2('(',E10.3,',',E10.3,') ') )
209 9955 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
210 $ 1P,1('(',E10.3,',',E10.3,') ') )
211 *
212 * DISPLAY 6 SIGNIFICANT DIGITS
213 *
214 9948 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
215 $ 1P,3('(',E12.5,',',E12.5,') ') )
216 9947 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
217 $ 1P,2('(',E12.5,',',E12.5,') ') )
218 9946 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
219 $ 1P,1('(',E12.5,',',E12.5,') ') )
220 *
221 * DISPLAY 8 SIGNIFICANT DIGITS
222 *
223 9938 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
224 $ 1P,3('(',E14.7,',',E14.7,') ') )
225 9937 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
226 $ 1P,2('(',E14.7,',',E14.7,') ') )
227 9936 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
228 $ 1P,1('(',E14.7,',',E14.7,') ') )
229 *
230 * DISPLAY 13 SIGNIFICANT DIGITS
231 *
232 9928 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
233 $ 1P,2('(',E20.13,',',E20.13,') ') )
234 9927 FORMAT( 1X, I4, ' - ', I4, ':', 1X,
235 $ 1P,1('(',E20.13,',',E20.13,') ') )
236 *
237 *
238 *
239 9994 FORMAT( 1X, ' ' )
240 END