使用Crank-Nicolson

时间:2017-10-25 12:27:04

标签: r numerical-methods pde

我正在尝试解决以下PDE系统,以模拟二维模式形成过程。

dU / dt = KU 2 V - k 1 U + D U 2 U

dV / dt =α - KU 2 V - k 2 V + D V 2 V

(U和V)的边界条件在右边界,左边界和上边界处都是0。对于底部边界,U的固定浓度为65,V具有零通量(dV / dy = 0)。

我尝试在R中实现它并且它或多或少有效,只要x和y方向的网格长度为1。一旦我改变Lx和Ly,整个事情就不再适用了。但是,对于我的基础模型,我需要解决它Lx = 262和Ly = 150。

我对这些东西很新,我有点怀疑我可能误解了一些东西而无法弄清楚它是什么。

编辑(10/25/2017):

我错过了补充说没有使用像ReacTran或deSolve这样的软件包的原因。我知道它们的存在并使用ReacTran来检查我的代码的结果。但是,我需要了解算法本身,以便稍后在一个更大的模拟项目中实现它,该项目应该模拟模式“群体”的演变。

代码中的注释tdma表示三对角矩阵算法。

R中的代码

library(igraph)
library(raster)
library(pheatmap)
library(RColorBrewer)

#Model: Connahs et al 2017 - Gray Scott Model: Butterfly eyespots
#Numerical algorithm: Crank Nicolson - ADI


#A1 -> reaction term: K*A1^2*A2-k1*A1
fu <- function(K, U, V, k1){
  X<-U
  for(i in 2:(nrow(U)-1)){
    for(j in 2:(ncol(U)-1)){
      X[i,j]<-dt*(K*(U[i,j]^2)*V[i,j] - k1*U[i,j])
    }
  }
  return(X)
}

#A2 -> reaction term: alpha-K*A1^2*A2-k2*A2
fv <- function(alpha, K, U, V, k2){
  Y<-V
  for(i in 2:(nrow(V)-1)){
    for(j in 2:(ncol(V)-1)){
      Y[i,j]<-dt*(alpha-K*(U[i,j]^2)*V[i,j]-k2*V[i,j])
    }
  }
  return(Y)
}

#Diffusion solver
CN<-function(Nx,Ny,dx,dy,dt,t,D,f,C,C2,M){
  S <- matrix(0,Nx,Ny)
  P <- matrix(0,Nx,Ny)
  Z <- matrix(0,Nx,Ny)

  bx <- 0.5*(D*dt/(dx^2))
  by <- 0.5*(D*dt/(dy^2))

  U<-C
  V<-C2

  if(M == 1){
    f <- fu(K, U, V, k1)
  }
  else if(M == 2){
    f <- fv(alpha, K, V, U, k2)
  }

  for(j in 2:(Ny-1)){
    for(i in 1:Nx){
      S[i,j]<-U[i,j]+by*(U[i,j+1]-2*U[i,j]+U[i,j-1])
    }
  }

  for(j in 2:(Ny-1)){
    for(i in 2:(Nx-1)){
      P[i,j]<-S[i,j]+bx*(S[i+1,j]-2*S[i,j]+S[i-1,j])+0.5*dt*f[i,j]
    }
  }

  for(j in 2:(Ny-1)){
    a<-NULL
    b<-NULL
    c<-NULL
    r<-NULL
    q<-NULL
    for(i in 2:Nx-1){
      a[i]<- -bx
      b[i]<- 1+2*bx
      c[i]<- -bx
      r[i]<- P[i,j]
    }

    #Boundary 
    ua <- U[1,j] - by*(U[1,j+1]-2*U[1,j]+U[1,j-1])
    ub <- U[Nx,j] - by*(U[Nx,j+1] - 2*U[Nx,j] + U[Nx,j-1])

    r[2] <- r[2] - a[2] * ua
    r[Nx-1] <- r[Nx-1] - c[Nx-1] * ub

    #tdma
    for(i in 2:(Nx-1)){
      b[i]<-b[i]-a[i]/b[i-1]*c[i-1]
      r[i]<-r[i]-a[i]/b[i-1]*r[i-1]
    }

    q[Nx-1]<-r[Nx-1]/b[Nx-1]
    for(i in seq(Nx-2,1,-1)){
      q[i]<-(r[i]-c[i]*q[i+1])/b[i]
    }

    for(i in 2:(Nx-1)){
      Z[i,j]<-q[i]
    }
    #Boundary - useless?
    if(M==2){
      Z[1,j]<-Z[2,j]
      Z[Nx,j]<-ub
    }
    else{
      Z[1,j]<-ua
      Z[Nx,j]<-ub
    }

  }## X end

  for(j in 2:(Nx-1)){
    a<-NULL
    b<-NULL
    c<-NULL
    r<-NULL
    q<-NULL
    for(i in 2:Ny-1){
      a[i]<- -by
      b[i]<- 1+2*by
      c[i]<- -by
      r[i]<- Z[j,i]
    }

    ua <- U[j,1]
    ub <- U[j,Ny]

    r[2] <- r[2] - a[2] * ua
    r[Ny-1] <- r[Ny-1] - c[Ny-1] * ub

    #tdma
    for(i in 2:(Ny-1)){
      b[i]<-b[i]-a[i]/b[i-1]*c[i-1]
      r[i]<-r[i]-a[i]/b[i-1]*r[i-1]
    }

    q[Ny-1]<-r[Ny-1]/b[Ny-1]
    for(i in seq(Ny-2,1,-1)){
      q[i]<-(r[i]-c[i]*q[i+1])/b[i]
    }

    for(i in 2:(Ny-1)){
      U[j,i]<-q[i]
    }
  }

  if(M==2){
    U[Nx,]<-U[Nx-1,]
  }
  return(U)

}##end CN

#grid points
Nx <- 105
Ny <- 60

#length (in micrometer)
Lx <- 1
Ly <- 1

x0 <- 0
xL <- Lx
y0 <- 0
yL <- Ly

#spatial steps
dx <- (xL-x0)/(Nx-1)
dy <- (yL-y0)/(Ny-1)

#time steps
Tmax <- 144
dt <- 0.0005
nt <- Tmax/dt
t<-0

#Diffusion constants
Du <- 0.01
Dv <- 0.12

#init - A1 = U; A2 = V
U<-matrix(0,Nx,Ny)
U[Nx,]<-65
V<-matrix(0,Nx,Ny)

#reaction parameter
alpha <- (5.5*10^-3)
K <- 2.22*10^-7
k1 <- 0.1*10^-3
k2 <- 0.08*10^-3   


while(t<Tmax){

  if(t==60){
    alpha<-alpha*0.75
  }

  du <- CN(Nx,Ny,dx,dy,dt,t,Du,f_u,U,V,1)
  dv <- CN(Nx,Ny,dx,dy,dt,t,Dv,f_v,V,U,2)

  print(t)

  U<-du
  V<-dv

  t <- t+dt
}

pheatmap(V, cluster_row = FALSE, cluster_col = FALSE, color= brewer.pal(5, "YlGnBu"),border_color = NA)

0 个答案:

没有答案