Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
ElmerCSC
GitHub Repository: ElmerCSC/elmerfem
Path: blob/devel/mathlibs/src/arpack/dvout.f
5195 views
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
123
124