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