خب.ایندفعه اومدم و از آرایه کمک گرفتم ولی همچنان یه جای کار میلنگه!
REAL ran3,r,b,d
INTEGER i,step,s,m,j,a,x,y, mat(1000,2),test(1,2)
open(12,file="selfmat2d.txt")
READ(*,*) step
s=0
m=0
Do k=1,1000
mat(k,1)=0
mat(k,2)=0
enddo
Do i=1,step
r=ran3(i)
if (r .gt.0.75 ) then
j=1
test(1,1)= s+1
test(1,2)= m
Do j=1,i
if (test(1,1)==mat(j,1) .and. test(1,2)==mat(j,2)) then
goto 66
endif
enddo
s=s+1
endif
if (r .gt. 0.5 .and. 0.75 .gt. r ) then
j=1
test(1,1)= s-1
test(1,2)= m
Do j=1,i
if (test(1,1)==mat(j,1) .and. test(1,2)==mat(j,2)) then
goto 66
end if
enddo
s=s-1
end if
if (r .gt. 0.25 .and. 0.5 .gt. r ) then
j=1
test(1,1)= s
test(1,2)= m+1
Do j=1,i
if (test(1,1)==mat(j,1) .and. test(1,2)==mat(j,2)) then
goto 66
end if
enddo
m=m+1
end if
if ( 0.25 .gt. r ) then
j=1
test(1,1)= s
test(1,2)= m-1
Do j=1,i
if (test(1,1)==mat(j,1) .and. test(1,2)==mat(j,2)) then
goto 66
end if
enddo
m=m-1
end if
d=((m**2+s**2))**(0.5)
write (12,88) i,s,m,d
mat(i,1)=s
mat(i,2)=m
66 END DO
88 format (I4,I4,I4,F8.3)
end
!!!!!!!!!!!!!!RAN3(idum) !!!!!!!!!!!!!!!!!!
FUNCTION ran3(idum)
INTEGER idum
INTEGER MBIG,MSEED,MZ
C REAL MBIG,MSEED,MZ
REAL ran3,FAC
PARAMETER (MBIG=1000000000,MSEED=161803398,MZ=0,FAC=1./MBIG)
C PARAMETER (MBIG=4000000.,MSEED=1618033.,MZ=0.,FAC=1./MBIG)
INTEGER i,iff,ii,inext,inextp,k
INTEGER mj,mk,ma(55)
C REAL mj,mk,ma(55)
SAVE iff,inext,inextp,ma
DATA iff /0/
if(idum.lt.0.or.iff.eq.0)then
iff=1
mj=MSEED-iabs(idum)
mj=mod(mj,MBIG)
ma(55)=mj
mk=1
do 11 i=1,54
ii=mod(21*i,55)
ma(ii)=mk
mk=mj-mk
if(mk.lt.MZ)mk=mk+MBIG
mj=ma(ii)
11 continue
do 13 k=1,4
do 12 i=1,55
ma(i)=ma(i)-ma(1+mod(i+30,55))
if(ma(i).lt.MZ)ma(i)=ma(i)+MBIG
12 continue
13 continue
inext=0
inextp=31
idum=1
endif
inext=inext+1
if(inext.eq.56)inext=1
inextp=inextp+1
if(inextp.eq.56)inextp=1
mj=ma(inext)-ma(inextp)
if(mj.lt.MZ)mj=mj+MBIG
ma(inext)=mj
ran3=mj*FAC
return
END
موضوع: یک سوال از فرترن (دفعات بازدید: 6356 بار)
