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 A( * ), CNORM( * ),
18 $ 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 ONE
36 parameter( one = 1.0e+0 )
37
38
39 INTEGER ICTXT, IIX, IROFF, JJX, MYCOL, MYROW, ,
40 $ NPCOL, NPROW, LDX, IXCOL, IXROW
41
42
43 INTEGER NUMROC
45
46
48 $ pstrsv
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 pstrsv( 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 sgebs2d( ictxt,
'R',
' ', np, 1, x( iix+(jjx-1)*ldx ),
77 $ ldx )
78 ELSE
79 CALL sgebr2d( ictxt,
'R',
' ', np, 1, x( iix+(jjx-1)*ldx ),
80 $ ldx, myrow, ixcol )
81 END IF
82
83 RETURN
84
85
86
subroutine sgebs2d(contxt, scope, top, m, n, a, lda)
subroutine sgebr2d(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)