1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
|
SUBROUTINE PCLATRS( UPLO, TRANS, DIAG, NORMIN, N, A, IA,
$ JA, DESCA, X, IX, JX, DESCX, SCALE, CNORM,
$ WORK )
*
* -- ScaLAPACK auxiliary routine (version 1.7) --
* University of Tennessee, Knoxville, Oak Ridge National Laboratory,
* and University of California, Berkeley.
* May 1, 1997
*
* .. Scalar Arguments ..
CHARACTER DIAG, NORMIN, TRANS, UPLO
INTEGER IA, IX, JA, JX, N
REAL SCALE
* ..
* .. Array Arguments ..
INTEGER DESCA( * ), DESCX( * )
REAL CNORM( * )
COMPLEX A( * ), X( * ), WORK( * )
* ..
*
* Purpose
* =======
*
* PCLATRS solves a triangular system. This routine in unfinished
* at this time, but will be part of the next release.
*
* =====================================================================
*
* .. Parameters ..
INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
$ LLD_, MB_, M_, NB_, N_, RSRC_
PARAMETER ( BLOCK_CYCLIC_2D = 1, DLEN_ = 9, DTYPE_ = 1,
$ CTXT_ = 2, M_ = 3, N_ = 4, MB_ = 5, NB_ = 6,
$ RSRC_ = 7, CSRC_ = 8, LLD_ = 9 )
REAL ONE
PARAMETER ( ONE = 1.0E+0 )
*
* .. Local Scalars ..
INTEGER ICTXT, IIX, IROFF, JJX, MYCOL, MYROW, NP,
$ NPCOL, NPROW, LDX, IXCOL, IXROW
* ..
* .. External Functions ..
INTEGER NUMROC
EXTERNAL NUMROC
* ..
* .. External Subroutines ..
EXTERNAL BLACS_GRIDINFO, CGEBR2D, CGEBS2D, INFOG2L,
$ PCTRSV
* ..
* .. Executable Statements ..
*
* Get grid parameters
*
ICTXT = DESCA( CTXT_ )
CALL BLACS_GRIDINFO( ICTXT, NPROW, NPCOL, MYROW, MYCOL )
*
* Quick return if possible
*
IF( N.EQ.0 )
$ RETURN
*
* ***** NO SCALING ***** Call PCTRSV for all cases *****
*
SCALE = ONE
CALL PCTRSV( UPLO, TRANS, DIAG, N, A, IA, JA, DESCA, X, IX, JX,
$ DESCX, 1 )
*
CALL INFOG2L( IX, JX, DESCX, NPROW, NPCOL, MYROW, MYCOL, IIX, JJX,
$ IXROW, IXCOL )
LDX = DESCX( LLD_ )
IROFF = MOD( IX-1, DESCX(MB_) )
NP = NUMROC( N+IROFF, DESCX( MB_ ), MYROW, IXROW, NPROW )
IF( MYROW.EQ.IXROW )
$ NP = NP - IROFF
IF( MYCOL.EQ.IXCOL ) THEN
CALL CGEBS2D( ICTXT, 'R', ' ', NP, 1, X( IIX+(JJX-1)*LDX ),
$ LDX )
ELSE
CALL CGEBR2D( ICTXT, 'R', ' ', NP, 1, X( IIX+(JJX-1)*LDX ),
$ LDX, MYROW, IXCOL )
END IF
*
RETURN
*
* End of PCLATRS
*
END
|
