Page Menu
Home
c4science
Search
Configure Global Search
Log In
Files
F102271696
dorgqr.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
Tue, Feb 18, 23:35
Size
7 KB
Mime Type
text/html
Expires
Thu, Feb 20, 23:35 (2 d)
Engine
blob
Format
Raw Data
Handle
24305215
Attached To
rLAMMPS lammps
dorgqr.f
View Options
*>
\
brief
\
b
DORGQR
*
*
===========
DOCUMENTATION
===========
*
*
Online
html
documentation
available
at
*
http
:
//
www
.
netlib
.
org
/
lapack
/
explore
-
html
/
*
*>
\
htmlonly
*>
Download
DORGQR
+
dependencies
*>
<
a
href
=
"http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dorgqr.f"
>
*>
[
TGZ
]
</
a
>
*>
<
a
href
=
"http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dorgqr.f"
>
*>
[
ZIP
]
</
a
>
*>
<
a
href
=
"http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dorgqr.f"
>
*>
[
TXT
]
</
a
>
*>
\
endhtmlonly
*
*
Definition
:
*
===========
*
*
SUBROUTINE
DORGQR
(
M
,
N
,
K
,
A
,
LDA
,
TAU
,
WORK
,
LWORK
,
INFO
)
*
*
..
Scalar
Arguments
..
*
INTEGER
INFO
,
K
,
LDA
,
LWORK
,
M
,
N
*
..
*
..
Array
Arguments
..
*
DOUBLE PRECISION
A
(
LDA
,
*
),
TAU
(
*
),
WORK
(
*
)
*
..
*
*
*>
\
par
Purpose
:
*
=============
*>
*>
\
verbatim
*>
*>
DORGQR
generates
an
M
-
by
-
N
real
matrix
Q
with
orthonormal
columns
,
*>
which
is
defined
as
the
first
N
columns
of
a
product
of
K
elementary
*>
reflectors
of
order
M
*>
*>
Q
=
H
(
1
)
H
(
2
)
.
.
.
H
(
k
)
*>
*>
as
returned
by
DGEQRF
.
*>
\
endverbatim
*
*
Arguments
:
*
==========
*
*>
\
param
[
in
]
M
*>
\
verbatim
*>
M
is
INTEGER
*>
The
number
of
rows
of
the
matrix
Q
.
M
>=
0.
*>
\
endverbatim
*>
*>
\
param
[
in
]
N
*>
\
verbatim
*>
N
is
INTEGER
*>
The
number
of
columns
of
the
matrix
Q
.
M
>=
N
>=
0.
*>
\
endverbatim
*>
*>
\
param
[
in
]
K
*>
\
verbatim
*>
K
is
INTEGER
*>
The
number
of
elementary
reflectors
whose
product
defines
the
*>
matrix
Q
.
N
>=
K
>=
0.
*>
\
endverbatim
*>
*>
\
param
[
in
,
out
]
A
*>
\
verbatim
*>
A
is
DOUBLE PRECISION
array
,
dimension
(
LDA
,
N
)
*>
On
entry
,
the
i
-
th
column
must
contain
the
vector
which
*>
defines
the
elementary
reflector
H
(
i
),
for
i
=
1
,
2
,
...
,
k
,
as
*>
returned
by
DGEQRF
in
the
first
k
columns
of
its
array
*>
argument
A
.
*>
On
exit
,
the
M
-
by
-
N
matrix
Q
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
LDA
*>
\
verbatim
*>
LDA
is
INTEGER
*>
The
first
dimension
of
the
array
A
.
LDA
>=
max
(
1
,
M
)
.
*>
\
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
DGEQRF
.
*>
\
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
.
LWORK
>=
max
(
1
,
N
)
.
*>
For
optimum
performance
LWORK
>=
N
*
NB
,
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
has
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
DORGQR
(
M
,
N
,
K
,
A
,
LDA
,
TAU
,
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
..
INTEGER
INFO
,
K
,
LDA
,
LWORK
,
M
,
N
*
..
*
..
Array
Arguments
..
DOUBLE PRECISION
A
(
LDA
,
*
),
TAU
(
*
),
WORK
(
*
)
*
..
*
*
=====================================================================
*
*
..
Parameters
..
DOUBLE PRECISION
ZERO
PARAMETER
(
ZERO
=
0.0
D
+
0
)
*
..
*
..
Local
Scalars
..
LOGICAL
LQUERY
INTEGER
I
,
IB
,
IINFO
,
IWS
,
J
,
KI
,
KK
,
L
,
LDWORK
,
$
LWKOPT
,
NB
,
NBMIN
,
NX
*
..
*
..
External
Subroutines
..
EXTERNAL
DLARFB
,
DLARFT
,
DORG2R
,
XERBLA
*
..
*
..
Intrinsic
Functions
..
INTRINSIC
MAX
,
MIN
*
..
*
..
External
Functions
..
INTEGER
ILAENV
EXTERNAL
ILAENV
*
..
*
..
Executable
Statements
..
*
*
Test
the
input
arguments
*
INFO
=
0
NB
=
ILAENV
(
1
,
'DORGQR'
,
' '
,
M
,
N
,
K
,
-
1
)
LWKOPT
=
MAX
(
1
,
N
)
*
NB
WORK
(
1
)
=
LWKOPT
LQUERY
=
(
LWORK
.EQ.
-
1
)
IF
(
M
.LT.
0
)
THEN
INFO
=
-
1
ELSE IF
(
N
.LT.
0
.OR.
N
.GT.
M
)
THEN
INFO
=
-
2
ELSE IF
(
K
.LT.
0
.OR.
K
.GT.
N
)
THEN
INFO
=
-
3
ELSE IF
(
LDA
.LT.
MAX
(
1
,
M
)
)
THEN
INFO
=
-
5
ELSE IF
(
LWORK
.LT.
MAX
(
1
,
N
)
.AND.
.NOT.
LQUERY
)
THEN
INFO
=
-
8
END IF
IF
(
INFO
.NE.
0
)
THEN
CALL
XERBLA
(
'DORGQR'
,
-
INFO
)
RETURN
ELSE IF
(
LQUERY
)
THEN
RETURN
END IF
*
*
Quick
return if
possible
*
IF
(
N
.LE.
0
)
THEN
WORK
(
1
)
=
1
RETURN
END IF
*
NBMIN
=
2
NX
=
0
IWS
=
N
IF
(
NB
.GT.
1
.AND.
NB
.LT.
K
)
THEN
*
*
Determine
when
to
cross
over
from
blocked
to
unblocked
code
.
*
NX
=
MAX
(
0
,
ILAENV
(
3
,
'DORGQR'
,
' '
,
M
,
N
,
K
,
-
1
)
)
IF
(
NX
.LT.
K
)
THEN
*
*
Determine
if
workspace
is
large
enough
for
blocked
code
.
*
LDWORK
=
N
IWS
=
LDWORK
*
NB
IF
(
LWORK
.LT.
IWS
)
THEN
*
*
Not
enough
workspace
to
use
optimal
NB
:
reduce
NB
and
*
determine
the
minimum
value
of
NB
.
*
NB
=
LWORK
/
LDWORK
NBMIN
=
MAX
(
2
,
ILAENV
(
2
,
'DORGQR'
,
' '
,
M
,
N
,
K
,
-
1
)
)
END IF
END IF
END IF
*
IF
(
NB
.GE.
NBMIN
.AND.
NB
.LT.
K
.AND.
NX
.LT.
K
)
THEN
*
*
Use
blocked
code
after
the
last
block
.
*
The
first
kk
columns
are
handled
by
the
block
method
.
*
KI
=
(
(
K
-
NX
-
1
)
/
NB
)
*
NB
KK
=
MIN
(
K
,
KI
+
NB
)
*
*
Set
A
(
1
:
kk
,
kk
+
1
:
n
)
to
zero
.
*
DO
20
J
=
KK
+
1
,
N
DO
10
I
=
1
,
KK
A
(
I
,
J
)
=
ZERO
10
CONTINUE
20
CONTINUE
ELSE
KK
=
0
END IF
*
*
Use
unblocked
code
for
the
last
or
only
block
.
*
IF
(
KK
.LT.
N
)
$
CALL
DORG2R
(
M
-
KK
,
N
-
KK
,
K
-
KK
,
A
(
KK
+
1
,
KK
+
1
),
LDA
,
$
TAU
(
KK
+
1
),
WORK
,
IINFO
)
*
IF
(
KK
.GT.
0
)
THEN
*
*
Use
blocked
code
*
DO
50
I
=
KI
+
1
,
1
,
-
NB
IB
=
MIN
(
NB
,
K
-
I
+
1
)
IF
(
I
+
IB
.LE.
N
)
THEN
*
*
Form
the
triangular
factor
of
the
block
reflector
*
H
=
H
(
i
)
H
(
i
+
1
)
.
.
.
H
(
i
+
ib
-
1
)
*
CALL
DLARFT
(
'Forward'
,
'Columnwise'
,
M
-
I
+
1
,
IB
,
$
A
(
I
,
I
),
LDA
,
TAU
(
I
),
WORK
,
LDWORK
)
*
*
Apply
H
to
A
(
i
:
m
,
i
+
ib
:
n
)
from
the
left
*
CALL
DLARFB
(
'Left'
,
'No transpose'
,
'Forward'
,
$
'Columnwise'
,
M
-
I
+
1
,
N
-
I
-
IB
+
1
,
IB
,
$
A
(
I
,
I
),
LDA
,
WORK
,
LDWORK
,
A
(
I
,
I
+
IB
),
$
LDA
,
WORK
(
IB
+
1
),
LDWORK
)
END IF
*
*
Apply
H
to
rows
i
:
m
of
current
block
*
CALL
DORG2R
(
M
-
I
+
1
,
IB
,
IB
,
A
(
I
,
I
),
LDA
,
TAU
(
I
),
WORK
,
$
IINFO
)
*
*
Set
rows
1
:
i
-
1
of
current
block
to
zero
*
DO
40
J
=
I
,
I
+
IB
-
1
DO
30
L
=
1
,
I
-
1
A
(
L
,
J
)
=
ZERO
30
CONTINUE
40
CONTINUE
50
CONTINUE
END IF
*
WORK
(
1
)
=
IWS
RETURN
*
*
End
of
DORGQR
*
END
Event Timeline
Log In to Comment