File:  [local] / rpl / lapack / lapack / dlamrg.f
Revision 1.13: download - view: text, annotated - select for diffs - revision graph
Mon Jan 27 09:28:20 2014 UTC (10 years, 3 months ago) by bertrand
Branches: MAIN
CVS tags: rpl-4_1_24, rpl-4_1_23, rpl-4_1_22, rpl-4_1_21, rpl-4_1_20, rpl-4_1_19, rpl-4_1_18, rpl-4_1_17, HEAD
Cohérence.

    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 arguements 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: *> \date September 2012
   96: *
   97: *> \ingroup auxOTHERcomputational
   98: *
   99: *  =====================================================================
  100:       SUBROUTINE DLAMRG( N1, N2, A, DTRD1, DTRD2, INDEX )
  101: *
  102: *  -- LAPACK computational routine (version 3.4.2) --
  103: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  104: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  105: *     September 2012
  106: *
  107: *     .. Scalar Arguments ..
  108:       INTEGER            DTRD1, DTRD2, N1, N2
  109: *     ..
  110: *     .. Array Arguments ..
  111:       INTEGER            INDEX( * )
  112:       DOUBLE PRECISION   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( DTRD1.GT.0 ) THEN
  125:          IND1 = 1
  126:       ELSE
  127:          IND1 = N1
  128:       END IF
  129:       IF( DTRD2.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 + DTRD1
  142:             N1SV = N1SV - 1
  143:          ELSE
  144:             INDEX( I ) = IND2
  145:             I = I + 1
  146:             IND2 = IND2 + DTRD2
  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 + DTRD2
  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 + DTRD1
  164:    30    CONTINUE
  165:       END IF
  166: *
  167:       RETURN
  168: *
  169: *     End of DLAMRG
  170: *
  171:       END

CVSweb interface <joel.bertrand@systella.fr>