alessand...@gmail.com wrote:
> Hello, I'm want simulate the fractional Brownian motion but I didn't
> found not yet. When I found I code or algorithm to simulate the fBm?
>
> Thanks
This is fortran, a random particle walk program, where particles
diffuse into neighbouring space.
I hope you can use the algoritm,from the book of Margolus and Toffoly.
(You might buy it :) )
-------------------------------------------------------
cc 'difuse1.for' 2 phase diffusion algorithm from margolus and toffoly.
include '
FGRAPH.FI'
include 'FGRAPH.FD'
character toets*1
integer*1 a(0:319,0:199),phase,idum(64004),k1,k2,k3,k4
integer*2 dummy
integer*4 pal
equivalence(idum(5),a(0,0))
dummy= setvideomoderows($mres256color,25)
call clearscreen($gclearscreen)
phase=0
pal=63
dummy=remappalette(1,pal)
pal=256*63
dummy=remappalette(2,pal)
pal=256*63+63
dummy=remappalette(3,pal)
pal=256*256*63
dummy=remappalette(4,pal)
pal=256*256*63+63
dummy=remappalette(5,pal)
pal=256*256*63+256*63
dummy=remappalette(6,pal)
pal=256*256*63+256*63+63
dummy=remappalette(7,pal)
call getimage(0,0,319,199,idum)
c 3circles rgb combining on screen
c clear dataarray.
a=0
c put 3 overlapping circles in the dataarray,
c with the proper color mixing when overlapping.
call xorcircle(1,160,130,66,a)
call putimage(0,0,idum,$gpset)
call xorcircle(2,160-33,70,66,a)
call putimage(0,0,idum,$gpset)
call xorcircle(4,160+33,70,66,a)
c
c in a two phase structure,
c use a local 2X2 square
c
toets=char(255)
do while(toets.eq.char(255))
c
c array to screen
c
c swap current data array to screen...
call putimage(0,0,idum,$gpset)
call keychk(toets)
c
c process data array
c
phase=ieor(phase,1)
if(phase.eq.0)then
nxb=0
nxe=318
nyb=0
nye=198
else
nxb=1
nxe=319
nyb=1
nye=199
endif
do ix=nxb,nxe,2
ixx=ix+1
if(ixx.eq.320)ixx=0
do iy=nyb,nye,2
iyy=iy+1
if(iyy.eq.200)iyy=0
k1=a(ix,iy)
k2=a(ixx,iy)
k3=a(ix,iyy)
k4=a(ixx,iyy)
c Random swap of particles.
call random(x)
if(x.lt..5)then
a(ix,iy)=k3
a(ixx,iy)=k1
a(ix,iyy)=k4
a(ixx,iyy)=k2
else
a(ix,iy)=k2
a(ixx,iy)=k4
a(ix,iyy)=k1
a(ixx,iyy)=k3
endif
enddo
enddo
enddo
dummy=setvideomode($textc80)
end
c
c Fill the dataarray with a circle
c xor the pixel color with the previous pixel color.
c
subroutine xorcircle(ncol,ix,iy,ir,a)
integer*1 a(0:319,0:199)
do kr=-ir,ir
dx=sqrt(float(ir)*float(ir)-float(kr)*float(kr))
ib=float(ix)-dx
ie=float(ix)+dx
do kx=ib,ie
a(kx,iy+kr)=ieor(a(kx,iy+kr),ncol)
enddo
enddo
return
end