Attempt to call a subroutine as if it were a real(kind=1) fu

I have a problem with the following code:

function ran2(idum)

      implicit real*8  (a-h,o-z)
      integer idum,im1,im2,imm1,ia1,ia2,iq1,iq2,ir1,ir2,ntab,ndiv
      parameter (im1=2147483563, im2=2147483399,am=1./im1,imm1=im1-1,&
                 ia1=40014, ia2=40692, iq1=53668,iq2=52774,ir1=12211,&
                 ir2=3791, ntab=32, ndiv=1+imm1/ntab, eps=1.2e-7, rnmx=1.-eps)
      integer idum2,j,k,iv(ntab),iy
      save iv, iy, idum2
      data idum2/123456789/, iv/ntab*0/, iy/0/

      if(idum.le.0) then
         idum=max(-idum,1)
         idum2=idum
         do 11 j=ntab+8,1,-1
               k=idum/iq1
               idum=ia1*(idum-k*iq1)-k*ir1
               if(idum.lt.0) idum=idum+im1
               if (j.le.ntab) iv(j)=idum
   11    continue
         iy=iv(1)
      endif
      k=idum/iq1
      idum=ia1*(idum-k*iq1)-k*ir1
      if (idum.lt.0) idum=idum+im1
      k=idum2/iq2
      idum2=ia2*(idum2-k*iq2)-k*ir2
      if (idum2.lt.0) idum2=idum2+im2
      j=1+iy/ndiv
      iy=iv(j)-idum2
      iv(j)=idum
      if (iy.lt.1) iy=iy+imm1
      ran2=min(am*iy,rnmx)
      return
      end

program ising_2d
real :: x
real, external :: ran2

x = ran2(22)
write(*,*) x

end program ising_2d

I get the error:

Run-time Error
Attempt to call a subroutine as if it were a real(kind=1) function

What might be wrong?

P.S. This ought to be a random number generator.

You could try real function ran2 (idum)

I could reproduce your problem with /check. I changed to real function... I then got the error: 'Attempt to alter an actual argument that is a constant, an expression, an INTENT (IN) argument, or DO Variable.'

This is an error that needs correcting.

John

If you are interested, I tried to test RAN2 as a suitable random number generator and got similar performance to Random_Number intrinsic. You might need to valudate idum input values.

real function ran2 (idum) 

      implicit real*8  (a-h,o-z) 
!
      integer, intent (inout) :: idum
!
      integer, parameter :: im1  =  2147483563
      integer, parameter :: im2  =  2147483399
      integer, parameter :: ia1  =       40014
      integer, parameter :: ia2  =       40692
      integer, parameter :: iq1  =       53668
      integer, parameter :: iq2  =       52774
      integer, parameter :: ir1  =       12211
      integer, parameter :: ir2  =        3791
!
      integer, parameter :: ntab =          32
      integer, parameter :: imm1 =       im1-1
      integer, parameter :: ndiv =  1+imm1/ntab
      real*8,  parameter :: am   =  1./im1
      real*8,  parameter :: eps  =  1.2e-7
      real*8,  parameter :: rnmx =  1.-eps
!
      integer idum2, iv(ntab), iy, j, k 
      save    idum2, iv, iy 
      data    idum2 /123456789/, iv /ntab*0/, iy /0/ 

      if (idum <= 0) then 
         idum  = max (-idum,1) 
         idum2 = idum 
         do j = ntab+8,1,-1 
               k    = idum/iq1 
               idum = ia1*(idum-k*iq1)-k*ir1 
               if (idum < 0) idum = idum+im1 
               if (j <= ntab) iv(j)=idum 
         end do
         iy = iv(1) 
      end if 
      
      k     = idum/iq1 
      idum  = ia1*(idum-k*iq1)-k*ir1 
      if (idum < 0) idum   = idum+im1 
      k     = idum2/iq2 
      idum2 = ia2*(idum2-k*iq2)-k*ir2 
      if (idum2 < 0) idum2 = idum2+im2 
      j     = 1+iy/ndiv 
      iy    = iv(j)-idum2 
      iv(j) = idum 
      if (iy < 1) iy = iy+imm1 

      ran2  = min (am*iy, rnmx) 
      return 
      end 

program ising_2d 
   real*8 :: x 
   real, external :: ran2 
   
   integer n, k, test, t1, t2, tr
   real*10 s, ss, sss, s1,s2, u,a
   real*10 d, dd, ddd
   integer, parameter :: ns = 20
   integer count(0:ns), ix
   integer :: million = 1000000

   n  = 50*million
   do test=1,2
      call system_clock (t1)
      j  = 22
      a  = 0.5   ! average etimate
      s  = 0
      ss = 0
      sss= 0
      d  = 0
      dd = 0
      ddd= 0
      xl = 0
      s1 = 1
      s2 = 0
      count = 0
      do k = 1,n
        if (test==1) x  = ran2 (j) 
        if (test==2) call random_number (x)
        u   = x - a
        s   = s + u
        ss  = ss + u*u
        sss = sss + u*u*u
        if (x < s1) s1 = x
        if (x > s2) s2 = x
        ix = x*ns
        count(ix) = count(ix) + 1
!
!    test randomness of difference between two successive values        
        u   = x - xl
        d   = d + u
        dd  = dd + u*u
        ddd = ddd + u*u*u
        xl  = x
      end do
      call system_clock (t2,tr)
      
      do ix = 0,ns
        write (*,*) ix, count(ix), (count(ix)-n/ns)
      end do
      write(*,*) 'seconds = ', real(t2-t1) / real(tr)
      write(*,*) 'number  = ', n
      write(*,*) ' min    = ', s1
      write(*,*) ' max    = ', s2

...ctd

      if (test==1) write(*,*) 'Test of variability of RAN2 function'      
      if (test==2) write(*,*) 'Test of variability of Random_Number intrinsic'      
      call av_sd_sk (n, s, ss, sss)
      x  = s + a
      write(*,*) 'average = ', x,  ' err =',abs (x-a)
      write(*,*) 'std dev = ', ss, ' err =',abs (ss-1./sqrt(12.0d0))
      write(*,*) 'skew    = ', sss

      write(*,*) 'Test of successive calls for randomness'      
      call av_sd_sk (n, d, dd, ddd)
      x  = d
      write(*,*) 'average = ', x
      write(*,*) 'std dev = ', dd, ' err =',abs (dd-1./sqrt(6.0d0))
      write(*,*) 'skew    = ', ddd

   end do

end program ising_2d 

      subroutine av_sd_sk (n, s, ss, sss)
!
!   routine to convert sum and sum of squares to average, variability & skew
!
      integer*4 n
      real*10   s, ss, sss, x
      real*10, parameter :: one = 1
      real*10, parameter :: two = 2
!
      x   = max (n,1)                               ! number of values
      ss  = ( ss - s*s/x ) / max (x-one,one)        ! variance
      s   = s / x                                   ! average
      if (ss > 0) then
       ss  = sqrt (ss)                              ! standard deviation
       sss = ( sss - 3*s*ss**2*(x-one) - x*s**3 ) & ! Excel skewness
           / ( ss**3 * max(x-two,one) )
      else
       ss  = 0
       sss = 0
      end if
!
      return
      end subroutine av_sd_sk

The test results look very similar, but I wonder if you can restart with an old idum seed, given all the values changeing in iv.

John

On 6.35 it seems to work OK for me, no error messages, and output of 0.655416

Eddie

Eddie,

I could only get the original post to fail with /check Without it the mixing of real4 and real8 sort of worked. Putting real function, or preferably real*8 function would fix that problem although there remains the issue of changing the value of constant 22 which is addressed as idum.

John