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