Book a Demo!
CoCalc Logo Icon
StoreFeaturesDocsShareSupportNewsAboutPoliciesSign UpSign In
ElmerCSC
GitHub Repository: ElmerCSC/elmerfem
Path: blob/devel/mathlibs/src/parpack/pdvout.f
5195 views
1
* Routine: PDVOUT - Parallel Version of ARPACK utility routine DVOUT
2
*
3
* Purpose: Double precision vector output routine.
4
*
5
* Usage: CALL PDVOUT (COMM, LOUT, N, SX, IDIGIT, IFMT)
6
*
7
* Arguments
8
* COMM - MPI Communicator for the processor grid
9
* N - Length of array SX. (Input)
10
* SX - Double precision 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
*\SCCS Information:
17
* FILE: vout.F SID: 1.2 DATE OF SID: 3/19/97 RELEASE: 1
18
*
19
*-----------------------------------------------------------------------
20
*
21
SUBROUTINE PDVOUT( COMM , LOUT, N, SX, IDIGIT, IFMT )
22
* ...
23
include 'mpif.h'
24
*
25
* .. MPI VARIABLES AND FUNCTIONS ..
26
* .. Variable Declaration ..
27
integer COMM, MYID, IERR
28
*
29
* ... SPECIFICATIONS FOR ARGUMENTS
30
* ...
31
* ... SPECIFICATIONS FOR LOCAL VARIABLES
32
* .. Scalar Arguments ..
33
CHARACTER*( * ) IFMT
34
INTEGER IDIGIT, LOUT, N
35
* ..
36
* .. Array Arguments ..
37
Double precision
38
& SX( * )
39
* ..
40
* .. Local Scalars ..
41
CHARACTER*80 LINE
42
INTEGER I, K1, K2, LLL, NDIGIT
43
* ..
44
* .. Intrinsic Functions ..
45
INTRINSIC LEN, MIN, MIN0
46
* ..
47
* .. Executable Statements ..
48
* ...
49
* ... FIRST EXECUTABLE STATEMENT
50
*
51
* Determine processor configuration
52
*
53
call MPI_COMM_RANK( comm, myid, ierr )
54
*
55
* .. Only Processor 0 will write to file LOUT ..
56
*
57
IF ( MYID .EQ. 0 ) THEN
58
*
59
LLL = MIN( LEN( IFMT ), 80 )
60
DO 10 I = 1, LLL
61
LINE( I: I ) = '-'
62
10 CONTINUE
63
*
64
DO 20 I = LLL + 1, 80
65
LINE( I: I ) = ' '
66
20 CONTINUE
67
*
68
WRITE( LOUT, FMT = 9999 )IFMT, LINE( 1: LLL )
69
9999 FORMAT( / 1X, A, / 1X, A )
70
*
71
IF( N.LE.0 )
72
$ RETURN
73
NDIGIT = IDIGIT
74
IF( IDIGIT.EQ.0 )
75
$ NDIGIT = 4
76
*
77
*=======================================================================
78
* CODE FOR OUTPUT USING 72 COLUMNS FORMAT
79
*=======================================================================
80
*
81
IF( IDIGIT.LT.0 ) THEN
82
NDIGIT = -IDIGIT
83
IF( NDIGIT.LE.4 ) THEN
84
DO 30 K1 = 1, N, 5
85
K2 = MIN0( N, K1+4 )
86
WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 )
87
30 CONTINUE
88
ELSE IF( NDIGIT.LE.6 ) THEN
89
DO 40 K1 = 1, N, 4
90
K2 = MIN0( N, K1+3 )
91
WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 )
92
40 CONTINUE
93
ELSE IF( NDIGIT.LE.10 ) THEN
94
DO 50 K1 = 1, N, 3
95
K2 = MIN0( N, K1+2 )
96
WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 )
97
50 CONTINUE
98
ELSE
99
DO 60 K1 = 1, N, 2
100
K2 = MIN0( N, K1+1 )
101
WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 )
102
60 CONTINUE
103
END IF
104
*
105
*=======================================================================
106
* CODE FOR OUTPUT USING 132 COLUMNS FORMAT
107
*=======================================================================
108
*
109
ELSE
110
IF( NDIGIT.LE.4 ) THEN
111
DO 70 K1 = 1, N, 10
112
K2 = MIN0( N, K1+9 )
113
WRITE( LOUT, FMT = 9998 )K1, K2, ( SX( I ), I = K1, K2 )
114
70 CONTINUE
115
ELSE IF( NDIGIT.LE.6 ) THEN
116
DO 80 K1 = 1, N, 8
117
K2 = MIN0( N, K1+7 )
118
WRITE( LOUT, FMT = 9997 )K1, K2, ( SX( I ), I = K1, K2 )
119
80 CONTINUE
120
ELSE IF( NDIGIT.LE.10 ) THEN
121
DO 90 K1 = 1, N, 6
122
K2 = MIN0( N, K1+5 )
123
WRITE( LOUT, FMT = 9996 )K1, K2, ( SX( I ), I = K1, K2 )
124
90 CONTINUE
125
ELSE
126
DO 100 K1 = 1, N, 5
127
K2 = MIN0( N, K1+4 )
128
WRITE( LOUT, FMT = 9995 )K1, K2, ( SX( I ), I = K1, K2 )
129
100 CONTINUE
130
END IF
131
END IF
132
WRITE( LOUT, FMT = 9994 )
133
134
ENDIF
135
RETURN
136
9998 FORMAT( 1X, I4, ' - ', I4, ':', 1P, 10D12.3 )
137
9997 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 8D14.5 )
138
9996 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 6D18.9 )
139
9995 FORMAT( 1X, I4, ' - ', I4, ':', 1X, 1P, 5D24.13 )
140
9994 FORMAT( 1X, ' ' )
141
END
142
143