Page Menu
Home
c4science
Search
Configure Global Search
Log In
Files
F80345837
dlasrt.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:41
Size
7 KB
Mime Type
text/html
Expires
Mon, Sep 2, 06:41 (1 d, 23 h)
Engine
blob
Format
Raw Data
Handle
20347793
Attached To
rLAMMPS lammps
dlasrt.f
View Options
*>
\
brief
\
b
DLASRT
sorts
numbers
in
increasing
or
decreasing
order
.
*
*
===========
DOCUMENTATION
===========
*
*
Online
html
documentation
available
at
*
http
:
//
www
.
netlib
.
org
/
lapack
/
explore
-
html
/
*
*>
\
htmlonly
*>
Download
DLASRT
+
dependencies
*>
<
a
href
=
"http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasrt.f"
>
*>
[
TGZ
]
</
a
>
*>
<
a
href
=
"http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasrt.f"
>
*>
[
ZIP
]
</
a
>
*>
<
a
href
=
"http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasrt.f"
>
*>
[
TXT
]
</
a
>
*>
\
endhtmlonly
*
*
Definition
:
*
===========
*
*
SUBROUTINE
DLASRT
(
ID
,
N
,
D
,
INFO
)
*
*
..
Scalar
Arguments
..
*
CHARACTER
ID
*
INTEGER
INFO
,
N
*
..
*
..
Array
Arguments
..
*
DOUBLE PRECISION
D
(
*
)
*
..
*
*
*>
\
par
Purpose
:
*
=============
*>
*>
\
verbatim
*>
*>
Sort
the
numbers
in
D
in
increasing
order
(
if
ID
=
'I'
)
or
*>
in
decreasing
order
(
if
ID
=
'D'
)
.
*>
*>
Use
Quick
Sort
,
reverting
to
Insertion
sort
on
arrays
of
*>
size
<=
2
0.
Dimension
of
STACK
limits
N
to
about
2
**
3
2.
*>
\
endverbatim
*
*
Arguments
:
*
==========
*
*>
\
param
[
in
]
ID
*>
\
verbatim
*>
ID
is
CHARACTER
*
1
*>
=
'I'
:
sort
D
in
increasing
order
;
*>
=
'D'
:
sort
D
in
decreasing
order
.
*>
\
endverbatim
*>
*>
\
param
[
in
]
N
*>
\
verbatim
*>
N
is
INTEGER
*>
The
length
of
the
array
D
.
*>
\
endverbatim
*>
*>
\
param
[
in
,
out
]
D
*>
\
verbatim
*>
D
is
DOUBLE PRECISION
array
,
dimension
(
N
)
*>
On
entry
,
the
array
to
be
sorted
.
*>
On
exit
,
D
has
been
sorted
into
increasing
order
*>
(
D
(
1
)
<=
...
<=
D
(
N
)
)
or
into
decreasing
order
*>
(
D
(
1
)
>=
...
>=
D
(
N
)
),
depending
on
ID
.
*>
\
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
*
*
=====================================================================
SUBROUTINE
DLASRT
(
ID
,
N
,
D
,
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
..
CHARACTER
ID
INTEGER
INFO
,
N
*
..
*
..
Array
Arguments
..
DOUBLE PRECISION
D
(
*
)
*
..
*
*
=====================================================================
*
*
..
Parameters
..
INTEGER
SELECT
PARAMETER
(
SELECT
=
20
)
*
..
*
..
Local
Scalars
..
INTEGER
DIR
,
ENDD
,
I
,
J
,
START
,
STKPNT
DOUBLE PRECISION
D1
,
D2
,
D3
,
DMNMX
,
TMP
*
..
*
..
Local
Arrays
..
INTEGER
STACK
(
2
,
32
)
*
..
*
..
External
Functions
..
LOGICAL
LSAME
EXTERNAL
LSAME
*
..
*
..
External
Subroutines
..
EXTERNAL
XERBLA
*
..
*
..
Executable
Statements
..
*
*
Test
the
input
paramters
.
*
INFO
=
0
DIR
=
-
1
IF
(
LSAME
(
ID
,
'D'
)
)
THEN
DIR
=
0
ELSE IF
(
LSAME
(
ID
,
'I'
)
)
THEN
DIR
=
1
END IF
IF
(
DIR
.EQ.
-
1
)
THEN
INFO
=
-
1
ELSE IF
(
N
.LT.
0
)
THEN
INFO
=
-
2
END IF
IF
(
INFO
.NE.
0
)
THEN
CALL
XERBLA
(
'DLASRT'
,
-
INFO
)
RETURN
END IF
*
*
Quick
return if
possible
*
IF
(
N
.LE.
1
)
$
RETURN
*
STKPNT
=
1
STACK
(
1
,
1
)
=
1
STACK
(
2
,
1
)
=
N
10
CONTINUE
START
=
STACK
(
1
,
STKPNT
)
ENDD
=
STACK
(
2
,
STKPNT
)
STKPNT
=
STKPNT
-
1
IF
(
ENDD
-
START
.LE.
SELECT
.AND.
ENDD
-
START
.GT.
0
)
THEN
*
*
Do
Insertion
sort
on
D
(
START
:
ENDD
)
*
IF
(
DIR
.EQ.
0
)
THEN
*
*
Sort
into
decreasing
order
*
DO
30
I
=
START
+
1
,
ENDD
DO
20
J
=
I
,
START
+
1
,
-
1
IF
(
D
(
J
)
.GT.
D
(
J
-
1
)
)
THEN
DMNMX
=
D
(
J
)
D
(
J
)
=
D
(
J
-
1
)
D
(
J
-
1
)
=
DMNMX
ELSE
GO
TO
30
END IF
20
CONTINUE
30
CONTINUE
*
ELSE
*
*
Sort
into
increasing
order
*
DO
50
I
=
START
+
1
,
ENDD
DO
40
J
=
I
,
START
+
1
,
-
1
IF
(
D
(
J
)
.LT.
D
(
J
-
1
)
)
THEN
DMNMX
=
D
(
J
)
D
(
J
)
=
D
(
J
-
1
)
D
(
J
-
1
)
=
DMNMX
ELSE
GO
TO
50
END IF
40
CONTINUE
50
CONTINUE
*
END IF
*
ELSE IF
(
ENDD
-
START
.GT.
SELECT
)
THEN
*
*
Partition
D
(
START
:
ENDD
)
and
stack
parts
,
largest
one
first
*
*
Choose
partition
entry
as
median
of
3
*
D1
=
D
(
START
)
D2
=
D
(
ENDD
)
I
=
(
START
+
ENDD
)
/
2
D3
=
D
(
I
)
IF
(
D1
.LT.
D2
)
THEN
IF
(
D3
.LT.
D1
)
THEN
DMNMX
=
D1
ELSE IF
(
D3
.LT.
D2
)
THEN
DMNMX
=
D3
ELSE
DMNMX
=
D2
END IF
ELSE
IF
(
D3
.LT.
D2
)
THEN
DMNMX
=
D2
ELSE IF
(
D3
.LT.
D1
)
THEN
DMNMX
=
D3
ELSE
DMNMX
=
D1
END IF
END IF
*
IF
(
DIR
.EQ.
0
)
THEN
*
*
Sort
into
decreasing
order
*
I
=
START
-
1
J
=
ENDD
+
1
60
CONTINUE
70
CONTINUE
J
=
J
-
1
IF
(
D
(
J
)
.LT.
DMNMX
)
$
GO
TO
70
80
CONTINUE
I
=
I
+
1
IF
(
D
(
I
)
.GT.
DMNMX
)
$
GO
TO
80
IF
(
I
.LT.
J
)
THEN
TMP
=
D
(
I
)
D
(
I
)
=
D
(
J
)
D
(
J
)
=
TMP
GO
TO
60
END IF
IF
(
J
-
START
.GT.
ENDD
-
J
-
1
)
THEN
STKPNT
=
STKPNT
+
1
STACK
(
1
,
STKPNT
)
=
START
STACK
(
2
,
STKPNT
)
=
J
STKPNT
=
STKPNT
+
1
STACK
(
1
,
STKPNT
)
=
J
+
1
STACK
(
2
,
STKPNT
)
=
ENDD
ELSE
STKPNT
=
STKPNT
+
1
STACK
(
1
,
STKPNT
)
=
J
+
1
STACK
(
2
,
STKPNT
)
=
ENDD
STKPNT
=
STKPNT
+
1
STACK
(
1
,
STKPNT
)
=
START
STACK
(
2
,
STKPNT
)
=
J
END IF
ELSE
*
*
Sort
into
increasing
order
*
I
=
START
-
1
J
=
ENDD
+
1
90
CONTINUE
100
CONTINUE
J
=
J
-
1
IF
(
D
(
J
)
.GT.
DMNMX
)
$
GO
TO
100
110
CONTINUE
I
=
I
+
1
IF
(
D
(
I
)
.LT.
DMNMX
)
$
GO
TO
110
IF
(
I
.LT.
J
)
THEN
TMP
=
D
(
I
)
D
(
I
)
=
D
(
J
)
D
(
J
)
=
TMP
GO
TO
90
END IF
IF
(
J
-
START
.GT.
ENDD
-
J
-
1
)
THEN
STKPNT
=
STKPNT
+
1
STACK
(
1
,
STKPNT
)
=
START
STACK
(
2
,
STKPNT
)
=
J
STKPNT
=
STKPNT
+
1
STACK
(
1
,
STKPNT
)
=
J
+
1
STACK
(
2
,
STKPNT
)
=
ENDD
ELSE
STKPNT
=
STKPNT
+
1
STACK
(
1
,
STKPNT
)
=
J
+
1
STACK
(
2
,
STKPNT
)
=
ENDD
STKPNT
=
STKPNT
+
1
STACK
(
1
,
STKPNT
)
=
START
STACK
(
2
,
STKPNT
)
=
J
END IF
END IF
END IF
IF
(
STKPNT
.GT.
0
)
$
GO
TO
10
RETURN
*
*
End
of
DLASRT
*
END
Event Timeline
Log In to Comment