Frequency chimera state induced by differing dynamical timescales
阅读
下载地址：
https://chinazhang-my.sharepoint.com/:b:/g/personal/rep_rebirth_zh_zhangwenhao_icu/Eeg6pMw1mIBKpxX4rfIAHdUB1MWCp-Tzs9nPt8aFJEPntg?e=4UbsXb
复现
单振子
module Rossler
implicit none
real,parameter :: h=0.01
integer,parameter :: N=100,MaxT=150000
integer,allocatable :: neighbour_matrix(:,:)
real :: x(N),y(N),z(N)
contains
subroutine x0_y0_z0()
implicit none
integer :: k
real :: x1,x2,x3
call random_seed()
do k=1,N,1
call random_number(x1)
call random_number(x2)
call random_number(x3)
x(k)=2.0*x1-1.0
y(k)=2.0*x2-1.0
z(k)=2.0*x3-1.0
write(10,*) x(k),y(k),z(k)
end do
end subroutine x0_y0_z0
subroutine fnf(p)
implicit none
integer :: i,j,p,t
real :: func_x(N),func_y(N),func_z(N),a,b,c,tau(N),epsilon,coupling(N),random
a=0.1
b=0.1
c=18.0
tau=0.76
epsilon=0.7
coupling=0.0
do t=1,MaxT,1
if(mod(t,5000)) then
write(*,*) t
end if
do i=1,N,1
do j=1,N,1
coupling(i)=coupling(i)+neighbour_matrix(i,j)*(x(j)-x(i))
end do
func_x(i)=x(i)+h*(tau(i)*(-y(i)-z(i)))
func_y(i)=y(i)+h*(tau(i)*(x(i)+a*y(i)))
func_z(i)=z(i)+h*(tau(i)*(b+z(i)*(x(i)-c)))
if(i==25.and.t>0) then
write(20,*) t*h,x(i)
end if
end do
x=func_x
y=func_y
z=func_z
end do
return
end subroutine fnf
subroutine neighbour(K)
implicit none
integer :: 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
do i=1,N,1
do j=1,N,1
write(30,"(I2)",advance='no') neighbour_matrix(i,j)
end do
write(30,*)
end do
return
end subroutine neighbour
end module Rossler
program main
use Rossler
implicit none
integer :: p
p=1
open(10,file="data_x0_y0_z0.txt")
open(20,file="data_i.txt")
open(30,file="neighbour_matrix.txt")
call x0_y0_z0()
call neighbour(2*p)
call fnf(p)
deallocate(neighbour_matrix)
close(10)
close(20)
close(30)
end program main
module Rossler
implicit none
real,parameter :: h=0.05
integer,parameter :: N=100,MaxT=130000
integer,allocatable :: neighbour_matrix(:,:)
real :: x(N),y(N),z(N)
contains
subroutine x0_y0_z0()
implicit none
integer :: k
real :: x1,x2,x3
call random_seed()
do k=1,N,1
read(10,*) x(k),y(k),z(k)
end do
end subroutine x0_y0_z0
subroutine fnf(p)
implicit none
integer :: i,j,p,t
real :: func_x(N),func_y(N),func_z(N),a,b,c,tau(N),epsilon,coupling(N),random,x_change(N,MaxT),&
&count_number_up(N),count_number_down(N),t_start(N),t_end(N),t_change(N),f_i(N),count(N)
a=0.1
b=0.1
c=18.0
tau=1.0
epsilon=0.7
count=0.0
t_change=0.0
x_change=0.0
read(90,*) tau
do t=1,MaxT,1
coupling=0.0
do i=1,N,1
do j=1,N,1
coupling(i)=coupling(i)+neighbour_matrix(i,j)*(x(j)-x(i))
end do
func_x(i)=x(i)+h*(tau(i)*(-y(i)-z(i))+tau(i)*epsilon*coupling(i))
func_y(i)=y(i)+h*(tau(i)*(x(i)+a*y(i)))
func_z(i)=z(i)+h*(tau(i)*(b+z(i)*(x(i)-c)))
if(i==25.and.t*h>6400) then
write(20,*) t*h,x(i)
end if
if(i==41.and.t*h>6400) then
write(41,*) t*h,x(i)
end if
if(i==60.and.t*h>6400) then
write(60,*) t*h,x(i)
end if
if(t*h==6500) then
write(50,*) i,x(i)
end if
if(t>129000) then
write(70,*) i,t,x(i)
end if
if(t*h>5500) then
x_change(i,t)=x(i)
if(x_change(i,t)>0.0) then
count_number_up(i)=count_number_up(i)+1
if(count_number_up(i)==1) then
t_start(i)=t*h
end if
else if(x_change(i,t)<0.0) then
count_number_down(i)=count_number_down(i)+1
end if
if(count_number_up(i)>30.and.count_number_down(i)>30.and.x_change(i,t)>0.0) then
t_end(i)=t*h
count(i)=count(i)+1
t_change(i)=t_change(i)+1.0/(t_end(i)-t_start(i))
count_number_up(i)=0
count_number_down(i)=0
end if
end if
end do
x=func_x
y=func_y
z=func_z
end do
do i=1,N,1
f_i(i)=(1.0/(count(i)+1))*t_change(i)
write(80,*) i,f_i(i)
end do
return
end subroutine fnf
subroutine neighbour(K)
implicit none
integer :: 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
do i=1,N,1
do j=1,N,1
write(30,"(I2)",advance='no') neighbour_matrix(i,j)
end do
write(30,*)
end do
return
end subroutine neighbour
end module Rossler
program main
use Rossler
implicit none
integer :: p
p=1
open(10,file="data_x0_y0_z0.txt")
open(20,file="data_i_20.txt")
open(41,file="data_i_45.txt")
open(60,file="data_i_70.txt")
open(50,file="data_i_x.txt")
open(30,file="neighbour_matrix.txt")
open(70,file="i_t_x.txt")
open(80,file="i_fi.txt")
open(90,file="tau.txt")
call x0_y0_z0()
call neighbour(2*p)
call fnf(p)
deallocate(neighbour_matrix)
close(10)
close(20)
close(41)
close(60)
close(50)
close(30)
close(70)
close(80)
end program main
module Rossler
implicit none
real,parameter :: h=0.05
integer,parameter :: N=100,MaxT=130000
integer,allocatable :: neighbour_matrix(:,:)
real :: x(N),y(N),z(N)
contains
subroutine x0_y0_z0()
implicit none
integer :: k
real :: x1,x2,x3
call random_seed()
do k=1,N,1
read(10,*) x(k),y(k),z(k)
end do
end subroutine x0_y0_z0
subroutine fnf(p)
implicit none
integer :: i,j,p,t
real :: func_x(N),func_y(N),func_z(N),a,b,c,tau(N),epsilon,coupling(N),random,x_change(N,MaxT),&
&count_number_up(N),count_number_down(N),t_start(N),t_end(N),t_change(N),f_i(N),count(N)
a=0.1
b=0.1
c=18.0
tau=1.0
epsilon=0.7
count=0.0
t_change=0.0
x_change=0.0
read(90,*) tau
do t=1,MaxT,1
coupling=0.0
do i=1,N,1
do j=1,N,1
coupling(i)=coupling(i)+neighbour_matrix(i,j)*(x(j)-x(i))
end do
func_x(i)=x(i)+h*(tau(i)*(-y(i)-z(i))+tau(i)*epsilon*coupling(i))
func_y(i)=y(i)+h*(tau(i)*(x(i)+a*y(i)))
func_z(i)=z(i)+h*(tau(i)*(b+z(i)*(x(i)-c)))
if(t>100000) then
x_change(i,t)=x(i)
if(x_change(i,t)>0.0) then
count_number_up(i)=count_number_up(i)+1
if(count_number_up(i)==1) then
t_start(i)=t*h
end if
else if(x_change(i,t)<0.0) then
count_number_down(i)=count_number_down(i)+1
end if
if(count_number_up(i)>30.and.count_number_down(i)>30.and.x_change(i,t)>0.0) then
t_end(i)=t*h
count(i)=count(i)+1
t_change(i)=t_change(i)+1.0/(t_end(i)-t_start(i))
count_number_up(i)=0
count_number_down(i)=0
end if
end if
end do
x=func_x
y=func_y
z=func_z
end do
do i=1,N,1
f_i(i)=(1.0/(count(i)+1))*t_change(i)
write(80,*) i,f_i(i)
end do
return
end subroutine fnf
subroutine neighbour(K)
implicit none
integer :: 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
do i=1,N,1
do j=1,N,1
write(30,"(I2)",advance='no') neighbour_matrix(i,j)
end do
write(30,*)
end do
return
end subroutine neighbour
end module Rossler
program main
use Rossler
implicit none
integer :: p
p=1
open(10,file="data_x0_y0_z0.txt")
open(30,file="neighbour_matrix.txt")
open(80,file="i_fi.txt")
open(90,file="tau.txt")
call x0_y0_z0()
call neighbour(2*p)
call fnf(p)
deallocate(neighbour_matrix)
close(10)
close(30)
close(80)
end program main
module Rossler
implicit none
real,parameter :: h=0.05
integer,parameter :: N=100,MaxT=130000
integer,allocatable :: neighbour_matrix(:,:)
real :: x(N),y(N),z(N)
contains
subroutine x0_y0_z0()
implicit none
integer :: k
real :: x1,x2,x3
call random_seed()
do k=1,N,1
call random_number(x1)
call random_number(x2)
call random_number(x3)
x(k)=2.0*x1-1.0
y(k)=2.0*x2-1.0
z(k)=2.0*x3-1.0
write(10,*) x(k),y(k),z(k)
end do
end subroutine x0_y0_z0
subroutine fnf(p)
implicit none
integer :: i,j,p,t
real :: func_x(N),func_y(N),func_z(N),a,b,c,tau(N),epsilon,coupling(N),random,x_change(N,MaxT),&
&count_number_up(N),count_number_down(N),t_start(N),t_end(N),t_change(N),f_i(N),count(N)
a=0.1
b=0.1
c=18.0
tau=1.0
epsilon=0.7
count=0.0
t_change=0.0
x_change=0.0
do i=1,N/2,1
100 call random_number(random)
if(abs(1.0-tau(ceiling(100.0*random)))<0.1) then
tau(ceiling(100.0*random))=0.6
else
goto 100
end if
end do
write(90,*) tau
do t=1,MaxT,1
coupling=0.0
do i=1,N,1
do j=1,N,1
coupling(i)=coupling(i)+neighbour_matrix(i,j)*(x(j)-x(i))
end do
func_x(i)=x(i)+h*(tau(i)*(-y(i)-z(i))+tau(i)*epsilon*coupling(i))
func_y(i)=y(i)+h*(tau(i)*(x(i)+a*y(i)))
func_z(i)=z(i)+h*(tau(i)*(b+z(i)*(x(i)-c)))
if(i==13.and.t*h>6400) then
write(20,*) t*h,x(i)
end if
if(i==56.and.t*h>6400) then
write(41,*) t*h,x(i)
end if
if(i==63.and.t*h>6400) then
write(60,*) t*h,x(i)
end if
if(t*h==6500) then
write(50,*) i,x(i)
end if
if(t>129000) then
write(70,*) i,t,x(i)
end if
if(t*h>5500) then
x_change(i,t)=x(i)
if(x_change(i,t)>0.0) then
count_number_up(i)=count_number_up(i)+1
if(count_number_up(i)==1) then
t_start(i)=t*h
end if
else if(x_change(i,t)<0.0) then
count_number_down(i)=count_number_down(i)+1
end if
if(count_number_up(i)>30.and.count_number_down(i)>30.and.x_change(i,t)>0.0) then
t_end(i)=t*h
count(i)=count(i)+1
t_change(i)=t_change(i)+1.0/(t_end(i)-t_start(i))
count_number_up(i)=0
count_number_down(i)=0
end if
end if
end do
x=func_x
y=func_y
z=func_z
end do
do i=1,N,1
f_i(i)=(1.0/(count(i)+1))*t_change(i)
write(80,*) i,f_i(i)
end do
return
end subroutine fnf
subroutine neighbour(K)
implicit none
integer :: 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
do i=1,N,1
do j=1,N,1
write(30,"(I2)",advance='no') neighbour_matrix(i,j)
end do
write(30,*)
end do
return
end subroutine neighbour
end module Rossler
program main
use Rossler
implicit none
integer :: p
p=1
open(10,file="data_x0_y0_z0.txt")
open(20,file="data_i_20.txt")
open(41,file="data_i_45.txt")
open(60,file="data_i_70.txt")
open(50,file="data_i_x.txt")
open(30,file="neighbour_matrix.txt")
open(70,file="i_t_x.txt")
open(80,file="i_fi.txt")
open(90,file="tau.txt")
call x0_y0_z0()
call neighbour(2*p)
call fnf(p)
deallocate(neighbour_matrix)
close(10)
close(20)
close(41)
close(60)
close(50)
close(30)
close(70)
close(80)
end program main
module Rossler
implicit none
real,parameter :: h=0.05
integer,parameter :: N=100,MaxT=130000
integer,allocatable :: neighbour_matrix(:,:)
real :: x(N),y(N),z(N)
contains
subroutine x0_y0_z0()
implicit none
integer :: k
real :: x1,x2,x3
call random_seed()
do k=1,N,1
call random_number(x1)
call random_number(x2)
call random_number(x3)
x(k)=2.0*x1-1.0
y(k)=2.0*x2-1.0
z(k)=2.0*x3-1.0
write(10,*) x(k),y(k),z(k)
end do
end subroutine x0_y0_z0
subroutine fnf(p)
implicit none
integer :: i,j,p,t
real :: func_x(N),func_y(N),func_z(N),a,b,c,tau(N),epsilon,coupling(N),random,x_change(N,MaxT),&
&count_number_up(N),count_number_down(N),t_start(N),t_end(N),t_change(N),f_i(N),count(N)
a=0.1
b=0.1
c=18.0
tau=1.0
epsilon=0.7
count=0.0
t_change=0.0
x_change=0.0
do i=1,N/2,1
100 call random_number(random)
if(abs(1.0-tau(ceiling(100.0*random)))<0.1) then
tau(ceiling(100.0*random))=0.9
else
goto 100
end if
end do
write(90,*) tau
do t=1,MaxT,1
coupling=0.0
do i=1,N,1
do j=1,N,1
coupling(i)=coupling(i)+neighbour_matrix(i,j)*(x(j)-x(i))
end do
func_x(i)=x(i)+h*(tau(i)*(-y(i)-z(i))+tau(i)*epsilon*coupling(i))
func_y(i)=y(i)+h*(tau(i)*(x(i)+a*y(i)))
func_z(i)=z(i)+h*(tau(i)*(b+z(i)*(x(i)-c)))
if(i==13.and.t*h>6400) then
write(20,*) t*h,x(i)
end if
if(i==56.and.t*h>6400) then
write(41,*) t*h,x(i)
end if
if(i==63.and.t*h>6400) then
write(60,*) t*h,x(i)
end if
if(t*h==6000) then
write(50,*) i,x(i)
end if
if(t>129000) then
write(70,*) i,t-129000,x(i)
end if
if(t*h>6000) then
x_change(i,t)=x(i)
if(x_change(i,t)>0.0) then
count_number_up(i)=count_number_up(i)+1
if(count_number_up(i)==1) then
t_start(i)=t*h
end if
else if(x_change(i,t)<0.0) then
count_number_down(i)=count_number_down(i)+1
end if
if(count_number_up(i)>30.and.count_number_down(i)>30.and.x_change(i,t)>0.0) then
t_end(i)=t*h
count(i)=count(i)+1
t_change(i)=t_change(i)+1.0/(t_end(i)-t_start(i))
count_number_up(i)=0
count_number_down(i)=0
end if
end if
end do
x=func_x
y=func_y
z=func_z
end do
do i=1,N,1
f_i(i)=(1.0/(count(i)+1))*t_change(i)
write(80,*) i,f_i(i)
end do
return
end subroutine fnf
subroutine neighbour(K)
implicit none
integer :: 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
do i=1,N,1
do j=1,N,1
write(30,"(I2)",advance='no') neighbour_matrix(i,j)
end do
write(30,*)
end do
return
end subroutine neighbour
end module Rossler
program main
use Rossler
implicit none
integer :: p
p=1
open(10,file="data_x0_y0_z0.txt")
open(20,file="data_i_20.txt")
open(41,file="data_i_45.txt")
open(60,file="data_i_70.txt")
open(50,file="data_i_x.txt")
open(30,file="neighbour_matrix.txt")
open(70,file="i_t_x.txt")
open(80,file="i_fi.txt")
open(90,file="tau.txt")
call x0_y0_z0()
call neighbour(2*p)
call fnf(p)
deallocate(neighbour_matrix)
close(10)
close(20)
close(41)
close(60)
close(50)
close(30)
close(70)
close(80)
end program main
module Rossler
implicit none
real,parameter :: h=0.05
integer,parameter :: N=100,MaxT=130000
integer,allocatable :: neighbour_matrix(:,:)
real :: x(N),y(N),z(N)
contains
subroutine x0_y0_z0()
implicit none
integer :: k
real :: x1,x2,x3
call random_seed()
do k=1,N,1
call random_number(x1)
call random_number(x2)
call random_number(x3)
x(k)=2.0*x1-1.0
y(k)=2.0*x2-1.0
z(k)=2.0*x3-1.0
write(10,*) x(k),y(k),z(k)
end do
end subroutine x0_y0_z0
subroutine fnf(p)
implicit none
integer :: i,j,p,t
real :: func_x(N),func_y(N),func_z(N),a,b,c,tau(N),epsilon,coupling(N),random,x_change(N,MaxT),&
&count_number_up(N),count_number_down(N),t_start(N),t_end(N),t_change(N),f_i(N),count(N)
a=0.1
b=0.1
c=18.0
tau=1.0
epsilon=0.7
count=0.0
t_change=0.0
x_change=0.0
do i=1,N/2,1
100 call random_number(random)
if(abs(1.0-tau(ceiling(100.0*random)))<0.1) then
tau(ceiling(100.0*random))=0.95
else
goto 100
end if
end do
write(20,*) tau
do t=1,MaxT,1
coupling=0.0
do i=1,N,1
do j=1,N,1
coupling(i)=coupling(i)+neighbour_matrix(i,j)*(x(j)-x(i))
end do
func_x(i)=x(i)+h*(tau(i)*(-y(i)-z(i))+tau(i)*epsilon*coupling(i))
func_y(i)=y(i)+h*(tau(i)*(x(i)+a*y(i)))
func_z(i)=z(i)+h*(tau(i)*(b+z(i)*(x(i)-c)))
if(t*h>2500) then
x_change(i,t)=x(i)
if(x_change(i,t)>0.0) then
count_number_up(i)=count_number_up(i)+1
if(count_number_up(i)==1) then
t_start(i)=t*h
end if
else if(x_change(i,t)<0.0) then
count_number_down(i)=count_number_down(i)+1
end if
if(count_number_up(i)>30.and.count_number_down(i)>30.and.x_change(i,t)>0.0) then
t_end(i)=t*h
count(i)=count(i)+1
t_change(i)=t_change(i)+1.0/(t_end(i)-t_start(i))
count_number_up(i)=0
count_number_down(i)=0
end if
end if
end do
x=func_x
y=func_y
z=func_z
end do
do i=1,N,1
f_i(i)=(1.0/(count(i)+1))*t_change(i)
write(80,*) i,f_i(i)
end do
do i=1,N-1,1
write(90,*) i,abs(f_i(i)-f_i(i+1))
end do
return
end subroutine fnf
subroutine neighbour(K)
implicit none
integer :: 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
do i=1,N,1
do j=1,N,1
write(30,"(I2)",advance='no') neighbour_matrix(i,j)
end do
write(30,*)
end do
return
end subroutine neighbour
end module Rossler
program main
use Rossler
implicit none
integer :: p
p=1
open(10,file="data_x0_y0_z0.txt")
open(20,file="tau.txt")
open(30,file="neighbour_matrix.txt")
open(80,file="i_fi.txt")
open(90,file="i_zi.txt")
call x0_y0_z0()
call neighbour(2*p)
call fnf(p)
deallocate(neighbour_matrix)
close(10)
close(30)
close(80)
end program main
module Rossler
implicit none
real,parameter :: h=0.05
integer,parameter :: N=100,MaxT=10000
integer,allocatable :: neighbour_matrix(:,:)
real :: epsilon=0.8,tau_change
real :: x(N),y(N),z(N)
contains
subroutine x0_y0_z0()
implicit none
integer :: k
real :: x1,x2,x3
do k=1,N,1
read(10,*) x(k),y(k),z(k)
end do
end subroutine x0_y0_z0
subroutine fnf(tau_change)
implicit none
integer :: i,j,t
real :: func_x(N),func_y(N),func_z(N),a,b,c,tau(N),coupling(N),random,x_change(N,MaxT),&
&count_number_up(N),count_number_down(N),t_start(N),t_end(N),t_change(N),f_i(N),count(N),tau_change
a=0.1
b=0.1
c=18.0
tau=1.0
count=0.0
t_change=0.0
x_change=0.0
read(20,*) tau
do i=1,N,1
if(abs(tau(i)-1.0)>0.01) then
tau(i)=tau_change
end if
end do
do t=1,MaxT,1
coupling=0.0
do i=1,N,1
do j=1,N,1
coupling(i)=coupling(i)+neighbour_matrix(i,j)*(x(j)-x(i))
end do
func_x(i)=x(i)+h*(tau(i)*(-y(i)-z(i))+tau(i)*epsilon*coupling(i))
func_y(i)=y(i)+h*(tau(i)*(x(i)+a*y(i)))
func_z(i)=z(i)+h*(tau(i)*(b+z(i)*(x(i)-c)))
if(t*h>0) then
x_change(i,t)=x(i)
if(x_change(i,t)>0.0) then
count_number_up(i)=count_number_up(i)+1
if(count_number_up(i)==1) then
t_start(i)=t*h
end if
else if(x_change(i,t)<0.0) then
count_number_down(i)=count_number_down(i)+1
end if
if(count_number_up(i)>30.and.count_number_down(i)>30.and.x_change(i,t)>0.0) then
t_end(i)=t*h
count(i)=count(i)+1
t_change(i)=t_change(i)+1.0/(t_end(i)-t_start(i))
count_number_up(i)=0
count_number_down(i)=0
end if
end if
end do
x=func_x
y=func_y
z=func_z
end do
do i=1,N,1
f_i(i)=(1.0/(count(i)+1))*t_change(i)
write(80,*) i,f_i(i)
end do
call S(f_i)
do i=1,N-1,1
write(90,*) i,abs(f_i(i)-f_i(i+1))
end do
return
end subroutine fnf
subroutine S(f)
implicit none
integer :: i,j,M,f_m(N)
real :: delta,f(N),f_l,sigma_l(N),S_f,nn
delta=0.05
f_l=0.0
sigma_l=0.0
S_f=0.0
f_m=0.0
do M=1,N,1
nn=real(N)/real(M)
do i=1,M,1
f_l=f_l+f(i)
end do
f_l=f_l/M
do j=nn*(M-1)+1,M*nn,1
sigma_l(M)=sigma_l(M)+(f(j)-f_l)**2
end do
sigma_l(M)=sqrt((1.0/nn)*sigma_l(M))
if(delta-sigma_l(M)<0) then
f_m(M)=0.0
else
f_m(M)=1.0
end if
end do
S_f=1.0-real(sum(f_m(:)))/N
write(100,*) epsilon,tau_change,S_f
write(*,*) epsilon,tau_change,S_f,delta
return
end subroutine S
subroutine neighbour(K)
implicit none
integer :: 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
do i=1,N,1
do j=1,N,1
write(30,"(I2)",advance='no') neighbour_matrix(i,j)
end do
write(30,*)
end do
return
end subroutine neighbour
end module Rossler
program main
use Rossler
implicit none
integer :: p,i
p=1
open(30,file="neighbour_matrix.txt")
open(80,file="i_fi.txt")
open(90,file="i_zi.txt")
open(100,file="i_S_f.txt")
call random_seed()
call neighbour(2*p)
do i=0,50,1
open(10,file="data_x0_y0_z0.txt")
open(20,file="tau.txt")
call x0_y0_z0
tau_change=i*0.02
call fnf(tau_change)
close(10)
close(20)
end do
deallocate(neighbour_matrix)
close(30)
close(80)
close(90)
end program main
- S(f)=0表示振幅死亡（AD）和完全相干态，S(f)=1表示完全不相干，0<1<1表示频率奇异态，似奇异态，多簇态。
module Rossler
implicit none
real,parameter :: h=0.05
integer,parameter :: N=100,MaxT=130000
integer,allocatable :: neighbour_matrix(:,:)
real :: x(N),y(N),z(N)
integer :: N_s
contains
subroutine x0_y0_z0()
implicit none
integer :: k
real :: x1,x2,x3
call random_seed()
do k=1,N,1
call random_number(x1)
call random_number(x2)
call random_number(x3)
x(k)=2.0*x1-1.0
y(k)=2.0*x2-1.0
z(k)=2.0*x3-1.0
write(10,*) x(k),y(k),z(k)
end do
end subroutine x0_y0_z0
subroutine fnf(N_s)
implicit none
integer :: i,j,t,N_s
real :: func_x(N),func_y(N),func_z(N),a,b,c,tau(N),coupling(N),random,x_change(N,MaxT),&
&count_number_up(N),count_number_down(N),t_start(N),t_end(N),t_change(N),f_i(N),count(N),tau_change,epsilon
a=0.1
b=0.1
c=18.0
tau=1.0
epsilon=0.7
count=0.0
t_change=0.0
x_change=0.0
write(*,*) N_s
do i=1,N_s,1
100 call random_number(random)
if(abs(1.0-tau(ceiling(100.0*random)))<0.1) then
tau(ceiling(100.0*random))=0.8
else
goto 100
end if
end do
write(20,*) tau
do t=1,MaxT,1
coupling=0.0
do i=1,N,1
do j=1,N,1
coupling(i)=coupling(i)+neighbour_matrix(i,j)*(x(j)-x(i))
end do
func_x(i)=x(i)+h*(tau(i)*(-y(i)-z(i))+tau(i)*epsilon*coupling(i))
func_y(i)=y(i)+h*(tau(i)*(x(i)+a*y(i)))
func_z(i)=z(i)+h*(tau(i)*(b+z(i)*(x(i)-c)))
if(t*h>0) then
x_change(i,t)=x(i)
if(x_change(i,t)>0.0) then
count_number_up(i)=count_number_up(i)+1
if(count_number_up(i)==1) then
t_start(i)=t*h
end if
else if(x_change(i,t)<0.0) then
count_number_down(i)=count_number_down(i)+1
end if
if(count_number_up(i)>30.and.count_number_down(i)>30.and.x_change(i,t)>0.0) then
t_end(i)=t*h
count(i)=count(i)+1
t_change(i)=t_change(i)+1.0/(t_end(i)-t_start(i))
count_number_up(i)=0
count_number_down(i)=0
end if
end if
end do
x=func_x
y=func_y
z=func_z
end do
do i=1,N,1
f_i(i)=(1.0/(count(i)+1))*t_change(i)
write(80,*) i,f_i(i)
end do
call S(f_i)
do i=1,N-1,1
write(90,*) i,abs(f_i(i)-f_i(i+1))
end do
return
end subroutine fnf
subroutine S(f)
implicit none
integer :: i,j,M,f_m(N)
real :: delta,f(N),f_l,sigma_l(N),S_f,nn
delta=0.05
f_l=0.0
sigma_l=0.0
S_f=0.0
f_m=0.0
do M=1,N,1
nn=real(N)/real(M)
do i=1,M,1
f_l=f_l+f(i)
end do
f_l=f_l/M
do j=nn*(M-1)+1,M*nn,1
sigma_l(M)=sigma_l(M)+(f(j)-f_l)**2
end do
sigma_l(M)=sqrt((1.0/nn)*sigma_l(M))
if(delta-sigma_l(M)<0) then
f_m(M)=0.0
else
f_m(M)=1.0
end if
end do
S_f=1.0-real(sum(f_m(:)))/N
write(100,*) real(N_s)/N,S_f
write(*,*) real(N_s)/N,S_f
return
end subroutine S
subroutine neighbour(K)
implicit none
integer :: 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
do i=1,N,1
do j=1,N,1
write(30,"(I2)",advance='no') neighbour_matrix(i,j)
end do
write(30,*)
end do
return
end subroutine neighbour
end module Rossler
program main
use Rossler
implicit none
integer :: p,i
p=1
open(10,file="data_x0_y0_z0.txt")
open(20,file="tau.txt")
open(30,file="neighbour_matrix.txt")
open(80,file="i_fi.txt")
open(90,file="i_zi.txt")
open(100,file="i_S_f.txt")
call neighbour(2*p)
do i=0,N,5
N_s=i
call x0_y0_z0()
call fnf(N_s)
end do
deallocate(neighbour_matrix)
close(10)
close(30)
close(80)
close(90)
end program main
module Rossler
implicit none
real,parameter :: h=0.05
integer,parameter :: N=100,MaxT=130000
integer,allocatable :: neighbour_matrix(:,:)
real :: x(N),y(N),z(N)
contains
subroutine x0_y0_z0()
implicit none
integer :: k
real :: x1,x2,x3
call random_seed()
do k=1,N,1
call random_number(x1)
call random_number(x2)
call random_number(x3)
x(k)=2.0*x1-1.0
y(k)=2.0*x2-1.0
z(k)=2.0*x3-1.0
write(10,*) x(k),y(k),z(k)
end do
end subroutine x0_y0_z0
subroutine fnf(p)
implicit none
integer :: i,j,p,t
real :: func_x(N),func_y(N),func_z(N),a,b,c,tau(N),epsilon,coupling(N),random,x_change(N,MaxT),&
&count_number_up(N),count_number_down(N),t_start(N),t_end(N),t_change(N),f_i(N),count(N)
a=0.1
b=0.1
c=18.0
tau=1.0
epsilon=0.6
count=0.0
t_change=0.0
x_change=0.0
do i=N/2+1,N,1
tau(i)=0.6
end do
do t=1,MaxT,1
coupling=0.0
do i=1,N,1
do j=1,N,1
coupling(i)=coupling(i)+neighbour_matrix(i,j)*(x(j)-x(i))
end do
func_x(i)=x(i)+h*(tau(i)*(-y(i)-z(i))+tau(i)*epsilon*coupling(i))
func_y(i)=y(i)+h*(tau(i)*(x(i)+a*y(i)))
func_z(i)=z(i)+h*(tau(i)*(b+z(i)*(x(i)-c)))
if(i==20.and.t*h>6400) then
write(20,*) t*h,x(i)
end if
if(i==45.and.t*h>6400) then
write(41,*) t*h,x(i)
end if
if(i==70.and.t*h>6400) then
write(60,*) t*h,x(i)
end if
if(t*h==6500) then
write(50,*) i,x(i)
end if
if(t>129000) then
write(70,*) i,t,x(i)
end if
if(t*h>5500) then
x_change(i,t)=x(i)
if(x_change(i,t)>0.0) then
count_number_up(i)=count_number_up(i)+1
if(count_number_up(i)==1) then
t_start(i)=t*h
end if
else if(x_change(i,t)<0.0) then
count_number_down(i)=count_number_down(i)+1
end if
if(count_number_up(i)>30.and.count_number_down(i)>30.and.x_change(i,t)>0.0) then
t_end(i)=t*h
count(i)=count(i)+1
t_change(i)=t_change(i)+1.0/(t_end(i)-t_start(i))
count_number_up(i)=0
count_number_down(i)=0
end if
end if
end do
x=func_x
y=func_y
z=func_z
end do
do i=1,N,1
f_i(i)=(1.0/(count(i)+1))*t_change(i)
write(80,*) i,f_i(i)
end do
return
end subroutine fnf
subroutine neighbour(K)
implicit none
integer :: 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
do i=1,N,1
do j=1,N,1
write(30,"(I2)",advance='no') neighbour_matrix(i,j)
end do
write(30,*)
end do
return
end subroutine neighbour
end module Rossler
program main
use Rossler
implicit none
integer :: p
p=5
open(10,file="data_x0_y0_z0.txt")
open(20,file="data_i_20.txt")
open(41,file="data_i_45.txt")
open(60,file="data_i_70.txt")
open(50,file="data_i_x.txt")
open(30,file="neighbour_matrix.txt")
open(70,file="i_t_x.txt")
open(80,file="i_fi.txt")
call x0_y0_z0()
call neighbour(2*p)
call fnf(p)
deallocate(neighbour_matrix)
close(10)
close(20)
close(41)
close(60)
close(50)
close(30)
close(70)
close(80)
end program main
module Rossler
implicit none
real,parameter :: h=0.01,PI=3.1415926
integer,parameter :: N=100,MaxT=250000
integer,allocatable :: neighbour_matrix(:,:)
real :: x(N),y(N)
contains
subroutine x0_y0_z0()
implicit none
integer :: k
real :: x1,x2
call random_seed()
do k=1,N,1
read(10,*) x(k),y(k)
end do
end subroutine x0_y0_z0
subroutine fnf(p)
implicit none
integer :: i,j,p,t
real :: func_x(N),func_y(N),tau(N),epsilon,coupling(N),random,x_change(N,MaxT),&
&count_number_up(N),count_number_down(N),t_start(N),t_end(N),t_change(N),f_i(N),count(N),mu,omega,A
A=1.2
omega=(2.0*PI)/10.0
mu=8.53
tau=1.0
epsilon=0.1
count=0.0
t_change=0.0
x_change=0.0
read(90,*) tau
do t=1,MaxT,1
coupling=0.0
do i=1,N,1
do j=1,N,1
coupling(i)=coupling(i)+neighbour_matrix(i,j)*(x(j)-x(i))
end do
func_x(i)=x(i)+h*(tau(i)*y(i)+tau(i)*epsilon*coupling(i))
func_y(i)=y(i)+h*(tau(i)*mu*(1.0-x(i)**2)*y(i)-tau(i)*x(i)+tau(i)*A*cos(omega*t))
if(i==20.and.t>240000) then
write(20,*) t*h,x(i)
end if
if(i==34.and.t>240000) then
write(41,*) t*h,x(i)
end if
if(i==70.and.t>240000) then
write(60,*) t*h,x(i)
end if
if(t==240000) then
write(50,*) i,x(i)
end if
if(t>50000.and.mod(t,50)==0) then
write(70,*) i,(t-50000)*h,x(i)
end if
if(t>0) then
x_change(i,t)=x(i)
if(x_change(i,t)>0.0) then
count_number_up(i)=count_number_up(i)+1
if(count_number_up(i)==1) then
t_start(i)=t*h
end if
else if(x_change(i,t)<0.0) then
count_number_down(i)=count_number_down(i)+1
end if
if(count_number_up(i)>30.and.count_number_down(i)>30.and.x_change(i,t)>0.0) then
t_end(i)=t*h
count(i)=count(i)+1
t_change(i)=t_change(i)+1.0/(t_end(i)-t_start(i))
count_number_up(i)=0
count_number_down(i)=0
end if
end if
end do
x=func_x
y=func_y
end do
do i=1,N,1
f_i(i)=(1.0/(count(i)+1))*t_change(i)
write(80,*) i,f_i(i)
end do
return
end subroutine fnf
subroutine neighbour(K)
implicit none
integer :: 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
do i=1,N,1
do j=1,N,1
write(30,"(I2)",advance='no') neighbour_matrix(i,j)
end do
write(30,*)
end do
return
end subroutine neighbour
end module Rossler
program main
use Rossler
implicit none
integer :: p
p=1
open(10,file="data_x0_y0_z0.txt")
open(20,file="data_i_20.txt")
open(41,file="data_i_45.txt")
open(60,file="data_i_70.txt")
open(50,file="data_i_x.txt")
open(30,file="neighbour_matrix.txt")
open(70,file="i_t_x.txt")
open(80,file="i_fi.txt")
open(90,file="tau.txt")
call x0_y0_z0()
call neighbour(2*p)
call fnf(p)
deallocate(neighbour_matrix)
close(10)
close(20)
close(41)
close(60)
close(50)
close(30)
close(70)
close(80)
end program main
