File indexing completed on 2025-08-05 08:21:08
0001 !-----------------------------------------------------------------
0002 ! The point of this set of routines is to replace all potentially
0003 ! used random number generators with functions and subroutines
0004 ! that utilize a common seed sequence. In this case:
0005 !
0006 ! the CERNLIB RANLUX series
0007 !
0008 ! MC programmers should now always use:
0009 ! rndmq to initialize or obtain status
0010 ! rlu to get a single 0:1 random number
0011 ! nra to get a vector of 0:1 random numbers
0012 ! rannor to get 2 Gaussian random numbers
0013 !
0014 ! Documentation on RANLUX can be found here:
0015 ! http://wwwinfo.cern.ch/asdoc/shortwrupsdir/v115/top.html
0016 !-----------------------------------------------------------------
0017 ! Initialization and status retrieval routine for random number sequence
0018 !
0019 ! CHOPT = ' ' reset sequence NSEQ to the beginning (seeds 0,0)
0020 ! 'S' set seeds for sequence NSEQ to given values
0021 ! 'G' get the current seeds for the current sequence
0022 !
0023 ! Note1: If ISEQ.le.0, the current (last used) sequence is used.
0024 !-----------------------------------------------------------------
0025
0026 subroutine rndmq (nseed1, nseed2, nseq, chopt)
0027
0028 implicit none
0029
0030 integer LUX_LEVEL
0031 parameter (LUX_LEVEL=4)
0032
0033 integer nseed1, nseed2, nseq
0034 integer iseed1, iseed2, iseq, ilux
0035 character*(*) chopt
0036 character*1 c1opt
0037
0038 ! ... force redefined random number generators to be taken from here
0039 external rndm, irndm, nran, rannor, ranf, rlu, ranums
0040
0041 ! Parse option string
0042
0043 c1opt = chopt(1:1)
0044 if (c1opt.ne.' '.and.c1opt.ne.'S'.and.c1opt.ne.'G') then
0045 write(*,*)('RNDMQ got unrecognized option')
0046 stop
0047 endif
0048
0049 ! Take care of the possibilities of resetting the generator
0050
0051 ! ... initialize generator to the beginning (seeds 0,0) of the given sequence
0052 if (c1opt.eq.' ') then
0053 call rluxgo(LUX_LEVEL,nseq,0,0)
0054
0055 ! ... set seeds to given values, after retrieving current sequence number
0056 ! ... (and luxury level, why not)
0057 elseif (c1opt.eq.'S') then
0058 call rluxat(ilux,iseq,iseed1,iseed2)
0059 call rluxgo(ilux,iseq,nseed1,nseed2)
0060
0061 ! ... retrieve current seeds and hand them back
0062 elseif (c1opt.eq.'G') then
0063 call rluxat(ilux,iseq,nseed1,nseed2)
0064 endif
0065
0066 return
0067 end
0068
0069 !-----------------------------------------------------------------
0070 ! Replace the obsolete CERNLIB RNDM functions
0071
0072 real function rndm (dummy)
0073
0074 implicit none
0075
0076 real dummy, r
0077
0078 call ranlux(r,1)
0079
0080 rndm = r
0081
0082 return
0083 end
0084
0085 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
0086 integer function irndm (dummy)
0087
0088 implicit none
0089
0090 real dummy, r
0091 integer i
0092
0093 equivalence (r,i)
0094
0095 call ranlux(r,1)
0096 irndm = i
0097
0098 return
0099 end
0100
0101 !-----------------------------------------------------------------
0102 ! Replace the obsolete CERNLIB NRAN subroutine
0103
0104 subroutine nran (r,n)
0105
0106 implicit none
0107
0108 integer n
0109 real r(n)
0110
0111 call ranlux(r,n)
0112
0113 return
0114 end
0115
0116 !-----------------------------------------------------------------
0117 ! Replace the obsolete CERNLIB RANNOR subroutine
0118
0119 subroutine rannor (a,b)
0120
0121 implicit none
0122
0123 real a, b, r(2)
0124 external nran
0125
0126 call rnormx(r,2,nran)
0127 a = r(1)
0128 b = r(2)
0129
0130 return
0131
0132 end
0133
0134 !-----------------------------------------------------------------
0135 ! Replace the F77 RANF
0136
0137 real function ranf (dummy)
0138
0139 implicit none
0140
0141 real dummy, r
0142
0143 call ranlux(r,1)
0144
0145 ranf = r
0146
0147 return
0148 end
0149
0150 !-----------------------------------------------------------------
0151 ! Replace the JETSET random number generator
0152
0153 real function rlu(idummy)
0154
0155 implicit none
0156
0157 integer idummy
0158 real r
0159
0160 call ranlux(r,1)
0161
0162 rlu = r
0163
0164 return
0165 end
0166
0167 !-----------------------------------------------------------------
0168 ! Replace the DIVONNE random number generator
0169
0170 subroutine ranums (r,n)
0171
0172 implicit none
0173
0174 integer n
0175 real r(n)
0176
0177 call ranlux(r,n)
0178
0179 return
0180 end
0181
