ScaLAPACK 2.1  2.1
ScaLAPACK: Scalable Linear Algebra PACKage
pspotrs.f
Go to the documentation of this file.
1  SUBROUTINE pspotrs( UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB,
2  $ DESCB, INFO )
3 *
4 * -- ScaLAPACK routine (version 1.7) --
5 * University of Tennessee, Knoxville, Oak Ridge National Laboratory,
6 * and University of California, Berkeley.
7 * May 1, 1997
8 *
9 * .. Scalar Arguments ..
10  CHARACTER UPLO
11  INTEGER IA, IB, INFO, JA, JB, N, NRHS
12 * ..
13 * .. Array Arguments ..
14  INTEGER DESCA( * ), DESCB( * )
15  REAL A( * ), B( * )
16 * ..
17 *
18 * Purpose
19 * =======
20 *
21 * PSPOTRS solves a system of linear equations
22 *
23 * sub( A ) * X = sub( B )
24 * A(IA:IA+N-1,JA:JA+N-1)*X = B(IB:IB+N-1,JB:JB+NRHS-1)
25 *
26 * where sub( A ) denotes A(IA:IA+N-1,JA:JA+N-1) and is a N-by-N
27 * symmetric positive definite distributed matrix using the Cholesky
28 * factorization sub( A ) = U**T*U or L*L**T computed by PSPOTRF.
29 * sub( B ) denotes the distributed matrix B(IB:IB+N-1,JB:JB+NRHS-1).
30 *
31 * Notes
32 * =====
33 *
34 * Each global data object is described by an associated description
35 * vector. This vector stores the information required to establish
36 * the mapping between an object element and its corresponding process
37 * and memory location.
38 *
39 * Let A be a generic term for any 2D block cyclicly distributed array.
40 * Such a global array has an associated description vector DESCA.
41 * In the following comments, the character _ should be read as
42 * "of the global array".
43 *
44 * NOTATION STORED IN EXPLANATION
45 * --------------- -------------- --------------------------------------
46 * DTYPE_A(global) DESCA( DTYPE_ )The descriptor type. In this case,
47 * DTYPE_A = 1.
48 * CTXT_A (global) DESCA( CTXT_ ) The BLACS context handle, indicating
49 * the BLACS process grid A is distribu-
50 * ted over. The context itself is glo-
51 * bal, but the handle (the integer
52 * value) may vary.
53 * M_A (global) DESCA( M_ ) The number of rows in the global
54 * array A.
55 * N_A (global) DESCA( N_ ) The number of columns in the global
56 * array A.
57 * MB_A (global) DESCA( MB_ ) The blocking factor used to distribute
58 * the rows of the array.
59 * NB_A (global) DESCA( NB_ ) The blocking factor used to distribute
60 * the columns of the array.
61 * RSRC_A (global) DESCA( RSRC_ ) The process row over which the first
62 * row of the array A is distributed.
63 * CSRC_A (global) DESCA( CSRC_ ) The process column over which the
64 * first column of the array A is
65 * distributed.
66 * LLD_A (local) DESCA( LLD_ ) The leading dimension of the local
67 * array. LLD_A >= MAX(1,LOCr(M_A)).
68 *
69 * Let K be the number of rows or columns of a distributed matrix,
70 * and assume that its process grid has dimension p x q.
71 * LOCr( K ) denotes the number of elements of K that a process
72 * would receive if K were distributed over the p processes of its
73 * process column.
74 * Similarly, LOCc( K ) denotes the number of elements of K that a
75 * process would receive if K were distributed over the q processes of
76 * its process row.
77 * The values of LOCr() and LOCc() may be determined via a call to the
78 * ScaLAPACK tool function, NUMROC:
79 * LOCr( M ) = NUMROC( M, MB_A, MYROW, RSRC_A, NPROW ),
80 * LOCc( N ) = NUMROC( N, NB_A, MYCOL, CSRC_A, NPCOL ).
81 * An upper bound for these quantities may be computed by:
82 * LOCr( M ) <= ceil( ceil(M/MB_A)/NPROW )*MB_A
83 * LOCc( N ) <= ceil( ceil(N/NB_A)/NPCOL )*NB_A
84 *
85 * This routine requires square block decomposition ( MB_A = NB_A ).
86 *
87 * Arguments
88 * =========
89 *
90 * UPLO (global input) CHARACTER
91 * = 'U': Upper triangle of sub( A ) is stored;
92 * = 'L': Lower triangle of sub( A ) is stored.
93 *
94 * N (global input) INTEGER
95 * The number of rows and columns to be operated on, i.e. the
96 * order of the distributed submatrix sub( A ). N >= 0.
97 *
98 * NRHS (global input) INTEGER
99 * The number of right hand sides, i.e., the number of columns
100 * of the distributed submatrix sub( B ). NRHS >= 0.
101 *
102 * A (local input) REAL pointer into local memory to
103 * an array of dimension (LLD_A, LOCc(JA+N-1)). On entry, this
104 * array contains the factors L or U from the Cholesky facto-
105 * rization sub( A ) = L*L**T or U**T*U, as computed by PSPOTRF.
106 *
107 * IA (global input) INTEGER
108 * The row index in the global array A indicating the first
109 * row of sub( A ).
110 *
111 * JA (global input) INTEGER
112 * The column index in the global array A indicating the
113 * first column of sub( A ).
114 *
115 * DESCA (global and local input) INTEGER array of dimension DLEN_.
116 * The array descriptor for the distributed matrix A.
117 *
118 * B (local input/local output) REAL pointer into the
119 * local memory to an array of local dimension
120 * (LLD_B,LOCc(JB+NRHS-1)). On entry, this array contains the
121 * the local pieces of the right hand sides sub( B ).
122 * On exit, this array contains the local pieces of the solution
123 * distributed matrix X.
124 *
125 * IB (global input) INTEGER
126 * The row index in the global array B indicating the first
127 * row of sub( B ).
128 *
129 * JB (global input) INTEGER
130 * The column index in the global array B indicating the
131 * first column of sub( B ).
132 *
133 * DESCB (global and local input) INTEGER array of dimension DLEN_.
134 * The array descriptor for the distributed matrix B.
135 *
136 * INFO (global output) INTEGER
137 * = 0: successful exit
138 * < 0: If the i-th argument is an array and the j-entry had
139 * an illegal value, then INFO = -(i*100+j), if the i-th
140 * argument is a scalar and had an illegal value, then
141 * INFO = -i.
142 *
143 * =====================================================================
144 *
145 * .. Parameters ..
146  INTEGER BLOCK_CYCLIC_2D, CSRC_, CTXT_, DLEN_, DTYPE_,
147  $ lld_, mb_, m_, nb_, n_, rsrc_
148  parameter( block_cyclic_2d = 1, dlen_ = 9, dtype_ = 1,
149  $ ctxt_ = 2, m_ = 3, n_ = 4, mb_ = 5, nb_ = 6,
150  $ rsrc_ = 7, csrc_ = 8, lld_ = 9 )
151  REAL ONE
152  parameter( one = 1.0e+0 )
153 * ..
154 * .. Local Scalars ..
155  LOGICAL UPPER
156  INTEGER IAROW, IBROW, ICTXT, IROFFA, IROFFB, ICOFFA,
157  $ mycol, myrow, npcol, nprow
158 * ..
159 * .. Local Arrays ..
160  INTEGER IDUM1( 1 ), IDUM2( 1 )
161 * ..
162 * .. External Subroutines ..
163  EXTERNAL blacs_gridinfo, chk1mat, pchk2mat, pstrsm,
164  $ pxerbla
165 * ..
166 * .. External Functions ..
167  LOGICAL LSAME
168  INTEGER INDXG2P
169  EXTERNAL indxg2p, lsame
170 * ..
171 * .. Intrinsic Functions ..
172  INTRINSIC ichar, mod
173 * ..
174 * .. Executable Statements ..
175 *
176 * Get grid parameters.
177 *
178  ictxt = desca( ctxt_ )
179  CALL blacs_gridinfo( ictxt, nprow, npcol, myrow, mycol )
180 *
181 * Test the input parameters.
182 *
183  info = 0
184  IF( nprow.EQ.-1 ) THEN
185  info = -(700+ctxt_)
186  ELSE
187  CALL chk1mat( n, 2, n, 2, ia, ja, desca, 7, info )
188  CALL chk1mat( n, 2, nrhs, 3, ib, jb, descb, 11, info )
189  upper = lsame( uplo, 'U' )
190  IF( info.EQ.0 ) THEN
191  iarow = indxg2p( ia, desca( mb_ ), myrow, desca( rsrc_ ),
192  $ nprow )
193  ibrow = indxg2p( ib, descb( mb_ ), myrow, descb( rsrc_ ),
194  $ nprow )
195  iroffa = mod( ia-1, desca( mb_ ) )
196  iroffb = mod( ib-1, descb( mb_ ) )
197  icoffa = mod( ja-1, desca( nb_ ) )
198  IF ( .NOT.upper .AND. .NOT.lsame( uplo, 'L' ) ) THEN
199  info = -1
200  ELSE IF( iroffa.NE.0 ) THEN
201  info = -5
202  ELSE IF( icoffa.NE.0 ) THEN
203  info = -6
204  ELSE IF( desca( mb_ ).NE.desca( nb_ ) ) THEN
205  info = -(700+nb_)
206  ELSE IF( iroffb.NE.0 .OR. ibrow.NE.iarow ) THEN
207  info = -9
208  ELSE IF( descb( mb_ ).NE.desca( nb_ ) ) THEN
209  info = -(1100+nb_)
210  END IF
211  END IF
212  IF( upper ) THEN
213  idum1( 1 ) = ichar( 'U' )
214  ELSE
215  idum1( 1 ) = ichar( 'L' )
216  END IF
217  idum2( 1 ) = 1
218  CALL pchk2mat( n, 2, n, 2, ia, ja, desca, 7, n, 2, nrhs,
219  $ 3, ib, jb, descb, 11, 1, idum1, idum2, info )
220  END IF
221 *
222  IF( info.NE.0 ) THEN
223  CALL pxerbla( ictxt, 'PSPOTRS', -info )
224  RETURN
225  END IF
226 *
227 * Quick return if possible
228 *
229  IF( n.EQ.0 .OR. nrhs.EQ.0 )
230  $ RETURN
231 *
232  IF( upper ) THEN
233 *
234 * Solve sub( A ) * X = sub( B ) where sub( A ) = U'*U.
235 *
236 * Solve U'*X = sub( B ), overwriting sub( B ) with X.
237 *
238  CALL pstrsm( 'Left', 'Upper', 'Transpose', 'Non-unit', n, nrhs,
239  $ one, a, ia, ja, desca, b, ib, jb, descb )
240 *
241 * Solve U*X = sub( B ), overwriting sub( B ) with X.
242 *
243  CALL pstrsm( 'Left', 'Upper', 'No transpose', 'Non-unit', n,
244  $ nrhs, one, a, ia, ja, desca, b, ib, jb, descb )
245  ELSE
246 *
247 * Solve sub( A ) *X = sub( B ) where sub( A ) = L*L'.
248 *
249 * Solve L*X = sub( B ), overwriting sub( B ) with X.
250 *
251  CALL pstrsm( 'Left', 'Lower', 'No transpose', 'Non-unit', n,
252  $ nrhs, one, a, ia, ja, desca, b, ib, jb, descb )
253 *
254 * Solve L'*X = sub( B ), overwriting sub( B ) with X.
255 *
256  CALL pstrsm( 'Left', 'Lower', 'Transpose', 'Non-unit', n, nrhs,
257  $ one, a, ia, ja, desca, b, ib, jb, descb )
258  END IF
259 *
260  RETURN
261 *
262 * End of PSPOTRS
263 *
264  END
pchk2mat
subroutine pchk2mat(MA, MAPOS0, NA, NAPOS0, IA, JA, DESCA, DESCAPOS0, MB, MBPOS0, NB, NBPOS0, IB, JB, DESCB, DESCBPOS0, NEXTRA, EX, EXPOS, INFO)
Definition: pchkxmat.f:175
pspotrs
subroutine pspotrs(UPLO, N, NRHS, A, IA, JA, DESCA, B, IB, JB, DESCB, INFO)
Definition: pspotrs.f:3
chk1mat
subroutine chk1mat(MA, MAPOS0, NA, NAPOS0, IA, JA, DESCA, DESCAPOS0, INFO)
Definition: chk1mat.f:3
pxerbla
subroutine pxerbla(ICTXT, SRNAME, INFO)
Definition: pxerbla.f:2