WS小世界网络
相关代码
program activity_diffusion
implicit none
integer, parameter :: n=10000,e=2,space=100,time=30000
integer :: i,j,k,head,tail,tt,cc,o
integer :: adj(n*space)=0,degree(n)=0
real :: r,t,p
real :: k1,k2,k3,k4,kk
real :: activity(n)=0,D(n)=0,suma(n)=0
real :: temp(n)=0,avactivity(n)=0
open(10,file='activity.txt',status='old')
do o=1,20
!****************************************************************
forall(i=1:n*space)adj(i)=0
forall(i=1:n)degree(i)=0
!####################generate a WS network#######################
do i=1,n
if(i0)then
cc=cc+1
end if
end do
D(i)=cc/degree(i)
k1=t*(D(i)*suma(i))
suma(i)=0
do k=1,degree(i)
suma(i)=suma(i)+(activity(adj(space*(i-1)+k))-(activity(i)+k1/2))
end do
k2=t*(D(i)*suma(i))
suma(i)=0
do k=1,degree(i)
suma(i)=suma(i)+(activity(adj(space*(i-1)+k))-(activity(i)+k2/2))
end do
k3=t*(D(i)*suma(i))
suma(i)=0
do k=1,degree(i)
suma(i)=suma(i)+(activity(adj(space*(i-1)+k))-(activity(i)+k3))
end do
k4=t*(D(i)*suma(i))
kk=((k1+k4)/2+k2+k3)/3
activity(i)=activity(i)+kk
end do
end do
!****************************************************************
do i=1,n
temp(i)=temp(i)+activity(i)
end do
write(*,*)o
end do
do i=1,n
avactivity(i)=temp(i)/20
end do
!###########################[output]#############################
do i=1,n
write(10,20) degree(i),avactivity(i)
write(*,*) degree(i),avactivity(i)
end do
20 format(1x,I5,2x,f15.5)
close(10)
stop
end program
BA无标度网络
代码
program activity_diffusion
implicit none
integer, parameter :: n=100,space=100,time=30000
integer :: i,j,k,head,tail1,tail2,tt,cc,o
integer :: adj(n*space)=0
real :: r,t,ktotal
real :: k1,k2,k3,k4,kk
real :: CDF(0:n)=0,degree(n)=0
real :: activity(n)=0,D(n)=0,suma(n)=0
real :: temp(n)=0,avactivity(n)=0
open(10,file='activity.txt',status='old')
!####################generate a BA network#######################
adj(space*(1-1)+1)=2
adj(space*(1-1)+2)=3
adj(space*(2-1)+1)=1
adj(space*(2-1)+2)=3
adj(space*(3-1)+1)=1
adj(space*(3-1)+2)=2
do i=1,3
degree(i)=2
CDF(i)=CDF(i-1)+1/3
end do
call random_seed
do head=4,n
call random_number(r)
do i=1,head-1
if(r<=CDF(i))then
tail1=i
goto 101
end if
end do
101 continue
adj(space*(head-1)+1)=tail1
degree(tail1)=degree(tail1)+1
102 call random_number(r)
do i=1,head-1
if(r<=CDF(i))then
tail2=i
if(tail2==tail1)then
goto 102
end if
goto 103
end if
end do
103 continue
adj(space*(head-1)+2)=tail2
degree(tail2)=degree(tail2)+1
degree(head)=2
do k=1,space
if(adj(space*(tail1-1)+k)==0)then
adj(space*(tail1-1)+k)=head
goto 104
end if
end do
104 continue
do k=1,space
if(adj(space*(tail2-1)+k)==0)then
adj(space*(tail2-1)+k)=head
goto 105
end if
end do
105 continue
ktotal=0
do i=1,head
ktotal=ktotal+degree(i)
end do
do i=1,head
CDF(i)=CDF(i-1)+degree(i)/ktotal
end do
end do
!####################the network is generated####################
!##########################diffusion#############################
do o=1,20
!****************************************************************
do i=1,n
call random_number(r)
activity(i)=r
end do
t=0.01
do tt=1,time
do i=1,n
cc=0
suma(i)=0
D(i)=0
do k=1,space
if(adj(space*(i-1)+k)/=0)then
suma(i)=suma(i)+(activity(adj(space*(i-1)+k))-activity(i))
end if
if(activity(adj(space*(i-1)+k))-activity(i)>0)then
cc=cc+1
end if
end do
D(i)=cc/degree(i)
k1=t*(D(i)*suma(i))
suma(i)=0
do k=1,space
if(adj(space*(i-1)+k)/=0)then
suma(i)=suma(i)+(activity(adj(space*(i-1)+k))-(activity(i)+k1/2))
end if
end do
k2=t*(D(i)*suma(i))
suma(i)=0
do k=1,space
if(adj(space*(i-1)+k)/=0)then
suma(i)=suma(i)+(activity(adj(space*(i-1)+k))-(activity(i)+k2/2))
end if
end do
k3=t*(D(i)*suma(i))
suma(i)=0
do k=1,space
if(adj(space*(i-1)+k)/=0)then
suma(i)=suma(i)+(activity(adj(space*(i-1)+k))-(activity(i)+k3))
end if
end do
k4=t*(D(i)*suma(i))
kk=((k1+k4)/2+k2+k3)/3
activity(i)=activity(i)+kk
! write(*,*)o,tt,activity(i)
end do
end do
!****************************************************************
do i=1,n
temp(i)=temp(i)+activity(i)
end do
write(*,*)o
end do
do i=1,n
avactivity(i)=temp(i)/20
end do
!###########################[output]#############################
do i=1,n
write(10,20) degree(i),avactivity(i)
write(*,*) degree(i),avactivity(i)
end do
20 format(1x,f15.5,2x,f15.5)
close(10)
stop
end program