0 کاربر و 1 مهمان درحال مشاهده موضوع.
ممنون از همه.من با ماتریس هم نوشتم ولی از یه if ایراد میگرفت که من نفهمیدم.@ سلمانرشتم فیزیک.اینم توضیح:http://en.wikipedia.org/wiki/Self-avoiding_walkالبته من در دوبعدش رو میخوام.@ doomhammerاینکه یه جا گیر میکنه درسته به شرط اینکه خیلی کوچیک باشه شبکه مون.من با ماتریسها اومدم یه ماتریس دادم و هر خونه ای رفته رو ریختم توش.بعد گفتم بیا و هر خونه ای رو میخوای بری چک کن تو اون ماتریسه هست؟اگر نیست برو.اگر هست که یه جهت دیگه انتخاب کن.برنامه ای هم که تو پست اول گذاشتم ویرایش کردم.این بدون ماتریس:کد: [انتخاب] REAL ran3,r,b,d INTEGER i,step,s,m,j,a,x,y open(12,file="self12.txt") open(14,file="self14.txt") READ(*,*) step s=0 m=0 Do k=1,4*step+1 write (12,88) 0,0,0,0.0 enddo rewind 12 Do i=1,step rewind 12 r=ran3(i) if (r .gt.0.75 ) then Do j=1,i rewind 12 READ (12,88) a,x,y,b if (s+1==x .and. m==y) thenc rewind 12c write (12,88) i,s+1,m,d goto 66 end if enddo s=s+1 endif if (r .gt. 0.5 .and. 0.75 .gt. r ) then Do j=1,i rewind 12 READ (12,88) a,x,y,b if (s-1==x .and. m==y) thenc rewind 12c write (12,88) i,s-1,m,d goto 66 end if enddo s=s-1 end if if (r .gt. 0.25 .and. 0.5 .gt. r ) then Do j=1,i rewind 12 READ (12,88) a,x,y,b if (s==x .and. m+1==y) thenc rewind 12c write (12,88) i,s,m+1,d goto 66 end if enddo m=m+1 end if if ( 0.25 .gt. r ) then Do j=1,i rewind 12 READ (12,88) a,x,y,b if (s==x .and. m-1==y) thenc rewind 12c write (12,88) i,s,m-1,d goto 66 end if enddo m=m-1 end if d=((m**2+s**2))**(0.5) write (14,*) i,s,m,d write (12,88) i,s,m,d66 END DO88 format (I4,I4,I4,F8.3) end !!!!!!!!!!!!!!RAN3(idum) !!!!!!!!!!!!!!!!!! FUNCTION ran3(idum) INTEGER idum INTEGER MBIG,MSEED,MZC 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)+MBIG12 continue13 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این هم ماتریسیش.البته اینی که شما میگین خیلی ایده بهتریه ولی مثلا برای ۱۰۰۰۰۰*۱۰۰۰۰ فکر کنم کم بیاره نه؟کد: [انتخاب] 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)=m66 END DO88 format (I4,I4,I4,F8.3) end !!!!!!!!!!!!!!RAN3(idum) !!!!!!!!!!!!!!!!!! FUNCTION ran3(idum) INTEGER idum INTEGER MBIG,MSEED,MZC 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)+MBIG12 continue13 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
REAL ran3,r,b,d INTEGER i,step,s,m,j,a,x,y open(12,file="self12.txt") open(14,file="self14.txt") READ(*,*) step s=0 m=0 Do k=1,4*step+1 write (12,88) 0,0,0,0.0 enddo rewind 12 Do i=1,step rewind 12 r=ran3(i) if (r .gt.0.75 ) then Do j=1,i rewind 12 READ (12,88) a,x,y,b if (s+1==x .and. m==y) thenc rewind 12c write (12,88) i,s+1,m,d goto 66 end if enddo s=s+1 endif if (r .gt. 0.5 .and. 0.75 .gt. r ) then Do j=1,i rewind 12 READ (12,88) a,x,y,b if (s-1==x .and. m==y) thenc rewind 12c write (12,88) i,s-1,m,d goto 66 end if enddo s=s-1 end if if (r .gt. 0.25 .and. 0.5 .gt. r ) then Do j=1,i rewind 12 READ (12,88) a,x,y,b if (s==x .and. m+1==y) thenc rewind 12c write (12,88) i,s,m+1,d goto 66 end if enddo m=m+1 end if if ( 0.25 .gt. r ) then Do j=1,i rewind 12 READ (12,88) a,x,y,b if (s==x .and. m-1==y) thenc rewind 12c write (12,88) i,s,m-1,d goto 66 end if enddo m=m-1 end if d=((m**2+s**2))**(0.5) write (14,*) i,s,m,d write (12,88) i,s,m,d66 END DO88 format (I4,I4,I4,F8.3) end !!!!!!!!!!!!!!RAN3(idum) !!!!!!!!!!!!!!!!!! FUNCTION ran3(idum) INTEGER idum INTEGER MBIG,MSEED,MZC 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)+MBIG12 continue13 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
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)=m66 END DO88 format (I4,I4,I4,F8.3) end !!!!!!!!!!!!!!RAN3(idum) !!!!!!!!!!!!!!!!!! FUNCTION ran3(idum) INTEGER idum INTEGER MBIG,MSEED,MZC 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)+MBIG12 continue13 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