SCALAPACK 2.2.2
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ bslaapp()

subroutine bslaapp ( integer  iside,
integer  m,
integer  n,
integer  nb,
real, dimension( lda, * )  a,
integer  lda,
integer  nitraf,
integer, dimension( * )  itraf,
real, dimension( * )  dtraf,
real, dimension( * )  work 
)

Definition at line 1 of file bslaapp.f.

3 IMPLICIT NONE
4*
5* .. Scalar Arguments ..
6 INTEGER ISIDE, LDA, M, N, NB, NITRAF
7* ..
8* .. Array Arguments ..
9 INTEGER ITRAF( * )
10 REAL A( LDA, * ), DTRAF( * ), WORK( * )
11*
12*
13* Purpose
14* =======
15*
16* BSLAAPP computes
17*
18* B = Q**T * A or B = A * Q,
19*
20* where A is an M-by-N matrix and Q is an orthogonal matrix represented
21* by the parameters in the arrays ITRAF and DTRAF as described in
22* BSTREXC.
23*
24* This is an auxiliary routine called by BDTRSEN.
25*
26* Arguments
27* =========
28*
29* ISIDE (input) INTEGER
30* Specifies whether Q multiplies A from the left or right as
31* follows:
32* = 0: compute B = Q**T * A;
33* = 1: compute B = A * Q.
34*
35* M (input) INTEGER
36* The number of rows of A.
37*
38* N (input) INTEGER
39* The number of columns of A.
40*
41* NB (input) INTEGER
42* If ISIDE = 0, the Q is applied block column-wise to the rows
43* of A and NB specifies the maximal width of the block columns.
44* If ISIDE = 1, this variable is not referenced.
45*
46* A (input/output) REAL array, dimension (LDA,N)
47* On entry, the matrix A.
48* On exit, A is overwritten by B.
49*
50* LDA (input) INTEGER
51* The leading dimension of the array A. LDA >= max(1,N).
52*
53* NITRAF (input) INTEGER
54* Length of the array ITRAF. NITRAF >= 0.
55*
56* ITRAF (input) INTEGER array, length NITRAF
57* List of parameters for representing the transformation
58* matrix Q, see BSTREXC.
59*
60* DTRAF (output) REAL array, length k, where
61* List of parameters for representing the transformation
62* matrix Q, see BSTREXC.
63*
64* WORK (workspace) REAL array, dimension (N)
65*
66* =====================================================================
67*
68
69* .. Parameters ..
70 REAL ZERO, ONE
71 parameter( zero = 0.0e+0, one = 1.0e+0 )
72* ..
73* .. Local Scalars ..
74 INTEGER I, IT, J, NNB, PD
75 REAL TAU
76* ..
77* .. External Subroutines ..
78 EXTERNAL slarfx, srot
79* .. Intrinsic Functions ..
80 INTRINSIC min
81* ..
82* .. Executable Statements ..
83*
84* Quick return if possible.
85*
86 IF( m.LE.0 .OR. n.LE.0 )
87 $ return
88*
89 IF( iside.EQ.0 ) then
90*
91* Apply Q from left.
92*
93 DO 20 j = 1, n, nb
94 pd = 1
95 nnb = min( nb, n - j + 1 )
96 DO 10 i = 1, nitraf
97 it = itraf(i)
98 IF( it.LE.m ) then
99*
100* Apply Givens rotation.
101*
102 CALL srot( nnb, a(it,j), lda, a(it+1,j), lda,
103 $ dtraf(pd), dtraf(pd+1) )
104 pd = pd + 2
105 ELSE IF( it.LE.2*m ) then
106*
107* Apply Householder reflector of first kind.
108*
109 tau = dtraf(pd)
110 dtraf(pd) = one
111 CALL slarfx( 'Left', 3, nnb, dtraf(pd), tau,
112 $ a(it-m,j), lda, work )
113 dtraf(pd) = tau
114 pd = pd + 3
115 else
116*
117* Apply Householder reflector of second kind.
118*
119 tau = dtraf(pd+2)
120 dtraf(pd+2) = one
121 CALL slarfx( 'Left', 3, nnb, dtraf(pd), tau,
122 $ a(it-2*m,j), lda, work )
123 dtraf(pd+2) = tau
124 pd = pd + 3
125 END IF
126 10 continue
127 20 continue
128 else
129 pd = 1
130 DO 30 i = 1, nitraf
131 it = itraf(i)
132 IF( it.LE.n ) then
133*
134* Apply Givens rotation.
135*
136 CALL srot( m, a(1,it), 1, a(1,it+1), 1, dtraf(pd),
137 $ dtraf(pd+1) )
138 pd = pd + 2
139 ELSE IF( it.LE.2*n ) then
140*
141* Apply Householder reflector of first kind.
142*
143 tau = dtraf(pd)
144 dtraf(pd) = one
145 CALL slarfx( 'Right', m, 3, dtraf(pd), tau, a(1,it-n),
146 $ lda, work )
147 dtraf(pd) = tau
148 pd = pd + 3
149 else
150*
151* Apply Householder reflector of second kind.
152*
153 tau = dtraf(pd+2)
154 dtraf(pd+2) = one
155 CALL slarfx( 'Right', m, 3, dtraf(pd), tau, a(1,it-2*n),
156 $ lda, work )
157 dtraf(pd+2) = tau
158 pd = pd + 3
159 END IF
160 30 continue
161 END IF
162*
163 return
164*
165* End of BSLAAPP
166*
min
#define min(A, B)
Definition pcgemr.c:181
Here is the caller graph for this function: