File:  [local] / rpl / lapack / lapack / dlamrg.f
Revision 1.19: download - view: text, annotated - select for diffs - revision graph
Mon Aug 7 08:38:54 2023 UTC (8 months, 3 weeks ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_35, rpl-4_1_34, HEAD
Première mise à jour de lapack et blas.

    1: *> \brief \b DLAMRG 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 DLAMRG + dependencies
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlamrg.f">
   11: *> [TGZ]</a>
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlamrg.f">
   13: *> [ZIP]</a>
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlamrg.f">
   15: *> [TXT]</a>
   16: *> \endhtmlonly
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE DLAMRG( N1, N2, A, DTRD1, DTRD2, INDEX )
   22: *
   23: *       .. Scalar Arguments ..
   24: *       INTEGER            DTRD1, DTRD2, N1, N2
   25: *       ..
   26: *       .. Array Arguments ..
   27: *       INTEGER            INDEX( * )
   28: *       DOUBLE PRECISION   A( * )
   29: *       ..
   30: *
   31: *
   32: *> \par Purpose:
   33: *  =============
   34: *>
   35: *> \verbatim
   36: *>
   37: *> DLAMRG 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 DOUBLE PRECISION 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] DTRD1
   66: *> \verbatim
   67: *>          DTRD1 is INTEGER
   68: *> \endverbatim
   69: *>
   70: *> \param[in] DTRD2
   71: *> \verbatim
   72: *>          DTRD2 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 (DTRDx = 1) or descending
   76: *>         (DTRDx = -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: *> \ingroup auxOTHERcomputational
   96: *
   97: *  =====================================================================
   98:       SUBROUTINE DLAMRG( N1, N2, A, DTRD1, DTRD2, INDEX )
   99: *
  100: *  -- LAPACK computational routine --
  101: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  102: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  103: *
  104: *     .. Scalar Arguments ..
  105:       INTEGER            DTRD1, DTRD2, N1, N2
  106: *     ..
  107: *     .. Array Arguments ..
  108:       INTEGER            INDEX( * )
  109:       DOUBLE PRECISION   A( * )
  110: *     ..
  111: *
  112: *  =====================================================================
  113: *
  114: *     .. Local Scalars ..
  115:       INTEGER            I, IND1, IND2, N1SV, N2SV
  116: *     ..
  117: *     .. Executable Statements ..
  118: *
  119:       N1SV = N1
  120:       N2SV = N2
  121:       IF( DTRD1.GT.0 ) THEN
  122:          IND1 = 1
  123:       ELSE
  124:          IND1 = N1
  125:       END IF
  126:       IF( DTRD2.GT.0 ) THEN
  127:          IND2 = 1 + N1
  128:       ELSE
  129:          IND2 = N1 + N2
  130:       END IF
  131:       I = 1
  132: *     while ( (N1SV > 0) & (N2SV > 0) )
  133:    10 CONTINUE
  134:       IF( N1SV.GT.0 .AND. N2SV.GT.0 ) THEN
  135:          IF( A( IND1 ).LE.A( IND2 ) ) THEN
  136:             INDEX( I ) = IND1
  137:             I = I + 1
  138:             IND1 = IND1 + DTRD1
  139:             N1SV = N1SV - 1
  140:          ELSE
  141:             INDEX( I ) = IND2
  142:             I = I + 1
  143:             IND2 = IND2 + DTRD2
  144:             N2SV = N2SV - 1
  145:          END IF
  146:          GO TO 10
  147:       END IF
  148: *     end while
  149:       IF( N1SV.EQ.0 ) THEN
  150:          DO 20 N1SV = 1, N2SV
  151:             INDEX( I ) = IND2
  152:             I = I + 1
  153:             IND2 = IND2 + DTRD2
  154:    20    CONTINUE
  155:       ELSE
  156: *     N2SV .EQ. 0
  157:          DO 30 N2SV = 1, N1SV
  158:             INDEX( I ) = IND1
  159:             I = I + 1
  160:             IND1 = IND1 + DTRD1
  161:    30    CONTINUE
  162:       END IF
  163: *
  164:       RETURN
  165: *
  166: *     End of DLAMRG
  167: *
  168:       END

CVSweb interface <joel.bertrand@systella.fr>