1 SUBROUTINE pzlatrz( M, N, L, A, IA, JA, DESCA, TAU, WORK )
9 INTEGER IA, JA, L, M, N
13 COMPLEX*16 A( * ), TAU( * ), WORK( * )
169 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
170 $ LLD_, MB_, M_, NB_, N_, RSRC_
171 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
172 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
173 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
175 parameter( one = ( 1.0d+0, 0.0d+0 ),
176 $ zero = ( 0.0d+0, 0.0d+0 ) )
179 INTEGER I, IAROW, ICTXT, II, J, J1, MP, MYCOL, MYROW,
184 INTEGER DESCTAU( DLEN_ )
195 INTRINSIC dconjg,
max
201 IF( m.EQ.0 .OR. n.EQ.0 )
206 ictxt = desca( ctxt_ )
207 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
209 mp = numroc( ia+m-1, desca( mb_ ), myrow, desca( rsrc_ ),
212 CALL descset( desctau, desca( m_ ), 1, desca( mb_ ), 1,
213 $ desca( rsrc_ ), mycol, ictxt,
max( 1, mp ) )
217 CALL infog1l( ia, desca( mb_ ), nprow, myrow, desca( rsrc_ ),
228 DO 20 i = ia+m-1, ia, -1
234 CALL pzlacgv( 1, a, i, j, desca, desca( m_ ) )
235 CALL pzlacgv( l, a, i, j1, desca, desca( m_ ) )
236 CALL pzlarfg( l+1, aii, i, j, a, i, j1, desca, desca( m_ ),
241 CALL pzlarz(
'Right', i-ia, ja+n-j, l, a, i, j1, desca,
242 $ desca( m_ ), tau, a, ia, j, desca, work )
243 CALL pzelset( a, i, j, desca, dconjg( aii ) )
247 CALL pzlacgv( m, tau, ia, 1, desctau, 1 )