001:       SUBROUTINE DLAMRG( N1, N2, A, DTRD1, DTRD2, INDEX )
002: *
003: *  -- LAPACK routine (version 3.2) --
004: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
005: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
006: *     November 2006
007: *
008: *     .. Scalar Arguments ..
009:       INTEGER            DTRD1, DTRD2, N1, N2
010: *     ..
011: *     .. Array Arguments ..
012:       INTEGER            INDEX( * )
013:       DOUBLE PRECISION   A( * )
014: *     ..
015: *
016: *  Purpose
017: *  =======
018: *
019: *  DLAMRG will create a permutation list which will merge the elements
020: *  of A (which is composed of two independently sorted sets) into a
021: *  single set which is sorted in ascending order.
022: *
023: *  Arguments
024: *  =========
025: *
026: *  N1     (input) INTEGER
027: *  N2     (input) INTEGER
028: *         These arguements contain the respective lengths of the two
029: *         sorted lists to be merged.
030: *
031: *  A      (input) DOUBLE PRECISION array, dimension (N1+N2)
032: *         The first N1 elements of A contain a list of numbers which
033: *         are sorted in either ascending or descending order.  Likewise
034: *         for the final N2 elements.
035: *
036: *  DTRD1  (input) INTEGER
037: *  DTRD2  (input) INTEGER
038: *         These are the strides to be taken through the array A.
039: *         Allowable strides are 1 and -1.  They indicate whether a
040: *         subset of A is sorted in ascending (DTRDx = 1) or descending
041: *         (DTRDx = -1) order.
042: *
043: *  INDEX  (output) INTEGER array, dimension (N1+N2)
044: *         On exit this array will contain a permutation such that
045: *         if B( I ) = A( INDEX( I ) ) for I=1,N1+N2, then B will be
046: *         sorted in ascending order.
047: *
048: *  =====================================================================
049: *
050: *     .. Local Scalars ..
051:       INTEGER            I, IND1, IND2, N1SV, N2SV
052: *     ..
053: *     .. Executable Statements ..
054: *
055:       N1SV = N1
056:       N2SV = N2
057:       IF( DTRD1.GT.0 ) THEN
058:          IND1 = 1
059:       ELSE
060:          IND1 = N1
061:       END IF
062:       IF( DTRD2.GT.0 ) THEN
063:          IND2 = 1 + N1
064:       ELSE
065:          IND2 = N1 + N2
066:       END IF
067:       I = 1
068: *     while ( (N1SV > 0) & (N2SV > 0) )
069:    10 CONTINUE
070:       IF( N1SV.GT.0 .AND. N2SV.GT.0 ) THEN
071:          IF( A( IND1 ).LE.A( IND2 ) ) THEN
072:             INDEX( I ) = IND1
073:             I = I + 1
074:             IND1 = IND1 + DTRD1
075:             N1SV = N1SV - 1
076:          ELSE
077:             INDEX( I ) = IND2
078:             I = I + 1
079:             IND2 = IND2 + DTRD2
080:             N2SV = N2SV - 1
081:          END IF
082:          GO TO 10
083:       END IF
084: *     end while
085:       IF( N1SV.EQ.0 ) THEN
086:          DO 20 N1SV = 1, N2SV
087:             INDEX( I ) = IND2
088:             I = I + 1
089:             IND2 = IND2 + DTRD2
090:    20    CONTINUE
091:       ELSE
092: *     N2SV .EQ. 0
093:          DO 30 N2SV = 1, N1SV
094:             INDEX( I ) = IND1
095:             I = I + 1
096:             IND1 = IND1 + DTRD1
097:    30    CONTINUE
098:       END IF
099: *
100:       RETURN
101: *
102: *     End of DLAMRG
103: *
104:       END
105: