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 CNORM( * )
18 COMPLEX*16 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 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 $ pztrsv
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 pztrsv( 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 zgebs2d( ictxt, 'r
', ' ', np, 1, x( iix+(jjx-1)*ldx ),
77 $ ldx )
78 ELSE
79 CALL zgebr2d( ictxt,
'R',
' ', np, 1, x( iix+(jjx-1)*ldx ),
80 $ ldx, myrow, ixcol )
81 END IF
82
83 RETURN
84
85
86
subroutine zgebr2d(contxt, scope, top, m, n, a, lda)
subroutine zgebs2d(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)