LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
slamrg.f
Go to the documentation of this file.
1*> \brief \b SLAMRG creates a permutation list to merge the entries of two independently sorted sets into a single set sorted in ascending order.
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> Download SLAMRG + dependencies
9*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slamrg.f">
10*> [TGZ]</a>
11*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slamrg.f">
12*> [ZIP]</a>
13*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slamrg.f">
14*> [TXT]</a>
15*
16* Definition:
17* ===========
18*
19* SUBROUTINE SLAMRG( N1, N2, A, STRD1, STRD2, INDEX )
20*
21* .. Scalar Arguments ..
22* INTEGER N1, N2, STRD1, STRD2
23* ..
24* .. Array Arguments ..
25* INTEGER INDEX( * )
26* REAL A( * )
27* ..
28*
29*
30*> \par Purpose:
31* =============
32*>
33*> \verbatim
34*>
35*> SLAMRG will create a permutation list which will merge the elements
36*> of A (which is composed of two independently sorted sets) into a
37*> single set which is sorted in ascending order.
38*> \endverbatim
39*
40* Arguments:
41* ==========
42*
43*> \param[in] N1
44*> \verbatim
45*> N1 is INTEGER
46*> \endverbatim
47*>
48*> \param[in] N2
49*> \verbatim
50*> N2 is INTEGER
51*> These arguments contain the respective lengths of the two
52*> sorted lists to be merged.
53*> \endverbatim
54*>
55*> \param[in] A
56*> \verbatim
57*> A is REAL array, dimension (N1+N2)
58*> The first N1 elements of A contain a list of numbers which
59*> are sorted in either ascending or descending order. Likewise
60*> for the final N2 elements.
61*> \endverbatim
62*>
63*> \param[in] STRD1
64*> \verbatim
65*> STRD1 is INTEGER
66*> \endverbatim
67*>
68*> \param[in] STRD2
69*> \verbatim
70*> STRD2 is INTEGER
71*> These are the strides to be taken through the array A.
72*> Allowable strides are 1 and -1. They indicate whether a
73*> subset of A is sorted in ascending (STRDx = 1) or descending
74*> (STRDx = -1) order.
75*> \endverbatim
76*>
77*> \param[out] INDEX
78*> \verbatim
79*> INDEX is INTEGER array, dimension (N1+N2)
80*> On exit this array will contain a permutation such that
81*> if B( I ) = A( INDEX( I ) ) for I=1,N1+N2, then B will be
82*> sorted in ascending order.
83*> \endverbatim
84*
85* Authors:
86* ========
87*
88*> \author Univ. of Tennessee
89*> \author Univ. of California Berkeley
90*> \author Univ. of Colorado Denver
91*> \author NAG Ltd.
92*
93*> \ingroup lamrg
94*
95* =====================================================================
96 SUBROUTINE slamrg( N1, N2, A, STRD1, STRD2, INDEX )
97*
98* -- LAPACK computational routine --
99* -- LAPACK is a software package provided by Univ. of Tennessee, --
100* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
101*
102* .. Scalar Arguments ..
103 INTEGER N1, N2, STRD1, STRD2
104* ..
105* .. Array Arguments ..
106 INTEGER INDEX( * )
107 REAL A( * )
108* ..
109*
110* =====================================================================
111*
112* .. Local Scalars ..
113 INTEGER I, IND1, IND2, N1SV, N2SV
114* ..
115* .. Executable Statements ..
116*
117 n1sv = n1
118 n2sv = n2
119 IF( strd1.GT.0 ) THEN
120 ind1 = 1
121 ELSE
122 ind1 = n1
123 END IF
124 IF( strd2.GT.0 ) THEN
125 ind2 = 1 + n1
126 ELSE
127 ind2 = n1 + n2
128 END IF
129 i = 1
130* while ( (N1SV > 0) & (N2SV > 0) )
131 10 CONTINUE
132 IF( n1sv.GT.0 .AND. n2sv.GT.0 ) THEN
133 IF( a( ind1 ).LE.a( ind2 ) ) THEN
134 index( i ) = ind1
135 i = i + 1
136 ind1 = ind1 + strd1
137 n1sv = n1sv - 1
138 ELSE
139 index( i ) = ind2
140 i = i + 1
141 ind2 = ind2 + strd2
142 n2sv = n2sv - 1
143 END IF
144 GO TO 10
145 END IF
146* end while
147 IF( n1sv.EQ.0 ) THEN
148 DO 20 n1sv = 1, n2sv
149 index( i ) = ind2
150 i = i + 1
151 ind2 = ind2 + strd2
152 20 CONTINUE
153 ELSE
154* N2SV .EQ. 0
155 DO 30 n2sv = 1, n1sv
156 index( i ) = ind1
157 i = i + 1
158 ind1 = ind1 + strd1
159 30 CONTINUE
160 END IF
161*
162 RETURN
163*
164* End of SLAMRG
165*
166 END
subroutine slamrg(n1, n2, a, strd1, strd2, index)
SLAMRG creates a permutation list to merge the entries of two independently sorted sets into a single...
Definition slamrg.f:97