|
forums.silverfrost.com Welcome to the Silverfrost forums
|
View previous topic :: View next topic |
Author |
Message |
dzovan137
Joined: 12 Sep 2013 Posts: 4
|
Posted: Sat Nov 09, 2013 2:10 pm Post subject: Attempt to call a subroutine as if it were a real(kind=1) fu |
|
|
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 |
|
|
JohnCampbell
Joined: 16 Feb 2006 Posts: 2554 Location: Sydney
|
Posted: Sun Nov 10, 2013 1:10 am Post subject: |
|
|
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 |
|
|
JohnCampbell
Joined: 16 Feb 2006 Posts: 2554 Location: Sydney
|
Posted: Mon Nov 11, 2013 3:04 am Post subject: |
|
|
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 |
|
|
JohnCampbell
Joined: 16 Feb 2006 Posts: 2554 Location: Sydney
|
Posted: Mon Nov 11, 2013 3:08 am Post subject: |
|
|
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 |
|
|
LitusSaxonicum
Joined: 23 Aug 2005 Posts: 2388 Location: Yateley, Hants, UK
|
Posted: Thu Nov 14, 2013 12:30 pm Post subject: |
|
|
On 6.35 it seems to work OK for me, no error messages, and output of 0.655416
Eddie |
|
Back to top |
|
|
JohnCampbell
Joined: 16 Feb 2006 Posts: 2554 Location: Sydney
|
Posted: Sun Nov 17, 2013 8:15 am Post subject: |
|
|
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 |
|
|
|
|
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
|