Page Menu
Home
c4science
Search
Configure Global Search
Log In
Files
F80344470
dormlq.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
Sat, Aug 31, 06:31
Size
9 KB
Mime Type
text/html
Expires
Mon, Sep 2, 06:31 (2 d)
Engine
blob
Format
Raw Data
Handle
20332278
Attached To
rLAMMPS lammps
dormlq.f
View Options
*>
\
brief
\
b
DORMLQ
*
*
===========
DOCUMENTATION
===========
*
*
Online
html
documentation
available
at
*
http
:
//
www
.
netlib
.
org
/
lapack
/
explore
-
html
/
*
*>
\
htmlonly
*>
Download
DORMLQ
+
dependencies
*>
<
a
href
=
"http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dormlq.f"
>
*>
[
TGZ
]
</
a
>
*>
<
a
href
=
"http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dormlq.f"
>
*>
[
ZIP
]
</
a
>
*>
<
a
href
=
"http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dormlq.f"
>
*>
[
TXT
]
</
a
>
*>
\
endhtmlonly
*
*
Definition
:
*
===========
*
*
SUBROUTINE
DORMLQ
(
SIDE
,
TRANS
,
M
,
N
,
K
,
A
,
LDA
,
TAU
,
C
,
LDC
,
*
WORK
,
LWORK
,
INFO
)
*
*
..
Scalar
Arguments
..
*
CHARACTER
SIDE
,
TRANS
*
INTEGER
INFO
,
K
,
LDA
,
LDC
,
LWORK
,
M
,
N
*
..
*
..
Array
Arguments
..
*
DOUBLE PRECISION
A
(
LDA
,
*
),
C
(
LDC
,
*
),
TAU
(
*
),
WORK
(
*
)
*
..
*
*
*>
\
par
Purpose
:
*
=============
*>
*>
\
verbatim
*>
*>
DORMLQ
overwrites
the
general
real
M
-
by
-
N
matrix
C
with
*>
*>
SIDE
=
'L'
SIDE
=
'R'
*>
TRANS
=
'N'
:
Q
*
C
C
*
Q
*>
TRANS
=
'T'
:
Q
**
T
*
C
C
*
Q
**
T
*>
*>
where
Q
is
a
real
orthogonal
matrix
defined
as
the
product
of
k
*>
elementary
reflectors
*>
*>
Q
=
H
(
k
)
.
.
.
H
(
2
)
H
(
1
)
*>
*>
as
returned
by
DGELQF
.
Q
is
of
order
M
if
SIDE
=
'L'
and
of
order
N
*>
if
SIDE
=
'R'
.
*>
\
endverbatim
*
*
Arguments
:
*
==========
*
*>
\
param
[
in
]
SIDE
*>
\
verbatim
*>
SIDE
is
CHARACTER
*
1
*>
=
'L'
:
apply
Q
or
Q
**
T
from
the
Left
;
*>
=
'R'
:
apply
Q
or
Q
**
T
from
the
Right
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
TRANS
*>
\
verbatim
*>
TRANS
is
CHARACTER
*
1
*>
=
'N'
:
No
transpose
,
apply
Q
;
*>
=
'T'
:
Transpose
,
apply
Q
**
T
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
M
*>
\
verbatim
*>
M
is
INTEGER
*>
The
number
of
rows
of
the
matrix
C
.
M
>=
0.
*>
\
endverbatim
*>
*>
\
param
[
in
]
N
*>
\
verbatim
*>
N
is
INTEGER
*>
The
number
of
columns
of
the
matrix
C
.
N
>=
0.
*>
\
endverbatim
*>
*>
\
param
[
in
]
K
*>
\
verbatim
*>
K
is
INTEGER
*>
The
number
of
elementary
reflectors
whose
product
defines
*>
the
matrix
Q
.
*>
If
SIDE
=
'L'
,
M
>=
K
>=
0
;
*>
if
SIDE
=
'R'
,
N
>=
K
>=
0.
*>
\
endverbatim
*>
*>
\
param
[
in
]
A
*>
\
verbatim
*>
A
is
DOUBLE PRECISION
array
,
dimension
*>
(
LDA
,
M
)
if
SIDE
=
'L'
,
*>
(
LDA
,
N
)
if
SIDE
=
'R'
*>
The
i
-
th
row
must
contain
the
vector
which
defines
the
*>
elementary
reflector
H
(
i
),
for
i
=
1
,
2
,
...
,
k
,
as
returned
by
*>
DGELQF
in
the
first
k
rows
of
its
array
argument
A
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
LDA
*>
\
verbatim
*>
LDA
is
INTEGER
*>
The
leading
dimension
of
the
array
A
.
LDA
>=
max
(
1
,
K
)
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
TAU
*>
\
verbatim
*>
TAU
is
DOUBLE PRECISION
array
,
dimension
(
K
)
*>
TAU
(
i
)
must
contain
the
scalar
factor
of
the
elementary
*>
reflector
H
(
i
),
as
returned
by
DGELQF
.
*>
\
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
Q
*
C
or
Q
**
T
*
C
or
C
*
Q
**
T
or
C
*
Q
.
*>
\
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
(
MAX
(
1
,
LWORK
))
*>
On
exit
,
if
INFO
=
0
,
WORK
(
1
)
returns
the
optimal
LWORK
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
LWORK
*>
\
verbatim
*>
LWORK
is
INTEGER
*>
The
dimension
of
the
array
WORK
.
*>
If
SIDE
=
'L'
,
LWORK
>=
max
(
1
,
N
);
*>
if
SIDE
=
'R'
,
LWORK
>=
max
(
1
,
M
)
.
*>
For
optimum
performance
LWORK
>=
N
*
NB
if
SIDE
=
'L'
,
and
*>
LWORK
>=
M
*
NB
if
SIDE
=
'R'
,
where
NB
is
the
optimal
*>
blocksize
.
*>
*>
If
LWORK
=
-
1
,
then
a
workspace
query
is
assumed
;
the
routine
*>
only
calculates
the
optimal
size
of
the
WORK
array
,
returns
*>
this
value
as
the
first
entry
of
the
WORK
array
,
and
no
error
*>
message
related
to
LWORK
is
issued
by
XERBLA
.
*>
\
endverbatim
*>
*>
\
param
[
out
]
INFO
*>
\
verbatim
*>
INFO
is
INTEGER
*>
=
0
:
successful
exit
*>
<
0
:
if
INFO
=
-
i
,
the
i
-
th
argument
had
an
illegal
value
*>
\
endverbatim
*
*
Authors
:
*
========
*
*>
\
author
Univ
.
of
Tennessee
*>
\
author
Univ
.
of
California
Berkeley
*>
\
author
Univ
.
of
Colorado
Denver
*>
\
author
NAG
Ltd
.
*
*>
\
date
November
2011
*
*>
\
ingroup
doubleOTHERcomputational
*
*
=====================================================================
SUBROUTINE
DORMLQ
(
SIDE
,
TRANS
,
M
,
N
,
K
,
A
,
LDA
,
TAU
,
C
,
LDC
,
$
WORK
,
LWORK
,
INFO
)
*
*
--
LAPACK
computational
routine
(
version
3.4.0
)
--
*
--
LAPACK
is
a
software
package
provided
by
Univ
.
of
Tennessee
,
--
*
--
Univ
.
of
California
Berkeley
,
Univ
.
of
Colorado
Denver
and
NAG
Ltd
..
--
*
November
2011
*
*
..
Scalar
Arguments
..
CHARACTER
SIDE
,
TRANS
INTEGER
INFO
,
K
,
LDA
,
LDC
,
LWORK
,
M
,
N
*
..
*
..
Array
Arguments
..
DOUBLE PRECISION
A
(
LDA
,
*
),
C
(
LDC
,
*
),
TAU
(
*
),
WORK
(
*
)
*
..
*
*
=====================================================================
*
*
..
Parameters
..
INTEGER
NBMAX
,
LDT
PARAMETER
(
NBMAX
=
64
,
LDT
=
NBMAX
+
1
)
*
..
*
..
Local
Scalars
..
LOGICAL
LEFT
,
LQUERY
,
NOTRAN
CHARACTER
TRANST
INTEGER
I
,
I1
,
I2
,
I3
,
IB
,
IC
,
IINFO
,
IWS
,
JC
,
LDWORK
,
$
LWKOPT
,
MI
,
NB
,
NBMIN
,
NI
,
NQ
,
NW
*
..
*
..
Local
Arrays
..
DOUBLE PRECISION
T
(
LDT
,
NBMAX
)
*
..
*
..
External
Functions
..
LOGICAL
LSAME
INTEGER
ILAENV
EXTERNAL
LSAME
,
ILAENV
*
..
*
..
External
Subroutines
..
EXTERNAL
DLARFB
,
DLARFT
,
DORML2
,
XERBLA
*
..
*
..
Intrinsic
Functions
..
INTRINSIC
MAX
,
MIN
*
..
*
..
Executable
Statements
..
*
*
Test
the
input
arguments
*
INFO
=
0
LEFT
=
LSAME
(
SIDE
,
'L'
)
NOTRAN
=
LSAME
(
TRANS
,
'N'
)
LQUERY
=
(
LWORK
.EQ.
-
1
)
*
*
NQ
is
the
order
of
Q
and
NW
is
the
minimum
dimension
of
WORK
*
IF
(
LEFT
)
THEN
NQ
=
M
NW
=
N
ELSE
NQ
=
N
NW
=
M
END IF
IF
(
.NOT.
LEFT
.AND.
.NOT.
LSAME
(
SIDE
,
'R'
)
)
THEN
INFO
=
-
1
ELSE IF
(
.NOT.
NOTRAN
.AND.
.NOT.
LSAME
(
TRANS
,
'T'
)
)
THEN
INFO
=
-
2
ELSE IF
(
M
.LT.
0
)
THEN
INFO
=
-
3
ELSE IF
(
N
.LT.
0
)
THEN
INFO
=
-
4
ELSE IF
(
K
.LT.
0
.OR.
K
.GT.
NQ
)
THEN
INFO
=
-
5
ELSE IF
(
LDA
.LT.
MAX
(
1
,
K
)
)
THEN
INFO
=
-
7
ELSE IF
(
LDC
.LT.
MAX
(
1
,
M
)
)
THEN
INFO
=
-
10
ELSE IF
(
LWORK
.LT.
MAX
(
1
,
NW
)
.AND.
.NOT.
LQUERY
)
THEN
INFO
=
-
12
END IF
*
IF
(
INFO
.EQ.
0
)
THEN
*
*
Determine
the
block
size
.
NB
may
be
at
most
NBMAX
,
where
NBMAX
*
is
used
to
define
the
local
array
T
.
*
NB
=
MIN
(
NBMAX
,
ILAENV
(
1
,
'DORMLQ'
,
SIDE
//
TRANS
,
M
,
N
,
K
,
$
-
1
)
)
LWKOPT
=
MAX
(
1
,
NW
)
*
NB
WORK
(
1
)
=
LWKOPT
END IF
*
IF
(
INFO
.NE.
0
)
THEN
CALL
XERBLA
(
'DORMLQ'
,
-
INFO
)
RETURN
ELSE IF
(
LQUERY
)
THEN
RETURN
END IF
*
*
Quick
return if
possible
*
IF
(
M
.EQ.
0
.OR.
N
.EQ.
0
.OR.
K
.EQ.
0
)
THEN
WORK
(
1
)
=
1
RETURN
END IF
*
NBMIN
=
2
LDWORK
=
NW
IF
(
NB
.GT.
1
.AND.
NB
.LT.
K
)
THEN
IWS
=
NW
*
NB
IF
(
LWORK
.LT.
IWS
)
THEN
NB
=
LWORK
/
LDWORK
NBMIN
=
MAX
(
2
,
ILAENV
(
2
,
'DORMLQ'
,
SIDE
//
TRANS
,
M
,
N
,
K
,
$
-
1
)
)
END IF
ELSE
IWS
=
NW
END IF
*
IF
(
NB
.LT.
NBMIN
.OR.
NB
.GE.
K
)
THEN
*
*
Use
unblocked
code
*
CALL
DORML2
(
SIDE
,
TRANS
,
M
,
N
,
K
,
A
,
LDA
,
TAU
,
C
,
LDC
,
WORK
,
$
IINFO
)
ELSE
*
*
Use
blocked
code
*
IF
(
(
LEFT
.AND.
NOTRAN
)
.OR.
$
(
.NOT.
LEFT
.AND.
.NOT.
NOTRAN
)
)
THEN
I1
=
1
I2
=
K
I3
=
NB
ELSE
I1
=
(
(
K
-
1
)
/
NB
)
*
NB
+
1
I2
=
1
I3
=
-
NB
END IF
*
IF
(
LEFT
)
THEN
NI
=
N
JC
=
1
ELSE
MI
=
M
IC
=
1
END IF
*
IF
(
NOTRAN
)
THEN
TRANST
=
'T'
ELSE
TRANST
=
'N'
END IF
*
DO
10
I
=
I1
,
I2
,
I3
IB
=
MIN
(
NB
,
K
-
I
+
1
)
*
*
Form
the
triangular
factor
of
the
block
reflector
*
H
=
H
(
i
)
H
(
i
+
1
)
.
.
.
H
(
i
+
ib
-
1
)
*
CALL
DLARFT
(
'Forward'
,
'Rowwise'
,
NQ
-
I
+
1
,
IB
,
A
(
I
,
I
),
$
LDA
,
TAU
(
I
),
T
,
LDT
)
IF
(
LEFT
)
THEN
*
*
H
or
H
**
T
is
applied
to
C
(
i
:
m
,
1
:
n
)
*
MI
=
M
-
I
+
1
IC
=
I
ELSE
*
*
H
or
H
**
T
is
applied
to
C
(
1
:
m
,
i
:
n
)
*
NI
=
N
-
I
+
1
JC
=
I
END IF
*
*
Apply
H
or
H
**
T
*
CALL
DLARFB
(
SIDE
,
TRANST
,
'Forward'
,
'Rowwise'
,
MI
,
NI
,
IB
,
$
A
(
I
,
I
),
LDA
,
T
,
LDT
,
C
(
IC
,
JC
),
LDC
,
WORK
,
$
LDWORK
)
10
CONTINUE
END IF
WORK
(
1
)
=
LWKOPT
RETURN
*
*
End
of
DORMLQ
*
END
Event Timeline
Log In to Comment