4
5
6
7
8
9
10
11 CHARACTER DIAG, NORMIN, TRANS, UPLO
12 INTEGER IA, IX, JA, JX, N
13 REAL SCALE
14
15
16 INTEGER DESCA( * ), DESCX( * )
17 REAL CNORM( * )
18 COMPLEX A( * ), X( * ), WORK( * )
19
20
21
22
23
24
25
26
27
28
29
30 INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
31 $ LLD_, MB_, M_, NB_, N_, RSRC_
32 parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
33 $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
34 $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
35 REAL
36 parameter( one = 1.0e+0 )
37
38
39 INTEGER ICTXT, IIX, IROFF, JJX, MYCOL, MYROW, NP,
40 $ NPCOL, NPROW, LDX, IXCOL, IXROW
41
42
43 INTEGER NUMROC
45
46
48 $ pctrsv
49
50
51
52
53
54 ictxt = desca( ctxt_ )
56
57
58
59 IF( n.EQ.0 )
60 $ RETURN
61
62
63
64 scale = one
65 CALL pctrsv( uplo, trans, diag, n, a, ia, ja, desca, x, ix, jx,
66 $ descx, 1 )
67
68 CALL infog2l( ix, jx, descx, nprow, npcol, myrow, mycol, iix, jjx,
69 $ ixrow, ixcol )
70 ldx = descx( lld_ )
71 iroff = mod( ix-1, descx(mb_) )
72 np =
numroc( n+iroff, descx( mb_ ), myrow, ixrow, nprow )
73 IF( myrow.EQ.ixrow )
74 $ np = np - iroff
75 IF( mycol.EQ.ixcol ) THEN
76 CALL cgebs2d( ictxt,
'R',
' ', np, 1, x( iix+(jjx-1)*ldx ),
77 $ ldx )
78 ELSE
79 CALL cgebr2d( ictxt, 'r
', ' ', NP, 1, X( IIX+(JJX-1)*LDX ),
80 $ LDX, MYROW, IXCOL )
81 END IF
82
83 RETURN
84
85
86
subroutine cgebs2d(contxt, scope, top, m, n, a, lda)
subroutine cgebr2d(contxt, scope, top, m, n, a, lda)
subroutine infog2l(grindx, gcindx, desc, nprow, npcol, myrow, mycol, lrindx, lcindx, rsrc, csrc)
subroutine blacs_gridinfo(cntxt, nprow, npcol, myrow, mycol)
integer function numroc(n, nb, iproc, isrcproc, nprocs)