Page Menu
Home
c4science
Search
Configure Global Search
Log In
Files
F76419661
dlaeda.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
Wed, Aug 7, 20:55
Size
9 KB
Mime Type
text/html
Expires
Fri, Aug 9, 20:55 (2 d)
Engine
blob
Format
Raw Data
Handle
19601723
Attached To
rLAMMPS lammps
dlaeda.f
View Options
*>
\
brief
\
b
DLAEDA
used
by
sstedc
.
Computes
the
Z
vector
determining
the
rank
-
one
modification
of
the
diagonal
matrix
.
Used
when
the
original
matrix
is
dense
.
*
*
===========
DOCUMENTATION
===========
*
*
Online
html
documentation
available
at
*
http
:
//
www
.
netlib
.
org
/
lapack
/
explore
-
html
/
*
*>
\
htmlonly
*>
Download
DLAEDA
+
dependencies
*>
<
a
href
=
"http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlaeda.f"
>
*>
[
TGZ
]
</
a
>
*>
<
a
href
=
"http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlaeda.f"
>
*>
[
ZIP
]
</
a
>
*>
<
a
href
=
"http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlaeda.f"
>
*>
[
TXT
]
</
a
>
*>
\
endhtmlonly
*
*
Definition
:
*
===========
*
*
SUBROUTINE
DLAEDA
(
N
,
TLVLS
,
CURLVL
,
CURPBM
,
PRMPTR
,
PERM
,
GIVPTR
,
*
GIVCOL
,
GIVNUM
,
Q
,
QPTR
,
Z
,
ZTEMP
,
INFO
)
*
*
..
Scalar
Arguments
..
*
INTEGER
CURLVL
,
CURPBM
,
INFO
,
N
,
TLVLS
*
..
*
..
Array
Arguments
..
*
INTEGER
GIVCOL
(
2
,
*
),
GIVPTR
(
*
),
PERM
(
*
),
*
$
PRMPTR
(
*
),
QPTR
(
*
)
*
DOUBLE PRECISION
GIVNUM
(
2
,
*
),
Q
(
*
),
Z
(
*
),
ZTEMP
(
*
)
*
..
*
*
*>
\
par
Purpose
:
*
=============
*>
*>
\
verbatim
*>
*>
DLAEDA
computes
the
Z
vector
corresponding
to
the
merge
step
in
the
*>
CURLVLth
step
of
the
merge
process
with
TLVLS
steps
for
the
CURPBMth
*>
problem
.
*>
\
endverbatim
*
*
Arguments
:
*
==========
*
*>
\
param
[
in
]
N
*>
\
verbatim
*>
N
is
INTEGER
*>
The
dimension
of
the
symmetric
tridiagonal
matrix
.
N
>=
0.
*>
\
endverbatim
*>
*>
\
param
[
in
]
TLVLS
*>
\
verbatim
*>
TLVLS
is
INTEGER
*>
The
total
number
of
merging
levels
in
the
overall
divide
and
*>
conquer
tree
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
CURLVL
*>
\
verbatim
*>
CURLVL
is
INTEGER
*>
The
current
level
in
the
overall
merge
routine
,
*>
0
<=
curlvl
<=
tlvls
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
CURPBM
*>
\
verbatim
*>
CURPBM
is
INTEGER
*>
The
current
problem
in
the
current
level
in
the
overall
*>
merge
routine
(
counting
from
upper
left
to
lower
right
)
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
PRMPTR
*>
\
verbatim
*>
PRMPTR
is
INTEGER
array
,
dimension
(
N
lg
N
)
*>
Contains
a
list
of
pointers
which
indicate
where
in
PERM
a
*>
level
's permutation is stored. PRMPTR(i+1) - PRMPTR(i)
*> indicates the size of the permutation and incidentally the
*> size of the full, non-deflated problem.
*> \endverbatim
*>
*> \param[in] PERM
*> \verbatim
*> PERM is INTEGER array, dimension (N lg N)
*> Contains the permutations (from deflation and sorting) to be
*> applied to each eigenblock.
*> \endverbatim
*>
*> \param[in] GIVPTR
*> \verbatim
*> GIVPTR is INTEGER array, dimension (N lg N)
*> Contains a list of pointers which indicate where in GIVCOL a
*> level'
s
Givens
rotations
are
stored
.
GIVPTR
(
i
+
1
)
-
GIVPTR
(
i
)
*>
indicates
the
number
of
Givens
rotations
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
GIVCOL
*>
\
verbatim
*>
GIVCOL
is
INTEGER
array
,
dimension
(
2
,
N
lg
N
)
*>
Each
pair
of
numbers
indicates
a
pair
of
columns
to
take
place
*>
in
a
Givens
rotation
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
GIVNUM
*>
\
verbatim
*>
GIVNUM
is
DOUBLE PRECISION
array
,
dimension
(
2
,
N
lg
N
)
*>
Each
number
indicates
the
S
value
to
be
used
in
the
*>
corresponding
Givens
rotation
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
Q
*>
\
verbatim
*>
Q
is
DOUBLE PRECISION
array
,
dimension
(
N
**
2
)
*>
Contains
the
square
eigenblocks
from
previous
levels
,
the
*>
starting
positions
for
blocks
are
given
by
QPTR
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
QPTR
*>
\
verbatim
*>
QPTR
is
INTEGER
array
,
dimension
(
N
+
2
)
*>
Contains
a
list
of
pointers
which
indicate
where
in
Q
an
*>
eigenblock
is
stored
.
SQRT
(
QPTR
(
i
+
1
)
-
QPTR
(
i
)
)
indicates
*>
the
size
of
the
block
.
*>
\
endverbatim
*>
*>
\
param
[
out
]
Z
*>
\
verbatim
*>
Z
is
DOUBLE PRECISION
array
,
dimension
(
N
)
*>
On
output
this
vector
contains
the
updating
vector
(
the
last
*>
row
of
the
first
sub
-
eigenvector
matrix
and
the
first
row
of
*>
the
second
sub
-
eigenvector
matrix
)
.
*>
\
endverbatim
*>
*>
\
param
[
out
]
ZTEMP
*>
\
verbatim
*>
ZTEMP
is
DOUBLE PRECISION
array
,
dimension
(
N
)
*>
\
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
September
2012
*
*>
\
ingroup
auxOTHERcomputational
*
*>
\
par
Contributors
:
*
==================
*>
*>
Jeff
Rutter
,
Computer
Science
Division
,
University
of
California
*>
at
Berkeley
,
USA
*
*
=====================================================================
SUBROUTINE
DLAEDA
(
N
,
TLVLS
,
CURLVL
,
CURPBM
,
PRMPTR
,
PERM
,
GIVPTR
,
$
GIVCOL
,
GIVNUM
,
Q
,
QPTR
,
Z
,
ZTEMP
,
INFO
)
*
*
--
LAPACK
computational
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
..
INTEGER
CURLVL
,
CURPBM
,
INFO
,
N
,
TLVLS
*
..
*
..
Array
Arguments
..
INTEGER
GIVCOL
(
2
,
*
),
GIVPTR
(
*
),
PERM
(
*
),
$
PRMPTR
(
*
),
QPTR
(
*
)
DOUBLE PRECISION
GIVNUM
(
2
,
*
),
Q
(
*
),
Z
(
*
),
ZTEMP
(
*
)
*
..
*
*
=====================================================================
*
*
..
Parameters
..
DOUBLE PRECISION
ZERO
,
HALF
,
ONE
PARAMETER
(
ZERO
=
0.0
D0
,
HALF
=
0.5
D0
,
ONE
=
1.0
D0
)
*
..
*
..
Local
Scalars
..
INTEGER
BSIZ1
,
BSIZ2
,
CURR
,
I
,
K
,
MID
,
PSIZ1
,
PSIZ2
,
$
PTR
,
ZPTR1
*
..
*
..
External
Subroutines
..
EXTERNAL
DCOPY
,
DGEMV
,
DROT
,
XERBLA
*
..
*
..
Intrinsic
Functions
..
INTRINSIC
DBLE
,
INT
,
SQRT
*
..
*
..
Executable
Statements
..
*
*
Test
the
input
parameters
.
*
INFO
=
0
*
IF
(
N
.LT.
0
)
THEN
INFO
=
-
1
END IF
IF
(
INFO
.NE.
0
)
THEN
CALL
XERBLA
(
'DLAEDA'
,
-
INFO
)
RETURN
END IF
*
*
Quick
return if
possible
*
IF
(
N
.EQ.
0
)
$
RETURN
*
*
Determine
location
of
first
number
in
second
half
.
*
MID
=
N
/
2
+
1
*
*
Gather
last
/
first
rows
of
appropriate
eigenblocks
into
center
of
Z
*
PTR
=
1
*
*
Determine
location
of
lowest
level
subproblem
in
the
full
storage
*
scheme
*
CURR
=
PTR
+
CURPBM
*
2
**
CURLVL
+
2
**
(
CURLVL
-
1
)
-
1
*
*
Determine
size
of
these
matrices
.
We
add
HALF
to
the
value
of
*
the
SQRT
in
case
the
machine
underestimates
one
of
these
square
*
roots
.
*
BSIZ1
=
INT
(
HALF
+
SQRT
(
DBLE
(
QPTR
(
CURR
+
1
)
-
QPTR
(
CURR
)
)
)
)
BSIZ2
=
INT
(
HALF
+
SQRT
(
DBLE
(
QPTR
(
CURR
+
2
)
-
QPTR
(
CURR
+
1
)
)
)
)
DO
10
K
=
1
,
MID
-
BSIZ1
-
1
Z
(
K
)
=
ZERO
10
CONTINUE
CALL
DCOPY
(
BSIZ1
,
Q
(
QPTR
(
CURR
)
+
BSIZ1
-
1
),
BSIZ1
,
$
Z
(
MID
-
BSIZ1
),
1
)
CALL
DCOPY
(
BSIZ2
,
Q
(
QPTR
(
CURR
+
1
)
),
BSIZ2
,
Z
(
MID
),
1
)
DO
20
K
=
MID
+
BSIZ2
,
N
Z
(
K
)
=
ZERO
20
CONTINUE
*
*
Loop
through
remaining
levels
1
->
CURLVL
applying
the
Givens
*
rotations
and
permutation
and
then
multiplying
the
center
matrices
*
against
the
current
Z
.
*
PTR
=
2
**
TLVLS
+
1
DO
70
K
=
1
,
CURLVL
-
1
CURR
=
PTR
+
CURPBM
*
2
**
(
CURLVL
-
K
)
+
2
**
(
CURLVL
-
K
-
1
)
-
1
PSIZ1
=
PRMPTR
(
CURR
+
1
)
-
PRMPTR
(
CURR
)
PSIZ2
=
PRMPTR
(
CURR
+
2
)
-
PRMPTR
(
CURR
+
1
)
ZPTR1
=
MID
-
PSIZ1
*
*
Apply
Givens
at
CURR
and
CURR
+
1
*
DO
30
I
=
GIVPTR
(
CURR
),
GIVPTR
(
CURR
+
1
)
-
1
CALL
DROT
(
1
,
Z
(
ZPTR1
+
GIVCOL
(
1
,
I
)
-
1
),
1
,
$
Z
(
ZPTR1
+
GIVCOL
(
2
,
I
)
-
1
),
1
,
GIVNUM
(
1
,
I
),
$
GIVNUM
(
2
,
I
)
)
30
CONTINUE
DO
40
I
=
GIVPTR
(
CURR
+
1
),
GIVPTR
(
CURR
+
2
)
-
1
CALL
DROT
(
1
,
Z
(
MID
-
1
+
GIVCOL
(
1
,
I
)
),
1
,
$
Z
(
MID
-
1
+
GIVCOL
(
2
,
I
)
),
1
,
GIVNUM
(
1
,
I
),
$
GIVNUM
(
2
,
I
)
)
40
CONTINUE
PSIZ1
=
PRMPTR
(
CURR
+
1
)
-
PRMPTR
(
CURR
)
PSIZ2
=
PRMPTR
(
CURR
+
2
)
-
PRMPTR
(
CURR
+
1
)
DO
50
I
=
0
,
PSIZ1
-
1
ZTEMP
(
I
+
1
)
=
Z
(
ZPTR1
+
PERM
(
PRMPTR
(
CURR
)
+
I
)
-
1
)
50
CONTINUE
DO
60
I
=
0
,
PSIZ2
-
1
ZTEMP
(
PSIZ1
+
I
+
1
)
=
Z
(
MID
+
PERM
(
PRMPTR
(
CURR
+
1
)
+
I
)
-
1
)
60
CONTINUE
*
*
Multiply
Blocks
at
CURR
and
CURR
+
1
*
*
Determine
size
of
these
matrices
.
We
add
HALF
to
the
value
of
*
the
SQRT
in
case
the
machine
underestimates
one
of
these
*
square
roots
.
*
BSIZ1
=
INT
(
HALF
+
SQRT
(
DBLE
(
QPTR
(
CURR
+
1
)
-
QPTR
(
CURR
)
)
)
)
BSIZ2
=
INT
(
HALF
+
SQRT
(
DBLE
(
QPTR
(
CURR
+
2
)
-
QPTR
(
CURR
+
$
1
)
)
)
)
IF
(
BSIZ1
.GT.
0
)
THEN
CALL
DGEMV
(
'T'
,
BSIZ1
,
BSIZ1
,
ONE
,
Q
(
QPTR
(
CURR
)
),
$
BSIZ1
,
ZTEMP
(
1
),
1
,
ZERO
,
Z
(
ZPTR1
),
1
)
END IF
CALL
DCOPY
(
PSIZ1
-
BSIZ1
,
ZTEMP
(
BSIZ1
+
1
),
1
,
Z
(
ZPTR1
+
BSIZ1
),
$
1
)
IF
(
BSIZ2
.GT.
0
)
THEN
CALL
DGEMV
(
'T'
,
BSIZ2
,
BSIZ2
,
ONE
,
Q
(
QPTR
(
CURR
+
1
)
),
$
BSIZ2
,
ZTEMP
(
PSIZ1
+
1
),
1
,
ZERO
,
Z
(
MID
),
1
)
END IF
CALL
DCOPY
(
PSIZ2
-
BSIZ2
,
ZTEMP
(
PSIZ1
+
BSIZ2
+
1
),
1
,
$
Z
(
MID
+
BSIZ2
),
1
)
*
PTR
=
PTR
+
2
**
(
TLVLS
-
K
)
70
CONTINUE
*
RETURN
*
*
End
of
DLAEDA
*
END
Event Timeline
Log In to Comment