ScaLAPACK 2.1  2.1 ScaLAPACK: Scalable Linear Algebra PACKage
bdlaapp.f
Go to the documentation of this file.
1  SUBROUTINE bdlaapp( ISIDE, M, N, NB, A, LDA, NITRAF, ITRAF,
2  \$ DTRAF, WORK )
3  IMPLICIT NONE
4 *
5 * .. Scalar Arguments ..
6  INTEGER ISIDE, LDA, M, N, NB, NITRAF
7 * ..
8 * .. Array Arguments ..
9  INTEGER ITRAF( * )
10  DOUBLE PRECISION A( LDA, * ), DTRAF( * ), WORK( * )
11 *
12 *
13 * Purpose
14 * =======
15 *
16 * BDLAAPP 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 * BDTREXC.
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) DOUBLE PRECISION 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 BDTREXC.
59 *
60 * DTRAF (output) DOUBLE PRECISION array, length k, where
61 * List of parameters for representing the transformation
62 * matrix Q, see BDTREXC.
63 *
64 * WORK (workspace) DOUBLE PRECISION array, dimension (N)
65 *
66 * =====================================================================
67 *
68
69 * .. Parameters ..
70  DOUBLE PRECISION ZERO, ONE
71  parameter( zero = 0.0d+0, one = 1.0d+0 )
72 * ..
73 * .. Local Scalars ..
74  INTEGER I, IT, J, NNB, PD
75  DOUBLE PRECISION TAU
76 * ..
77 * .. External Subroutines ..
78  EXTERNAL dlarfx, drot
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 drot( 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 dlarfx( '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 dlarfx( '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 drot( 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 dlarfx( '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 dlarfx( '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 BDLAAPP
166 *
167  END
bdlaapp
subroutine bdlaapp(ISIDE, M, N, NB, A, LDA, NITRAF, ITRAF, DTRAF, WORK)
Definition: bdlaapp.f:3
min
#define min(A, B)
Definition: pcgemr.c:181