da/d04/slamrg_8f_source.html

00001       SUBROUTINE SLAMRG( N1, N2, A, STRD1, STRD2, INDEX )
00002 *
00003 *  -- LAPACK routine (version 3.2) --
00004 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00005 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00006 *     November 2006
00007 *
00008 *     .. Scalar Arguments ..
00009       INTEGER            N1, N2, STRD1, STRD2
00010 *     ..
00011 *     .. Array Arguments ..
00012       INTEGER            INDEX( * )
00013       REAL               A( * )
00014 *     ..
00015 *
00016 *  Purpose
00017 *  =======
00018 *
00019 *  SLAMRG will create a permutation list which will merge the elements
00020 *  of A (which is composed of two independently sorted sets) into a
00021 *  single set which is sorted in ascending order.
00022 *
00023 *  Arguments
00024 *  =========
00025 *
00026 *  N1     (input) INTEGER
00027 *  N2     (input) INTEGER
00028 *         These arguements contain the respective lengths of the two
00029 *         sorted lists to be merged.
00030 *
00031 *  A      (input) REAL array, dimension (N1+N2)
00032 *         The first N1 elements of A contain a list of numbers which
00033 *         are sorted in either ascending or descending order.  Likewise
00034 *         for the final N2 elements.
00035 *
00036 *  STRD1  (input) INTEGER
00037 *  STRD2  (input) INTEGER
00038 *         These are the strides to be taken through the array A.
00039 *         Allowable strides are 1 and -1.  They indicate whether a
00040 *         subset of A is sorted in ascending (STRDx = 1) or descending
00041 *         (STRDx = -1) order.
00042 *
00043 *  INDEX  (output) INTEGER array, dimension (N1+N2)
00044 *         On exit this array will contain a permutation such that
00045 *         if B( I ) = A( INDEX( I ) ) for I=1,N1+N2, then B will be
00046 *         sorted in ascending order.
00047 *
00048 *  =====================================================================
00049 *
00050 *     .. Local Scalars ..
00051       INTEGER            I, IND1, IND2, N1SV, N2SV
00052 *     ..
00053 *     .. Executable Statements ..
00054 *
00055       N1SV = N1
00056       N2SV = N2
00057       IF( STRD1.GT.0 ) THEN
00058          IND1 = 1
00059       ELSE
00060          IND1 = N1
00061       END IF
00062       IF( STRD2.GT.0 ) THEN
00063          IND2 = 1 + N1
00064       ELSE
00065          IND2 = N1 + N2
00066       END IF
00067       I = 1
00068 *     while ( (N1SV > 0) & (N2SV > 0) )
00069    10 CONTINUE
00070       IF( N1SV.GT.0 .AND. N2SV.GT.0 ) THEN
00071          IF( A( IND1 ).LE.A( IND2 ) ) THEN
00072             INDEX( I ) = IND1
00073             I = I + 1
00074             IND1 = IND1 + STRD1
00075             N1SV = N1SV - 1
00076          ELSE
00077             INDEX( I ) = IND2
00078             I = I + 1
00079             IND2 = IND2 + STRD2
00080             N2SV = N2SV - 1
00081          END IF
00082          GO TO 10
00083       END IF
00084 *     end while
00085       IF( N1SV.EQ.0 ) THEN
00086          DO 20 N1SV = 1, N2SV
00087             INDEX( I ) = IND2
00088             I = I + 1
00089             IND2 = IND2 + STRD2
00090    20    CONTINUE
00091       ELSE
00092 *     N2SV .EQ. 0
00093          DO 30 N2SV = 1, N1SV
00094             INDEX( I ) = IND1
00095             I = I + 1
00096             IND1 = IND1 + STRD1
00097    30    CONTINUE
00098       END IF
00099 *
00100       RETURN
00101 *
00102 *     End of SLAMRG
00103 *
00104       END