File:  [local] / rpl / lapack / lapack / dlarnv.f
Revision 1.18: download - view: text, annotated - select for diffs - revision graph
Mon Aug 7 08:38:57 2023 UTC (9 months, 1 week 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 DLARNV returns a vector of random numbers from a uniform or normal distribution.
    2: *
    3: *  =========== DOCUMENTATION ===========
    4: *
    5: * Online html documentation available at
    6: *            http://www.netlib.org/lapack/explore-html/
    7: *
    8: *> \htmlonly
    9: *> Download DLARNV + dependencies
   10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarnv.f">
   11: *> [TGZ]</a>
   12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarnv.f">
   13: *> [ZIP]</a>
   14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarnv.f">
   15: *> [TXT]</a>
   16: *> \endhtmlonly
   17: *
   18: *  Definition:
   19: *  ===========
   20: *
   21: *       SUBROUTINE DLARNV( IDIST, ISEED, N, X )
   22: *
   23: *       .. Scalar Arguments ..
   24: *       INTEGER            IDIST, N
   25: *       ..
   26: *       .. Array Arguments ..
   27: *       INTEGER            ISEED( 4 )
   28: *       DOUBLE PRECISION   X( * )
   29: *       ..
   30: *
   31: *
   32: *> \par Purpose:
   33: *  =============
   34: *>
   35: *> \verbatim
   36: *>
   37: *> DLARNV returns a vector of n random real numbers from a uniform or
   38: *> normal distribution.
   39: *> \endverbatim
   40: *
   41: *  Arguments:
   42: *  ==========
   43: *
   44: *> \param[in] IDIST
   45: *> \verbatim
   46: *>          IDIST is INTEGER
   47: *>          Specifies the distribution of the random numbers:
   48: *>          = 1:  uniform (0,1)
   49: *>          = 2:  uniform (-1,1)
   50: *>          = 3:  normal (0,1)
   51: *> \endverbatim
   52: *>
   53: *> \param[in,out] ISEED
   54: *> \verbatim
   55: *>          ISEED is INTEGER array, dimension (4)
   56: *>          On entry, the seed of the random number generator; the array
   57: *>          elements must be between 0 and 4095, and ISEED(4) must be
   58: *>          odd.
   59: *>          On exit, the seed is updated.
   60: *> \endverbatim
   61: *>
   62: *> \param[in] N
   63: *> \verbatim
   64: *>          N is INTEGER
   65: *>          The number of random numbers to be generated.
   66: *> \endverbatim
   67: *>
   68: *> \param[out] X
   69: *> \verbatim
   70: *>          X is DOUBLE PRECISION array, dimension (N)
   71: *>          The generated random numbers.
   72: *> \endverbatim
   73: *
   74: *  Authors:
   75: *  ========
   76: *
   77: *> \author Univ. of Tennessee
   78: *> \author Univ. of California Berkeley
   79: *> \author Univ. of Colorado Denver
   80: *> \author NAG Ltd.
   81: *
   82: *> \ingroup OTHERauxiliary
   83: *
   84: *> \par Further Details:
   85: *  =====================
   86: *>
   87: *> \verbatim
   88: *>
   89: *>  This routine calls the auxiliary routine DLARUV to generate random
   90: *>  real numbers from a uniform (0,1) distribution, in batches of up to
   91: *>  128 using vectorisable code. The Box-Muller method is used to
   92: *>  transform numbers from a uniform to a normal distribution.
   93: *> \endverbatim
   94: *>
   95: *  =====================================================================
   96:       SUBROUTINE DLARNV( IDIST, ISEED, N, X )
   97: *
   98: *  -- LAPACK auxiliary routine --
   99: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
  100: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  101: *
  102: *     .. Scalar Arguments ..
  103:       INTEGER            IDIST, N
  104: *     ..
  105: *     .. Array Arguments ..
  106:       INTEGER            ISEED( 4 )
  107:       DOUBLE PRECISION   X( * )
  108: *     ..
  109: *
  110: *  =====================================================================
  111: *
  112: *     .. Parameters ..
  113:       DOUBLE PRECISION   ONE, TWO
  114:       PARAMETER          ( ONE = 1.0D+0, TWO = 2.0D+0 )
  115:       INTEGER            LV
  116:       PARAMETER          ( LV = 128 )
  117:       DOUBLE PRECISION   TWOPI
  118:       PARAMETER  ( TWOPI = 6.28318530717958647692528676655900576839D+0 )
  119: *     ..
  120: *     .. Local Scalars ..
  121:       INTEGER            I, IL, IL2, IV
  122: *     ..
  123: *     .. Local Arrays ..
  124:       DOUBLE PRECISION   U( LV )
  125: *     ..
  126: *     .. Intrinsic Functions ..
  127:       INTRINSIC          COS, LOG, MIN, SQRT
  128: *     ..
  129: *     .. External Subroutines ..
  130:       EXTERNAL           DLARUV
  131: *     ..
  132: *     .. Executable Statements ..
  133: *
  134:       DO 40 IV = 1, N, LV / 2
  135:          IL = MIN( LV / 2, N-IV+1 )
  136:          IF( IDIST.EQ.3 ) THEN
  137:             IL2 = 2*IL
  138:          ELSE
  139:             IL2 = IL
  140:          END IF
  141: *
  142: *        Call DLARUV to generate IL2 numbers from a uniform (0,1)
  143: *        distribution (IL2 <= LV)
  144: *
  145:          CALL DLARUV( ISEED, IL2, U )
  146: *
  147:          IF( IDIST.EQ.1 ) THEN
  148: *
  149: *           Copy generated numbers
  150: *
  151:             DO 10 I = 1, IL
  152:                X( IV+I-1 ) = U( I )
  153:    10       CONTINUE
  154:          ELSE IF( IDIST.EQ.2 ) THEN
  155: *
  156: *           Convert generated numbers to uniform (-1,1) distribution
  157: *
  158:             DO 20 I = 1, IL
  159:                X( IV+I-1 ) = TWO*U( I ) - ONE
  160:    20       CONTINUE
  161:          ELSE IF( IDIST.EQ.3 ) THEN
  162: *
  163: *           Convert generated numbers to normal (0,1) distribution
  164: *
  165:             DO 30 I = 1, IL
  166:                X( IV+I-1 ) = SQRT( -TWO*LOG( U( 2*I-1 ) ) )*
  167:      $                       COS( TWOPI*U( 2*I ) )
  168:    30       CONTINUE
  169:          END IF
  170:    40 CONTINUE
  171:       RETURN
  172: *
  173: *     End of DLARNV
  174: *
  175:       END

CVSweb interface <joel.bertrand@systella.fr>