Page Menu
Home
c4science
Search
Configure Global Search
Log In
Files
F80360477
dsytrd.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, 08:23
Size
11 KB
Mime Type
text/html
Expires
Mon, Sep 2, 08:23 (1 d, 23 h)
Engine
blob
Format
Raw Data
Handle
20305907
Attached To
rLAMMPS lammps
dsytrd.f
View Options
*>
\
brief
\
b
DSYTRD
*
*
===========
DOCUMENTATION
===========
*
*
Online
html
documentation
available
at
*
http
:
//
www
.
netlib
.
org
/
lapack
/
explore
-
html
/
*
*>
\
htmlonly
*>
Download
DSYTRD
+
dependencies
*>
<
a
href
=
"http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dsytrd.f"
>
*>
[
TGZ
]
</
a
>
*>
<
a
href
=
"http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dsytrd.f"
>
*>
[
ZIP
]
</
a
>
*>
<
a
href
=
"http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dsytrd.f"
>
*>
[
TXT
]
</
a
>
*>
\
endhtmlonly
*
*
Definition
:
*
===========
*
*
SUBROUTINE
DSYTRD
(
UPLO
,
N
,
A
,
LDA
,
D
,
E
,
TAU
,
WORK
,
LWORK
,
INFO
)
*
*
..
Scalar
Arguments
..
*
CHARACTER
UPLO
*
INTEGER
INFO
,
LDA
,
LWORK
,
N
*
..
*
..
Array
Arguments
..
*
DOUBLE PRECISION
A
(
LDA
,
*
),
D
(
*
),
E
(
*
),
TAU
(
*
),
*
$
WORK
(
*
)
*
..
*
*
*>
\
par
Purpose
:
*
=============
*>
*>
\
verbatim
*>
*>
DSYTRD
reduces
a
real
symmetric
matrix
A
to
real
symmetric
*>
tridiagonal
form
T
by
an
orthogonal
similarity
transformation
:
*>
Q
**
T
*
A
*
Q
=
T
.
*>
\
endverbatim
*
*
Arguments
:
*
==========
*
*>
\
param
[
in
]
UPLO
*>
\
verbatim
*>
UPLO
is
CHARACTER
*
1
*>
=
'U'
:
Upper
triangle
of
A
is
stored
;
*>
=
'L'
:
Lower
triangle
of
A
is
stored
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
N
*>
\
verbatim
*>
N
is
INTEGER
*>
The
order
of
the
matrix
A
.
N
>=
0.
*>
\
endverbatim
*>
*>
\
param
[
in
,
out
]
A
*>
\
verbatim
*>
A
is
DOUBLE PRECISION
array
,
dimension
(
LDA
,
N
)
*>
On
entry
,
the
symmetric
matrix
A
.
If
UPLO
=
'U'
,
the
leading
*>
N
-
by
-
N
upper
triangular
part
of
A
contains
the
upper
*>
triangular
part
of
the
matrix
A
,
and
the
strictly
lower
*>
triangular
part
of
A
is
not
referenced
.
If
UPLO
=
'L'
,
the
*>
leading
N
-
by
-
N
lower
triangular
part
of
A
contains
the
lower
*>
triangular
part
of
the
matrix
A
,
and
the
strictly
upper
*>
triangular
part
of
A
is
not
referenced
.
*>
On
exit
,
if
UPLO
=
'U'
,
the
diagonal
and
first
superdiagonal
*>
of
A
are
overwritten
by
the
corresponding
elements
of
the
*>
tridiagonal
matrix
T
,
and
the
elements
above
the
first
*>
superdiagonal
,
with
the
array
TAU
,
represent
the
orthogonal
*>
matrix
Q
as
a
product
of
elementary
reflectors
;
if
UPLO
*>
=
'L'
,
the
diagonal
and
first
subdiagonal
of
A
are
over
-
*>
written
by
the
corresponding
elements
of
the
tridiagonal
*>
matrix
T
,
and
the
elements
below
the
first
subdiagonal
,
with
*>
the
array
TAU
,
represent
the
orthogonal
matrix
Q
as
a
product
*>
of
elementary
reflectors
.
See
Further
Details
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
LDA
*>
\
verbatim
*>
LDA
is
INTEGER
*>
The
leading
dimension
of
the
array
A
.
LDA
>=
max
(
1
,
N
)
.
*>
\
endverbatim
*>
*>
\
param
[
out
]
D
*>
\
verbatim
*>
D
is
DOUBLE PRECISION
array
,
dimension
(
N
)
*>
The
diagonal
elements
of
the
tridiagonal
matrix
T
:
*>
D
(
i
)
=
A
(
i
,
i
)
.
*>
\
endverbatim
*>
*>
\
param
[
out
]
E
*>
\
verbatim
*>
E
is
DOUBLE PRECISION
array
,
dimension
(
N
-
1
)
*>
The
off
-
diagonal
elements
of
the
tridiagonal
matrix
T
:
*>
E
(
i
)
=
A
(
i
,
i
+
1
)
if
UPLO
=
'U'
,
E
(
i
)
=
A
(
i
+
1
,
i
)
if
UPLO
=
'L'
.
*>
\
endverbatim
*>
*>
\
param
[
out
]
TAU
*>
\
verbatim
*>
TAU
is
DOUBLE PRECISION
array
,
dimension
(
N
-
1
)
*>
The
scalar
factors
of
the
elementary
reflectors
(
see
Further
*>
Details
)
.
*>
\
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
>=
1.
*>
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
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
doubleSYcomputational
*
*>
\
par
Further
Details
:
*
=====================
*>
*>
\
verbatim
*>
*>
If
UPLO
=
'U'
,
the
matrix
Q
is
represented
as
a
product
of
elementary
*>
reflectors
*>
*>
Q
=
H
(
n
-
1
)
.
.
.
H
(
2
)
H
(
1
)
.
*>
*>
Each
H
(
i
)
has
the
form
*>
*>
H
(
i
)
=
I
-
tau
*
v
*
v
**
T
*>
*>
where
tau
is
a
real
scalar
,
and
v
is
a
real
vector
with
*>
v
(
i
+
1
:
n
)
=
0
and
v
(
i
)
=
1
;
v
(
1
:
i
-
1
)
is
stored
on
exit
in
*>
A
(
1
:
i
-
1
,
i
+
1
),
and
tau
in
TAU
(
i
)
.
*>
*>
If
UPLO
=
'L'
,
the
matrix
Q
is
represented
as
a
product
of
elementary
*>
reflectors
*>
*>
Q
=
H
(
1
)
H
(
2
)
.
.
.
H
(
n
-
1
)
.
*>
*>
Each
H
(
i
)
has
the
form
*>
*>
H
(
i
)
=
I
-
tau
*
v
*
v
**
T
*>
*>
where
tau
is
a
real
scalar
,
and
v
is
a
real
vector
with
*>
v
(
1
:
i
)
=
0
and
v
(
i
+
1
)
=
1
;
v
(
i
+
2
:
n
)
is
stored
on
exit
in
A
(
i
+
2
:
n
,
i
),
*>
and
tau
in
TAU
(
i
)
.
*>
*>
The
contents
of
A
on
exit
are
illustrated
by
the
following
examples
*>
with
n
=
5
:
*>
*>
if
UPLO
=
'U'
:
if
UPLO
=
'L'
:
*>
*>
(
d
e
v2
v3
v4
)
(
d
)
*>
(
d
e
v3
v4
)
(
e
d
)
*>
(
d
e
v4
)
(
v1
e
d
)
*>
(
d
e
)
(
v1
v2
e
d
)
*>
(
d
)
(
v1
v2
v3
e
d
)
*>
*>
where
d
and
e
denote
diagonal
and
off
-
diagonal
elements
of
T
,
and
vi
*>
denotes
an
element
of
the
vector
defining
H
(
i
)
.
*>
\
endverbatim
*>
*
=====================================================================
SUBROUTINE
DSYTRD
(
UPLO
,
N
,
A
,
LDA
,
D
,
E
,
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
..
CHARACTER
UPLO
INTEGER
INFO
,
LDA
,
LWORK
,
N
*
..
*
..
Array
Arguments
..
DOUBLE PRECISION
A
(
LDA
,
*
),
D
(
*
),
E
(
*
),
TAU
(
*
),
$
WORK
(
*
)
*
..
*
*
=====================================================================
*
*
..
Parameters
..
DOUBLE PRECISION
ONE
PARAMETER
(
ONE
=
1.0
D
+
0
)
*
..
*
..
Local
Scalars
..
LOGICAL
LQUERY
,
UPPER
INTEGER
I
,
IINFO
,
IWS
,
J
,
KK
,
LDWORK
,
LWKOPT
,
NB
,
$
NBMIN
,
NX
*
..
*
..
External
Subroutines
..
EXTERNAL
DLATRD
,
DSYR2K
,
DSYTD2
,
XERBLA
*
..
*
..
Intrinsic
Functions
..
INTRINSIC
MAX
*
..
*
..
External
Functions
..
LOGICAL
LSAME
INTEGER
ILAENV
EXTERNAL
LSAME
,
ILAENV
*
..
*
..
Executable
Statements
..
*
*
Test
the
input
parameters
*
INFO
=
0
UPPER
=
LSAME
(
UPLO
,
'U'
)
LQUERY
=
(
LWORK
.EQ.
-
1
)
IF
(
.NOT.
UPPER
.AND.
.NOT.
LSAME
(
UPLO
,
'L'
)
)
THEN
INFO
=
-
1
ELSE IF
(
N
.LT.
0
)
THEN
INFO
=
-
2
ELSE IF
(
LDA
.LT.
MAX
(
1
,
N
)
)
THEN
INFO
=
-
4
ELSE IF
(
LWORK
.LT.
1
.AND.
.NOT.
LQUERY
)
THEN
INFO
=
-
9
END IF
*
IF
(
INFO
.EQ.
0
)
THEN
*
*
Determine
the
block
size
.
*
NB
=
ILAENV
(
1
,
'DSYTRD'
,
UPLO
,
N
,
-
1
,
-
1
,
-
1
)
LWKOPT
=
N
*
NB
WORK
(
1
)
=
LWKOPT
END IF
*
IF
(
INFO
.NE.
0
)
THEN
CALL
XERBLA
(
'DSYTRD'
,
-
INFO
)
RETURN
ELSE IF
(
LQUERY
)
THEN
RETURN
END IF
*
*
Quick
return if
possible
*
IF
(
N
.EQ.
0
)
THEN
WORK
(
1
)
=
1
RETURN
END IF
*
NX
=
N
IWS
=
1
IF
(
NB
.GT.
1
.AND.
NB
.LT.
N
)
THEN
*
*
Determine
when
to
cross
over
from
blocked
to
unblocked
code
*
(
last
block
is
always
handled
by
unblocked
code
)
.
*
NX
=
MAX
(
NB
,
ILAENV
(
3
,
'DSYTRD'
,
UPLO
,
N
,
-
1
,
-
1
,
-
1
)
)
IF
(
NX
.LT.
N
)
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
:
determine
the
*
minimum
value
of
NB
,
and
reduce
NB
or
force
use
of
*
unblocked
code
by
setting
NX
=
N
.
*
NB
=
MAX
(
LWORK
/
LDWORK
,
1
)
NBMIN
=
ILAENV
(
2
,
'DSYTRD'
,
UPLO
,
N
,
-
1
,
-
1
,
-
1
)
IF
(
NB
.LT.
NBMIN
)
$
NX
=
N
END IF
ELSE
NX
=
N
END IF
ELSE
NB
=
1
END IF
*
IF
(
UPPER
)
THEN
*
*
Reduce
the
upper
triangle
of
A
.
*
Columns
1
:
kk
are
handled
by
the
unblocked
method
.
*
KK
=
N
-
(
(
N
-
NX
+
NB
-
1
)
/
NB
)
*
NB
DO
20
I
=
N
-
NB
+
1
,
KK
+
1
,
-
NB
*
*
Reduce
columns
i
:
i
+
nb
-
1
to
tridiagonal
form
and
form
the
*
matrix
W
which
is
needed
to
update
the
unreduced
part
of
*
the
matrix
*
CALL
DLATRD
(
UPLO
,
I
+
NB
-
1
,
NB
,
A
,
LDA
,
E
,
TAU
,
WORK
,
$
LDWORK
)
*
*
Update
the
unreduced
submatrix
A
(
1
:
i
-
1
,
1
:
i
-
1
),
using
an
*
update
of
the
form
:
A
:
=
A
-
V
*
W
**
T
-
W
*
V
**
T
*
CALL
DSYR2K
(
UPLO
,
'No transpose'
,
I
-
1
,
NB
,
-
ONE
,
A
(
1
,
I
),
$
LDA
,
WORK
,
LDWORK
,
ONE
,
A
,
LDA
)
*
*
Copy
superdiagonal
elements
back
into
A
,
and
diagonal
*
elements
into
D
*
DO
10
J
=
I
,
I
+
NB
-
1
A
(
J
-
1
,
J
)
=
E
(
J
-
1
)
D
(
J
)
=
A
(
J
,
J
)
10
CONTINUE
20
CONTINUE
*
*
Use
unblocked
code
to
reduce
the
last
or
only
block
*
CALL
DSYTD2
(
UPLO
,
KK
,
A
,
LDA
,
D
,
E
,
TAU
,
IINFO
)
ELSE
*
*
Reduce
the
lower
triangle
of
A
*
DO
40
I
=
1
,
N
-
NX
,
NB
*
*
Reduce
columns
i
:
i
+
nb
-
1
to
tridiagonal
form
and
form
the
*
matrix
W
which
is
needed
to
update
the
unreduced
part
of
*
the
matrix
*
CALL
DLATRD
(
UPLO
,
N
-
I
+
1
,
NB
,
A
(
I
,
I
),
LDA
,
E
(
I
),
$
TAU
(
I
),
WORK
,
LDWORK
)
*
*
Update
the
unreduced
submatrix
A
(
i
+
ib
:
n
,
i
+
ib
:
n
),
using
*
an
update
of
the
form
:
A
:
=
A
-
V
*
W
**
T
-
W
*
V
**
T
*
CALL
DSYR2K
(
UPLO
,
'No transpose'
,
N
-
I
-
NB
+
1
,
NB
,
-
ONE
,
$
A
(
I
+
NB
,
I
),
LDA
,
WORK
(
NB
+
1
),
LDWORK
,
ONE
,
$
A
(
I
+
NB
,
I
+
NB
),
LDA
)
*
*
Copy
subdiagonal
elements
back
into
A
,
and
diagonal
*
elements
into
D
*
DO
30
J
=
I
,
I
+
NB
-
1
A
(
J
+
1
,
J
)
=
E
(
J
)
D
(
J
)
=
A
(
J
,
J
)
30
CONTINUE
40
CONTINUE
*
*
Use
unblocked
code
to
reduce
the
last
or
only
block
*
CALL
DSYTD2
(
UPLO
,
N
-
I
+
1
,
A
(
I
,
I
),
LDA
,
D
(
I
),
E
(
I
),
$
TAU
(
I
),
IINFO
)
END IF
*
WORK
(
1
)
=
LWKOPT
RETURN
*
*
End
of
DSYTRD
*
END
Event Timeline
Log In to Comment