SRC/slamrg.f

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