3 SUBROUTINE pdlatms( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX,
4 $ KL, KU, PACK, A, IA, JA, DESCA, ORDER, WORK,
13 CHARACTER DIST, PACK, SYM
14 INTEGER IA, INFO, JA, KL, KU, LWORK, M, MODE, N, ORDER
15 DOUBLE PRECISION COND, DMAX
18 INTEGER DESCA( * ), ISEED( 4 )
19 DOUBLE PRECISION A( * ), D( * ), WORK( * )
199 INTEGER BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
200 $ MB_, NB_, RSRC_, CSRC_, LLD_
201 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
202 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
203 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
204 DOUBLE PRECISION ZERO, ONE
205 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0 )
208 INTEGER I, IDIST, IINFO, IPACK, IRSIGN, ISYM, LLB,
209 $ MNMIN, MYCOL, MYROW, NP, NPCOL, NPROW, NQ
210 DOUBLE PRECISION ALPHA, TEMP
213 INTEGER IDUM1( 1 ), IDUM2( 1 )
218 EXTERNAL lsame, numroc
225 INTRINSIC abs,
max,
min, mod
229 IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
238 CALL blacs_gridinfo( desca( ctxt_ ), nprow, npcol, myrow, mycol )
239 IF( ( myrow.GE.nprow .OR. myrow.LT.0 ) .OR.
240 $ ( mycol.GE.npcol .OR. mycol.LT.0 ) )
RETURN
242 np = numroc( n, desca( mb_ ), myrow, 0, nprow )
243 nq = numroc( n, desca( nb_ ), mycol, 0, npcol )
247 IF( m.EQ.0 .OR. n.EQ.0 )
252 IF( lsame( dist,
'U' ) )
THEN
254 ELSE IF( lsame( dist,
'S' ) )
THEN
256 ELSE IF( lsame( dist,
'N' ) )
THEN
264 IF( lsame( sym,
'N' ) )
THEN
267 ELSE IF( lsame( sym,
'P' ) )
THEN
270 ELSE IF( lsame( sym,
'S' ) )
THEN
273 ELSE IF( lsame( sym,
'H' ) )
THEN
282 IF( lsame( pack,
'N' ) )
THEN
298 IF( nprow.EQ.-1 )
THEN
299 info = -( 1600+ctxt_ )
301 CALL chk1mat( m, 1, n, 2, ia, ja, desca, 16, info )
303 IF( m.NE.n .AND. isym.NE.1 )
THEN
305 ELSE IF( idist.EQ.-1 )
THEN
307 ELSE IF( isym.EQ.-1 )
THEN
309 ELSE IF( abs( mode ).GT.6 )
THEN
311 ELSE IF( ( mode.NE.0 .AND. abs( mode ).NE.6 ) .AND. cond.LT.
314 ELSE IF( kl.LT.0 )
THEN
316 ELSE IF( ku.LT.0 .OR. ( isym.NE.1 .AND. kl.NE.ku ) )
THEN
318 ELSE IF( ( order.LT.0 ) .OR. ( order.GT.n ) )
THEN
322 CALL pchk1mat( m, 1, n, 2, ia, ja, desca, 16, 0, idum1, idum2,
330 ELSE IF( ipack.NE.0 )
THEN
332 ELSE IF( kl.GT.0 .AND. kl.LT.m-1 )
THEN
334 ELSE IF( ku.GT.0 .AND. ku.LT.n-1 )
THEN
336 ELSE IF( llb.NE.0 .AND. llb.NE.m-1 )
THEN
340 CALL pxerbla( desca( ctxt_ ),
'PDLATMS', -info )
347 iseed( i ) = mod( abs( iseed( i ) ), 4096 )
350 IF( mod( iseed( 4 ), 2 ).NE.1 )
351 $ iseed( 4 ) = iseed( 4 ) + 1
357 CALL dlatm1( mode, cond, irsign, idist, iseed, d, mnmin, iinfo )
359 IF( iinfo.NE.0 )
THEN
365 IF( mode.NE.0 .AND. abs( mode ).NE.6 )
THEN
371 temp =
max( temp, abs( d( i ) ) )
374 IF( temp.GT.zero )
THEN
381 CALL dscal( mnmin, alpha, d, 1 )
385 CALL dlaset(
'A', np, nq, zero, zero, a, desca( lld_ ) )
389 CALL pdlagsy( m, llb, d, a, ia, ja, desca, iseed, order, work,
subroutine pdlatms(m, n, dist, iseed, sym, d, mode, cond, dmax, kl, ku, pack, a, ia, ja, desca, order, work, lwork, info)