11 deleted 514 characters in body
source | link
Needs["NDSolve`FEM`"]; mesh = 
 ImplicitRegion[x^2 + y^2 <= R^2, {x, y}]; mesh1 = 
 ImplicitRegion[R1^2 <= x^2 + y^2 <= R^2, {x, y}];
d2 = .03; d3 = 11 ; R = 4; R1 = 
 7/2; N42 = 3000; NB = 6500; N24 = 1000; \[Alpha]1α1 = 0.2; \[Alpha]2α2 = 
 0.12 /60; \[Alpha]3α3 = 1 ; \[Beta]1β1 = 0.266 ; \[Beta]2β2 = 0.28 ; \
\[Beta]3β3 = 1; \[Gamma]1γ1 = 0.2667 ; \[Gamma]2γ2 = 0.35 ; \[Delta]1δ1 = \
0.00297;  \[Delta]2δ2 = 0.35;
c0 = {.3, .65, .1}; m0 = {.0, .3, .65, 0.1};
C1[0][x_, y_] := 
 c0[[1]]*(1 + 
    Sum[RandomReal[{-.01, .01}]*
      Exp[-Norm[{x, y} - RandomReal[{-R, R}, 2]]^2], {i, 1, 10}]); 
C2[0][x_, y_] := 
 c0[[2]]*(1 + 
    Sum[RandomReal[{-.01, .01}]*
      Exp[-Norm[{x, y} - RandomReal[{-R, R}, 2]]^2], {i, 1, 10}]); 
C3[0][x_, y_] := 
 c0[[3]]*(1 + 
    Sum[RandomReal[{-.01, .01}]*
      Exp[-Norm[{x, y} - RandomReal[{-R, R}, 2]]^2], {i, 1, 10}]);
M1[0][x_, y_] := 
  m0[[1]]*(1 + 
     Sum[RandomReal[{-.01, .01}]*
       Exp[-Norm[{x, y} - RandomReal[{-R, R}, 2]]^2], {i, 1, 10}]);
M2[0][x_, y_] := 
 m0[[2]]*(1 + 
    Sum[RandomReal[{-.01, .01}]*
      Exp[-Norm[{x, y} - RandomReal[{-R, R}, 2]]^2], {i, 1, 10}]); 
M3[0][x_, y_] := 
 m0[[3]]*(1 + 
    Sum[RandomReal[{-.01, .01}]*
      Exp[-Norm[{x, y} - RandomReal[{-R, R}, 2]]^2], {i, 1, 10}]); 
M4[0][x_, y_] := 
 m0[[4]]*(1 + 
    Sum[RandomReal[{-.01, .01}]*
      Exp[-Norm[{x, y} - RandomReal[{-R, R}, 2]]^2], {i, 1, 10}]);
t0 = 1/2; n = 60;
Do[{C1[t], C2[t], C3[t]} = 
   NDSolveValue[{(c1[x, y] - C1[t - t0][x, y])/t0 - 
       d3*Laplacian[c1[x, y], {x, y}] == 
      NeumannValue[-C1[t - t0][x, 
           y] (\[Beta]1*M4[tβ1*M4[t - t0][x, y] + \[Beta]2β2) + \[Beta]3*β3*
         M2[t - t0][x, y], True], (c2[x, y] - C2[t - t0][x, y])/t0 - 
       d3*Laplacian[c2[x, y], {x, y}] == 
      NeumannValue[-\[Gamma]1*M1[tγ1*M1[t - t0][x, y] + \[Gamma]2*γ2*
         M3[t - t0][x, y], True], (c3[x, y] - C3[t - t0][x, y])/t0 - 
       d3*Laplacian[c3[x, y], {x, y}] == 
      NeumannValue[-\[Delta]1*M3[tδ1*M3[t - t0][x, y]*
         C3[t - t0][x, y] + \[Delta]2*M4[tδ2*M4[t - t0][x, y], True]}, {c1, 
     c2, c3}, {x, y} \[Element] mesh, 
    Method -> {"FiniteElement", 
      InterpolationOrder -> {c1 -> 2, c2 -> 2, c3 -> 2}, 
      "MeshOptions" -> {"MaxCellMeasure" -> 0.01, "MeshOrder" -> 2}}];
  {M1[t], M2[t], M3[t], M4[t]} = 
   NDSolveValue[{(m1[x, y] - M1[t - t0][x, y])/t0 - 
       d2*Laplacian[m1[x, y], {x, y}] == -\[Alpha]3α3 M1[t - t0][x, 
         y] + \[Beta]1β1 C1[t - t0][x, y] M4[t - t0][x, y] + 
       M2[t - t0][x, 
         y] (\[Alpha]2α2 + \[Alpha]1α1 M4[t - t0][x, y]), (m2[x, y] - 
          M2[t - t0][x, y])/t0 - 
       d2*Laplacian[m2[x, y], {x, y}] == \[Beta]2β2 C1[t - t0][x, 
         y] + \[Alpha]3α3 M1[t - t0][x, y] - \[Beta]3β3 M2[t - t0][x, y] +
        M2[t - t0][x, 
         y] (-\[Alpha]2α2 - \[Alpha]1α1 M4[t - t0][x, y]), (m3[x, y] - 
          M3[t - t0][x, y])/t0 - 
       d2*Laplacian[m3[x, y], {x, y}] == \[Gamma]1γ1 C2[t - t0][x, 
         y] M1[t - t0][x, y] - \[Gamma]2γ2 M3[t - t0][x, 
         y] - \[Delta]1δ1 C3[t - t0][x, y] M3[t - t0][x, 
         y] + \[Delta]2δ2 M4[t - t0][x, 
         y], (m4[x, y] - M4[t - t0][x, y])/t0 - 
       d2*
        Laplacian[m4[x, y], {x, y}] == \[Delta]1δ1 C3[t - t0][x, 
         y] M3[t - t0][x, y] - \[Delta]2δ2 M4[t - t0][x, y]}, {m1, m2, 
     m3, m4}, {x, y} \[Element] mesh1, 
    Method -> {"FiniteElement", 
      InterpolationOrder -> {m1 -> 2, m2 -> 2, m3 -> 2, m4 -> 2}, 
      "MeshOptions" -> {"MaxCellMeasure" -> 0.01, 
        "MeshOrder" -> 2}}];, {t, t0, n*t0, t0}] // Quiet
Needs["NDSolve`FEM`"]; mesh = 
 ImplicitRegion[x^2 + y^2 <= R^2, {x, y}]; mesh1 = 
 ImplicitRegion[R1^2 <= x^2 + y^2 <= R^2, {x, y}];
C0[x_, y_] := Exp[-20*Norm[{x + 1/2, y}]^2];
M0[x_, y_] := 0;
t0 = 1; d3 = 1; d2 = 1; R = 1; R1 = 9/10;
C1 = NDSolveValue[{D[c1[t, x, y], t] - 
      d3*Laplacian[c1[t, x, y], {x, y}] == 
     NeumannValue[-c1[t, x, y], True], c1[0, x, y] == C0[x, y]}, 
   c1, {t, 0, t0}, {x, y} \[Element] mesh, 
   Method -> {"FiniteElement", InterpolationOrder -> {c1 -> 2}, 
     "MeshOptions" -> {"MaxCellMeasure" -> 0.01, "MeshOrder" -> 2}}];
M1 = NDSolveValue[{D[m1[t, x, y], t] - 
      d2*Laplacian[m1[t, x, y], {x, y}] == C1[t, x, y], 
    m1[0, x, y] == M0[x, y]} , 
   m1, {t, 0, t0}, {x, y} \[Element] mesh1, 
   Method -> {"FiniteElement", InterpolationOrder -> {m1 -> 2}, 
     "MeshOptions" -> {"MaxCellMeasure" -> 0.01, "MeshOrder" -> 2}}];
ClearAll[b, m, v, x, y, t];
alpha = 1.0; R1 = .9;
geometry = Disk[];

sol = NDSolveValue[{D[v[x, y, t], t] == 
    D[v[x, y, t], x, x] + D[v[x, y, t], y, y] + 
     NeumannValue[-1*alpha*v[x, y, t], x^2 + y^2 == 1], 
   D[m[x, y, t], t] == 
    UnitStep[
      x^2 + y^2 - R1^2] (D[m[x, y, t], x, x] + D[m[x, y, t], y, y] + 
       alpha*v[x, y, t]), m[x, y, 0] == 0, 
   v[x, y, 0] == Exp[-20*((x + .5)^2 + y^2)]}, {v, 
   m}, {x, y} \[Element] geometry, {t, 0, 10}]

vsol = sol[[1]];
msol = sol[[2]];
alpha = 1.0;
geometry = Disk[];

{x0, y0} = {-.5, .0};

sol = NDSolve[{D[v[x, y, t], t] == 
     D[v[x, y, t], x, x] + D[v[x, y, t], y, y] + 
      NeumannValue[-1*alpha*v[x, y, t], x^2 + y^2 == 1], 
    v[x, y, 0] == Exp[-20*((x - x0)^2 + (y - y0)^2)]}, 
   v, {x, y} \[Element] geometry, {t, 0, 10}, 
   Method -> {"FiniteElement", InterpolationOrder -> {v -> 2}, 
     "MeshOptions" -> {"MaxCellMeasure" -> 0.01, "MeshOrder" -> 2}}];

vsol = v /. sol[[1, 1]];

vBoundary[phi_, t_] := vsol[.99 Cos[phi], .99 Sin[phi], t]

sol = NDSolve[{D[m[phi, t], t] == 
     D[m[phi, t], {phi, 2}] + alpha*vBoundary[phi, t], 
    PeriodicBoundaryCondition[m[phi, t], phi == 2 \[Pi]π, 
     Function[x, x - 2 \[Pi]]]π]], m[phi, 0] == 0}, 
   m, {phi, 0, 2 \[Pi]π}, {t, 0, 10}];

msol = m /. sol[[1, 1]];
Needs["NDSolve`FEM`"]; mesh = 
 ImplicitRegion[x^2 + y^2 <= R^2, {x, y}]; mesh1 = 
 ImplicitRegion[R1^2 <= x^2 + y^2 <= R^2, {x, y}];
d2 = 1; d3 = 1 ; R = 1; R1 = 9/10; 
C1[0][x_, y_] := Exp[-20*Norm[{x + 1/2, y}]^2];
M1[0][x_, y_] := 0;

t0 = 1/50; n = 20;
Do[C1[t] = 
   NDSolveValue[(c1[x, y] - C1[t - t0][x, y])/t0 - 
      d3*Laplacian[c1[x, y], {x, y}] == NeumannValue[-c1[x, y], True],
     c1, {x, y} \[Element] mesh, 
    Method -> {"FiniteElement", InterpolationOrder -> {c1 -> 2}, 
      "MeshOptions" -> {"MaxCellMeasure" -> 0.01, "MeshOrder" -> 2}}];
  M1[t] = 
   NDSolveValue[(m1[x, y] - M1[t - t0][x, y])/t0 - 
      d2*Laplacian[m1[x, y], {x, y}] == C1[t][x, y] , 
    m1, {x, y} \[Element] mesh1, 
    Method -> {"FiniteElement", InterpolationOrder -> {m1 -> 2}, 
      "MeshOptions" -> {"MaxCellMeasure" -> 0.01, 
        "MeshOrder" -> 2}}];, {t, t0, n*t0, t0}] // Quiet
Needs["NDSolve`FEM`"]; mesh = ImplicitRegion[x^2 + y^2 + z^2 <= R^2, {x, y, z}]; mesh1 = ImplicitRegion[(9*(R/10))^2 <= x^2 + y^2 + z^2 <= R^2, {x, y, z}]; 
d2 = 0.03; d3 = 11; R = 4; N42 = 3000; NB = 6500; N24 = 1000; \[Alpha]1α1 = 0.2; \[Alpha]2α2 = 0.12/60; \[Alpha]3α3 = 1; \[Beta]1β1 = 0.266; \[Beta]2β2 = 0.28; \[Beta]3β3 = 1; \[Gamma]1γ1 = 0.2667; \[Gamma]2γ2 = 0.35; 
  \[Delta]1δ1 = 0.00297; \[Delta]2δ2 = 0.35; 
c0 = {3, 6.5, 1}; m0 = {3, 3, 6.5, 1}; a = 1/30; 
C1[0][x_, y_, z_] := c0[[1]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  C2[0][x_, y_, z_] := c0[[2]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  C3[0][x_, y_, z_] := c0[[3]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
M1[0][x_, y_, z_] := m0[[1]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  M2[0][x_, y_, z_] := m0[[2]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  M3[0][x_, y_, z_] := m0[[3]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  M4[0][x_, y_, z_] := m0[[4]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
t0 = 1/10; n = 40; 
Quiet[Do[{C1[t], C2[t], C3[t]} = NDSolveValue[{(c1[x, y, z] - C1[t - t0][x, y, z])/t0 - d3*Laplacian[c1[x, y, z], {x, y, z}] == 
        NeumannValue[(-C1[t - t0][x, y, z])*(\[Beta]1*M4[tβ1*M4[t - t0][x, y, z] + \[Beta]2β2) + \[Beta]3*M2[tβ3*M2[t - t0][x, y, z], True], 
       (c2[x, y, z] - C2[t - t0][x, y, z])/t0 - d3*Laplacian[c2[x, y, z], {x, y, z}] == NeumannValue[(-\[Gamma]1γ1)*M1[t - t0][x, y, z] + \[Gamma]2*M3[tγ2*M3[t - t0][x, y, z], True], 
       (c3[x, y, z] - C3[t - t0][x, y, z])/t0 - d3*Laplacian[c3[x, y, z], {x, y, z}] == NeumannValue[(-\[Delta]1δ1)*M3[t - t0][x, y, z]*C3[t - t0][x, y, z] + 
          \[Delta]2*M4[tδ2*M4[t - t0][x, y, z], True]}, {c1, c2, c3}, Element[{x, y, z}, mesh], 
      Method -> {"FiniteElement", InterpolationOrder -> {c1 -> 2, c2 -> 2, c3 -> 2}}]; {M1[t], M2[t], M3[t], M4[t]} = 
     NDSolveValue[{(m1[x, y, z] - M1[t - t0][x, y, z])/t0 - d2*Laplacian[m1[x, y, z], {x, y, z}] == (-\[Alpha]3α3)*M1[t - t0][x, y, z] + 
         \[Beta]1*C1[tβ1*C1[t - t0][x, y, z]*M4[t - t0][x, y, z] + M2[t - t0][x, y, z]*(\[Alpha]2α2 + \[Alpha]1*M4[tα1*M4[t - t0][x, y, z]), 
       (m2[x, y, z] - M2[t - t0][x, y, z])/t0 - d2*Laplacian[m2[x, y, z], {x, y, z}] == \[Beta]2*C1[tβ2*C1[t - t0][x, y, z] + \[Alpha]3*M1[tα3*M1[t - t0][x, y, z] - 
         \[Beta]3*M2[tβ3*M2[t - t0][x, y, z] + M2[t - t0][x, y, z]*(-\[Alpha]2α2 - \[Alpha]1*M4[tα1*M4[t - t0][x, y, z]), 
       (m3[x, y, z] - M3[t - t0][x, y, z])/t0 - d2*Laplacian[m3[x, y, z], {x, y, z}] == \[Gamma]1*C2[tγ1*C2[t - t0][x, y, z]*M1[t - t0][x, y, z] - \[Gamma]2*M3[tγ2*M3[t - t0][x, y, z] - 
         \[Delta]1*C3[tδ1*C3[t - t0][x, y, z]*M3[t - t0][x, y, z] + \[Delta]2*M4[tδ2*M4[t - t0][x, y, z], (m4[x, y, z] - M4[t - t0][x, y, z])/t0 - d2*Laplacian[m4[x, y, z], {x, y, z}] == 
        \[Delta]1*C3[tδ1*C3[t - t0][x, y, z]*M3[t - t0][x, y, z] - \[Delta]2*M4[tδ2*M4[t - t0][x, y, z]}, {m1, m2, m3, m4}, Element[{x, y, z}, mesh1], 
      Method -> {"FiniteElement", InterpolationOrder -> {m1 -> 2, m2 -> 2, m3 -> 2, m4 -> 2}}]; , {t, t0, n*t0, t0}]]  
Needs["NDSolve`FEM`"]; mesh = 
 ImplicitRegion[x^2 + y^2 <= R^2, {x, y}]; mesh1 = 
 ImplicitRegion[R1^2 <= x^2 + y^2 <= R^2, {x, y}];
d2 = .03; d3 = 11 ; R = 4; R1 = 
 7/2; N42 = 3000; NB = 6500; N24 = 1000; \[Alpha]1 = 0.2; \[Alpha]2 = 
 0.12 /60; \[Alpha]3 = 1 ; \[Beta]1 = 0.266 ; \[Beta]2 = 0.28 ; \
\[Beta]3 = 1; \[Gamma]1 = 0.2667 ; \[Gamma]2 = 0.35 ; \[Delta]1 = \
0.00297;  \[Delta]2 = 0.35;
c0 = {.3, .65, .1}; m0 = {.0, .3, .65, 0.1};
C1[0][x_, y_] := 
 c0[[1]]*(1 + 
    Sum[RandomReal[{-.01, .01}]*
      Exp[-Norm[{x, y} - RandomReal[{-R, R}, 2]]^2], {i, 1, 10}]); 
C2[0][x_, y_] := 
 c0[[2]]*(1 + 
    Sum[RandomReal[{-.01, .01}]*
      Exp[-Norm[{x, y} - RandomReal[{-R, R}, 2]]^2], {i, 1, 10}]); 
C3[0][x_, y_] := 
 c0[[3]]*(1 + 
    Sum[RandomReal[{-.01, .01}]*
      Exp[-Norm[{x, y} - RandomReal[{-R, R}, 2]]^2], {i, 1, 10}]);
M1[0][x_, y_] := 
  m0[[1]]*(1 + 
     Sum[RandomReal[{-.01, .01}]*
       Exp[-Norm[{x, y} - RandomReal[{-R, R}, 2]]^2], {i, 1, 10}]);
M2[0][x_, y_] := 
 m0[[2]]*(1 + 
    Sum[RandomReal[{-.01, .01}]*
      Exp[-Norm[{x, y} - RandomReal[{-R, R}, 2]]^2], {i, 1, 10}]); 
M3[0][x_, y_] := 
 m0[[3]]*(1 + 
    Sum[RandomReal[{-.01, .01}]*
      Exp[-Norm[{x, y} - RandomReal[{-R, R}, 2]]^2], {i, 1, 10}]); 
M4[0][x_, y_] := 
 m0[[4]]*(1 + 
    Sum[RandomReal[{-.01, .01}]*
      Exp[-Norm[{x, y} - RandomReal[{-R, R}, 2]]^2], {i, 1, 10}]);
t0 = 1/2; n = 60;
Do[{C1[t], C2[t], C3[t]} = 
   NDSolveValue[{(c1[x, y] - C1[t - t0][x, y])/t0 - 
       d3*Laplacian[c1[x, y], {x, y}] == 
      NeumannValue[-C1[t - t0][x, 
           y] (\[Beta]1*M4[t - t0][x, y] + \[Beta]2) + \[Beta]3*
         M2[t - t0][x, y], True], (c2[x, y] - C2[t - t0][x, y])/t0 - 
       d3*Laplacian[c2[x, y], {x, y}] == 
      NeumannValue[-\[Gamma]1*M1[t - t0][x, y] + \[Gamma]2*
         M3[t - t0][x, y], True], (c3[x, y] - C3[t - t0][x, y])/t0 - 
       d3*Laplacian[c3[x, y], {x, y}] == 
      NeumannValue[-\[Delta]1*M3[t - t0][x, y]*
         C3[t - t0][x, y] + \[Delta]2*M4[t - t0][x, y], True]}, {c1, 
     c2, c3}, {x, y} \[Element] mesh, 
    Method -> {"FiniteElement", 
      InterpolationOrder -> {c1 -> 2, c2 -> 2, c3 -> 2}, 
      "MeshOptions" -> {"MaxCellMeasure" -> 0.01, "MeshOrder" -> 2}}];
  {M1[t], M2[t], M3[t], M4[t]} = 
   NDSolveValue[{(m1[x, y] - M1[t - t0][x, y])/t0 - 
       d2*Laplacian[m1[x, y], {x, y}] == -\[Alpha]3 M1[t - t0][x, 
         y] + \[Beta]1 C1[t - t0][x, y] M4[t - t0][x, y] + 
       M2[t - t0][x, 
         y] (\[Alpha]2 + \[Alpha]1 M4[t - t0][x, y]), (m2[x, y] - 
          M2[t - t0][x, y])/t0 - 
       d2*Laplacian[m2[x, y], {x, y}] == \[Beta]2 C1[t - t0][x, 
         y] + \[Alpha]3 M1[t - t0][x, y] - \[Beta]3 M2[t - t0][x, y] +
        M2[t - t0][x, 
         y] (-\[Alpha]2 - \[Alpha]1 M4[t - t0][x, y]), (m3[x, y] - 
          M3[t - t0][x, y])/t0 - 
       d2*Laplacian[m3[x, y], {x, y}] == \[Gamma]1 C2[t - t0][x, 
         y] M1[t - t0][x, y] - \[Gamma]2 M3[t - t0][x, 
         y] - \[Delta]1 C3[t - t0][x, y] M3[t - t0][x, 
         y] + \[Delta]2 M4[t - t0][x, 
         y], (m4[x, y] - M4[t - t0][x, y])/t0 - 
       d2*
        Laplacian[m4[x, y], {x, y}] == \[Delta]1 C3[t - t0][x, 
         y] M3[t - t0][x, y] - \[Delta]2 M4[t - t0][x, y]}, {m1, m2, 
     m3, m4}, {x, y} \[Element] mesh1, 
    Method -> {"FiniteElement", 
      InterpolationOrder -> {m1 -> 2, m2 -> 2, m3 -> 2, m4 -> 2}, 
      "MeshOptions" -> {"MaxCellMeasure" -> 0.01, 
        "MeshOrder" -> 2}}];, {t, t0, n*t0, t0}] // Quiet
Needs["NDSolve`FEM`"]; mesh = 
 ImplicitRegion[x^2 + y^2 <= R^2, {x, y}]; mesh1 = 
 ImplicitRegion[R1^2 <= x^2 + y^2 <= R^2, {x, y}];
C0[x_, y_] := Exp[-20*Norm[{x + 1/2, y}]^2];
M0[x_, y_] := 0;
t0 = 1; d3 = 1; d2 = 1; R = 1; R1 = 9/10;
C1 = NDSolveValue[{D[c1[t, x, y], t] - 
      d3*Laplacian[c1[t, x, y], {x, y}] == 
     NeumannValue[-c1[t, x, y], True], c1[0, x, y] == C0[x, y]}, 
   c1, {t, 0, t0}, {x, y} \[Element] mesh, 
   Method -> {"FiniteElement", InterpolationOrder -> {c1 -> 2}, 
     "MeshOptions" -> {"MaxCellMeasure" -> 0.01, "MeshOrder" -> 2}}];
M1 = NDSolveValue[{D[m1[t, x, y], t] - 
      d2*Laplacian[m1[t, x, y], {x, y}] == C1[t, x, y], 
    m1[0, x, y] == M0[x, y]} , 
   m1, {t, 0, t0}, {x, y} \[Element] mesh1, 
   Method -> {"FiniteElement", InterpolationOrder -> {m1 -> 2}, 
     "MeshOptions" -> {"MaxCellMeasure" -> 0.01, "MeshOrder" -> 2}}];
ClearAll[b, m, v, x, y, t];
alpha = 1.0; R1 = .9;
geometry = Disk[];

sol = NDSolveValue[{D[v[x, y, t], t] == 
    D[v[x, y, t], x, x] + D[v[x, y, t], y, y] + 
     NeumannValue[-1*alpha*v[x, y, t], x^2 + y^2 == 1], 
   D[m[x, y, t], t] == 
    UnitStep[
      x^2 + y^2 - R1^2] (D[m[x, y, t], x, x] + D[m[x, y, t], y, y] + 
       alpha*v[x, y, t]), m[x, y, 0] == 0, 
   v[x, y, 0] == Exp[-20*((x + .5)^2 + y^2)]}, {v, 
   m}, {x, y} \[Element] geometry, {t, 0, 10}]

vsol = sol[[1]];
msol = sol[[2]];
alpha = 1.0;
geometry = Disk[];

{x0, y0} = {-.5, .0};

sol = NDSolve[{D[v[x, y, t], t] == 
     D[v[x, y, t], x, x] + D[v[x, y, t], y, y] + 
      NeumannValue[-1*alpha*v[x, y, t], x^2 + y^2 == 1], 
    v[x, y, 0] == Exp[-20*((x - x0)^2 + (y - y0)^2)]}, 
   v, {x, y} \[Element] geometry, {t, 0, 10}, 
   Method -> {"FiniteElement", InterpolationOrder -> {v -> 2}, 
     "MeshOptions" -> {"MaxCellMeasure" -> 0.01, "MeshOrder" -> 2}}];

vsol = v /. sol[[1, 1]];

vBoundary[phi_, t_] := vsol[.99 Cos[phi], .99 Sin[phi], t]

sol = NDSolve[{D[m[phi, t], t] == 
     D[m[phi, t], {phi, 2}] + alpha*vBoundary[phi, t], 
    PeriodicBoundaryCondition[m[phi, t], phi == 2 \[Pi], 
     Function[x, x - 2 \[Pi]]], m[phi, 0] == 0}, 
   m, {phi, 0, 2 \[Pi]}, {t, 0, 10}];

msol = m /. sol[[1, 1]];
Needs["NDSolve`FEM`"]; mesh = 
 ImplicitRegion[x^2 + y^2 <= R^2, {x, y}]; mesh1 = 
 ImplicitRegion[R1^2 <= x^2 + y^2 <= R^2, {x, y}];
d2 = 1; d3 = 1 ; R = 1; R1 = 9/10; 
C1[0][x_, y_] := Exp[-20*Norm[{x + 1/2, y}]^2];
M1[0][x_, y_] := 0;

t0 = 1/50; n = 20;
Do[C1[t] = 
   NDSolveValue[(c1[x, y] - C1[t - t0][x, y])/t0 - 
      d3*Laplacian[c1[x, y], {x, y}] == NeumannValue[-c1[x, y], True],
     c1, {x, y} \[Element] mesh, 
    Method -> {"FiniteElement", InterpolationOrder -> {c1 -> 2}, 
      "MeshOptions" -> {"MaxCellMeasure" -> 0.01, "MeshOrder" -> 2}}];
  M1[t] = 
   NDSolveValue[(m1[x, y] - M1[t - t0][x, y])/t0 - 
      d2*Laplacian[m1[x, y], {x, y}] == C1[t][x, y] , 
    m1, {x, y} \[Element] mesh1, 
    Method -> {"FiniteElement", InterpolationOrder -> {m1 -> 2}, 
      "MeshOptions" -> {"MaxCellMeasure" -> 0.01, 
        "MeshOrder" -> 2}}];, {t, t0, n*t0, t0}] // Quiet
Needs["NDSolve`FEM`"]; mesh = ImplicitRegion[x^2 + y^2 + z^2 <= R^2, {x, y, z}]; mesh1 = ImplicitRegion[(9*(R/10))^2 <= x^2 + y^2 + z^2 <= R^2, {x, y, z}]; 
d2 = 0.03; d3 = 11; R = 4; N42 = 3000; NB = 6500; N24 = 1000; \[Alpha]1 = 0.2; \[Alpha]2 = 0.12/60; \[Alpha]3 = 1; \[Beta]1 = 0.266; \[Beta]2 = 0.28; \[Beta]3 = 1; \[Gamma]1 = 0.2667; \[Gamma]2 = 0.35; 
  \[Delta]1 = 0.00297; \[Delta]2 = 0.35; 
c0 = {3, 6.5, 1}; m0 = {3, 3, 6.5, 1}; a = 1/30; 
C1[0][x_, y_, z_] := c0[[1]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  C2[0][x_, y_, z_] := c0[[2]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  C3[0][x_, y_, z_] := c0[[3]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
M1[0][x_, y_, z_] := m0[[1]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  M2[0][x_, y_, z_] := m0[[2]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  M3[0][x_, y_, z_] := m0[[3]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  M4[0][x_, y_, z_] := m0[[4]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
t0 = 1/10; n = 40; 
Quiet[Do[{C1[t], C2[t], C3[t]} = NDSolveValue[{(c1[x, y, z] - C1[t - t0][x, y, z])/t0 - d3*Laplacian[c1[x, y, z], {x, y, z}] == 
        NeumannValue[(-C1[t - t0][x, y, z])*(\[Beta]1*M4[t - t0][x, y, z] + \[Beta]2) + \[Beta]3*M2[t - t0][x, y, z], True], 
       (c2[x, y, z] - C2[t - t0][x, y, z])/t0 - d3*Laplacian[c2[x, y, z], {x, y, z}] == NeumannValue[(-\[Gamma]1)*M1[t - t0][x, y, z] + \[Gamma]2*M3[t - t0][x, y, z], True], 
       (c3[x, y, z] - C3[t - t0][x, y, z])/t0 - d3*Laplacian[c3[x, y, z], {x, y, z}] == NeumannValue[(-\[Delta]1)*M3[t - t0][x, y, z]*C3[t - t0][x, y, z] + 
          \[Delta]2*M4[t - t0][x, y, z], True]}, {c1, c2, c3}, Element[{x, y, z}, mesh], 
      Method -> {"FiniteElement", InterpolationOrder -> {c1 -> 2, c2 -> 2, c3 -> 2}}]; {M1[t], M2[t], M3[t], M4[t]} = 
     NDSolveValue[{(m1[x, y, z] - M1[t - t0][x, y, z])/t0 - d2*Laplacian[m1[x, y, z], {x, y, z}] == (-\[Alpha]3)*M1[t - t0][x, y, z] + 
         \[Beta]1*C1[t - t0][x, y, z]*M4[t - t0][x, y, z] + M2[t - t0][x, y, z]*(\[Alpha]2 + \[Alpha]1*M4[t - t0][x, y, z]), 
       (m2[x, y, z] - M2[t - t0][x, y, z])/t0 - d2*Laplacian[m2[x, y, z], {x, y, z}] == \[Beta]2*C1[t - t0][x, y, z] + \[Alpha]3*M1[t - t0][x, y, z] - 
         \[Beta]3*M2[t - t0][x, y, z] + M2[t - t0][x, y, z]*(-\[Alpha]2 - \[Alpha]1*M4[t - t0][x, y, z]), 
       (m3[x, y, z] - M3[t - t0][x, y, z])/t0 - d2*Laplacian[m3[x, y, z], {x, y, z}] == \[Gamma]1*C2[t - t0][x, y, z]*M1[t - t0][x, y, z] - \[Gamma]2*M3[t - t0][x, y, z] - 
         \[Delta]1*C3[t - t0][x, y, z]*M3[t - t0][x, y, z] + \[Delta]2*M4[t - t0][x, y, z], (m4[x, y, z] - M4[t - t0][x, y, z])/t0 - d2*Laplacian[m4[x, y, z], {x, y, z}] == 
        \[Delta]1*C3[t - t0][x, y, z]*M3[t - t0][x, y, z] - \[Delta]2*M4[t - t0][x, y, z]}, {m1, m2, m3, m4}, Element[{x, y, z}, mesh1], 
      Method -> {"FiniteElement", InterpolationOrder -> {m1 -> 2, m2 -> 2, m3 -> 2, m4 -> 2}}]; , {t, t0, n*t0, t0}]]  
Needs["NDSolve`FEM`"]; mesh = 
 ImplicitRegion[x^2 + y^2 <= R^2, {x, y}]; mesh1 = 
 ImplicitRegion[R1^2 <= x^2 + y^2 <= R^2, {x, y}];
d2 = .03; d3 = 11 ; R = 4; R1 = 
 7/2; N42 = 3000; NB = 6500; N24 = 1000; α1 = 0.2; α2 = 
 0.12 /60; α3 = 1 ; β1 = 0.266 ; β2 = 0.28 ; \
β3 = 1; γ1 = 0.2667 ; γ2 = 0.35 ; δ1 = \
0.00297;  δ2 = 0.35;
c0 = {.3, .65, .1}; m0 = {.0, .3, .65, 0.1};
C1[0][x_, y_] := 
 c0[[1]]*(1 + 
    Sum[RandomReal[{-.01, .01}]*
      Exp[-Norm[{x, y} - RandomReal[{-R, R}, 2]]^2], {i, 1, 10}]); 
C2[0][x_, y_] := 
 c0[[2]]*(1 + 
    Sum[RandomReal[{-.01, .01}]*
      Exp[-Norm[{x, y} - RandomReal[{-R, R}, 2]]^2], {i, 1, 10}]); 
C3[0][x_, y_] := 
 c0[[3]]*(1 + 
    Sum[RandomReal[{-.01, .01}]*
      Exp[-Norm[{x, y} - RandomReal[{-R, R}, 2]]^2], {i, 1, 10}]);
M1[0][x_, y_] := 
  m0[[1]]*(1 + 
     Sum[RandomReal[{-.01, .01}]*
       Exp[-Norm[{x, y} - RandomReal[{-R, R}, 2]]^2], {i, 1, 10}]);
M2[0][x_, y_] := 
 m0[[2]]*(1 + 
    Sum[RandomReal[{-.01, .01}]*
      Exp[-Norm[{x, y} - RandomReal[{-R, R}, 2]]^2], {i, 1, 10}]); 
M3[0][x_, y_] := 
 m0[[3]]*(1 + 
    Sum[RandomReal[{-.01, .01}]*
      Exp[-Norm[{x, y} - RandomReal[{-R, R}, 2]]^2], {i, 1, 10}]); 
M4[0][x_, y_] := 
 m0[[4]]*(1 + 
    Sum[RandomReal[{-.01, .01}]*
      Exp[-Norm[{x, y} - RandomReal[{-R, R}, 2]]^2], {i, 1, 10}]);
t0 = 1/2; n = 60;
Do[{C1[t], C2[t], C3[t]} = 
   NDSolveValue[{(c1[x, y] - C1[t - t0][x, y])/t0 - 
       d3*Laplacian[c1[x, y], {x, y}] == 
      NeumannValue[-C1[t - t0][x, 
           y] (β1*M4[t - t0][x, y] + β2) + β3*
         M2[t - t0][x, y], True], (c2[x, y] - C2[t - t0][x, y])/t0 - 
       d3*Laplacian[c2[x, y], {x, y}] == 
      NeumannValue[-γ1*M1[t - t0][x, y] + γ2*
         M3[t - t0][x, y], True], (c3[x, y] - C3[t - t0][x, y])/t0 - 
       d3*Laplacian[c3[x, y], {x, y}] == 
      NeumannValue[-δ1*M3[t - t0][x, y]*
         C3[t - t0][x, y] + δ2*M4[t - t0][x, y], True]}, {c1, 
     c2, c3}, {x, y}  mesh, 
    Method -> {"FiniteElement", 
      InterpolationOrder -> {c1 -> 2, c2 -> 2, c3 -> 2}, 
      "MeshOptions" -> {"MaxCellMeasure" -> 0.01, "MeshOrder" -> 2}}];
  {M1[t], M2[t], M3[t], M4[t]} = 
   NDSolveValue[{(m1[x, y] - M1[t - t0][x, y])/t0 - 
       d2*Laplacian[m1[x, y], {x, y}] == -α3 M1[t - t0][x, 
         y] + β1 C1[t - t0][x, y] M4[t - t0][x, y] + 
       M2[t - t0][x, 
         y] (α2 + α1 M4[t - t0][x, y]), (m2[x, y] - 
          M2[t - t0][x, y])/t0 - 
       d2*Laplacian[m2[x, y], {x, y}] == β2 C1[t - t0][x, 
         y] + α3 M1[t - t0][x, y] - β3 M2[t - t0][x, y] +
        M2[t - t0][x, 
         y] (-α2 - α1 M4[t - t0][x, y]), (m3[x, y] - 
          M3[t - t0][x, y])/t0 - 
       d2*Laplacian[m3[x, y], {x, y}] == γ1 C2[t - t0][x, 
         y] M1[t - t0][x, y] - γ2 M3[t - t0][x, 
         y] - δ1 C3[t - t0][x, y] M3[t - t0][x, 
         y] + δ2 M4[t - t0][x, 
         y], (m4[x, y] - M4[t - t0][x, y])/t0 - 
       d2*
        Laplacian[m4[x, y], {x, y}] == δ1 C3[t - t0][x, 
         y] M3[t - t0][x, y] - δ2 M4[t - t0][x, y]}, {m1, m2, 
     m3, m4}, {x, y}  mesh1, 
    Method -> {"FiniteElement", 
      InterpolationOrder -> {m1 -> 2, m2 -> 2, m3 -> 2, m4 -> 2}, 
      "MeshOptions" -> {"MaxCellMeasure" -> 0.01, 
        "MeshOrder" -> 2}}];, {t, t0, n*t0, t0}] // Quiet
Needs["NDSolve`FEM`"]; mesh = 
 ImplicitRegion[x^2 + y^2 <= R^2, {x, y}]; mesh1 = 
 ImplicitRegion[R1^2 <= x^2 + y^2 <= R^2, {x, y}];
C0[x_, y_] := Exp[-20*Norm[{x + 1/2, y}]^2];
M0[x_, y_] := 0;
t0 = 1; d3 = 1; d2 = 1; R = 1; R1 = 9/10;
C1 = NDSolveValue[{D[c1[t, x, y], t] - 
      d3*Laplacian[c1[t, x, y], {x, y}] == 
     NeumannValue[-c1[t, x, y], True], c1[0, x, y] == C0[x, y]}, 
   c1, {t, 0, t0}, {x, y}  mesh, 
   Method -> {"FiniteElement", InterpolationOrder -> {c1 -> 2}, 
     "MeshOptions" -> {"MaxCellMeasure" -> 0.01, "MeshOrder" -> 2}}];
M1 = NDSolveValue[{D[m1[t, x, y], t] - 
      d2*Laplacian[m1[t, x, y], {x, y}] == C1[t, x, y], 
    m1[0, x, y] == M0[x, y]} , 
   m1, {t, 0, t0}, {x, y}  mesh1, 
   Method -> {"FiniteElement", InterpolationOrder -> {m1 -> 2}, 
     "MeshOptions" -> {"MaxCellMeasure" -> 0.01, "MeshOrder" -> 2}}];
ClearAll[b, m, v, x, y, t];
alpha = 1.0; R1 = .9;
geometry = Disk[];

sol = NDSolveValue[{D[v[x, y, t], t] == 
    D[v[x, y, t], x, x] + D[v[x, y, t], y, y] + 
     NeumannValue[-1*alpha*v[x, y, t], x^2 + y^2 == 1], 
   D[m[x, y, t], t] == 
    UnitStep[
      x^2 + y^2 - R1^2] (D[m[x, y, t], x, x] + D[m[x, y, t], y, y] + 
       alpha*v[x, y, t]), m[x, y, 0] == 0, 
   v[x, y, 0] == Exp[-20*((x + .5)^2 + y^2)]}, {v, 
   m}, {x, y}  geometry, {t, 0, 10}]

vsol = sol[[1]];
msol = sol[[2]];
alpha = 1.0;
geometry = Disk[];

{x0, y0} = {-.5, .0};

sol = NDSolve[{D[v[x, y, t], t] == 
     D[v[x, y, t], x, x] + D[v[x, y, t], y, y] + 
      NeumannValue[-1*alpha*v[x, y, t], x^2 + y^2 == 1], 
    v[x, y, 0] == Exp[-20*((x - x0)^2 + (y - y0)^2)]}, 
   v, {x, y}  geometry, {t, 0, 10}, 
   Method -> {"FiniteElement", InterpolationOrder -> {v -> 2}, 
     "MeshOptions" -> {"MaxCellMeasure" -> 0.01, "MeshOrder" -> 2}}];

vsol = v /. sol[[1, 1]];

vBoundary[phi_, t_] := vsol[.99 Cos[phi], .99 Sin[phi], t]

sol = NDSolve[{D[m[phi, t], t] == 
     D[m[phi, t], {phi, 2}] + alpha*vBoundary[phi, t], 
    PeriodicBoundaryCondition[m[phi, t], phi == 2 π, 
     Function[x, x - 2 π]], m[phi, 0] == 0}, 
   m, {phi, 0, 2 π}, {t, 0, 10}];

msol = m /. sol[[1, 1]];
Needs["NDSolve`FEM`"]; mesh = 
 ImplicitRegion[x^2 + y^2 <= R^2, {x, y}]; mesh1 = 
 ImplicitRegion[R1^2 <= x^2 + y^2 <= R^2, {x, y}];
d2 = 1; d3 = 1 ; R = 1; R1 = 9/10; 
C1[0][x_, y_] := Exp[-20*Norm[{x + 1/2, y}]^2];
M1[0][x_, y_] := 0;

t0 = 1/50; n = 20;
Do[C1[t] = 
   NDSolveValue[(c1[x, y] - C1[t - t0][x, y])/t0 - 
      d3*Laplacian[c1[x, y], {x, y}] == NeumannValue[-c1[x, y], True],
     c1, {x, y}  mesh, 
    Method -> {"FiniteElement", InterpolationOrder -> {c1 -> 2}, 
      "MeshOptions" -> {"MaxCellMeasure" -> 0.01, "MeshOrder" -> 2}}];
  M1[t] = 
   NDSolveValue[(m1[x, y] - M1[t - t0][x, y])/t0 - 
      d2*Laplacian[m1[x, y], {x, y}] == C1[t][x, y] , 
    m1, {x, y}  mesh1, 
    Method -> {"FiniteElement", InterpolationOrder -> {m1 -> 2}, 
      "MeshOptions" -> {"MaxCellMeasure" -> 0.01, 
        "MeshOrder" -> 2}}];, {t, t0, n*t0, t0}] // Quiet
Needs["NDSolve`FEM`"]; mesh = ImplicitRegion[x^2 + y^2 + z^2 <= R^2, {x, y, z}]; mesh1 = ImplicitRegion[(9*(R/10))^2 <= x^2 + y^2 + z^2 <= R^2, {x, y, z}]; 
d2 = 0.03; d3 = 11; R = 4; N42 = 3000; NB = 6500; N24 = 1000; α1 = 0.2; α2 = 0.12/60; α3 = 1; β1 = 0.266; β2 = 0.28; β3 = 1; γ1 = 0.2667; γ2 = 0.35; 
  δ1 = 0.00297; δ2 = 0.35; 
c0 = {3, 6.5, 1}; m0 = {3, 3, 6.5, 1}; a = 1/30; 
C1[0][x_, y_, z_] := c0[[1]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  C2[0][x_, y_, z_] := c0[[2]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  C3[0][x_, y_, z_] := c0[[3]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
M1[0][x_, y_, z_] := m0[[1]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  M2[0][x_, y_, z_] := m0[[2]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  M3[0][x_, y_, z_] := m0[[3]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  M4[0][x_, y_, z_] := m0[[4]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
t0 = 1/10; n = 40; 
Quiet[Do[{C1[t], C2[t], C3[t]} = NDSolveValue[{(c1[x, y, z] - C1[t - t0][x, y, z])/t0 - d3*Laplacian[c1[x, y, z], {x, y, z}] == 
        NeumannValue[(-C1[t - t0][x, y, z])*(β1*M4[t - t0][x, y, z] + β2) + β3*M2[t - t0][x, y, z], True], 
       (c2[x, y, z] - C2[t - t0][x, y, z])/t0 - d3*Laplacian[c2[x, y, z], {x, y, z}] == NeumannValue[(-γ1)*M1[t - t0][x, y, z] + γ2*M3[t - t0][x, y, z], True], 
       (c3[x, y, z] - C3[t - t0][x, y, z])/t0 - d3*Laplacian[c3[x, y, z], {x, y, z}] == NeumannValue[(-δ1)*M3[t - t0][x, y, z]*C3[t - t0][x, y, z] + 
          δ2*M4[t - t0][x, y, z], True]}, {c1, c2, c3}, Element[{x, y, z}, mesh], 
      Method -> {"FiniteElement", InterpolationOrder -> {c1 -> 2, c2 -> 2, c3 -> 2}}]; {M1[t], M2[t], M3[t], M4[t]} = 
     NDSolveValue[{(m1[x, y, z] - M1[t - t0][x, y, z])/t0 - d2*Laplacian[m1[x, y, z], {x, y, z}] == (-α3)*M1[t - t0][x, y, z] + 
         β1*C1[t - t0][x, y, z]*M4[t - t0][x, y, z] + M2[t - t0][x, y, z]*(α2 + α1*M4[t - t0][x, y, z]), 
       (m2[x, y, z] - M2[t - t0][x, y, z])/t0 - d2*Laplacian[m2[x, y, z], {x, y, z}] == β2*C1[t - t0][x, y, z] + α3*M1[t - t0][x, y, z] - 
         β3*M2[t - t0][x, y, z] + M2[t - t0][x, y, z]*(-α2 - α1*M4[t - t0][x, y, z]), 
       (m3[x, y, z] - M3[t - t0][x, y, z])/t0 - d2*Laplacian[m3[x, y, z], {x, y, z}] == γ1*C2[t - t0][x, y, z]*M1[t - t0][x, y, z] - γ2*M3[t - t0][x, y, z] - 
         δ1*C3[t - t0][x, y, z]*M3[t - t0][x, y, z] + δ2*M4[t - t0][x, y, z], (m4[x, y, z] - M4[t - t0][x, y, z])/t0 - d2*Laplacian[m4[x, y, z], {x, y, z}] == 
        δ1*C3[t - t0][x, y, z]*M3[t - t0][x, y, z] - δ2*M4[t - t0][x, y, z]}, {m1, m2, m3, m4}, Element[{x, y, z}, mesh1], 
      Method -> {"FiniteElement", InterpolationOrder -> {m1 -> 2, m2 -> 2, m3 -> 2, m4 -> 2}}]; , {t, t0, n*t0, t0}]]  
    Bounty Ended with 500 reputation awarded by MOON
10 deleted 544 characters in body
source | link
Needs["NDSolve`FEM`"]; mesh = 
 ImplicitRegion[x^2 + y^2 + z^2 <= R^2, {x, y, z}]; mesh1 = 
 ImplicitRegion[(9*R9*(R/10))^2 <= x^2 + y^2 + z^2 <= R^2, {x, y, z}]; 
d2 = 0.03; d3 = 11 ;11; R = 4; N42 = 3000; NB = 6500; N24 = 1000; \
\[Alpha]1 = 0.2; \[Alpha]2 = 
 0.12 /60; \[Alpha]3 = 1 ;1; \[Beta]1 = 0.266 ;266; \[Beta]2 = 0.28 ;28; \
\[Beta]3 = 1; \[Gamma]1 = 0.2667 ;2667; \[Gamma]2 = 0.3535; ;
  \[Delta]1 = \
0.00297;  \[Delta]2 = 0.35; 
c0 = {3, 6.5, 1}; m0 = {3, 3, 6.5, 1}; a = 1/50;30; 
C1[0][x_, y_, z_] := 
 c0[[1]] + 
  Sum[RandomReal[{-a, a}]*
    Exp[]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  C2[0][x_, y_, z_] := 
 c0[[2]] + 
  Sum[RandomReal[{-a, a}]*
    Exp[]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  C3[0][x_, y_, z_] := 
 c0[[3]] + 
  Sum[RandomReal[{-a, a}]*
    Exp[]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
M1[0][x_, y_, z_] := 
 m0[[1]] + 
  Sum[RandomReal[{-a, a}]*
    Exp[]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  M2[0][x_, y_, z_] := 
 m0[[2]] + 
  Sum[RandomReal[{-a, a}]*
    Exp[]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  M3[0][x_, y_, z_] := 
 m0[[3]] + 
  Sum[RandomReal[{-a, a}]*
    Exp[]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  M4[0][x_, y_, z_] := 
 m0[[4]] + 
  Sum[RandomReal[{-a, a}]*
    Exp[]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
t0 = 1/10; n = 20;40; 
Do[Quiet[Do[{C1[t], C2[t], C3[t]} = 
   NDSolveValue[{(c1[x, y, z] - C1[t - t0][x, y, z])/t0 - 
       d3*Laplacian[c1[x, y, z], {x, y, z}] == 
        NeumannValue[(-C1[t - t0][x, y, 
           z] )*(\[Beta]1*M4[t - t0][x, y, z] + \[Beta]2) + \[Beta]3*
         M2[t\[Beta]3*M2[t - t0][x, y, z], 
 True],  
      True], (c2[x, y, z] - C2[t - t0][x, y, z])/t0 - 
       d3*Laplacian[c2[x, y, z], {x, y, z}] == 
      NeumannValue[(-\[Gamma]1*M1[t\[Gamma]1)*M1[t - t0][x, y, z] + \[Gamma]2*
         M3[t\[Gamma]2*M3[t - t0][x, y, z], 
 True],  
      True], (c3[x, y, z] - C3[t - t0][x, y, z])/t0 - 
       d3*Laplacian[c3[x, y, z], {x, y, z}] == 
      NeumannValue[(-\[Delta]1*M3[t\[Delta]1)*M3[t - t0][x, y, z]*
z]*C3[t - t0][x, y, z] +  
   C3[t - t0][x, y, z] +  \[Delta]2*M4[t - t0][x, y, z], 
       True]}, {c1, c2, c3}, Element[{x, y, z} \[Element], meshmesh], 
      Method -> {"FiniteElement", 
      InterpolationOrder -> {c1 -> 2, c2 -> 2, c3 -> 2}}];
  {M1[t], M2[t], M3[t], M4[t]} = 
     NDSolveValue[{(m1[x, y, z] - M1[t - t0][x, y, z])/t0 - 
       d2*Laplacian[m1[x, y, z], {x, y, z}] == (-\[Alpha]3 M1[t)*M1[t - t0][
t0][x, y, z] +  
     x, y, z] + \[Beta]1 C1[t\[Beta]1*C1[t - t0][x, y, z] M4[tz]*M4[t - t0][x, y, z] +
        M2[t - t0][x, y, 
         z] z]*(\[Alpha]2 + \[Alpha]1 M4[t\[Alpha]1*M4[t - t0][x, y, z]), (m2[x, y, 
         (m2[x, y, z] - M2[t - t0][x, y, z])/t0 - 
       d2*Laplacian[m2[x, y, z], {x, y, z}] == \[Beta]2 C1[t\[Beta]2*C1[t - t0][x, 
         y, z] + \[Alpha]3 M1[t\[Alpha]3*M1[t - t0][x, y, z] - \[Beta]3 M2[t 
 - t0][
       \[Beta]3*M2[t - xt0][x, y, z] + 
       M2[t - t0][x, y, 
         z] z]*(-\[Alpha]2 - \[Alpha]1 M4[t\[Alpha]1*M4[t - t0][x, y, z]), (m3[x, y, 
         (m3[x, y, z] - M3[t - t0][x, y, z])/t0 - 
       d2*Laplacian[m3[x, y, z], {x, y, z}] == \[Gamma]1 C2[t\[Gamma]1*C2[t - t0][x,
          y, z] M1[tz]*M1[t - t0][x, y, z] - \[Gamma]2 M3[t\[Gamma]2*M3[t - t0][x, y, 
 z] -  
       z] - \[Delta]1 C3[t\[Delta]1*C3[t - t0][x, y, z] M3[tz]*M3[t - t0][x, y, 
         z] + \[Delta]2 M4[t\[Delta]2*M4[t - t0][x, y, 
         z], (m4[x, y, z] - M4[t - t0][x, y, z])/t0 - 
       d2*Laplacian[m4[x, y, z], {x, y, z}] == \[Delta]1 C3[t - t0][x,
        \[Delta]1*C3[t - t0][x, y, z] M3[tz]*M3[t - t0][x, y, z] - \[Delta]2 M4[t\[Delta]2*M4[t - t0][x, y, 
         z]}, {m1, m2, m3, m4}, Element[{x, y, z} \[Element], mesh1mesh1], 
      Method -> {"FiniteElement", 
      InterpolationOrder -> {m1 -> 2, m2 -> 2, m3 -> 2, 
        m4 -> 2}}]; , {t, t0, n*t0, t0}]]] // Quiet
Needs["NDSolve`FEM`"]; mesh = 
 ImplicitRegion[x^2 + y^2 + z^2 <= R^2, {x, y, z}]; mesh1 = 
 ImplicitRegion[(9*R/10)^2 <= x^2 + y^2 + z^2 <= R^2, {x, y, z}];
d2 = .03; d3 = 11 ; R = 4; N42 = 3000; NB = 6500; N24 = 1000; \
\[Alpha]1 = 0.2; \[Alpha]2 = 
 0.12 /60; \[Alpha]3 = 1 ; \[Beta]1 = 0.266 ; \[Beta]2 = 0.28 ; \
\[Beta]3 = 1; \[Gamma]1 = 0.2667 ; \[Gamma]2 = 0.35 ; \[Delta]1 = \
0.00297;  \[Delta]2 = 0.35;
c0 = {3, 6.5, 1}; m0 = {3, 3, 6.5, 1}; a = 1/50;
C1[0][x_, y_, z_] := 
 c0[[1]] + 
  Sum[RandomReal[{-a, a}]*
    Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
C2[0][x_, y_, z_] := 
 c0[[2]] + 
  Sum[RandomReal[{-a, a}]*
    Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
C3[0][x_, y_, z_] := 
 c0[[3]] + 
  Sum[RandomReal[{-a, a}]*
    Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}];
M1[0][x_, y_, z_] := 
 m0[[1]] + 
  Sum[RandomReal[{-a, a}]*
    Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
M2[0][x_, y_, z_] := 
 m0[[2]] + 
  Sum[RandomReal[{-a, a}]*
    Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
M3[0][x_, y_, z_] := 
 m0[[3]] + 
  Sum[RandomReal[{-a, a}]*
    Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
M4[0][x_, y_, z_] := 
 m0[[4]] + 
  Sum[RandomReal[{-a, a}]*
    Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}];
t0 = 1/10; n = 20;
Do[{C1[t], C2[t], C3[t]} = 
   NDSolveValue[{(c1[x, y, z] - C1[t - t0][x, y, z])/t0 - 
       d3*Laplacian[c1[x, y, z], {x, y, z}] == 
      NeumannValue[-C1[t - t0][x, y, 
           z] (\[Beta]1*M4[t - t0][x, y, z] + \[Beta]2) + \[Beta]3*
         M2[t - t0][x, y, z], 
        True], (c2[x, y, z] - C2[t - t0][x, y, z])/t0 - 
       d3*Laplacian[c2[x, y, z], {x, y, z}] == 
      NeumannValue[-\[Gamma]1*M1[t - t0][x, y, z] + \[Gamma]2*
         M3[t - t0][x, y, z], 
        True], (c3[x, y, z] - C3[t - t0][x, y, z])/t0 - 
       d3*Laplacian[c3[x, y, z], {x, y, z}] == 
      NeumannValue[-\[Delta]1*M3[t - t0][x, y, z]*
         C3[t - t0][x, y, z] + \[Delta]2*M4[t - t0][x, y, z], 
       True]}, {c1, c2, c3}, {x, y, z} \[Element] mesh, 
    Method -> {"FiniteElement", 
      InterpolationOrder -> {c1 -> 2, c2 -> 2, c3 -> 2}}];
  {M1[t], M2[t], M3[t], M4[t]} = 
   NDSolveValue[{(m1[x, y, z] - M1[t - t0][x, y, z])/t0 - 
       d2*Laplacian[m1[x, y, z], {x, y, z}] == -\[Alpha]3 M1[t - t0][
         x, y, z] + \[Beta]1 C1[t - t0][x, y, z] M4[t - t0][x, y, z] +
        M2[t - t0][x, y, 
         z] (\[Alpha]2 + \[Alpha]1 M4[t - t0][x, y, z]), (m2[x, y, 
           z] - M2[t - t0][x, y, z])/t0 - 
       d2*Laplacian[m2[x, y, z], {x, y, z}] == \[Beta]2 C1[t - t0][x, 
         y, z] + \[Alpha]3 M1[t - t0][x, y, z] - \[Beta]3 M2[t - t0][
         x, y, z] + 
       M2[t - t0][x, y, 
         z] (-\[Alpha]2 - \[Alpha]1 M4[t - t0][x, y, z]), (m3[x, y, 
           z] - M3[t - t0][x, y, z])/t0 - 
       d2*Laplacian[m3[x, y, z], {x, y, z}] == \[Gamma]1 C2[t - t0][x,
          y, z] M1[t - t0][x, y, z] - \[Gamma]2 M3[t - t0][x, y, 
          z] - \[Delta]1 C3[t - t0][x, y, z] M3[t - t0][x, y, 
         z] + \[Delta]2 M4[t - t0][x, y, 
         z], (m4[x, y, z] - M4[t - t0][x, y, z])/t0 - 
       d2*Laplacian[m4[x, y, z], {x, y, z}] == \[Delta]1 C3[t - t0][x,
          y, z] M3[t - t0][x, y, z] - \[Delta]2 M4[t - t0][x, y, 
         z]}, {m1, m2, m3, m4}, {x, y, z} \[Element] mesh1, 
    Method -> {"FiniteElement", 
      InterpolationOrder -> {m1 -> 2, m2 -> 2, m3 -> 2, 
        m4 -> 2}}];, {t, t0, n*t0, t0}] // Quiet
Needs["NDSolve`FEM`"]; mesh = ImplicitRegion[x^2 + y^2 + z^2 <= R^2, {x, y, z}]; mesh1 = ImplicitRegion[(9*(R/10))^2 <= x^2 + y^2 + z^2 <= R^2, {x, y, z}]; 
d2 = 0.03; d3 = 11; R = 4; N42 = 3000; NB = 6500; N24 = 1000; \[Alpha]1 = 0.2; \[Alpha]2 = 0.12/60; \[Alpha]3 = 1; \[Beta]1 = 0.266; \[Beta]2 = 0.28; \[Beta]3 = 1; \[Gamma]1 = 0.2667; \[Gamma]2 = 0.35; 
  \[Delta]1 = 0.00297; \[Delta]2 = 0.35; 
c0 = {3, 6.5, 1}; m0 = {3, 3, 6.5, 1}; a = 1/30; 
C1[0][x_, y_, z_] := c0[[1]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  C2[0][x_, y_, z_] := c0[[2]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  C3[0][x_, y_, z_] := c0[[3]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
M1[0][x_, y_, z_] := m0[[1]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  M2[0][x_, y_, z_] := m0[[2]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  M3[0][x_, y_, z_] := m0[[3]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
  M4[0][x_, y_, z_] := m0[[4]] + Sum[RandomReal[{-a, a}]*Exp[-Norm[{x, y, z} - RandomReal[{-R, R}, 3]]^2], {i, 1, 10}]; 
t0 = 1/10; n = 40; 
Quiet[Do[{C1[t], C2[t], C3[t]} = NDSolveValue[{(c1[x, y, z] - C1[t - t0][x, y, z])/t0 - d3*Laplacian[c1[x, y, z], {x, y, z}] == 
        NeumannValue[(-C1[t - t0][x, y, z])*(\[Beta]1*M4[t - t0][x, y, z] + \[Beta]2) + \[Beta]3*M2[t - t0][x, y, z], True],  
       (c2[x, y, z] - C2[t - t0][x, y, z])/t0 - d3*Laplacian[c2[x, y, z], {x, y, z}] == NeumannValue[(-\[Gamma]1)*M1[t - t0][x, y, z] + \[Gamma]2*M3[t - t0][x, y, z], True],  
       (c3[x, y, z] - C3[t - t0][x, y, z])/t0 - d3*Laplacian[c3[x, y, z], {x, y, z}] == NeumannValue[(-\[Delta]1)*M3[t - t0][x, y, z]*C3[t - t0][x, y, z] +  
          \[Delta]2*M4[t - t0][x, y, z], True]}, {c1, c2, c3}, Element[{x, y, z}, mesh], 
      Method -> {"FiniteElement", InterpolationOrder -> {c1 -> 2, c2 -> 2, c3 -> 2}}]; {M1[t], M2[t], M3[t], M4[t]} = 
     NDSolveValue[{(m1[x, y, z] - M1[t - t0][x, y, z])/t0 - d2*Laplacian[m1[x, y, z], {x, y, z}] == (-\[Alpha]3)*M1[t - t0][x, y, z] +  
         \[Beta]1*C1[t - t0][x, y, z]*M4[t - t0][x, y, z] + M2[t - t0][x, y, z]*(\[Alpha]2 + \[Alpha]1*M4[t - t0][x, y, z]), 
       (m2[x, y, z] - M2[t - t0][x, y, z])/t0 - d2*Laplacian[m2[x, y, z], {x, y, z}] == \[Beta]2*C1[t - t0][x, y, z] + \[Alpha]3*M1[t - t0][x, y, z] -  
         \[Beta]3*M2[t - t0][x, y, z] + M2[t - t0][x, y, z]*(-\[Alpha]2 - \[Alpha]1*M4[t - t0][x, y, z]), 
       (m3[x, y, z] - M3[t - t0][x, y, z])/t0 - d2*Laplacian[m3[x, y, z], {x, y, z}] == \[Gamma]1*C2[t - t0][x, y, z]*M1[t - t0][x, y, z] - \[Gamma]2*M3[t - t0][x, y, z] -  
         \[Delta]1*C3[t - t0][x, y, z]*M3[t - t0][x, y, z] + \[Delta]2*M4[t - t0][x, y, z], (m4[x, y, z] - M4[t - t0][x, y, z])/t0 - d2*Laplacian[m4[x, y, z], {x, y, z}] == 
        \[Delta]1*C3[t - t0][x, y, z]*M3[t - t0][x, y, z] - \[Delta]2*M4[t - t0][x, y, z]}, {m1, m2, m3, m4}, Element[{x, y, z}, mesh1], 
      Method -> {"FiniteElement", InterpolationOrder -> {m1 -> 2, m2 -> 2, m3 -> 2, m4 -> 2}}]; , {t, t0, n*t0, t0}]]  
9 added 137 characters in body
source | link

The distribution of $m_T,m_D$ on the membrane with multiple clusters fig13

The distribution of $m_T,m_D$ on the membrane with multiple clusters fig13

8 added 5596 characters in body
source | link
7 deleted 87 characters in body
source | link
6 added 1480 characters in body
source | link
5 added 1320 characters in body
source | link
4 added 7 characters in body
source | link
3 added 1071 characters in body
source | link
2 added 1371 characters in body
source | link
1
source | link