Page Menu
Home
c4science
Search
Configure Global Search
Log In
Files
F79879035
dlasq4.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 28, 18:32
Size
11 KB
Mime Type
text/html
Expires
Fri, Aug 30, 18:32 (2 d)
Engine
blob
Format
Raw Data
Handle
20165193
Attached To
rLAMMPS lammps
dlasq4.f
View Options
*>
\
brief
\
b
DLASQ4
computes
an
approximation
to
the
smallest
eigenvalue
using
values
of
d
from
the
previous
transform
.
Used
by
sbdsqr
.
*
*
===========
DOCUMENTATION
===========
*
*
Online
html
documentation
available
at
*
http
:
//
www
.
netlib
.
org
/
lapack
/
explore
-
html
/
*
*>
\
htmlonly
*>
Download
DLASQ4
+
dependencies
*>
<
a
href
=
"http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasq4.f"
>
*>
[
TGZ
]
</
a
>
*>
<
a
href
=
"http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasq4.f"
>
*>
[
ZIP
]
</
a
>
*>
<
a
href
=
"http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasq4.f"
>
*>
[
TXT
]
</
a
>
*>
\
endhtmlonly
*
*
Definition
:
*
===========
*
*
SUBROUTINE
DLASQ4
(
I0
,
N0
,
Z
,
PP
,
N0IN
,
DMIN
,
DMIN1
,
DMIN2
,
DN
,
*
DN1
,
DN2
,
TAU
,
TTYPE
,
G
)
*
*
..
Scalar
Arguments
..
*
INTEGER
I0
,
N0
,
N0IN
,
PP
,
TTYPE
*
DOUBLE PRECISION
DMIN
,
DMIN1
,
DMIN2
,
DN
,
DN1
,
DN2
,
G
,
TAU
*
..
*
..
Array
Arguments
..
*
DOUBLE PRECISION
Z
(
*
)
*
..
*
*
*>
\
par
Purpose
:
*
=============
*>
*>
\
verbatim
*>
*>
DLASQ4
computes
an
approximation
TAU
to
the
smallest
eigenvalue
*>
using
values
of
d
from
the
previous
transform
.
*>
\
endverbatim
*
*
Arguments
:
*
==========
*
*>
\
param
[
in
]
I0
*>
\
verbatim
*>
I0
is
INTEGER
*>
First
index
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
N0
*>
\
verbatim
*>
N0
is
INTEGER
*>
Last
index
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
Z
*>
\
verbatim
*>
Z
is
DOUBLE PRECISION
array
,
dimension
(
4
*
N
)
*>
Z
holds
the
qd
array
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
PP
*>
\
verbatim
*>
PP
is
INTEGER
*>
PP
=
0
for
ping
,
PP
=
1
for
pong
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
N0IN
*>
\
verbatim
*>
N0IN
is
INTEGER
*>
The
value
of
N0
at
start
of
EIGTEST
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
DMIN
*>
\
verbatim
*>
DMIN
is
DOUBLE PRECISION
*>
Minimum
value
of
d
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
DMIN1
*>
\
verbatim
*>
DMIN1
is
DOUBLE PRECISION
*>
Minimum
value
of
d
,
excluding
D
(
N0
)
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
DMIN2
*>
\
verbatim
*>
DMIN2
is
DOUBLE PRECISION
*>
Minimum
value
of
d
,
excluding
D
(
N0
)
and
D
(
N0
-
1
)
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
DN
*>
\
verbatim
*>
DN
is
DOUBLE PRECISION
*>
d
(
N
)
*>
\
endverbatim
*>
*>
\
param
[
in
]
DN1
*>
\
verbatim
*>
DN1
is
DOUBLE PRECISION
*>
d
(
N
-
1
)
*>
\
endverbatim
*>
*>
\
param
[
in
]
DN2
*>
\
verbatim
*>
DN2
is
DOUBLE PRECISION
*>
d
(
N
-
2
)
*>
\
endverbatim
*>
*>
\
param
[
out
]
TAU
*>
\
verbatim
*>
TAU
is
DOUBLE PRECISION
*>
This
is
the
shift
.
*>
\
endverbatim
*>
*>
\
param
[
out
]
TTYPE
*>
\
verbatim
*>
TTYPE
is
INTEGER
*>
Shift
type
.
*>
\
endverbatim
*>
*>
\
param
[
in
,
out
]
G
*>
\
verbatim
*>
G
is
REAL
*>
G
is
passed
as
an
argument
in
order
to
save
its
value
between
*>
calls
to
DLASQ4
.
*>
\
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
Further
Details
:
*
=====================
*>
*>
\
verbatim
*>
*>
CNST1
=
9
/
16
*>
\
endverbatim
*>
*
=====================================================================
SUBROUTINE
DLASQ4
(
I0
,
N0
,
Z
,
PP
,
N0IN
,
DMIN
,
DMIN1
,
DMIN2
,
DN
,
$
DN1
,
DN2
,
TAU
,
TTYPE
,
G
)
*
*
--
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
I0
,
N0
,
N0IN
,
PP
,
TTYPE
DOUBLE PRECISION
DMIN
,
DMIN1
,
DMIN2
,
DN
,
DN1
,
DN2
,
G
,
TAU
*
..
*
..
Array
Arguments
..
DOUBLE PRECISION
Z
(
*
)
*
..
*
*
=====================================================================
*
*
..
Parameters
..
DOUBLE PRECISION
CNST1
,
CNST2
,
CNST3
PARAMETER
(
CNST1
=
0.5630
D0
,
CNST2
=
1.010
D0
,
$
CNST3
=
1.050
D0
)
DOUBLE PRECISION
QURTR
,
THIRD
,
HALF
,
ZERO
,
ONE
,
TWO
,
HUNDRD
PARAMETER
(
QURTR
=
0.250
D0
,
THIRD
=
0.3330
D0
,
$
HALF
=
0.50
D0
,
ZERO
=
0.0
D0
,
ONE
=
1.0
D0
,
$
TWO
=
2.0
D0
,
HUNDRD
=
10
0.0
D0
)
*
..
*
..
Local
Scalars
..
INTEGER
I4
,
NN
,
NP
DOUBLE PRECISION
A2
,
B1
,
B2
,
GAM
,
GAP1
,
GAP2
,
S
*
..
*
..
Intrinsic
Functions
..
INTRINSIC
MAX
,
MIN
,
SQRT
*
..
*
..
Executable
Statements
..
*
*
A
negative
DMIN
forces
the
shift
to
take
that
absolute
value
*
TTYPE
records
the
type
of
shift
.
*
IF
(
DMIN
.LE.
ZERO
)
THEN
TAU
=
-
DMIN
TTYPE
=
-
1
RETURN
END IF
*
NN
=
4
*
N0
+
PP
IF
(
N0IN
.EQ.
N0
)
THEN
*
*
No
eigenvalues
deflated
.
*
IF
(
DMIN
.EQ.
DN
.OR.
DMIN
.EQ.
DN1
)
THEN
*
B1
=
SQRT
(
Z
(
NN
-
3
)
)
*
SQRT
(
Z
(
NN
-
5
)
)
B2
=
SQRT
(
Z
(
NN
-
7
)
)
*
SQRT
(
Z
(
NN
-
9
)
)
A2
=
Z
(
NN
-
7
)
+
Z
(
NN
-
5
)
*
*
Cases
2
and
3.
*
IF
(
DMIN
.EQ.
DN
.AND.
DMIN1
.EQ.
DN1
)
THEN
GAP2
=
DMIN2
-
A2
-
DMIN2
*
QURTR
IF
(
GAP2
.GT.
ZERO
.AND.
GAP2
.GT.
B2
)
THEN
GAP1
=
A2
-
DN
-
(
B2
/
GAP2
)
*
B2
ELSE
GAP1
=
A2
-
DN
-
(
B1
+
B2
)
END IF
IF
(
GAP1
.GT.
ZERO
.AND.
GAP1
.GT.
B1
)
THEN
S
=
MAX
(
DN
-
(
B1
/
GAP1
)
*
B1
,
HALF
*
DMIN
)
TTYPE
=
-
2
ELSE
S
=
ZERO
IF
(
DN
.GT.
B1
)
$
S
=
DN
-
B1
IF
(
A2
.GT.
(
B1
+
B2
)
)
$
S
=
MIN
(
S
,
A2
-
(
B1
+
B2
)
)
S
=
MAX
(
S
,
THIRD
*
DMIN
)
TTYPE
=
-
3
END IF
ELSE
*
*
Case
4.
*
TTYPE
=
-
4
S
=
QURTR
*
DMIN
IF
(
DMIN
.EQ.
DN
)
THEN
GAM
=
DN
A2
=
ZERO
IF
(
Z
(
NN
-
5
)
.GT.
Z
(
NN
-
7
)
)
$
RETURN
B2
=
Z
(
NN
-
5
)
/
Z
(
NN
-
7
)
NP
=
NN
-
9
ELSE
NP
=
NN
-
2
*
PP
B2
=
Z
(
NP
-
2
)
GAM
=
DN1
IF
(
Z
(
NP
-
4
)
.GT.
Z
(
NP
-
2
)
)
$
RETURN
A2
=
Z
(
NP
-
4
)
/
Z
(
NP
-
2
)
IF
(
Z
(
NN
-
9
)
.GT.
Z
(
NN
-
11
)
)
$
RETURN
B2
=
Z
(
NN
-
9
)
/
Z
(
NN
-
11
)
NP
=
NN
-
13
END IF
*
*
Approximate
contribution
to
norm
squared
from
I
<
NN
-
1.
*
A2
=
A2
+
B2
DO
10
I4
=
NP
,
4
*
I0
-
1
+
PP
,
-
4
IF
(
B2
.EQ.
ZERO
)
$
GO
TO
20
B1
=
B2
IF
(
Z
(
I4
)
.GT.
Z
(
I4
-
2
)
)
$
RETURN
B2
=
B2
*
(
Z
(
I4
)
/
Z
(
I4
-
2
)
)
A2
=
A2
+
B2
IF
(
HUNDRD
*
MAX
(
B2
,
B1
)
.LT.
A2
.OR.
CNST1
.LT.
A2
)
$
GO
TO
20
10
CONTINUE
20
CONTINUE
A2
=
CNST3
*
A2
*
*
Rayleigh
quotient
residual
bound
.
*
IF
(
A2
.LT.
CNST1
)
$
S
=
GAM
*
(
ONE
-
SQRT
(
A2
)
)
/
(
ONE
+
A2
)
END IF
ELSE IF
(
DMIN
.EQ.
DN2
)
THEN
*
*
Case
5.
*
TTYPE
=
-
5
S
=
QURTR
*
DMIN
*
*
Compute
contribution
to
norm
squared
from
I
>
NN
-
2.
*
NP
=
NN
-
2
*
PP
B1
=
Z
(
NP
-
2
)
B2
=
Z
(
NP
-
6
)
GAM
=
DN2
IF
(
Z
(
NP
-
8
)
.GT.
B2
.OR.
Z
(
NP
-
4
)
.GT.
B1
)
$
RETURN
A2
=
(
Z
(
NP
-
8
)
/
B2
)
*
(
ONE
+
Z
(
NP
-
4
)
/
B1
)
*
*
Approximate
contribution
to
norm
squared
from
I
<
NN
-
2.
*
IF
(
N0
-
I0
.GT.
2
)
THEN
B2
=
Z
(
NN
-
13
)
/
Z
(
NN
-
15
)
A2
=
A2
+
B2
DO
30
I4
=
NN
-
17
,
4
*
I0
-
1
+
PP
,
-
4
IF
(
B2
.EQ.
ZERO
)
$
GO
TO
40
B1
=
B2
IF
(
Z
(
I4
)
.GT.
Z
(
I4
-
2
)
)
$
RETURN
B2
=
B2
*
(
Z
(
I4
)
/
Z
(
I4
-
2
)
)
A2
=
A2
+
B2
IF
(
HUNDRD
*
MAX
(
B2
,
B1
)
.LT.
A2
.OR.
CNST1
.LT.
A2
)
$
GO
TO
40
30
CONTINUE
40
CONTINUE
A2
=
CNST3
*
A2
END IF
*
IF
(
A2
.LT.
CNST1
)
$
S
=
GAM
*
(
ONE
-
SQRT
(
A2
)
)
/
(
ONE
+
A2
)
ELSE
*
*
Case
6
,
no
information
to
guide
us
.
*
IF
(
TTYPE
.EQ.
-
6
)
THEN
G
=
G
+
THIRD
*
(
ONE
-
G
)
ELSE IF
(
TTYPE
.EQ.
-
18
)
THEN
G
=
QURTR
*
THIRD
ELSE
G
=
QURTR
END IF
S
=
G
*
DMIN
TTYPE
=
-
6
END IF
*
ELSE IF
(
N0IN
.EQ.
(
N0
+
1
)
)
THEN
*
*
One
eigenvalue
just
deflated
.
Use
DMIN1
,
DN1
for
DMIN and
DN
.
*
IF
(
DMIN1
.EQ.
DN1
.AND.
DMIN2
.EQ.
DN2
)
THEN
*
*
Cases
7
and
8.
*
TTYPE
=
-
7
S
=
THIRD
*
DMIN1
IF
(
Z
(
NN
-
5
)
.GT.
Z
(
NN
-
7
)
)
$
RETURN
B1
=
Z
(
NN
-
5
)
/
Z
(
NN
-
7
)
B2
=
B1
IF
(
B2
.EQ.
ZERO
)
$
GO
TO
60
DO
50
I4
=
4
*
N0
-
9
+
PP
,
4
*
I0
-
1
+
PP
,
-
4
A2
=
B1
IF
(
Z
(
I4
)
.GT.
Z
(
I4
-
2
)
)
$
RETURN
B1
=
B1
*
(
Z
(
I4
)
/
Z
(
I4
-
2
)
)
B2
=
B2
+
B1
IF
(
HUNDRD
*
MAX
(
B1
,
A2
)
.LT.
B2
)
$
GO
TO
60
50
CONTINUE
60
CONTINUE
B2
=
SQRT
(
CNST3
*
B2
)
A2
=
DMIN1
/
(
ONE
+
B2
**
2
)
GAP2
=
HALF
*
DMIN2
-
A2
IF
(
GAP2
.GT.
ZERO
.AND.
GAP2
.GT.
B2
*
A2
)
THEN
S
=
MAX
(
S
,
A2
*
(
ONE
-
CNST2
*
A2
*
(
B2
/
GAP2
)
*
B2
)
)
ELSE
S
=
MAX
(
S
,
A2
*
(
ONE
-
CNST2
*
B2
)
)
TTYPE
=
-
8
END IF
ELSE
*
*
Case
9.
*
S
=
QURTR
*
DMIN1
IF
(
DMIN1
.EQ.
DN1
)
$
S
=
HALF
*
DMIN1
TTYPE
=
-
9
END IF
*
ELSE IF
(
N0IN
.EQ.
(
N0
+
2
)
)
THEN
*
*
Two
eigenvalues
deflated
.
Use
DMIN2
,
DN2
for
DMIN and
DN
.
*
*
Cases
10
and
1
1.
*
IF
(
DMIN2
.EQ.
DN2
.AND.
TWO
*
Z
(
NN
-
5
)
.LT.
Z
(
NN
-
7
)
)
THEN
TTYPE
=
-
10
S
=
THIRD
*
DMIN2
IF
(
Z
(
NN
-
5
)
.GT.
Z
(
NN
-
7
)
)
$
RETURN
B1
=
Z
(
NN
-
5
)
/
Z
(
NN
-
7
)
B2
=
B1
IF
(
B2
.EQ.
ZERO
)
$
GO
TO
80
DO
70
I4
=
4
*
N0
-
9
+
PP
,
4
*
I0
-
1
+
PP
,
-
4
IF
(
Z
(
I4
)
.GT.
Z
(
I4
-
2
)
)
$
RETURN
B1
=
B1
*
(
Z
(
I4
)
/
Z
(
I4
-
2
)
)
B2
=
B2
+
B1
IF
(
HUNDRD
*
B1
.LT.
B2
)
$
GO
TO
80
70
CONTINUE
80
CONTINUE
B2
=
SQRT
(
CNST3
*
B2
)
A2
=
DMIN2
/
(
ONE
+
B2
**
2
)
GAP2
=
Z
(
NN
-
7
)
+
Z
(
NN
-
9
)
-
$
SQRT
(
Z
(
NN
-
11
)
)
*
SQRT
(
Z
(
NN
-
9
)
)
-
A2
IF
(
GAP2
.GT.
ZERO
.AND.
GAP2
.GT.
B2
*
A2
)
THEN
S
=
MAX
(
S
,
A2
*
(
ONE
-
CNST2
*
A2
*
(
B2
/
GAP2
)
*
B2
)
)
ELSE
S
=
MAX
(
S
,
A2
*
(
ONE
-
CNST2
*
B2
)
)
END IF
ELSE
S
=
QURTR
*
DMIN2
TTYPE
=
-
11
END IF
ELSE IF
(
N0IN
.GT.
(
N0
+
2
)
)
THEN
*
*
Case
12
,
more
than
two
eigenvalues
deflated
.
No
information
.
*
S
=
ZERO
TTYPE
=
-
12
END IF
*
TAU
=
S
RETURN
*
*
End
of
DLASQ4
*
END
Event Timeline
Log In to Comment