Line data    Source code

       1              : 
       2              : #if defined HAVE_CONFIG_H
       3              : #include "config.h"
       4              : #endif
       5              : !!****m* ABINIT/m_OurRng
       6              : !! NAME
       7              : !!  m_OurRng
       8              : !!
       9              : !! FUNCTION
      10              : !!  Random number generator module
      11              : !!  Should be modify and merge with uniformrandom and zbq
      12              : !!
      13              : !! COPYRIGHT
      14              : !!  Copyright (C) 2013-2026 ABINIT group (J. Bieder)
      15              : !!  This file is distributed under the terms of the
      16              : !!  GNU General Public License, see ~abinit/COPYING
      17              : !!  or http://www.gnu.org/copyleft/gpl.txt .
      18              : !!
      19              : !! NOTES
      20              : !!
      21              : !! SOURCE
      22              : 
      23              : #include "defs.h"
      24              : 
      25              : MODULE m_OurRng
      26              : !! Implementation of various RNG with a small footprint
      27              : 
      28              :  !use m_numeric_tools,  only : uniformrandom
      29              : 
      30              : IMPLICIT NONE
      31              : 
      32              : PRIVATE
      33              : 
      34              : PUBLIC :: OurRng
      35              : 
      36              : CONTAINS
      37              : !!***
      38              : 
      39              : !!****f* ABINIT/m_OurRng/OurRng
      40              : !! NAME
      41              : !!  OurRng
      42              : !!
      43              : !! FUNCTION
      44              : !!  Generator given by G. Colin de Verdiere
      45              : !!  Efficient on GPU and MIC
      46              : !!
      47              : !! COPYRIGHT
      48              : !!  Copyright (C) 2013-2026 ABINIT group (J. Bieder)
      49              : !!  This file is distributed under the terms of the
      50              : !!  GNU General Public License, see ~abinit/COPYING
      51              : !!  or http://www.gnu.org/copyleft/gpl.txt .
      52              : !!
      53              : !! INPUTS
      54              : !!  xn=seed
      55              : !!  rng=random number
      56              : !!
      57              : !! OUTPUT
      58              : !!
      59              : !! SIDE EFFECTS
      60              : !!
      61              : !! NOTES
      62              : !!
      63              : !! SOURCE
      64              : 
      65   5237822987 : SUBROUTINE OurRng(xn,rng)
      66              :   ! returns a value between 0. and 1. with a period of 2**31
      67              :   ! implements the Marsaglia serie:
      68              :   !   xn+1 = (69069 * xn) mod 2^31
      69              : !Arguments ------------------------------------
      70              :   DOUBLE PRECISION, INTENT(  OUT) :: rng
      71              :   INTEGER(8), INTENT(INOUT) :: xn
      72              :   !
      73              :   INTEGER(8) :: two31  ! 2 ** 31
      74              :   INTEGER(8) :: two31m ! 2 ** 31 -1
      75              :   INTEGER(8), PARAMETER :: mars   = 69069
      76              :   INTEGER(8) :: xn8
      77              :   INTRINSIC MOD, REAL, IAND
      78              : 
      79              :   two31 = 1
      80              :   two31 = two31 * 65536   ! **16
      81   5237822987 :   two31 = two31 * 32768   ! **31
      82   5237822987 :   two31m = two31 - 1
      83              : 
      84              : !!$  two31  = z'80000000'
      85              : !!$  two31m = z'7FFFFFFF'
      86              : 
      87   5237822987 :   IF (xn == 0) xn = 1
      88   5237822987 :   xn8 = (mars * xn)
      89   5237822987 :   xn8 = IAND(xn8, two31m)
      90   5237822987 :   xn = xn8
      91              : 
      92   5237822987 :   rng = REAL(xn, 8) / REAL(two31m, 8)
      93              :   ! guard to avoid pick up one since that sould never happen (otherwise ctqmc
      94              :   ! may generate an error and exit the code)
      95   5237822987 :   if ( rng == 1.d0 ) rng = 0.d0
      96   5237822987 : END SUBROUTINE OurRng
      97              : !!***
      98              : 
      99              : END MODULE m_OurRng
     100              : !!***