ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pslamr1d.f
Go to the documentation of this file.
1  SUBROUTINE pslamr1d( N, A, IA, JA, DESCA, B, IB, JB, DESCB )
2 *
3 * -- ScaLAPACK routine (version 1.7) --
4 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
5 * and University of California, Berkeley.
6 * October 15, 1999
7 *
8 * .. Scalar Arguments ..
9  INTEGER IA, IB, JA, JB, N
10 * ..
11 * .. Array Arguments ..
12  INTEGER DESCA( * ), DESCB( * )
13  REAL A( * ), B( * )
14 * ..
15 *
16 * Bugs
17 * ====
18 *
19 * I am not sure that this works correctly when IB and JB are not equal
20 * to 1. Indeed, I suspect that IB should always be set to 1 or ignored
21 * with 1 used in its place.
22 *
23 * PSLAMR1D has not been tested except withint the contect of
24 * PSSYPTRD, the prototype reduction to tridiagonal form code.
25 *
26 * Purpose
27 *
28 * =======
29 *
30 * PSLAMR1D redistributes a one-dimensional row vector from one data
31 * decomposition to another.
32 *
33 * This is an auxiliary routine called by PSSYTRD to redistribute D, E
34 * and TAU.
35 *
36 * Notes
37 * =====
38 *
39 * Although all processes call PSGEMR2D, only the processes that own
40 * the first column of A send data and only processes that own the
41 * first column of B receive data. The calls to SGEBS2D/SGEBR2D
42 * spread the data down.
43 *
44 * Arguments
45 * =========
46 *
47 * N (global input) INTEGER
48 * The size of the matrix to be transposed.
49 *
50 * A (local output) COMPLEX*16 pointer into the
51 * local memory to an array of dimension (LOCc(JA+N-1)).
52 * On output, A is replicated across all processes in
53 * this processor column.
54 *
55 * IA (global input) INTEGER
56 * A's global row index, which points to the beginning of
57 * the submatrix which is to be operated on.
58 *
59 * JA (global input) INTEGER
60 * A's global column index, which points to the beginning of
61 * the submatrix which is to be operated on.
62 *
63 * DESCA (global and local input) INTEGER array of dimension DLEN_.
64 * The array descriptor for the distributed matrix A.
65 *
66 * B (local input/local output) COMPLEX*16 pointer into the
67 * local memory to an array of dimension (LOCc(JB+N-1)).
68 *
69 * IB (global input) INTEGER
70 * B's global row index, NOT USED
71 *
72 * JB (global input) INTEGER
73 * B's global column index, which points to the beginning of
74 * the submatrix which is to be operated on.
75 *
76 * DESCB (global and local input) INTEGER array of dimension DLEN_.
77 * The array descriptor for the distributed matrix B.
78 *
79 * WORK (local workspace) COMPLEX*16 array, dimension ( LWORK )
80 *
81 * LWORK (local input) INTEGER
82 * The dimension of the array WORK.
83 * LWORK is local input and must be at least
84 * LWORK >= NB * NUMROC( N, 1, 0, 0, NPROW )
85 *
86 * =====================================================================
87 *
88 * .. Parameters ..
89  INTEGER BLOCK_CYCLIC_2D, DLEN_, DTYPE_, CTXT_, M_, N_,
90  $ MB_, NB_, RSRC_, CSRC_, LLD_
91  parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
92  $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
93  $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
94 * ..
95 * .. Local Scalars ..
96  INTEGER I, ICTXT, MYCOL, MYROW, NPCOL, NPROW, NQ
97 * ..
98 * .. Local Arrays ..
99  INTEGER DESCAA( DLEN_ ), DESCBB( DLEN_ )
100 * ..
101 * .. External Subroutines ..
102  EXTERNAL blacs_gridinfo, psgemr2d, sgebr2d, sgebs2d
103 * ..
104 * .. External Functions ..
105  INTEGER NUMROC
106  EXTERNAL numroc
107 * ..
108 * .. Executable Statements ..
109 * This is just to keep ftnchek and toolpack/1 happy
110  IF( block_cyclic_2d*csrc_*ctxt_*dlen_*dtype_*lld_*mb_*m_*nb_*n_*
111  $ rsrc_.LT.0 )RETURN
112 *
113 * Quick return if possible
114 *
115  IF( n.LE.0 )
116  $ RETURN
117 *
118  DO 10 i = 1, dlen_
119  descaa( i ) = desca( i )
120  descbb( i ) = descb( i )
121  10 CONTINUE
122 *
123  descaa( m_ ) = 1
124  descbb( m_ ) = 1
125  descaa( lld_ ) = 1
126  descbb( lld_ ) = 1
127 *
128  ictxt = descb( ctxt_ )
129  CALL psgemr2d( 1, n, a, ia, ja, descaa, b, ib, jb, descbb, ictxt )
130 *
131  CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
132  nq = numroc( n, descb( nb_ ), mycol, 0, npcol )
133 *
134  IF( myrow.EQ.0 ) THEN
135  CALL sgebs2d( ictxt, 'C', ' ', nq, 1, b, nq )
136  ELSE
137  CALL sgebr2d( ictxt, 'C', ' ', nq, 1, b, nq, 0, mycol )
138  END IF
139 *
140  RETURN
141 *
142 * End of PSLAMR1D
143 *
144  END
pslamr1d
subroutine pslamr1d(N, A, IA, JA, DESCA, B, IB, JB, DESCB)
Definition: pslamr1d.f:2