gcc/testsuite/gfortran.dg/pr37286.f90

   1 ! { dg-do compile }
   2
   3 module general_rand
   4   implicit none
   5   private
   6
   7   integer, public, parameter :: GNDP = kind(1.0d0)
   8
   9   real(kind = GNDP), save :: &
  10     gnc = 362436.0 / 16777216.0, &
  11     gncd = 7654321.0 / 16777216.0, &
  12     gncm = 16777213.0 / 16777216.0
  13   integer, save :: &
  14     gni97 = 97, &
  15     gnj97 = 33
  16
  17   real(kind = GNDP), save :: gnu(97)
  18
  19 contains
  20   subroutine gn_fatal(message)
  21     character(len = *), intent(in) :: message
  22
  23     stop 1
  24   end subroutine gn_fatal
  25
  26   function gn_monte_rand(min, max) result(monte)
  27     real(kind = GNDP), intent(in) :: min
  28     real(kind = GNDP), intent(in) :: max
  29     real(kind = GNDP) :: monte
  30
  31     real :: monte_temp
  32
  33     if (min > max) then
  34       call gn_fatal('gn_monte_rand: min > max')
  35     else if (min == max) then
  36       call gn_fatal('gn_monte_rand: min = max: returning min')
  37       monte_temp = min
  38     else
  39
  40       monte_temp = gnu(gni97) - gnu(gnj97)
  41       if (monte_temp < 0.0) then
  42         monte_temp = monte_temp + 1.0
  43       end if
  44
  45       gnu(gni97) = monte_temp
  46       gni97 = gni97 - 1
  47       if (gni97 == 0) then
  48         gni97 = 97
  49       end if
  50     end if
  51
  52     monte = min + monte_temp * (max - min)
  53
  54   end function gn_monte_rand
  55
  56 end module general_rand
  57
  58 ! { dg-final { cleanup-modules "general_rand" } }