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(i<n)then
adj(space*(i-1)+1)=i+1
adj(space*(i+1-1)+3)=i
else
adj(space*(i-1)+1)=1
adj(space*(1-1)+3)=i
end if
if(i<n-1)then
adj(space*(i-1)+2)=i+2
adj(space*(i+2-1)+4)=i
else
adj(space*(i-1)+2)=i+2-n
adj(space*(i+2-n-1)+4)=i
end if
end do
do i=1,n
degree(i)=4
end do
p=0.2
call random_seed
do i=1,n
if(degree(i)==1)then
goto 102
end if
do j=1,2
call random_number(r)
if(r<p)then
adj(space*(i-1)+j)=0
101 call random_number(r)
head=r*n+1
if(i+j<=n)then
do k=1,degree(i+j)
if(adj(space*(i+j-1)+k)==head)then
goto 101
end if
end do
adj(space*(i+j-1)+degree(i+j)+1)=head
adj(space*(head-1)+degree(head)+1)=i+j
degree(head)=degree(head)+1
else
do k=1,degree(i+j-n)
if(adj(space*(i+j-n-1)+k)==head)then
goto 101
end if
end do
adj(space*(i+j-n-1)+degree(i+j-n)+1)=head
adj(space*(head-1)+degree(head)+1)=i+j-n
degree(head)=degree(head)+1
end if
end if
end do
102 continue
end do
do i=1,n
do j=1,2
if(adj(space*(i-1)+1)==0)then
do k=1,degree(i)
adj(space*(i-1)+k)=adj(space*(i-1)+k+1)
end do
degree(i)=degree(i)-1
end if
end do
end do
!####################the network is generated####################
!##########################diffusion#############################
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,degree(i)
suma(i)=suma(i)+(activity(adj(space*(i-1)+k))-activity(i))
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,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
