Bistability-mechanism induced chimera state in one-dimensional paced excitable ring with nonlocal couplings
阅读
复现
module BOM
implicit none
integer,parameter :: R=33,MaxT=50000,L=200
integer,allocatable :: neighbour_matrix(:,:)
real,parameter :: h=0.02,PI=3.1415926
contains
subroutine fnf()
implicit none
integer :: i,j,t,num
real :: epsilon=0.04,a=0.84,b=0.07,A1=0.01,f=4.0,sigma=0.132,effect,u(L),v(L),fun_u(L),fun_v(L),x,y,Z(L),U_max(L),U_min(L)
U_max=-10.0
U_min=10.0
do i=1,L,1
read(10,*) u(i),v(i)
end do
do t=1,MaxT,1
do i=1,L,1
effect=0.0
do j=1,L
effect=effect+neighbour_matrix(i,j)*(u(j)-u(i))
end do
fun_u(i)=u(i)+h*(1.0/epsilon*u(i)*(1.0-u(i))*(u(i)-(v(i)+b)/a)+sigma/(2.0*R)*effect+A1*sin(2.0*PI*f*t*h))
if(u(i)<1.0/3.0)then
fun_v(i)=v(i)+h*(-v(i))
else if(u(i)>=1.0/3.0.and.u(i)<=1)then
fun_v(i)=v(i)+h*(1-6.75*u(i)*(u(i)-1)**2-v(i))
else if(u(i)>1.0)then
fun_v(i)=v(i)+h*(1-v(i))
end if
call parameter_Z(u,v,i,Z)
if(mod(t,50)==0) then
write(20,*) i,t*h,u(i)
write(40,*) i,t*h,Z(i)
end if
end do
call U_max_min(u,U_max,U_min)
u=fun_u
v=fun_v
end do
do j=1,L,1
write(60,*) j,U_max(j)
write(80,*) j,U_min(j)
end do
return
end subroutine fnf
subroutine parameter_Z(u,v,i,Z)
implicit none
real :: u(L),v(L),Z(L),Ans_Z_X,Ans_Z_Y
integer :: i,j
Ans_Z_X=0.0
Ans_Z_Y=0.0
do j=1,L,1
Ans_Z_X=Ans_Z_X+neighbour_matrix(i,j)*(cos(atan(v(j)/u(j))))
Ans_Z_Y=Ans_Z_Y+neighbour_matrix(i,j)*(sin(atan(v(j)/u(j))))
end do
Z(i)=sqrt((Ans_Z_X/(2.0*R))**2+(Ans_Z_Y/(2.0*R))**2)
return
end subroutine parameter_Z
subroutine neighbour(N,K)
implicit none
integer :: N,K
integer :: i,j,number
allocate(neighbour_matrix(N,N))
neighbour_matrix=0
do i=1,N-1,1
do j=i+1,N,1
if(abs(i-j)<=K/2.or.abs(i-j)>=N-K/2) then
neighbour_matrix(i,j)=1
neighbour_matrix(j,i)=1
end if
end do
end do
end subroutine neighbour
end module BOM
program main
use BOM
implicit none
open(10,file="u0_article.txt",access='sequential',position = 'rewind',action = 'read')
open(20,file="data_u.txt")
open(40,file="data_z.txt")
open(60,file="data_u_max.txt")
open(80,file="data_u_min.txt")
call neighbour(L,2*R)
call random_seed()
call fnf()
deallocate(neighbour_matrix)
close(20)
end program main
module BOM
implicit none
integer,parameter :: R=33,MaxT=50000,L=200
integer,allocatable :: neighbour_matrix(:,:)
real,parameter :: h=0.02,PI=3.1415926
contains
subroutine fnf()
implicit none
integer :: i,j,t,num
real :: epsilon=0.04,a=0.84,b=0.07,A1=0.01,f=4.0,sigma=0.132,effect,u(L),v(L),fun_u(L),fun_v(L),x,y,Z(L),U_max(L),U_min(L)
U_max=-10.0
U_min=10.0
do i=1,L,1
read(10,*) u(i),v(i)
end do
do t=1,MaxT,1
do i=1,L,1
effect=0.0
do j=1,L
effect=effect+neighbour_matrix(i,j)*(u(j)-u(i))
end do
fun_u(i)=u(i)+h*(1.0/epsilon*u(i)*(1.0-u(i))*(u(i)-(v(i)+b)/a)+sigma/(2.0*R)*effect+A1*sin(2.0*PI*f*t*h))
if(u(i)<1.0/3.0)then
fun_v(i)=v(i)+h*(-v(i))
else if(u(i)>=1.0/3.0.and.u(i)<=1)then
fun_v(i)=v(i)+h*(1-6.75*u(i)*(u(i)-1)**2-v(i))
else if(u(i)>1.0)then
fun_v(i)=v(i)+h*(1-v(i))
end if
end do
if(t>=45000) then
call U_max_min(u,U_max,U_min)
end if
u=fun_u
v=fun_v
end do
do j=1,L,1
if(U_max(j)<0.2) then
write(60,*) j,U_max(j)
write(80,*) j,U_min(j)
end if
end do
return
end subroutine fnf
subroutine U_max_min(u,U_max,U_min)
implicit none
real :: U_max(L),U_min(L),u(L)
integer :: i
do i=1,L,1
if(U_max(i)<u(i)) then
U_max(i)=u(i)
end if
if(U_min(i)>u(i)) then
U_min(i)=u(i)
end if
end do
return
end subroutine U_max_min
subroutine neighbour(N,K)
implicit none
integer :: N,K
integer :: i,j,number
allocate(neighbour_matrix(N,N))
neighbour_matrix=0
do i=1,N-1,1
do j=i+1,N,1
if(abs(i-j)<=K/2.or.abs(i-j)>=N-K/2) then
neighbour_matrix(i,j)=1
neighbour_matrix(j,i)=1
end if
end do
end do
end subroutine neighbour
end module BOM
program main
use BOM
implicit none
open(10,file="u0_article.txt",access='sequential',position = 'rewind',action = 'read')
open(60,file="data_u_max.txt")
open(80,file="data_u_min.txt")
call neighbour(L,2*R)
call random_seed()
call fnf()
deallocate(neighbour_matrix)
close(20)
end program main
module BOM
implicit none
integer,parameter :: R=33,MaxT=50000,L=200
integer,allocatable :: neighbour_matrix(:,:)
real,parameter :: h=0.02,PI=3.1415926
contains
subroutine fnf()
implicit none
integer :: i,j,t,M(L),stepT,count_number(L)
real :: epsilon=0.04,a=0.84,b=0.07,A1=0.01,f=4.0,sigma=0.132,effect,u(L),v(L),fun_u(L),fun_v(L)
M(L)=0
count_number(L)=0
do i=1,L,1
read(10,*) u(i),v(i)
end do
do t=1,MaxT,1
do i=1,L,1
effect=0.0
do j=1,L
effect=effect+neighbour_matrix(i,j)*(u(j)-u(i))
end do
fun_u(i)=u(i)+h*(1.0/epsilon*u(i)*(1.0-u(i))*(u(i)-(v(i)+b)/a)+sigma/(2.0*R)*effect+A1*sin(2.0*PI*f*t*h))
if(u(i)<1.0/3.0)then
fun_v(i)=v(i)+h*(-v(i))
else if(u(i)>=1.0/3.0.and.u(i)<=1)then
fun_v(i)=v(i)+h*(1-6.75*u(i)*(u(i)-1)**2-v(i))
else if(u(i)>1.0)then
fun_v(i)=v(i)+h*(1-v(i))
end if
if(t>=1) then
if(u(i)>0.2) then
count_number(i)=count_number(i)+1
else if(count_number(i)>30.and.u(i)<0.2) then
M(i)=M(i)+1
count_number(i)=0
end if
if(i==4) then
continue
end if
end if
end do
u=fun_u
v=fun_v
end do
stepT=MaxT
call parameter_Omega(M,stepT)
return
end subroutine fnf
subroutine parameter_Omega(M,stepT)
implicit none
real :: omega(L)
integer :: i,stepT,M(L)
do i=1,L,1
omega(i)=(2.0*PI*M(i))/(stepT*h)
write(20,*) i,omega(i)
end do
return
end subroutine parameter_Omega
subroutine neighbour(N,K)
implicit none
integer :: N,K
integer :: i,j,number
allocate(neighbour_matrix(N,N))
neighbour_matrix=0
do i=1,N-1,1
do j=i+1,N,1
if(abs(i-j)<=K/2.or.abs(i-j)>=N-K/2) then
neighbour_matrix(i,j)=1
neighbour_matrix(j,i)=1
end if
end do
end do
end subroutine neighbour
end module BOM
program main
use BOM
implicit none
open(10,file="u0_article.txt",access='sequential',position = 'rewind',action = 'read')
open(20,file="data.txt")
open(60,file="data_M.txt")
open(80,file="data_u_min.txt")
call neighbour(L,2*R)
call random_seed()
call fnf()
deallocate(neighbour_matrix)
close(20)
end program main
module BOM
implicit none
integer,parameter :: R=33,MaxT=50000,L=200
integer,allocatable :: neighbour_matrix(:,:)
real,parameter :: h=0.02,PI=3.1415926
contains
subroutine fnf()
implicit none
integer :: i,j,t,num
real :: epsilon=0.04,a=0.84,b=0.07,A1=0.01,f=4.0,sigma=0.132,effect,u(L),v(L),fun_u(L),fun_v(L),x,y,Z(L),U_max(L),U_min(L)
U_max=-10.0
U_min=10.0
do i=1,L,1
read(10,*) u(i),v(i)
end do
do t=1,MaxT,1
do i=1,L,1
effect=0.0
do j=1,L
effect=effect+neighbour_matrix(i,j)*(u(j)-u(i))
end do
fun_u(i)=u(i)+h*(1.0/epsilon*u(i)*(1.0-u(i))*(u(i)-(v(i)+b)/a)+sigma/(2.0*R)*effect+A1*sin(2.0*PI*f*t*h))
if(u(i)<1.0/3.0)then
fun_v(i)=v(i)+h*(-v(i))
else if(u(i)>=1.0/3.0.and.u(i)<=1)then
fun_v(i)=v(i)+h*(1-6.75*u(i)*(u(i)-1)**2-v(i))
else if(u(i)>1.0)then
fun_v(i)=v(i)+h*(1-v(i))
end if
if(i==140.and.t>=45000) then
write(20,*) t*h,u(i)
write(40,*) t*h,v(i)
end if
end do
u=fun_u
v=fun_v
end do
return
end subroutine fnf
subroutine neighbour(N,K)
implicit none
integer :: N,K
integer :: i,j,number
allocate(neighbour_matrix(N,N))
neighbour_matrix=0
do i=1,N-1,1
do j=i+1,N,1
if(abs(i-j)<=K/2.or.abs(i-j)>=N-K/2) then
neighbour_matrix(i,j)=1
neighbour_matrix(j,i)=1
end if
end do
end do
end subroutine neighbour
end module BOM
program main
use BOM
implicit none
open(10,file="u0_article.txt",access='sequential',position = 'rewind',action = 'read')
open(20,file="data_u.txt")
open(40,file="data_v.txt")
call neighbour(L,2*R)
call random_seed()
call fnf()
deallocate(neighbour_matrix)
close(20)
close(40)
end program main
module BOM
implicit none
real,parameter :: PI=3.1415926
contains
subroutine fnf(u,v)
implicit none
integer :: i,j,t,num
real :: epsilon=0.04,a=0.84,b=0.07,fun_u,fun_v,u,v
real :: theta,tantheta,sintheta,radius
fun_u=1.0/epsilon*u*(1.0-u)*(u-(v+b)/a)
if(u<1.0/3.0)then
fun_v=0.0-v
else if(u>=1.0/3.0.and.u<=1)then
fun_v=1-6.75*u*(u-1)**2-v
else if(u>1.0)then
fun_v=1.0-v
end if
tantheta=fun_v/fun_u
radius=sqrt(fun_u**2+fun_v**2)
sintheta=fun_v/radius
if(sintheta>=0.0) then
if(tantheta>=0.0) then
theta=atan(tantheta)
else
theta=atan(tantheta)+PI
end if
else
if(tantheta>=0) then
theta=atan(tantheta)+PI
else
theta=atan(tantheta)
end if
end if
write(20,*) u,v,theta,1
return
end subroutine fnf
end module BOM
program main
use BOM
implicit none
integer :: a,b
open(20,file="data_vector.txt")
do a=-5,29,1
do b=-5,25,1
call fnf(a*0.05,b*0.05)
end do
end do
close(20)
end program main
module BOM
implicit none
integer,parameter :: R=33,MaxT=1500,L=200
integer,allocatable :: neighbour_matrix(:,:)
real,parameter :: h=0.02,PI=3.1415926
contains
subroutine fnf()
implicit none
integer :: i,j,t,num
real :: epsilon=0.04,a=0.84,b=0.07,A1=0.01,f=4.0,sigma=0.132,effect,u(L),v(L),fun_u(L),fun_v(L)
u=1.01
v=0.5
do t=1,MaxT,1
do i=1,L,1
effect=0.0
do j=1,L
effect=effect+neighbour_matrix(i,j)*(u(j)-u(i))
end do
fun_u(i)=u(i)+h*(1.0/epsilon*u(i)*(1.0-u(i))*(u(i)-(v(i)+b)/a)+sigma/(2.0*R)*effect+A1*sin(2.0*PI*f*t*h))
if(u(i)<1.0/3.0)then
fun_v(i)=v(i)+h*(-v(i))
else if(u(i)>=1.0/3.0.and.u(i)<=1)then
fun_v(i)=v(i)+h*(1-6.75*u(i)*(u(i)-1)**2-v(i))
else if(u(i)>1.0)then
fun_v(i)=v(i)+h*(1-v(i))
end if
if(i==10) then
write(20,*) t*h,u(i)
write(40,*) t*h,v(i)
end if
end do
u=fun_u
v=fun_v
end do
return
end subroutine fnf
subroutine neighbour(N,K)
implicit none
integer :: N,K
integer :: i,j,number
allocate(neighbour_matrix(N,N))
neighbour_matrix=0
do i=1,N-1,1
do j=i+1,N,1
if(abs(i-j)<=K/2.or.abs(i-j)>=N-K/2) then
neighbour_matrix(i,j)=1
neighbour_matrix(j,i)=1
end if
end do
end do
end subroutine neighbour
end module BOM
program main
use BOM
implicit none
open(20,file="data_u.txt")
open(40,file="data_v.txt")
call neighbour(L,2*R)
call random_seed()
call fnf()
deallocate(neighbour_matrix)
close(20)
close(40)
end program main
module BOM
implicit none
integer,parameter :: R=33,MaxT=1500,L=200
integer,allocatable :: neighbour_matrix(:,:)
real,parameter :: h=0.02,PI=3.1415926
contains
subroutine fnf(u0,v0)
implicit none
integer :: i,j,t,state
real :: epsilon=0.04,a=0.84,b=0.07,A1=0.01,f=4.0,sigma=0.132,effect,u(L),v(L),fun_u(L),fun_v(L),U_max(L),U_min(L),u0,v0
U_max=-10.0
U_min=10.0
u=u0
v=v0
do t=1,MaxT,1
do i=1,L,1
effect=0.0
do j=1,L
effect=effect+neighbour_matrix(i,j)*(u(j)-u(i))
end do
fun_u(i)=u(i)+h*(1.0/epsilon*u(i)*(1.0-u(i))*(u(i)-(v(i)+b)/a)+sigma/(2.0*R)*effect+A1*sin(2.0*PI*f*t*h))
if(u(i)<1.0/3.0)then
fun_v(i)=v(i)+h*(-v(i))
else if(u(i)>=1.0/3.0.and.u(i)<=1)then
fun_v(i)=v(i)+h*(1-6.75*u(i)*(u(i)-1)**2-v(i))
else if(u(i)>1.0)then
fun_v(i)=v(i)+h*(1-v(i))
end if
end do
if(t>=1000) then
call U_max_min(u,U_max,U_min)
end if
u=fun_u
v=fun_v
end do
do j=10,10,1
if(U_max(j)>1.2) then
state = 1
else
state = 0
end if
write(20,*) u0,v0,state
write(*,*) u0,v0,state
end do
return
end subroutine fnf
subroutine neighbour(N,K)
implicit none
integer :: N,K
integer :: i,j,number
allocate(neighbour_matrix(N,N))
neighbour_matrix=0
do i=1,N-1,1
do j=i+1,N,1
if(abs(i-j)<=K/2.or.abs(i-j)>=N-K/2) then
neighbour_matrix(i,j)=1
neighbour_matrix(j,i)=1
end if
end do
end do
end subroutine neighbour
subroutine U_max_min(u,U_max,U_min)
implicit none
real :: U_max(L),U_min(L),u(L)
integer :: i
do i=1,L,1
if(U_max(i)<u(i)) then
U_max(i)=u(i)
end if
if(U_min(i)>u(i)) then
U_min(i)=u(i)
end if
end do
return
end subroutine U_max_min
end module BOM
program main
use BOM
implicit none
integer :: a,b
open(20,file="data_u0_v0.txt")
call neighbour(L,2*R)
do a=1,200,1
do b=1,200,1
call fnf(a*0.01,b*0.01)
end do
end do
deallocate(neighbour_matrix)
close(20)
end program main
module BOM
implicit none
integer,parameter :: R=33,MaxT=50000,L=200
integer,allocatable :: neighbour_matrix(:,:)
real,parameter :: h=0.02,PI=3.1415926
contains
subroutine fnf()
implicit none
integer :: i,j,t,num
real :: epsilon=0.04,a=0.84,b=0.07,A1=3.0,f=4.0,sigma=0.132,effect,u(L),v(L),fun_u(L),fun_v(L),x,y,Z(L),U_max(L),U_min(L)
U_max=-10.0
U_min=10.0
do i=1,L,1
read(10,*) u(i),v(i)
end do
do t=1,MaxT,1
do i=1,L,1
effect=0.0
do j=1,L
effect=effect+neighbour_matrix(i,j)*(u(j)-u(i))
end do
fun_u(i)=u(i)+h*(1.0/epsilon*u(i)*(1.0-u(i))*(u(i)-(v(i)+b)/a)+sigma/(2.0*R)*effect+A1*sin(2.0*PI*f*t*h))
if(u(i)<1.0/3.0)then
fun_v(i)=v(i)+h*(-v(i))
else if(u(i)>=1.0/3.0.and.u(i)<=1)then
fun_v(i)=v(i)+h*(1-6.75*u(i)*(u(i)-1)**2-v(i))
else if(u(i)>1.0)then
fun_v(i)=v(i)+h*(1-v(i))
end if
call parameter_Z(u,v,i,Z)
if(mod(t,50)==0) then
write(20,*) i,t*h,u(i)
write(40,*) i,t*h,Z(i)
end if
end do
if(t>=45000) then
call U_max_min(u,U_max,U_min)
end if
u=fun_u
v=fun_v
end do
do j=1,L,1
if(U_max(j)<0.2) then
write(61,*) j,U_max(j),U_min(j)
else if(U_max(j)>0.2.and.U_max(j)<1.2) then
write(62,*) j,U_max(j),U_min(j)
else
write(63,*) j,U_max(j),U_min(j)
end if
end do
return
end subroutine fnf
subroutine parameter_Z(u,v,i,Z)
implicit none
real :: u(L),v(L),Z(L),Ans_Z_X,Ans_Z_Y
integer :: i,j
Ans_Z_X=0.0
Ans_Z_Y=0.0
do j=1,L,1
Ans_Z_X=Ans_Z_X+neighbour_matrix(i,j)*(cos(atan(v(j)/u(j))))
Ans_Z_Y=Ans_Z_Y+neighbour_matrix(i,j)*(sin(atan(v(j)/u(j))))
end do
Z(i)=sqrt((Ans_Z_X/(2.0*R))**2+(Ans_Z_Y/(2.0*R))**2)
return
end subroutine parameter_Z
subroutine U_max_min(u,U_max,U_min)
implicit none
real :: U_max(L),U_min(L),u(L)
integer :: i
do i=1,L,1
if(U_max(i)<u(i)) then
U_max(i)=u(i)
end if
if(U_min(i)>u(i)) then
U_min(i)=u(i)
end if
end do
return
end subroutine U_max_min
subroutine neighbour(N,K)
implicit none
integer :: N,K
integer :: i,j,number
allocate(neighbour_matrix(N,N))
neighbour_matrix=0
do i=1,N-1,1
do j=i+1,N,1
if(abs(i-j)<=K/2.or.abs(i-j)>=N-K/2) then
neighbour_matrix(i,j)=1
neighbour_matrix(j,i)=1
end if
end do
end do
end subroutine neighbour
end module BOM
program main
use BOM
implicit none
open(10,file="u0_article.txt",access='sequential',position = 'rewind',action = 'read')
open(20,file="data_u.txt")
open(40,file="data_z.txt")
open(61,file="data_u_max_min_blue.txt")
open(62,file="data_u_max_min_green.txt")
open(63,file="data_u_max_min_red.txt")
call neighbour(L,2*R)
call random_seed()
call fnf()
deallocate(neighbour_matrix)
close(20)
end program main
module chimera
implicit none
integer,parameter :: L=200,MaxT=1500,R=33
integer,allocatable :: neighbour_matrix(:,:)
real,parameter :: h=0.02,PI=3.1415926
contains
subroutine fnf()
implicit none
real :: epsilon=0.04,a=0.84,b=0.07,D=1.0,A1=3.0,f=4.0,sigma=0.132,effect,u(L),v(L),fun_u(L),fun_v(L)
integer :: i,j,t
u=0.9
v=1.0
do t=1,MaxT,1
do i=1,L,1
effect=0
do j=1,L
effect=effect+neighbour_matrix(i,j)*(u(j)-u(i))
end do
fun_u(i)=u(i)+h*(1.0/epsilon*u(i)*(1.0-u(i))*(u(i)-(v(i)+b)/a)+sigma/2.0*R*effect+A1*sin(2.0*PI*f*t*h))
if(u(i)<1.0/3.0)then
fun_v(i)=v(i)+h*(-v(i))
else if(u(i)>=1.0/3.0.and.u(i)<=1)then
fun_v(i)=v(i)+h*(1-6.75D0*u(i)*(u(i)-1)**2-v(i))
else if(u(i)>1.0)then
fun_v(i)=v(i)+h*(1-v(i))
end if
if(i==1) then
write(20,*) t*h,fun_u(i)
write(40,*) t*h,fun_v(i)
end if
end do
u=fun_u
v=fun_v
end do
close(20)
close(40)
return
end subroutine fnf
subroutine neighbour(N,K)
implicit none
integer :: N,K
integer :: i,j,number
allocate(neighbour_matrix(N,N))
neighbour_matrix=0
do i=1,N-1,1
do j=i+1,N,1
if(abs(i-j)<=K/2.or.abs(i-j)>=N-K/2) then
neighbour_matrix(i,j)=1
neighbour_matrix(j,i)=1
end if
end do
end do
end subroutine neighbour
end module chimera
program main
use chimera
implicit none
integer :: i
open(10,file="neighbour_matrix.txt")
open(20,file="data_u.txt")
open(40,file="data_v.txt")
call neighbour(L,2*R)
call fnf()
deallocate(neighbour_matrix)
end program main
module BOM
implicit none
integer,parameter :: R=33,MaxT=1500,L=200
integer,allocatable :: neighbour_matrix(:,:)
real,parameter :: h=0.02,PI=3.1415926
contains
subroutine fnf(A1,f)
implicit none
integer :: i,j,t,num=0
real :: epsilon=0.04,a=0.84,b=0.07,A1,f,sigma=0.132,effect,u(L),v(L),fun_u(L),fun_v(L),x,y,Z(L),U_max(L),U_min(L)
U_max=-10.0
U_min=10.0
do i=1,L,1
read(10,*) u(i),v(i)
end do
do t=1,MaxT,1
do i=1,L,1
effect=0.0
do j=1,L
effect=effect+neighbour_matrix(i,j)*(u(j)-u(i))
end do
fun_u(i)=u(i)+h*(1.0/epsilon*u(i)*(1.0-u(i))*(u(i)-(v(i)+b)/a)+sigma/(2.0*R)*effect+A1*sin(2.0*PI*f*t*h))
if(u(i)<1.0/3.0)then
fun_v(i)=v(i)+h*(-v(i))
else if(u(i)>=1.0/3.0.and.u(i)<=1)then
fun_v(i)=v(i)+h*(1-6.75*u(i)*(u(i)-1)**2-v(i))
else if(u(i)>1.0)then
fun_v(i)=v(i)+h*(1-v(i))
end if
end do
if(t>=1000) then
call U_max_min(u,U_max,U_min)
end if
u=fun_u
v=fun_v
end do
do j=1,1,1
if(U_max(j)<0.2) then
num = 0
else if(U_max(j)>0.2.and.U_max(j)<1.2) then
num = 1
else
num = 2
end if
write(40,*) A1,f,num
write(*,*) A1,f,num
end do
return
end subroutine fnf
subroutine U_max_min(u,U_max,U_min)
implicit none
real :: U_max(L),U_min(L),u(L)
integer :: i
do i=1,L,1
if(U_max(i)<u(i)) then
U_max(i)=u(i)
end if
if(U_min(i)>u(i)) then
U_min(i)=u(i)
end if
end do
return
end subroutine U_max_min
subroutine neighbour(N,K)
implicit none
integer :: N,K
integer :: i,j,number
allocate(neighbour_matrix(N,N))
neighbour_matrix=0
do i=1,N-1,1
do j=i+1,N,1
if(abs(i-j)<=K/2.or.abs(i-j)>=N-K/2) then
neighbour_matrix(i,j)=1
neighbour_matrix(j,i)=1
end if
end do
end do
end subroutine neighbour
end module BOM
program main
use BOM
implicit none
integer :: a,b
open(40,file="data_A_f.txt")
call neighbour(L,2*R)
call random_seed()
do a=1,50,1
do b=1,50,1
open(10,file="u0_article.txt",access='sequential',position = 'rewind',action = 'read')
call fnf(a*0.1,b*0.1)
close(10)
end do
end do
deallocate(neighbour_matrix)
close(40)
end program main
module BOM
implicit none
integer,parameter :: MaxT=50000,L=200
integer,allocatable :: matrix(:,:)
real,parameter :: h=0.02,PI=3.1415926
contains
subroutine fnf()
implicit none
integer :: i,j,t,num
real :: epsilon=0.04,a=0.84,b=0.07,A1=0.01,f=4.0,sigma=0.02,effect,u(L),v(L),fun_u(L),fun_v(L),x,y,Z(L),U_max(L),U_min(L)
U_max=-10.0
U_min=10.0
do i=1,L,1
call random_number(x)
call random_number(y)
u(i)=2.0*x
v(i)=2.0*y
write(10,*) u(i),v(i)
end do
do t=1,MaxT,1
do i=1,L,1
effect=0.0
do j=1,L
effect=effect+matrix(i,j)*(u(j)-u(i))
end do
fun_u(i)=u(i)+h*(1.0/epsilon*u(i)*(1.0-u(i))*(u(i)-(v(i)+b)/a)+0.002*effect+A1*sin(2.0*PI*f*t*h))
if(u(i)<1.0/3.0)then
fun_v(i)=v(i)+h*(-v(i))
else if(u(i)>=1.0/3.0.and.u(i)<=1)then
fun_v(i)=v(i)+h*(1-6.75*u(i)*(u(i)-1)**2-v(i))
else if(u(i)>1.0)then
fun_v(i)=v(i)+h*(1-v(i))
end if
if(mod(t,50)==0) then
write(20,*) i,t*h,u(i)
end if
end do
if(t>=45000) then
call U_max_min(u,U_max,U_min)
end if
u=fun_u
v=fun_v
end do
do j=1,L,1
if(U_max(j)<0.2) then
write(41,*) j,U_max(j),U_min(j)
else if(U_max(j)>0.2.and.U_max(j)<1.2) then
write(42,*) j,U_max(j),U_min(j)
else
write(43,*) j,U_max(j),U_min(j)
end if
end do
return
end subroutine fnf
subroutine U_max_min(u,U_max,U_min)
implicit none
real :: U_max(L),U_min(L),u(L)
integer :: i
do i=1,L,1
if(U_max(i)<u(i)) then
U_max(i)=u(i)
end if
if(U_min(i)>u(i)) then
U_min(i)=u(i)
end if
end do
return
end subroutine U_max_min
subroutine network(N,P)
implicit none
integer :: N,i,j,a,b
real :: x,P
allocate(matrix(N,N))
matrix=0
do i=N,2,-1
do j=i-1,1,-1
call random_number(x)
if(x<p) then
matrix(j,i)=1
matrix(i,j)=1
end if
end do
end do
end subroutine network
end module BOM
program main
use BOM
implicit none
open(20,file="data_u.txt")
open(41,file="data_umax_umin_blue.txt")
open(42,file="data_umax_umin_green.txt")
open(43,file="data_umax_umin_red.txt")
call random_seed()
call network(L,0.4)
call fnf()
deallocate(matrix)
close(20)
close(41)
close(42)
close(43)
end program main
module BOM
implicit none
integer,parameter :: R=22,MaxT=50000,L=200
integer,allocatable :: matrix(:,:)
real,parameter :: h=0.02,PI=3.1415926
contains
subroutine fnf()
implicit none
integer :: i,j,t,num
real :: epsilon=0.04,a=0.84,b=0.07,A1=0.01,f=4.0,sigma=0.132,effect,u(L),v(L),fun_u(L),fun_v(L),U_max(L),U_min(L)
U_max=-10.0
U_min=10.0
do i=1,L,1
call random_number(u(i))
call random_number(v(i))
u(i)=2.0*u(i)
v(i)=2.0*v(i)
end do
do t=1,MaxT,1
do i=1,L,1
effect=0.0
do j=1,L
effect=effect+matrix(i,j)*(u(j)-u(i))
end do
fun_u(i)=u(i)+h*(1.0/epsilon*u(i)*(1.0-u(i))*(u(i)-(v(i)+b)/a)+0.02*effect+A1*sin(2.0*PI*f*t*h))
if(u(i)<1.0/3.0)then
fun_v(i)=v(i)+h*(-v(i))
else if(u(i)>=1.0/3.0.and.u(i)<=1)then
fun_v(i)=v(i)+h*(1-6.75*u(i)*(u(i)-1)**2-v(i))
else if(u(i)>1.0)then
fun_v(i)=v(i)+h*(1-v(i))
end if
if(mod(t,50)==1) then
write(20,*) i,t*h,u(i)
end if
end do
if(t>=49000) then
call U_max_min(u,U_max,U_min)
end if
u=fun_u
v=fun_v
end do
do j=1,L,1
if(U_max(j)<0.2) then
write(41,*) j,U_max(j),U_min(j)
else if(U_max(j)>0.2.and.U_max(j)<1.2) then
write(42,*) j,U_max(j),U_min(j)
else
write(43,*) j,U_max(j),U_min(j)
end if
end do
return
end subroutine fnf
subroutine U_max_min(u,U_max,U_min)
implicit none
real :: U_max(L),U_min(L),u(L)
integer :: i
do i=1,L,1
if(U_max(i)<u(i)) then
U_max(i)=u(i)
end if
if(U_min(i)>u(i)) then
U_min(i)=u(i)
end if
end do
return
end subroutine U_max_min
subroutine network(N,K,P_con)
implicit none
integer :: N,K
integer :: i,j,a,b,number
real :: x,P,P_con
integer :: y
allocate(matrix(N,N))
matrix=0
do i=1,N-1,1
do j=i+1,N,1
if(abs(i-j)<=K/2.or.abs(i-j)>=N-K/2) then
matrix(i,j)=1
matrix(j,i)=1
end if
end do
end do
do i=1,N,1
call random_number(P)
if(P<=P_con) then
100 call random_number(x)
y=nint((x-0.51/N)*N+1)
number=0
do a=1,N,1
if(matrix(i,a)==1) then
number=number+1
end if
end do
if(number<N-1) then
if(matrix(i,y)==0.and.i/=y) then
matrix(i,y)=1
matrix(y,i)=1
else
goto 100
end if
else
cycle
end if
end if
end do
end subroutine network
end module BOM
program main
use BOM
implicit none
"u0_article.txt",access='sequential',position = 'rewind',action = 'read')
open(20,file="data_u.txt")
open(41,file="data_umax_umin_blue.txt")
open(42,file="data_umax_umin_green.txt")
open(43,file="data_umax_umin_red.txt")
call random_seed()
call network(L,2*R,1.0)
call fnf()
deallocate(matrix)
close(20)
close(41)
close(42)
close(43)
end program main
module BOM
implicit none
integer,parameter :: MaxT=50000,L=200
integer,allocatable :: matrix(:,:)
real,parameter :: h=0.02,PI=3.1415926
contains
subroutine fnf()
implicit none
integer :: i,j,t,num
real :: epsilon=0.04,a=0.84,b=0.07,A1=0.01,f=4.0,sigma=0.02,effect,u(L),v(L),fun_u(L),fun_v(L),x,y,Z(L),U_max(L),U_min(L)
U_max=-10.0
U_min=10.0
do i=1,L,1
read(10,*) u(i),v(i)
end do
do t=1,MaxT,1
do i=1,L,1
effect=0.0
do j=1,L
effect=effect+matrix(i,j)*(u(j)-u(i))
end do
fun_u(i)=u(i)+h*(1.0/epsilon*u(i)*(1.0-u(i))*(u(i)-(v(i)+b)/a)+0.02*effect+A1*sin(2.0*PI*f*t*h))
if(u(i)<1.0/3.0)then
fun_v(i)=v(i)+h*(-v(i))
else if(u(i)>=1.0/3.0.and.u(i)<=1)then
fun_v(i)=v(i)+h*(1-6.75*u(i)*(u(i)-1)**2-v(i))
else if(u(i)>1.0)then
fun_v(i)=v(i)+h*(1-v(i))
end if
if(mod(t,50)==0) then
write(20,*) i,t*h,u(i)
end if
end do
if(t>=45000) then
call U_max_min(u,U_max,U_min)
end if
u=fun_u
v=fun_v
end do
do j=1,L,1
if(U_max(j)<0.2) then
write(41,*) j,U_max(j),U_min(j)
else if(U_max(j)>0.2.and.U_max(j)<1.2) then
write(42,*) j,U_max(j),U_min(j)
else
write(43,*) j,U_max(j),U_min(j)
end if
end do
return
end subroutine fnf
subroutine U_max_min(u,U_max,U_min)
implicit none
real :: U_max(L),U_min(L),u(L)
integer :: i
do i=1,L,1
if(U_max(i)<u(i)) then
U_max(i)=u(i)
end if
if(U_min(i)>u(i)) then
U_min(i)=u(i)
end if
end do
return
end subroutine U_max_min
subroutine network(N,P_ER,M,K)
implicit none
integer :: N,K,M
integer :: i,j,a,b
real :: sum1,sum2,sum3
real,allocatable :: sequence_1(:)
real :: x,P_ER,P
allocate(matrix(N+M,N+M))
allocate(sequence_1(N+M-1))
matrix=0
do i=N,2,-1
do j=i-1,1,-1
call random_number(x)
if(x<P_ER) then
matrix(i,j)=1
matrix(j,i)=1
end if
end do
end do
do i=1,M,1
matrix(:,N+i)=0
matrix(N+i,:)=0
sum1=0.0
sum1=sum(matrix(:,:))
sequence_1=0.0
do a=1,N+i-1,1
sum2=0.0
do b=1,N+i-1,1
if(matrix(a,b)==1) then
sum2=sum2+1
end if
end do
sequence_1(a)=sum2/sum1
end do
do j=1,K,1
100 call random_number(P)
sum3=0.0
do a=1,N+M-1,1
sum3=sum3+sequence_1(a)
if(P<=sum3) then
if(matrix(a,N+i)==0) then
matrix(a,N+i)=1
matrix(N+i,a)=1
exit
else
goto 100
end if
end if
end do
end do
end do
deallocate(sequence_1)
end subroutine network
end module BOM
program main
use BOM
implicit none
open(10,file="u0_article.txt",access='sequential',position = 'rewind',action = 'read')
open(20,file="data_u.txt")
open(41,file="data_umax_umin_blue.txt")
open(42,file="data_umax_umin_green.txt")
open(43,file="data_umax_umin_red.txt")
call network(2,1.0,L-2,2)
call fnf()
deallocate(matrix)
close(10)
close(20)
close(41)
close(42)
close(43)
end program main