4
5
6
7
8
9
10
11 CHARACTER DIAG, NORMIN, TRANS, UPLO
12 INTEGER IA, IX, JA, JX, N
13 DOUBLE PRECISION SCALE
14
15
16 INTEGER DESCA( * ), DESCX( * )
17 DOUBLE PRECISION 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 DOUBLE PRECISION ONE
36 parameter( one = 1.0d+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 $ pdtrsv
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 pdtrsv( 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 dgebs2d( ictxt,
'R',
' ', np, 1, x( iix+(jjx-1)*ldx ),
77 $ ldx )
78 ELSE
79 CALL dgebr2d( ictxt,
'R',
' ', np, 1, x( iix+(jjx-1)*ldx ),
80 $ ldx, myrow, ixcol )
81 END IF
82
83 RETURN
84
85
86
subroutine dgebs2d(contxt, scope, top, m, n, a, lda)
subroutine dgebr2d(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)