1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
|
SUBROUTINE PZBMATGEN( ICTXT, AFORM, AFORM2, BWL, BWU, N,
$ MB, NB, A,
$ LDA, IAROW, IACOL, ISEED,
$ MYROW, MYCOL, NPROW, NPCOL )
*
*
*
* -- ScaLAPACK routine (version 1.7) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
* and University of California, Berkeley.
* November 15, 1997
*
* .. Scalar Arguments ..
* .. Scalar Arguments ..
CHARACTER*1 AFORM, AFORM2
INTEGER IACOL, IAROW, ICTXT,
$ ISEED, LDA, MB, MYCOL, MYROW, N,
$ NB, NPCOL, NPROW, BWL, BWU
* ..
* .. Array Arguments ..
COMPLEX*16 A( LDA, * )
* ..
*
* Purpose
* =======
*
* PZBMATGEN : Parallel Complex Double precision Band MATrix GENerator.
* (Re)Generate a distributed Band matrix A (or sub-matrix of A).
*
* Arguments
* =========
*
* ICTXT (global input) INTEGER
* The BLACS context handle, indicating the global context of
* the operation. The context itself is global.
*
* AFORM (global input) CHARACTER*1
* if AFORM = 'L' : A is returned as a hermitian lower
* triangular matrix, and is diagonally dominant.
* if AFORM = 'U' : A is returned as a hermitian upper
* triangular matrix, and is diagonally dominant.
* if AFORM = 'G' : A is returned as a general matrix.
* if AFORM = 'T' : A is returned as a general matrix in
* tridiagonal-compatible form.
*
* AFORM2 (global input) CHARACTER*1
* if the matrix is general:
* if AFORM2 = 'D' : A is returned diagonally dominant.
* if AFORM2 != 'D' : A is not returned diagonally dominant.
* if the matrix is symmetric or hermitian:
* if AFORM2 = 'T' : A is returned in tridiagonally-compatible
* form (a transpose form).
* if AFORM2 != 'T' : A is returned in banded-compatible form.
*
* M (global input) INTEGER
* The number of nonzero rows in the generated distributed
* band matrix.
*
* N (global input) INTEGER
* The number of columns in the generated distributed
* matrix.
*
* MB (global input) INTEGER
* The row blocking factor of the distributed matrix A.
*
* NB (global input) INTEGER
* The column blocking factor of the distributed matrix A.
*
* A (local output) COMPLEX*16, pointer into the local memory
* to an array of dimension ( LDA, * ) containing the local
* pieces of the distributed matrix.
*
* LDA (local input) INTEGER
* The leading dimension of the array containing the local
* pieces of the distributed matrix A.
*
* IAROW (global input) INTEGER
* The row processor coordinate which holds the first block
* of the distributed matrix A.
* A( DIAG_INDEX, I ) = A( DIAG_INDEX, I ) + BWL+BWU
*
* IACOL (global input) INTEGER
* The column processor coordinate which holds the first
* block of the distributed matrix A.
*
* ISEED (global input) INTEGER
* The seed number to generate the distributed matrix A.
*
* MYROW (local input) INTEGER
* The row process coordinate of the calling process.
*
* MYCOL (local input) INTEGER
* The column process coordinate of the calling process.
*
* NPROW (global input) INTEGER
* The number of process rows in the grid.
*
* NPCOL (global input) INTEGER
* The number of process columns in the grid.
*
* Notes
* =====
*
* This code is a simple wrapper around PZMATGEN, for band matrices.
*
* =====================================================================
*
* Code Developer: Andrew J. Cleary, University of Tennessee.
* Current address: Lawrence Livermore National Labs.
* This version released: August, 2001.
*
* =====================================================================
*
* ..
* .. Parameters ..
DOUBLE PRECISION ONE, ZERO
PARAMETER ( ONE = 1.0D+0 )
PARAMETER ( ZERO = 0.0D+0 )
COMPLEX*16 CONE, CZERO
PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ) )
PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ) )
* ..
* .. Local Scalars ..
INTEGER DIAG_INDEX, I, J, M_MATGEN, NQ, N_MATGEN,
$ START_INDEX
* ..
* .. External Subroutines ..
EXTERNAL PZMATGEN
* ..
* .. External Functions ..
LOGICAL LSAME
INTEGER ICEIL, NUMROC
EXTERNAL ICEIL, NUMROC, LSAME
* ..
* .. Executable Statements ..
*
*
IF( LSAME( AFORM, 'L' ).OR.LSAME( AFORM, 'U' ) ) THEN
M_MATGEN = BWL + 1
N_MATGEN = N
START_INDEX = 1
IF( LSAME( AFORM, 'L' ) ) THEN
DIAG_INDEX = 1
ELSE
DIAG_INDEX = BWL + 1
ENDIF
ELSE
M_MATGEN = BWL + BWU + 1
N_MATGEN = N
DIAG_INDEX = BWU + 1
START_INDEX = 1
ENDIF
*
NQ = NUMROC( N, NB, MYCOL, IACOL, NPCOL )
*
*
* Generate a random matrix initially
*
IF( LSAME( AFORM, 'T' ) .OR.
$ ( LSAME( AFORM2, 'T' ) ) ) THEN
*
CALL PZMATGEN( ICTXT, 'T', 'N',
$ N_MATGEN, M_MATGEN,
$ NB, M_MATGEN, A( START_INDEX, 1 ),
$ LDA, IAROW, IACOL,
$ ISEED, 0, NQ, 0, M_MATGEN,
$ MYCOL, MYROW, NPCOL, NPROW )
*
ELSE
*
CALL PZMATGEN( ICTXT, 'N', 'N',
$ M_MATGEN, N_MATGEN,
$ M_MATGEN, NB, A( START_INDEX, 1 ),
$ LDA, IAROW, IACOL,
$ ISEED, 0, M_MATGEN, 0, NQ,
$ MYROW, MYCOL, NPROW, NPCOL )
*
* Zero out padding at tops of columns
*
DO 1000 J=1,NB
*
DO 2000 I=1, LDA-M_MATGEN
*
* Indexing goes negative; BMATGEN assumes that space
* has been preallocated above the first column as it
* has to be if the matrix is to be input to
* Scalapack's band solvers.
*
A( I-LDA+M_MATGEN, J ) = CZERO
*
2000 CONTINUE
*
1000 CONTINUE
*
ENDIF
*
IF( LSAME( AFORM2, 'D' ).OR.
$ ( LSAME( AFORM, 'L' ).OR.LSAME( AFORM, 'U' ) ) ) THEN
*
* Loop over diagonal elements stored on this processor.
*
*
DO 330 I=1, NQ
IF( LSAME( AFORM, 'T' ) .OR.
$ ( LSAME( AFORM2, 'T' ) ) ) THEN
IF( NPROW .EQ. 1 ) THEN
A( I, DIAG_INDEX ) = DCMPLX( DBLE( A( I, DIAG_INDEX ) )
$ + DBLE( 2*( BWL+BWU+1 ) ) )
ENDIF
ELSE
IF( NPROW .EQ. 1 ) THEN
A( DIAG_INDEX, I ) = DCMPLX( DBLE( A( DIAG_INDEX, I ) )
$ + DBLE( 2*( BWL+BWU+1 ) ) )
ENDIF
END IF
330 CONTINUE
*
*
ELSE
*
* Must add elements to keep condition of matrix in check
*
DO 380 I=1, NQ
*
IF( NPROW .EQ. 1 ) THEN
*
IF( MOD(I+MYCOL*NB,2) .EQ. 1 ) THEN
A( DIAG_INDEX+1, I ) =
$ DCMPLX( DBLE( A( DIAG_INDEX+1, I ) )
$ + DBLE( 2*( BWL+BWU+1 ) ) )
*
ELSE
*
A( DIAG_INDEX-1, I ) =
$ DCMPLX( DBLE( A( DIAG_INDEX-1, I ) )
$ + DBLE( 2*( BWL+BWU+1 ) ) )
ENDIF
*
ENDIF
*
380 CONTINUE
*
END IF
*
RETURN
*
* End of PZBMATGEN
*
END
|
