1*> \brief \b SPFTRS
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download SPFTRS + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/spftrs.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/spftrs.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/spftrs.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE SPFTRS( TRANSR, UPLO, N, NRHS, A, B, LDB, INFO )
22*
23*       .. Scalar Arguments ..
24*       CHARACTER          TRANSR, UPLO
25*       INTEGER            INFO, LDB, N, NRHS
26*       ..
27*       .. Array Arguments ..
28*       REAL               A( 0: * ), B( LDB, * )
29*       ..
30*
31*
32*> \par Purpose:
33*  =============
34*>
35*> \verbatim
36*>
37*> SPFTRS solves a system of linear equations A*X = B with a symmetric
38*> positive definite matrix A using the Cholesky factorization
39*> A = U**T*U or A = L*L**T computed by SPFTRF.
40*> \endverbatim
41*
42*  Arguments:
43*  ==========
44*
45*> \param[in] TRANSR
46*> \verbatim
47*>          TRANSR is CHARACTER*1
48*>          = 'N':  The Normal TRANSR of RFP A is stored;
49*>          = 'T':  The Transpose TRANSR of RFP A is stored.
50*> \endverbatim
51*>
52*> \param[in] UPLO
53*> \verbatim
54*>          UPLO is CHARACTER*1
55*>          = 'U':  Upper triangle of RFP A is stored;
56*>          = 'L':  Lower triangle of RFP A is stored.
57*> \endverbatim
58*>
59*> \param[in] N
60*> \verbatim
61*>          N is INTEGER
62*>          The order of the matrix A.  N >= 0.
63*> \endverbatim
64*>
65*> \param[in] NRHS
66*> \verbatim
67*>          NRHS is INTEGER
68*>          The number of right hand sides, i.e., the number of columns
69*>          of the matrix B.  NRHS >= 0.
70*> \endverbatim
71*>
72*> \param[in] A
73*> \verbatim
74*>          A is REAL array, dimension ( N*(N+1)/2 )
75*>          The triangular factor U or L from the Cholesky factorization
76*>          of RFP A = U**H*U or RFP A = L*L**T, as computed by SPFTRF.
77*>          See note below for more details about RFP A.
78*> \endverbatim
79*>
80*> \param[in,out] B
81*> \verbatim
82*>          B is REAL array, dimension (LDB,NRHS)
83*>          On entry, the right hand side matrix B.
84*>          On exit, the solution matrix X.
85*> \endverbatim
86*>
87*> \param[in] LDB
88*> \verbatim
89*>          LDB is INTEGER
90*>          The leading dimension of the array B.  LDB >= max(1,N).
91*> \endverbatim
92*>
93*> \param[out] INFO
94*> \verbatim
95*>          INFO is INTEGER
96*>          = 0:  successful exit
97*>          < 0:  if INFO = -i, the i-th argument had an illegal value
98*> \endverbatim
99*
100*  Authors:
101*  ========
102*
103*> \author Univ. of Tennessee
104*> \author Univ. of California Berkeley
105*> \author Univ. of Colorado Denver
106*> \author NAG Ltd.
107*
108*> \date December 2016
109*
110*> \ingroup realOTHERcomputational
111*
112*> \par Further Details:
113*  =====================
114*>
115*> \verbatim
116*>
117*>  We first consider Rectangular Full Packed (RFP) Format when N is
118*>  even. We give an example where N = 6.
119*>
120*>      AP is Upper             AP is Lower
121*>
122*>   00 01 02 03 04 05       00
123*>      11 12 13 14 15       10 11
124*>         22 23 24 25       20 21 22
125*>            33 34 35       30 31 32 33
126*>               44 45       40 41 42 43 44
127*>                  55       50 51 52 53 54 55
128*>
129*>
130*>  Let TRANSR = 'N'. RFP holds AP as follows:
131*>  For UPLO = 'U' the upper trapezoid A(0:5,0:2) consists of the last
132*>  three columns of AP upper. The lower triangle A(4:6,0:2) consists of
133*>  the transpose of the first three columns of AP upper.
134*>  For UPLO = 'L' the lower trapezoid A(1:6,0:2) consists of the first
135*>  three columns of AP lower. The upper triangle A(0:2,0:2) consists of
136*>  the transpose of the last three columns of AP lower.
137*>  This covers the case N even and TRANSR = 'N'.
138*>
139*>         RFP A                   RFP A
140*>
141*>        03 04 05                33 43 53
142*>        13 14 15                00 44 54
143*>        23 24 25                10 11 55
144*>        33 34 35                20 21 22
145*>        00 44 45                30 31 32
146*>        01 11 55                40 41 42
147*>        02 12 22                50 51 52
148*>
149*>  Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
150*>  transpose of RFP A above. One therefore gets:
151*>
152*>
153*>           RFP A                   RFP A
154*>
155*>     03 13 23 33 00 01 02    33 00 10 20 30 40 50
156*>     04 14 24 34 44 11 12    43 44 11 21 31 41 51
157*>     05 15 25 35 45 55 22    53 54 55 22 32 42 52
158*>
159*>
160*>  We then consider Rectangular Full Packed (RFP) Format when N is
161*>  odd. We give an example where N = 5.
162*>
163*>     AP is Upper                 AP is Lower
164*>
165*>   00 01 02 03 04              00
166*>      11 12 13 14              10 11
167*>         22 23 24              20 21 22
168*>            33 34              30 31 32 33
169*>               44              40 41 42 43 44
170*>
171*>
172*>  Let TRANSR = 'N'. RFP holds AP as follows:
173*>  For UPLO = 'U' the upper trapezoid A(0:4,0:2) consists of the last
174*>  three columns of AP upper. The lower triangle A(3:4,0:1) consists of
175*>  the transpose of the first two columns of AP upper.
176*>  For UPLO = 'L' the lower trapezoid A(0:4,0:2) consists of the first
177*>  three columns of AP lower. The upper triangle A(0:1,1:2) consists of
178*>  the transpose of the last two columns of AP lower.
179*>  This covers the case N odd and TRANSR = 'N'.
180*>
181*>         RFP A                   RFP A
182*>
183*>        02 03 04                00 33 43
184*>        12 13 14                10 11 44
185*>        22 23 24                20 21 22
186*>        00 33 34                30 31 32
187*>        01 11 44                40 41 42
188*>
189*>  Now let TRANSR = 'T'. RFP A in both UPLO cases is just the
190*>  transpose of RFP A above. One therefore gets:
191*>
192*>           RFP A                   RFP A
193*>
194*>     02 12 22 00 01             00 10 20 30 40 50
195*>     03 13 23 33 11             33 11 21 31 41 51
196*>     04 14 24 34 44             43 44 22 32 42 52
197*> \endverbatim
198*>
199*  =====================================================================
200      SUBROUTINE SPFTRS( TRANSR, UPLO, N, NRHS, A, B, LDB, INFO )
201*
202*  -- LAPACK computational routine (version 3.7.0) --
203*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
204*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
205*     December 2016
206*
207*     .. Scalar Arguments ..
208      CHARACTER          TRANSR, UPLO
209      INTEGER            INFO, LDB, N, NRHS
210*     ..
211*     .. Array Arguments ..
212      REAL               A( 0: * ), B( LDB, * )
213*     ..
214*
215*  =====================================================================
216*
217*     .. Parameters ..
218      REAL               ONE
219      PARAMETER          ( ONE = 1.0E+0 )
220*     ..
221*     .. Local Scalars ..
222      LOGICAL            LOWER, NORMALTRANSR
223*     ..
224*     .. External Functions ..
225      LOGICAL            LSAME
226      EXTERNAL           LSAME
227*     ..
228*     .. External Subroutines ..
229      EXTERNAL           XERBLA, STFSM
230*     ..
231*     .. Intrinsic Functions ..
232      INTRINSIC          MAX
233*     ..
234*     .. Executable Statements ..
235*
236*     Test the input parameters.
237*
238      INFO = 0
239      NORMALTRANSR = LSAME( TRANSR, 'N' )
240      LOWER = LSAME( UPLO, 'L' )
241      IF( .NOT.NORMALTRANSR .AND. .NOT.LSAME( TRANSR, 'T' ) ) THEN
242         INFO = -1
243      ELSE IF( .NOT.LOWER .AND. .NOT.LSAME( UPLO, 'U' ) ) THEN
244         INFO = -2
245      ELSE IF( N.LT.0 ) THEN
246         INFO = -3
247      ELSE IF( NRHS.LT.0 ) THEN
248         INFO = -4
249      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
250         INFO = -7
251      END IF
252      IF( INFO.NE.0 ) THEN
253         CALL XERBLA( 'SPFTRS', -INFO )
254         RETURN
255      END IF
256*
257*     Quick return if possible
258*
259      IF( N.EQ.0 .OR. NRHS.EQ.0 )
260     $   RETURN
261*
262*     start execution: there are two triangular solves
263*
264      IF( LOWER ) THEN
265         CALL STFSM( TRANSR, 'L', UPLO, 'N', 'N', N, NRHS, ONE, A, B,
266     $               LDB )
267         CALL STFSM( TRANSR, 'L', UPLO, 'T', 'N', N, NRHS, ONE, A, B,
268     $               LDB )
269      ELSE
270         CALL STFSM( TRANSR, 'L', UPLO, 'T', 'N', N, NRHS, ONE, A, B,
271     $               LDB )
272         CALL STFSM( TRANSR, 'L', UPLO, 'N', 'N', N, NRHS, ONE, A, B,
273     $               LDB )
274      END IF
275*
276      RETURN
277*
278*     End of SPFTRS
279*
280      END
281