1 SUBROUTINE pzungql( M, N, K, A, IA, JA, DESCA, TAU, WORK, LWORK,
10 INTEGER IA, INFO, JA, K, LWORK, M, N
14 COMPLEX*16 A( * ), TAU( * ), WORK( * )
157 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
158 $ lld_, mb_, m_, nb_, n_, rsrc_
159 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
160 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
161 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
163 parameter( zero = ( 0.0d+0, 0.0d+0 ) )
167 CHARACTER COLBTOP, ROWBTOP
168 INTEGER IACOL, IAROW, ICTXT, IINFO, IPW, J, JB, JN,
169 $ lwmin, mpa0, mycol, myrow, npcol, nprow, nqa0
172 INTEGER IDUM1( 2 ), IDUM2( 2 )
180 INTEGER ICEIL, INDXG2P, NUMROC
181 EXTERNAL iceil, indxg2p, numroc
184 INTRINSIC dble, dcmplx,
min, mod
190 ictxt = desca( ctxt_ )
191 CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
196 IF( nprow.EQ.-1 )
THEN
199 CALL chk1mat( m, 1, n, 2, ia, ja, desca, 7, info )
201 iarow = indxg2p( ia, desca( mb_ ), myrow, desca( rsrc_ ),
203 iacol = indxg2p( ja, desca( nb_ ), mycol, desca( csrc_ ),
205 mpa0 = numroc( m+mod( ia-1, desca( mb_ ) ), desca( mb_ ),
206 $ myrow, iarow, nprow )
207 nqa0 = numroc( n+mod( ja-1, desca( nb_ ) ), desca( nb_ ),
208 $ mycol, iacol, npcol )
209 lwmin = desca( nb_ ) * ( mpa0 + nqa0 + desca( nb_ ) )
211 work( 1 ) = dcmplx( dble( lwmin ) )
212 lquery = ( lwork.EQ.-1 )
215 ELSE IF( k.LT.0 .OR. k.GT.n )
THEN
217 ELSE IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
223 IF( lwork.EQ.-1 )
THEN
229 CALL pchk1mat( m, 1, n, 2, ia, ja, desca, 7, 2, idum1, idum2,
233 CALL pxerbla( ictxt,
'PZUNGQL', -info )
235 ELSE IF( lquery )
THEN
244 ipw = desca( nb_ )*desca( nb_ ) + 1
245 jn =
min( iceil( ja+n-k, desca( nb_ ) )*desca( nb_ ), ja+n-1 )
246 CALL pb_topget( ictxt,
'Broadcast',
'Rowwise', rowbtop )
247 CALL pb_topget( ictxt,
'Broadcast',
'Columnwise', colbtop )
248 CALL pb_topset( ictxt,
'Broadcast',
'Rowwise',
'I-ring' )
249 CALL pb_topset( ictxt,
'Broadcast',
'Columnwise',
' ' )
253 CALL pzlaset(
'All', n-jn+ja-1, jn-ja+1, zero, zero, a,
254 $ ia+m-n+jn-ja+1, ja, desca )
258 CALL pzung2l( m-n+jn-ja+1, jn-ja+1, jn-ja-n+k+1, a, ia, ja, desca,
259 $ tau, work, lwork, iinfo )
263 DO 10 j = jn+1, ja+n-1, desca( nb_ )
264 jb =
min( ja+n-j, desca( nb_ ) )
269 CALL pzlarft(
'Backward',
'Columnwise', m-n+j+jb-ja, jb,
270 $ a, ia, j, desca, tau, work, work( ipw ) )
274 CALL pzlarfb(
'Left',
'No transpose',
'Backward',
275 $
'Columnwise', m-n+j+jb-ja, j-ja, jb, a, ia,
276 $ j, desca, work, a, ia, ja, desca, work( ipw ) )
280 CALL pzung2l( m-n+j+jb-ja, jb, jb, a, ia, j, desca, tau, work,
286 CALL pzlaset(
'All', n-j-jb+ja, jb, zero, zero, a,
287 $ ia+m-n+j+jb-ja, j, desca )
291 CALL pb_topget( ictxt,
'Broadcast',
'Rowwise', rowbtop )
292 CALL pb_topget( ictxt,
'Broadcast',
'Columnwise', colbtop )
294 work( 1 ) = dcmplx( dble( lwmin ) )