Page Menu
Home
c4science
Search
Configure Global Search
Log In
Files
F90383284
dlarfb.f
No One
Temporary
Actions
Download File
Edit File
Delete File
View Transforms
Subscribe
Mute Notifications
Award Token
Subscribers
None
File Metadata
Details
File Info
Storage
Attached
Created
Fri, Nov 1, 04:03
Size
21 KB
Mime Type
text/html
Expires
Sun, Nov 3, 04:03 (1 d, 21 h)
Engine
blob
Format
Raw Data
Handle
21992720
Attached To
rLAMMPS lammps
dlarfb.f
View Options
*>
\
brief
\
b
DLARFB
applies
a
block
reflector
or
its
transpose
to
a
general
rectangular
matrix
.
*
*
===========
DOCUMENTATION
===========
*
*
Online
html
documentation
available
at
*
http
:
//
www
.
netlib
.
org
/
lapack
/
explore
-
html
/
*
*>
\
htmlonly
*>
Download
DLARFB
+
dependencies
*>
<
a
href
=
"http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarfb.f"
>
*>
[
TGZ
]
</
a
>
*>
<
a
href
=
"http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarfb.f"
>
*>
[
ZIP
]
</
a
>
*>
<
a
href
=
"http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarfb.f"
>
*>
[
TXT
]
</
a
>
*>
\
endhtmlonly
*
*
Definition
:
*
===========
*
*
SUBROUTINE
DLARFB
(
SIDE
,
TRANS
,
DIRECT
,
STOREV
,
M
,
N
,
K
,
V
,
LDV
,
*
T
,
LDT
,
C
,
LDC
,
WORK
,
LDWORK
)
*
*
..
Scalar
Arguments
..
*
CHARACTER
DIRECT
,
SIDE
,
STOREV
,
TRANS
*
INTEGER
K
,
LDC
,
LDT
,
LDV
,
LDWORK
,
M
,
N
*
..
*
..
Array
Arguments
..
*
DOUBLE PRECISION
C
(
LDC
,
*
),
T
(
LDT
,
*
),
V
(
LDV
,
*
),
*
$
WORK
(
LDWORK
,
*
)
*
..
*
*
*>
\
par
Purpose
:
*
=============
*>
*>
\
verbatim
*>
*>
DLARFB
applies
a
real
block
reflector
H
or
its
transpose
H
**
T
to
a
*>
real
m
by
n
matrix
C
,
from
either
the
left
or
the
right
.
*>
\
endverbatim
*
*
Arguments
:
*
==========
*
*>
\
param
[
in
]
SIDE
*>
\
verbatim
*>
SIDE
is
CHARACTER
*
1
*>
=
'L'
:
apply
H
or
H
**
T
from
the
Left
*>
=
'R'
:
apply
H
or
H
**
T
from
the
Right
*>
\
endverbatim
*>
*>
\
param
[
in
]
TRANS
*>
\
verbatim
*>
TRANS
is
CHARACTER
*
1
*>
=
'N'
:
apply
H
(
No
transpose
)
*>
=
'T'
:
apply
H
**
T
(
Transpose
)
*>
\
endverbatim
*>
*>
\
param
[
in
]
DIRECT
*>
\
verbatim
*>
DIRECT
is
CHARACTER
*
1
*>
Indicates
how
H
is
formed
from
a
product
of
elementary
*>
reflectors
*>
=
'F'
:
H
=
H
(
1
)
H
(
2
)
.
.
.
H
(
k
)
(
Forward
)
*>
=
'B'
:
H
=
H
(
k
)
.
.
.
H
(
2
)
H
(
1
)
(
Backward
)
*>
\
endverbatim
*>
*>
\
param
[
in
]
STOREV
*>
\
verbatim
*>
STOREV
is
CHARACTER
*
1
*>
Indicates
how
the
vectors
which
define
the
elementary
*>
reflectors
are
stored
:
*>
=
'C'
:
Columnwise
*>
=
'R'
:
Rowwise
*>
\
endverbatim
*>
*>
\
param
[
in
]
M
*>
\
verbatim
*>
M
is
INTEGER
*>
The
number
of
rows
of
the
matrix
C
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
N
*>
\
verbatim
*>
N
is
INTEGER
*>
The
number
of
columns
of
the
matrix
C
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
K
*>
\
verbatim
*>
K
is
INTEGER
*>
The
order
of
the
matrix
T
(
=
the
number
of
elementary
*>
reflectors
whose
product
defines
the
block
reflector
)
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
V
*>
\
verbatim
*>
V
is
DOUBLE PRECISION
array
,
dimension
*>
(
LDV
,
K
)
if
STOREV
=
'C'
*>
(
LDV
,
M
)
if
STOREV
=
'R'
and
SIDE
=
'L'
*>
(
LDV
,
N
)
if
STOREV
=
'R'
and
SIDE
=
'R'
*>
The
matrix
V
.
See
Further
Details
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
LDV
*>
\
verbatim
*>
LDV
is
INTEGER
*>
The
leading
dimension
of
the
array
V
.
*>
If
STOREV
=
'C'
and
SIDE
=
'L'
,
LDV
>=
max
(
1
,
M
);
*>
if
STOREV
=
'C'
and
SIDE
=
'R'
,
LDV
>=
max
(
1
,
N
);
*>
if
STOREV
=
'R'
,
LDV
>=
K
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
T
*>
\
verbatim
*>
T
is
DOUBLE PRECISION
array
,
dimension
(
LDT
,
K
)
*>
The
triangular
k
by
k
matrix
T
in
the
representation
of
the
*>
block
reflector
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
LDT
*>
\
verbatim
*>
LDT
is
INTEGER
*>
The
leading
dimension
of
the
array
T
.
LDT
>=
K
.
*>
\
endverbatim
*>
*>
\
param
[
in
,
out
]
C
*>
\
verbatim
*>
C
is
DOUBLE PRECISION
array
,
dimension
(
LDC
,
N
)
*>
On
entry
,
the
m
by
n
matrix
C
.
*>
On
exit
,
C
is
overwritten
by
H
*
C
or
H
**
T
*
C
or
C
*
H
or
C
*
H
**
T
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
LDC
*>
\
verbatim
*>
LDC
is
INTEGER
*>
The
leading
dimension
of
the
array
C
.
LDC
>=
max
(
1
,
M
)
.
*>
\
endverbatim
*>
*>
\
param
[
out
]
WORK
*>
\
verbatim
*>
WORK
is
DOUBLE PRECISION
array
,
dimension
(
LDWORK
,
K
)
*>
\
endverbatim
*>
*>
\
param
[
in
]
LDWORK
*>
\
verbatim
*>
LDWORK
is
INTEGER
*>
The
leading
dimension
of
the
array
WORK
.
*>
If
SIDE
=
'L'
,
LDWORK
>=
max
(
1
,
N
);
*>
if
SIDE
=
'R'
,
LDWORK
>=
max
(
1
,
M
)
.
*>
\
endverbatim
*
*
Authors
:
*
========
*
*>
\
author
Univ
.
of
Tennessee
*>
\
author
Univ
.
of
California
Berkeley
*>
\
author
Univ
.
of
Colorado
Denver
*>
\
author
NAG
Ltd
.
*
*>
\
date
September
2012
*
*>
\
ingroup
doubleOTHERauxiliary
*
*>
\
par
Further
Details
:
*
=====================
*>
*>
\
verbatim
*>
*>
The
shape
of
the
matrix
V
and
the
storage
of
the
vectors
which
define
*>
the
H
(
i
)
is
best
illustrated
by
the
following
example
with
n
=
5
and
*>
k
=
3.
The
elements
equal
to
1
are
not
stored
;
the
corresponding
*>
array
elements
are
modified
but
restored
on
exit
.
The
rest
of
the
*>
array
is
not
used
.
*>
*>
DIRECT
=
'F'
and
STOREV
=
'C'
:
DIRECT
=
'F'
and
STOREV
=
'R'
:
*>
*>
V
=
(
1
)
V
=
(
1
v1
v1
v1
v1
)
*>
(
v1
1
)
(
1
v2
v2
v2
)
*>
(
v1
v2
1
)
(
1
v3
v3
)
*>
(
v1
v2
v3
)
*>
(
v1
v2
v3
)
*>
*>
DIRECT
=
'B'
and
STOREV
=
'C'
:
DIRECT
=
'B'
and
STOREV
=
'R'
:
*>
*>
V
=
(
v1
v2
v3
)
V
=
(
v1
v1
1
)
*>
(
v1
v2
v3
)
(
v2
v2
v2
1
)
*>
(
1
v2
v3
)
(
v3
v3
v3
v3
1
)
*>
(
1
v3
)
*>
(
1
)
*>
\
endverbatim
*>
*
=====================================================================
SUBROUTINE
DLARFB
(
SIDE
,
TRANS
,
DIRECT
,
STOREV
,
M
,
N
,
K
,
V
,
LDV
,
$
T
,
LDT
,
C
,
LDC
,
WORK
,
LDWORK
)
*
*
--
LAPACK
auxiliary
routine
(
version
3.4.2
)
--
*
--
LAPACK
is
a
software
package
provided
by
Univ
.
of
Tennessee
,
--
*
--
Univ
.
of
California
Berkeley
,
Univ
.
of
Colorado
Denver
and
NAG
Ltd
..
--
*
September
2012
*
*
..
Scalar
Arguments
..
CHARACTER
DIRECT
,
SIDE
,
STOREV
,
TRANS
INTEGER
K
,
LDC
,
LDT
,
LDV
,
LDWORK
,
M
,
N
*
..
*
..
Array
Arguments
..
DOUBLE PRECISION
C
(
LDC
,
*
),
T
(
LDT
,
*
),
V
(
LDV
,
*
),
$
WORK
(
LDWORK
,
*
)
*
..
*
*
=====================================================================
*
*
..
Parameters
..
DOUBLE PRECISION
ONE
PARAMETER
(
ONE
=
1.0
D
+
0
)
*
..
*
..
Local
Scalars
..
CHARACTER
TRANST
INTEGER
I
,
J
,
LASTV
,
LASTC
,
lastv2
*
..
*
..
External
Functions
..
LOGICAL
LSAME
INTEGER
ILADLR
,
ILADLC
EXTERNAL
LSAME
,
ILADLR
,
ILADLC
*
..
*
..
External
Subroutines
..
EXTERNAL
DCOPY
,
DGEMM
,
DTRMM
*
..
*
..
Executable
Statements
..
*
*
Quick
return if
possible
*
IF
(
M
.LE.
0
.OR.
N
.LE.
0
)
$
RETURN
*
IF
(
LSAME
(
TRANS
,
'N'
)
)
THEN
TRANST
=
'T'
ELSE
TRANST
=
'N'
END IF
*
IF
(
LSAME
(
STOREV
,
'C'
)
)
THEN
*
IF
(
LSAME
(
DIRECT
,
'F'
)
)
THEN
*
*
Let
V
=
(
V1
)
(
first
K
rows
)
*
(
V2
)
*
where
V1
is
unit
lower
triangular
.
*
IF
(
LSAME
(
SIDE
,
'L'
)
)
THEN
*
*
Form
H
*
C
or
H
**
T
*
C
where
C
=
(
C1
)
*
(
C2
)
*
LASTV
=
MAX
(
K
,
ILADLR
(
M
,
K
,
V
,
LDV
)
)
LASTC
=
ILADLC
(
LASTV
,
N
,
C
,
LDC
)
*
*
W
:
=
C
**
T
*
V
=
(
C1
**
T
*
V1
+
C2
**
T
*
V2
)
(
stored
in
WORK
)
*
*
W
:
=
C1
**
T
*
DO
10
J
=
1
,
K
CALL
DCOPY
(
LASTC
,
C
(
J
,
1
),
LDC
,
WORK
(
1
,
J
),
1
)
10
CONTINUE
*
*
W
:
=
W
*
V1
*
CALL
DTRMM
(
'Right'
,
'Lower'
,
'No transpose'
,
'Unit'
,
$
LASTC
,
K
,
ONE
,
V
,
LDV
,
WORK
,
LDWORK
)
IF
(
LASTV
.GT.
K
)
THEN
*
*
W
:
=
W
+
C2
**
T
*
V2
*
CALL
DGEMM
(
'Transpose'
,
'No transpose'
,
$
LASTC
,
K
,
LASTV
-
K
,
$
ONE
,
C
(
K
+
1
,
1
),
LDC
,
V
(
K
+
1
,
1
),
LDV
,
$
ONE
,
WORK
,
LDWORK
)
END IF
*
*
W
:
=
W
*
T
**
T
or
W
*
T
*
CALL
DTRMM
(
'Right'
,
'Upper'
,
TRANST
,
'Non-unit'
,
$
LASTC
,
K
,
ONE
,
T
,
LDT
,
WORK
,
LDWORK
)
*
*
C
:
=
C
-
V
*
W
**
T
*
IF
(
LASTV
.GT.
K
)
THEN
*
*
C2
:
=
C2
-
V2
*
W
**
T
*
CALL
DGEMM
(
'No transpose'
,
'Transpose'
,
$
LASTV
-
K
,
LASTC
,
K
,
$
-
ONE
,
V
(
K
+
1
,
1
),
LDV
,
WORK
,
LDWORK
,
ONE
,
$
C
(
K
+
1
,
1
),
LDC
)
END IF
*
*
W
:
=
W
*
V1
**
T
*
CALL
DTRMM
(
'Right'
,
'Lower'
,
'Transpose'
,
'Unit'
,
$
LASTC
,
K
,
ONE
,
V
,
LDV
,
WORK
,
LDWORK
)
*
*
C1
:
=
C1
-
W
**
T
*
DO
30
J
=
1
,
K
DO
20
I
=
1
,
LASTC
C
(
J
,
I
)
=
C
(
J
,
I
)
-
WORK
(
I
,
J
)
20
CONTINUE
30
CONTINUE
*
ELSE IF
(
LSAME
(
SIDE
,
'R'
)
)
THEN
*
*
Form
C
*
H
or
C
*
H
**
T
where
C
=
(
C1
C2
)
*
LASTV
=
MAX
(
K
,
ILADLR
(
N
,
K
,
V
,
LDV
)
)
LASTC
=
ILADLR
(
M
,
LASTV
,
C
,
LDC
)
*
*
W
:
=
C
*
V
=
(
C1
*
V1
+
C2
*
V2
)
(
stored
in
WORK
)
*
*
W
:
=
C1
*
DO
40
J
=
1
,
K
CALL
DCOPY
(
LASTC
,
C
(
1
,
J
),
1
,
WORK
(
1
,
J
),
1
)
40
CONTINUE
*
*
W
:
=
W
*
V1
*
CALL
DTRMM
(
'Right'
,
'Lower'
,
'No transpose'
,
'Unit'
,
$
LASTC
,
K
,
ONE
,
V
,
LDV
,
WORK
,
LDWORK
)
IF
(
LASTV
.GT.
K
)
THEN
*
*
W
:
=
W
+
C2
*
V2
*
CALL
DGEMM
(
'No transpose'
,
'No transpose'
,
$
LASTC
,
K
,
LASTV
-
K
,
$
ONE
,
C
(
1
,
K
+
1
),
LDC
,
V
(
K
+
1
,
1
),
LDV
,
$
ONE
,
WORK
,
LDWORK
)
END IF
*
*
W
:
=
W
*
T
or
W
*
T
**
T
*
CALL
DTRMM
(
'Right'
,
'Upper'
,
TRANS
,
'Non-unit'
,
$
LASTC
,
K
,
ONE
,
T
,
LDT
,
WORK
,
LDWORK
)
*
*
C
:
=
C
-
W
*
V
**
T
*
IF
(
LASTV
.GT.
K
)
THEN
*
*
C2
:
=
C2
-
W
*
V2
**
T
*
CALL
DGEMM
(
'No transpose'
,
'Transpose'
,
$
LASTC
,
LASTV
-
K
,
K
,
$
-
ONE
,
WORK
,
LDWORK
,
V
(
K
+
1
,
1
),
LDV
,
ONE
,
$
C
(
1
,
K
+
1
),
LDC
)
END IF
*
*
W
:
=
W
*
V1
**
T
*
CALL
DTRMM
(
'Right'
,
'Lower'
,
'Transpose'
,
'Unit'
,
$
LASTC
,
K
,
ONE
,
V
,
LDV
,
WORK
,
LDWORK
)
*
*
C1
:
=
C1
-
W
*
DO
60
J
=
1
,
K
DO
50
I
=
1
,
LASTC
C
(
I
,
J
)
=
C
(
I
,
J
)
-
WORK
(
I
,
J
)
50
CONTINUE
60
CONTINUE
END IF
*
ELSE
*
*
Let
V
=
(
V1
)
*
(
V2
)
(
last
K
rows
)
*
where
V2
is
unit
upper
triangular
.
*
IF
(
LSAME
(
SIDE
,
'L'
)
)
THEN
*
*
Form
H
*
C
or
H
**
T
*
C
where
C
=
(
C1
)
*
(
C2
)
*
LASTC
=
ILADLC
(
M
,
N
,
C
,
LDC
)
*
*
W
:
=
C
**
T
*
V
=
(
C1
**
T
*
V1
+
C2
**
T
*
V2
)
(
stored
in
WORK
)
*
*
W
:
=
C2
**
T
*
DO
70
J
=
1
,
K
CALL
DCOPY
(
LASTC
,
C
(
M
-
K
+
J
,
1
),
LDC
,
$
WORK
(
1
,
J
),
1
)
70
CONTINUE
*
*
W
:
=
W
*
V2
*
CALL
DTRMM
(
'Right'
,
'Upper'
,
'No transpose'
,
'Unit'
,
$
LASTC
,
K
,
ONE
,
V
(
M
-
K
+
1
,
1
),
LDV
,
$
WORK
,
LDWORK
)
IF
(
M
.GT.
K
)
THEN
*
*
W
:
=
W
+
C1
**
T
*
V1
*
CALL
DGEMM
(
'Transpose'
,
'No transpose'
,
$
LASTC
,
K
,
M
-
K
,
ONE
,
C
,
LDC
,
V
,
LDV
,
$
ONE
,
WORK
,
LDWORK
)
END IF
*
*
W
:
=
W
*
T
**
T
or
W
*
T
*
CALL
DTRMM
(
'Right'
,
'Lower'
,
TRANST
,
'Non-unit'
,
$
LASTC
,
K
,
ONE
,
T
,
LDT
,
WORK
,
LDWORK
)
*
*
C
:
=
C
-
V
*
W
**
T
*
IF
(
M
.GT.
K
)
THEN
*
*
C1
:
=
C1
-
V1
*
W
**
T
*
CALL
DGEMM
(
'No transpose'
,
'Transpose'
,
$
M
-
K
,
LASTC
,
K
,
-
ONE
,
V
,
LDV
,
WORK
,
LDWORK
,
$
ONE
,
C
,
LDC
)
END IF
*
*
W
:
=
W
*
V2
**
T
*
CALL
DTRMM
(
'Right'
,
'Upper'
,
'Transpose'
,
'Unit'
,
$
LASTC
,
K
,
ONE
,
V
(
M
-
K
+
1
,
1
),
LDV
,
$
WORK
,
LDWORK
)
*
*
C2
:
=
C2
-
W
**
T
*
DO
90
J
=
1
,
K
DO
80
I
=
1
,
LASTC
C
(
M
-
K
+
J
,
I
)
=
C
(
M
-
K
+
J
,
I
)
-
WORK
(
I
,
J
)
80
CONTINUE
90
CONTINUE
*
ELSE IF
(
LSAME
(
SIDE
,
'R'
)
)
THEN
*
*
Form
C
*
H
or
C
*
H
**
T
where
C
=
(
C1
C2
)
*
LASTC
=
ILADLR
(
M
,
N
,
C
,
LDC
)
*
*
W
:
=
C
*
V
=
(
C1
*
V1
+
C2
*
V2
)
(
stored
in
WORK
)
*
*
W
:
=
C2
*
DO
100
J
=
1
,
K
CALL
DCOPY
(
LASTC
,
C
(
1
,
N
-
K
+
J
),
1
,
WORK
(
1
,
J
),
1
)
100
CONTINUE
*
*
W
:
=
W
*
V2
*
CALL
DTRMM
(
'Right'
,
'Upper'
,
'No transpose'
,
'Unit'
,
$
LASTC
,
K
,
ONE
,
V
(
N
-
K
+
1
,
1
),
LDV
,
$
WORK
,
LDWORK
)
IF
(
N
.GT.
K
)
THEN
*
*
W
:
=
W
+
C1
*
V1
*
CALL
DGEMM
(
'No transpose'
,
'No transpose'
,
$
LASTC
,
K
,
N
-
K
,
ONE
,
C
,
LDC
,
V
,
LDV
,
$
ONE
,
WORK
,
LDWORK
)
END IF
*
*
W
:
=
W
*
T
or
W
*
T
**
T
*
CALL
DTRMM
(
'Right'
,
'Lower'
,
TRANS
,
'Non-unit'
,
$
LASTC
,
K
,
ONE
,
T
,
LDT
,
WORK
,
LDWORK
)
*
*
C
:
=
C
-
W
*
V
**
T
*
IF
(
N
.GT.
K
)
THEN
*
*
C1
:
=
C1
-
W
*
V1
**
T
*
CALL
DGEMM
(
'No transpose'
,
'Transpose'
,
$
LASTC
,
N
-
K
,
K
,
-
ONE
,
WORK
,
LDWORK
,
V
,
LDV
,
$
ONE
,
C
,
LDC
)
END IF
*
*
W
:
=
W
*
V2
**
T
*
CALL
DTRMM
(
'Right'
,
'Upper'
,
'Transpose'
,
'Unit'
,
$
LASTC
,
K
,
ONE
,
V
(
N
-
K
+
1
,
1
),
LDV
,
$
WORK
,
LDWORK
)
*
*
C2
:
=
C2
-
W
*
DO
120
J
=
1
,
K
DO
110
I
=
1
,
LASTC
C
(
I
,
N
-
K
+
J
)
=
C
(
I
,
N
-
K
+
J
)
-
WORK
(
I
,
J
)
110
CONTINUE
120
CONTINUE
END IF
END IF
*
ELSE IF
(
LSAME
(
STOREV
,
'R'
)
)
THEN
*
IF
(
LSAME
(
DIRECT
,
'F'
)
)
THEN
*
*
Let
V
=
(
V1
V2
)
(
V1
:
first
K
columns
)
*
where
V1
is
unit
upper
triangular
.
*
IF
(
LSAME
(
SIDE
,
'L'
)
)
THEN
*
*
Form
H
*
C
or
H
**
T
*
C
where
C
=
(
C1
)
*
(
C2
)
*
LASTV
=
MAX
(
K
,
ILADLC
(
K
,
M
,
V
,
LDV
)
)
LASTC
=
ILADLC
(
LASTV
,
N
,
C
,
LDC
)
*
*
W
:
=
C
**
T
*
V
**
T
=
(
C1
**
T
*
V1
**
T
+
C2
**
T
*
V2
**
T
)
(
stored
in
WORK
)
*
*
W
:
=
C1
**
T
*
DO
130
J
=
1
,
K
CALL
DCOPY
(
LASTC
,
C
(
J
,
1
),
LDC
,
WORK
(
1
,
J
),
1
)
130
CONTINUE
*
*
W
:
=
W
*
V1
**
T
*
CALL
DTRMM
(
'Right'
,
'Upper'
,
'Transpose'
,
'Unit'
,
$
LASTC
,
K
,
ONE
,
V
,
LDV
,
WORK
,
LDWORK
)
IF
(
LASTV
.GT.
K
)
THEN
*
*
W
:
=
W
+
C2
**
T
*
V2
**
T
*
CALL
DGEMM
(
'Transpose'
,
'Transpose'
,
$
LASTC
,
K
,
LASTV
-
K
,
$
ONE
,
C
(
K
+
1
,
1
),
LDC
,
V
(
1
,
K
+
1
),
LDV
,
$
ONE
,
WORK
,
LDWORK
)
END IF
*
*
W
:
=
W
*
T
**
T
or
W
*
T
*
CALL
DTRMM
(
'Right'
,
'Upper'
,
TRANST
,
'Non-unit'
,
$
LASTC
,
K
,
ONE
,
T
,
LDT
,
WORK
,
LDWORK
)
*
*
C
:
=
C
-
V
**
T
*
W
**
T
*
IF
(
LASTV
.GT.
K
)
THEN
*
*
C2
:
=
C2
-
V2
**
T
*
W
**
T
*
CALL
DGEMM
(
'Transpose'
,
'Transpose'
,
$
LASTV
-
K
,
LASTC
,
K
,
$
-
ONE
,
V
(
1
,
K
+
1
),
LDV
,
WORK
,
LDWORK
,
$
ONE
,
C
(
K
+
1
,
1
),
LDC
)
END IF
*
*
W
:
=
W
*
V1
*
CALL
DTRMM
(
'Right'
,
'Upper'
,
'No transpose'
,
'Unit'
,
$
LASTC
,
K
,
ONE
,
V
,
LDV
,
WORK
,
LDWORK
)
*
*
C1
:
=
C1
-
W
**
T
*
DO
150
J
=
1
,
K
DO
140
I
=
1
,
LASTC
C
(
J
,
I
)
=
C
(
J
,
I
)
-
WORK
(
I
,
J
)
140
CONTINUE
150
CONTINUE
*
ELSE IF
(
LSAME
(
SIDE
,
'R'
)
)
THEN
*
*
Form
C
*
H
or
C
*
H
**
T
where
C
=
(
C1
C2
)
*
LASTV
=
MAX
(
K
,
ILADLC
(
K
,
N
,
V
,
LDV
)
)
LASTC
=
ILADLR
(
M
,
LASTV
,
C
,
LDC
)
*
*
W
:
=
C
*
V
**
T
=
(
C1
*
V1
**
T
+
C2
*
V2
**
T
)
(
stored
in
WORK
)
*
*
W
:
=
C1
*
DO
160
J
=
1
,
K
CALL
DCOPY
(
LASTC
,
C
(
1
,
J
),
1
,
WORK
(
1
,
J
),
1
)
160
CONTINUE
*
*
W
:
=
W
*
V1
**
T
*
CALL
DTRMM
(
'Right'
,
'Upper'
,
'Transpose'
,
'Unit'
,
$
LASTC
,
K
,
ONE
,
V
,
LDV
,
WORK
,
LDWORK
)
IF
(
LASTV
.GT.
K
)
THEN
*
*
W
:
=
W
+
C2
*
V2
**
T
*
CALL
DGEMM
(
'No transpose'
,
'Transpose'
,
$
LASTC
,
K
,
LASTV
-
K
,
$
ONE
,
C
(
1
,
K
+
1
),
LDC
,
V
(
1
,
K
+
1
),
LDV
,
$
ONE
,
WORK
,
LDWORK
)
END IF
*
*
W
:
=
W
*
T
or
W
*
T
**
T
*
CALL
DTRMM
(
'Right'
,
'Upper'
,
TRANS
,
'Non-unit'
,
$
LASTC
,
K
,
ONE
,
T
,
LDT
,
WORK
,
LDWORK
)
*
*
C
:
=
C
-
W
*
V
*
IF
(
LASTV
.GT.
K
)
THEN
*
*
C2
:
=
C2
-
W
*
V2
*
CALL
DGEMM
(
'No transpose'
,
'No transpose'
,
$
LASTC
,
LASTV
-
K
,
K
,
$
-
ONE
,
WORK
,
LDWORK
,
V
(
1
,
K
+
1
),
LDV
,
$
ONE
,
C
(
1
,
K
+
1
),
LDC
)
END IF
*
*
W
:
=
W
*
V1
*
CALL
DTRMM
(
'Right'
,
'Upper'
,
'No transpose'
,
'Unit'
,
$
LASTC
,
K
,
ONE
,
V
,
LDV
,
WORK
,
LDWORK
)
*
*
C1
:
=
C1
-
W
*
DO
180
J
=
1
,
K
DO
170
I
=
1
,
LASTC
C
(
I
,
J
)
=
C
(
I
,
J
)
-
WORK
(
I
,
J
)
170
CONTINUE
180
CONTINUE
*
END IF
*
ELSE
*
*
Let
V
=
(
V1
V2
)
(
V2
:
last
K
columns
)
*
where
V2
is
unit
lower
triangular
.
*
IF
(
LSAME
(
SIDE
,
'L'
)
)
THEN
*
*
Form
H
*
C
or
H
**
T
*
C
where
C
=
(
C1
)
*
(
C2
)
*
LASTC
=
ILADLC
(
M
,
N
,
C
,
LDC
)
*
*
W
:
=
C
**
T
*
V
**
T
=
(
C1
**
T
*
V1
**
T
+
C2
**
T
*
V2
**
T
)
(
stored
in
WORK
)
*
*
W
:
=
C2
**
T
*
DO
190
J
=
1
,
K
CALL
DCOPY
(
LASTC
,
C
(
M
-
K
+
J
,
1
),
LDC
,
$
WORK
(
1
,
J
),
1
)
190
CONTINUE
*
*
W
:
=
W
*
V2
**
T
*
CALL
DTRMM
(
'Right'
,
'Lower'
,
'Transpose'
,
'Unit'
,
$
LASTC
,
K
,
ONE
,
V
(
1
,
M
-
K
+
1
),
LDV
,
$
WORK
,
LDWORK
)
IF
(
M
.GT.
K
)
THEN
*
*
W
:
=
W
+
C1
**
T
*
V1
**
T
*
CALL
DGEMM
(
'Transpose'
,
'Transpose'
,
$
LASTC
,
K
,
M
-
K
,
ONE
,
C
,
LDC
,
V
,
LDV
,
$
ONE
,
WORK
,
LDWORK
)
END IF
*
*
W
:
=
W
*
T
**
T
or
W
*
T
*
CALL
DTRMM
(
'Right'
,
'Lower'
,
TRANST
,
'Non-unit'
,
$
LASTC
,
K
,
ONE
,
T
,
LDT
,
WORK
,
LDWORK
)
*
*
C
:
=
C
-
V
**
T
*
W
**
T
*
IF
(
M
.GT.
K
)
THEN
*
*
C1
:
=
C1
-
V1
**
T
*
W
**
T
*
CALL
DGEMM
(
'Transpose'
,
'Transpose'
,
$
M
-
K
,
LASTC
,
K
,
-
ONE
,
V
,
LDV
,
WORK
,
LDWORK
,
$
ONE
,
C
,
LDC
)
END IF
*
*
W
:
=
W
*
V2
*
CALL
DTRMM
(
'Right'
,
'Lower'
,
'No transpose'
,
'Unit'
,
$
LASTC
,
K
,
ONE
,
V
(
1
,
M
-
K
+
1
),
LDV
,
$
WORK
,
LDWORK
)
*
*
C2
:
=
C2
-
W
**
T
*
DO
210
J
=
1
,
K
DO
200
I
=
1
,
LASTC
C
(
M
-
K
+
J
,
I
)
=
C
(
M
-
K
+
J
,
I
)
-
WORK
(
I
,
J
)
200
CONTINUE
210
CONTINUE
*
ELSE IF
(
LSAME
(
SIDE
,
'R'
)
)
THEN
*
*
Form
C
*
H
or
C
*
H
**
T
where
C
=
(
C1
C2
)
*
LASTC
=
ILADLR
(
M
,
N
,
C
,
LDC
)
*
*
W
:
=
C
*
V
**
T
=
(
C1
*
V1
**
T
+
C2
*
V2
**
T
)
(
stored
in
WORK
)
*
*
W
:
=
C2
*
DO
220
J
=
1
,
K
CALL
DCOPY
(
LASTC
,
C
(
1
,
N
-
K
+
J
),
1
,
$
WORK
(
1
,
J
),
1
)
220
CONTINUE
*
*
W
:
=
W
*
V2
**
T
*
CALL
DTRMM
(
'Right'
,
'Lower'
,
'Transpose'
,
'Unit'
,
$
LASTC
,
K
,
ONE
,
V
(
1
,
N
-
K
+
1
),
LDV
,
$
WORK
,
LDWORK
)
IF
(
N
.GT.
K
)
THEN
*
*
W
:
=
W
+
C1
*
V1
**
T
*
CALL
DGEMM
(
'No transpose'
,
'Transpose'
,
$
LASTC
,
K
,
N
-
K
,
ONE
,
C
,
LDC
,
V
,
LDV
,
$
ONE
,
WORK
,
LDWORK
)
END IF
*
*
W
:
=
W
*
T
or
W
*
T
**
T
*
CALL
DTRMM
(
'Right'
,
'Lower'
,
TRANS
,
'Non-unit'
,
$
LASTC
,
K
,
ONE
,
T
,
LDT
,
WORK
,
LDWORK
)
*
*
C
:
=
C
-
W
*
V
*
IF
(
N
.GT.
K
)
THEN
*
*
C1
:
=
C1
-
W
*
V1
*
CALL
DGEMM
(
'No transpose'
,
'No transpose'
,
$
LASTC
,
N
-
K
,
K
,
-
ONE
,
WORK
,
LDWORK
,
V
,
LDV
,
$
ONE
,
C
,
LDC
)
END IF
*
*
W
:
=
W
*
V2
*
CALL
DTRMM
(
'Right'
,
'Lower'
,
'No transpose'
,
'Unit'
,
$
LASTC
,
K
,
ONE
,
V
(
1
,
N
-
K
+
1
),
LDV
,
$
WORK
,
LDWORK
)
*
*
C1
:
=
C1
-
W
*
DO
240
J
=
1
,
K
DO
230
I
=
1
,
LASTC
C
(
I
,
N
-
K
+
J
)
=
C
(
I
,
N
-
K
+
J
)
-
WORK
(
I
,
J
)
230
CONTINUE
240
CONTINUE
*
END IF
*
END IF
END IF
*
RETURN
*
*
End
of
DLARFB
*
END
Event Timeline
Log In to Comment