forums.silverfrost.com Forum Index forums.silverfrost.com
Welcome to the Silverfrost forums
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

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

 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> Plato
View previous topic :: View next topic  
Author Message
dzovan137



Joined: 12 Sep 2013
Posts: 4

PostPosted: Sat Nov 09, 2013 2:10 pm    Post subject: Attempt to call a subroutine as if it were a real(kind=1) fu Reply with quote

I have a problem with the following code:

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:

Code:
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.
Back to top
View user's profile Send private message
JohnCampbell



Joined: 16 Feb 2006
Posts: 2554
Location: Sydney

PostPosted: Sun Nov 10, 2013 1:10 am    Post subject: Reply with quote

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
Back to top
View user's profile Send private message
JohnCampbell



Joined: 16 Feb 2006
Posts: 2554
Location: Sydney

PostPosted: Mon Nov 11, 2013 3:04 am    Post subject: Reply with quote

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.
Code:
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
Back to top
View user's profile Send private message
JohnCampbell



Joined: 16 Feb 2006
Posts: 2554
Location: Sydney

PostPosted: Mon Nov 11, 2013 3:08 am    Post subject: Reply with quote

Code:

      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
Back to top
View user's profile Send private message
LitusSaxonicum



Joined: 23 Aug 2005
Posts: 2388
Location: Yateley, Hants, UK

PostPosted: Thu Nov 14, 2013 12:30 pm    Post subject: Reply with quote

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

Eddie
Back to top
View user's profile Send private message
JohnCampbell



Joined: 16 Feb 2006
Posts: 2554
Location: Sydney

PostPosted: Sun Nov 17, 2013 8:15 am    Post subject: Reply with quote

Eddie,

I could only get the original post to fail with /check
Without it the mixing of real*4 and real*8 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
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> Plato All times are GMT + 1 Hour
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group