Branch data     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                 :  6752782701 : 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                 :  6752782701 :   two31 = two31 * 32768   ! **31
      82                 :  6752782701 :   two31m = two31 - 1
      83                 :             : 
      84                 :             : !!$  two31  = z'80000000'
      85                 :             : !!$  two31m = z'7FFFFFFF'
      86                 :             : 
      87         [ -  + ]:  6752782701 :   IF (xn == 0) xn = 1
      88                 :  6752782701 :   xn8 = (mars * xn)
      89                 :  6752782701 :   xn8 = IAND(xn8, two31m)
      90                 :  6752782701 :   xn = xn8
      91                 :             : 
      92                 :  6752782701 :   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         [ +  + ]:  6752782701 :   if ( rng == 1.d0 ) rng = 0.d0
      96                 :  6752782701 : END SUBROUTINE OurRng
      97                 :             : !!***
      98                 :             : 
      99                 :             : END MODULE m_OurRng
     100                 :             : !!***