!***********************************************************************
! This file is part of OpenMolcas.                                     *
!                                                                      *
! OpenMolcas is free software; you can redistribute it and/or modify   *
! it under the terms of the GNU Lesser General Public License, v. 2.1. *
! OpenMolcas is distributed in the hope that it will be useful, but it *
! is provided "as is" and without any express or implied warranties.   *
! For more details see the full text of the license in the file        *
! LICENSE or in <http://www.gnu.org/licenses/>.                        *
!***********************************************************************

!***********************************************************************
! This file from SLATEC:                                               *
!   http://www.netlib.org/slatec                                       *
!                                                                      *
! To the best of our knowledge, the routines in SLATEC are public      *
! domain or freely distributable and modifiable.                       *
!***********************************************************************

!******************************
!** Random number generation **
!******************************
function rand_cvb(r)
!***BEGIN PROLOGUE  RAND
!***DATE WRITTEN   770401   (YYMMDD)
!***REVISION DATE  820801   (YYMMDD)
!***CATEGORY NO.  L6A21
!***KEYWORDS  RANDOM NUMBER,SPECIAL FUNCTION,UNIFORM
!***AUTHOR  FULLERTON, W., (LANL)
!***PURPOSE  Generates a uniformly distributed random number.
!***DESCRIPTION
!
!      This pseudo-random number generator is portable among a wide
! variety of computers.  RAND(R) undoubtedly is not as good as many
! readily available installation dependent versions, and so this
! routine is not recommended for widespread usage.  Its redeeming
! feature is that the exact same random numbers (to within final round-
! off error) can be generated from machine to machine.  Thus, programs
! that make use of random numbers can be easily transported to and
! checked in a new environment.
!      The random numbers are generated by the linear congruential
! method described, e.g., by Knuth in Seminumerical Methods (p.9),
! Addison-Wesley, 1969.  Given the I-th number of a pseudo-random
! sequence, the I+1 -st number is generated from
!             X(I+1) = (A*X(I) + C) MOD M,
! where here M = 2**22 = 4194304, C = 1731 and several suitable values
! of the multiplier A are discussed below.  Both the multiplier A and
! random number X are represented in REAL(kind=wp) as two 11-bit
! words.  The constants are chosen so that the period is the maximum
! possible, 4194304.
!      In order that the same numbers be generated from machine to
! machine, it is necessary that 23-bit integers be reducible modulo
! 2**11 exactly, that 23-bit integers be added exactly, and that 11-bit
! integers be multiplied exactly.  Furthermore, if the restart option
! is used (where R is between 0 and 1), then the product R*2**22 =
! R*4194304 must be correct to the nearest integer.
!      The first four random numbers should be .0004127026,
! .6750836372, .1614754200, and .9086198807.  The tenth random number
! is .5527787209, and the hundredth is .3600893021 .  The thousandth
! number should be .2176990509 .
!      In order to generate several effectively independent sequences
! with the same generator, it is necessary to know the random number
! for several widely spaced calls.  The I-th random number times 2**22,
! where I=K*P/8 and P is the period of the sequence (P = 2**22), is
! still of the form L*P/8.  In particular we find the I-th random
! number multiplied by 2**22 is given by
! I   =  0  1*P/8  2*P/8  3*P/8  4*P/8  5*P/8  6*P/8  7*P/8  8*P/8
! RAND=  0  5*P/8  2*P/8  7*P/8  4*P/8  1*P/8  6*P/8  3*P/8  0
! Thus the 4*P/8 = 2097152 random number is 2097152/2**22.
!      Several multipliers have been subjected to the spectral test
! (see Knuth, p. 82).  Four suitable multipliers roughly in order of
! goodness according to the spectral test are
!    3146757 = 1536*2048 + 1029 = 2**21 + 2**20 + 2**10 + 5
!    2098181 = 1024*2048 + 1029 = 2**21 + 2**10 + 5
!    3146245 = 1536*2048 +  517 = 2**21 + 2**20 + 2**9 + 5
!    2776669 = 1355*2048 + 1629 = 5**9 + 7**7 + 1
!
!      In the table below LOG10(NU(I)) gives roughly the number of
! random decimal digits in the random numbers considered I at a time.
! C is the primary measure of goodness.  In both cases bigger is better.
!
!                   LOG10 NU(I)              C(I)
!       A       I=2  I=3  I=4  I=5    I=2  I=3  I=4  I=5
!
!    3146757    3.3  2.0  1.6  1.3    3.1  1.3  4.6  2.6
!    2098181    3.3  2.0  1.6  1.2    3.2  1.3  4.6  1.7
!    3146245    3.3  2.2  1.5  1.1    3.2  4.2  1.1  0.4
!    2776669    3.3  2.1  1.6  1.3    2.5  2.0  1.9  2.6
!   Best
!    Possible   3.3  2.3  1.7  1.4    3.6  5.9  9.7  14.9
!
!             Input Argument --
! R      If R = 0., the next random number of the sequence is generated.
!        If R < 0., the last generated number will be returned for
!          possible use in a restart procedure.
!        If R > 0., the sequence of random numbers will start with
!          the seed R mod 1.  This seed is also returned as the value of
!          RAND provided the arithmetic is done exactly.
!
!             Output Value --
! RAND   a pseudo-random number between 0. and 1.
!***REFERENCES  (NONE)
!***ROUTINES CALLED  (NONE)
!***END PROLOGUE  RAND

use Constants, only: Zero, One, Half
use Definitions, only: wp, iwp

implicit none
real(kind=wp) :: rand_cvb
real(kind=wp), intent(in) :: r
integer(kind=iwp) :: ix0 = 0, ix1 = 0, iy0, iy1
real(kind=wp) :: rand
integer(kind=iwp), parameter :: ia0 = 1029, ia1 = 1536, ia1ma0 = ia1-ia0, ic = 1731, sc = 2048
real(kind=wp), parameter :: xx = 4194304.0_wp

!***FIRST EXECUTABLE STATEMENT  RAND
if (r > Zero) then

  ix1 = int(mod(r,One)*xx+Half)
  ix0 = mod(ix1,sc)
  ix1 = (ix1-ix0)/sc

else if (r == Zero) then

  ! A*X = 2**22*IA1*IX1 + 2**11*(IA1*IX1 + (IA1-IA0)*(IX0-IX1) + IA0*IX0) + IA0*IX0

  iy0 = ia0*ix0
  iy1 = ia1*ix1+ia1ma0*(ix0-ix1)+iy0
  iy0 = iy0+ic
  ix0 = mod(iy0,sc)
  iy1 = iy1+(iy0-ix0)/sc
  ix1 = mod(iy1,sc)

end if

rand = real(ix1*sc+ix0,kind=wp)
rand_cvb = rand/xx

return

end function rand_cvb
