Three dimensional Laplacian insulated on lateral faces and convectively exposed on transverse faces (updated)
Problem Statement
For notational simplicity, use the non-dimensional formulation described near the end of the question. (Doing so also facilitates comparison with results of a 2D approximation solved earlier.) The PDE is given by
λh D[θw[x, y, z], x, x] + λc D[θw[x, y, z], y, y] + λz D[θw[x, y, z], z, z] == 0
over the domain {x, 0, 1}, {y, 0, 1}, {z, 0, 1}
. Normal derivatives vanish on the x
and y
boundaries. Conditions on the z
boundaries are given by
(D[θw[x, y, z], z] + rh (θw[x, y, z] - θwh[x, y]) == 0) /. z -> 1
(D[θw[x, y, z], z] - rh (θw[x, y, z] - θwc[x, y]) == 0) /. z -> 0
with θwc
and θwh
specified by
D[θwh[x, y], x] + bh (θw[x, y, 1] - θwh[x, y]) == 0
θwh[0, y] == 1
D[θwc[x, y], y] + bc (θw[x, y, 0] - θwh[x, y]) == 0
θwc[x, 0] = 0
Although the solution of the PDE itself can be expressed as a sum of trigonometric functions, the z
boundary conditions couple what otherwise would be separable eigenfunctions.
Coupling Coefficients
The coupling coefficients in question are given by
DSolveValue[{D[θc[y], y] + b (θc[y] - 1) == 0, θc[0] == 0}, θc[y], y] // Simplify
a00 = Simplify[Integrate[% , {y, 0, 1}]]
an0 = Simplify[Integrate[%% 2 Cos[n π y], {y, 0, 1}], Assumptions -> n ∈ Integers]
(* 1 - E^(-b y) *)
(* (-1 + b + E^-b)/b *)
(* -((2 b E^-b ((-1)^(1 + n) + E^b))/(b^2 + n^2 π^2)) *)
DSolveValue[{D[θc[y], y] + b (θc[y] - Cos[m Pi y]) == 0, θc[0] == 0}, θc[y], y] // Simplify
a0m = Simplify[Integrate[%, {y, 0, 1}], Assumptions -> m ∈ Integers]
amm = Simplify[Integrate[%% 2 Cos[m π y], {y, 0, 1}], Assumptions -> m ∈ Integers]
anm = FullSimplify[Integrate[%%% 2 Cos[n π y], {y, 0, 1}], Assumptions -> (m | n) ∈ Integers]
(* (b (-b E^(-b y) + b Cos[m π y] + m π Sin[m π y]))/(b^2 + m^2 π^2) *)
(* (b ((-1)^(1 + m) + E^-b))/(b^2 + m^2) *) *)
(* (b^2 E^-b (b^2 E^b + 2 b ((-1)^m - E^b) + E^b m^2 π^2))/(b^2 + m^2 π^2)^2 *)
(* (E^-b (2 (-1)^n b^3 (m - n) (m + n) + 2 b E^b (n^2 (b^2 + m^2 π^2) + (-1)^(1 + m + n)
m^2 (b^2 + n^2 π^2))))/((m - n) (m + n) (b^2 + m^2 π^2) (b^2 + n^2 π^2)) *)
a[nn_?IntegerQ, mm_?IntegerQ] := Which[nn == 0 && mm == 0, a00, mm == 0, an0, nn == 0, a0m,
nn == mm, amm, True, anm] /. {n -> nn, m -> mm}
General Solution
Express the solution as a sum of eigenfunctions in the absence of the z
boundary conditions.
λh D[θw[x, y, z], x, x] + λc D[θw[x, y, z], y, y] + λz D[θw[x, y, z], z, z];
Simplify[(% /. θw -> Function[{x, y, z}, Cos[nh Pi x] Cos[nc Pi y] θwz[z]])/
(Cos[nh Pi x] Cos[nc Pi y])] /. π^2 (nc^2 λc + nh^2 λh) -> k[nh, nc]^2 λz
Flatten@DSolveValue[% == 0, θwz[z], z] /. {C[1] -> c1[nh, nc], C[2] -> c2[nh, nc]}
(* -λz k[nh, nc]^2 θwz[z] + λz (θwz''[z] *)
(* E^(z k[nh, nc]) c1[nh, nc] + E^(-z k[nh, nc]) c2[nh, nc] *)
as expected. Note that k[nh, nc] = Sqrt[π^2 (nc^2 λc + nh^2 λh)/λz]
has been introduced for notational simplicity. Although the result above for θwz
is correct, rearranging the terms a bit is helpful in what follows.
sz = c2[nh, nc] Sinh[k[nh, nc] z]/Cosh[k[nh, nc]] +
c1[nh, nc] Sinh[k[nh, nc] (1 - z)]/Sinh[k[nh, nc]];
because sz /. z -> 0
, needed in the z = 0
boundary condition, reduces to c1[nh, nc]
. Next, use that boundary condition to eliminate c2[nh, nc]
.
sθc[nh_?IntegerQ, nc_?IntegerQ] := Sum[a[nc, m] c1[nh, m], {m, 0, maxc}] /. b -> bc;
(D[sz, z] == rc (sz - sθc[nh, nc])) /. z -> 0;
Solve[%, c2[nh, nc]] // Flatten // Apart;
sz1 = Simplify[sz /. %] // Apart
(* (c1[nh, nc] (Cosh[z k[nh, nc]] k[nh, nc] + rc Sinh[z k[nh, nc]]))/k[nh, nc]
- (rc Sinh[z k[nh, nc]] sθc[nh, nc])/k[nh, nc] *)
Finally, use the z = 1
boundary condition to produce a matrix equation for c[nh, nc]
.
szθh[nh_?IntegerQ, nc_?IntegerQ] := Evaluate[sz1 /. z -> 1]
sθh[nh_?IntegerQ, nc_?IntegerQ] := Evaluate[Sum[a[nh, m] szθh[m, nc], {m, 0, maxh}]]
eq = Simplify[(D[sz1, z] + rh (sz1 - sθh[nh, nc])) /. z -> 1] -
rh (DiscreteDelta[nh] - a[nh, 0]) DiscreteDelta[nc]
(* -rh DiscreteDelta[nc] (-a[nh, 0] + DiscreteDelta[nh]) + (1/k[nh, nc])
(c1[nh, nc] ((rc + rh) Cosh[k[nh, nc]] k[nh, nc] + rc rh Sinh[k[nh, nc]] +
k[nh, nc]^2 Sinh[k[nh, nc]]) - rc rh Sinh[k[nh, nc]] sθc[nh, nc] -
k[nh, nc] (rc Cosh[k[nh, nc]] sθc[nh, nc] + rh sθh[nh, nc])) *)
The source term rh (DiscreteDelta[nh] - a[nh, 0]) DiscreteDelta[nc]
arises from θwh[0, y] == 1
instead of equaling zero.
Specific solution for Parameters Set to Unity.
maxh = 3; maxc = 3; λh = 1; λc = 1; λz = 1; bh = 1; bc = 1; rh = 1; rc = 1;
ks = Flatten@Table[k[nh, nc] -> Sqrt[π^2 (nc^2 λc + nh^2 λh)/λz],
{nh, 0, maxh}, {nc, 0, maxc}]
eql = N[Collect[Flatten@Table[eq /. Sinh[k[0, 0]] -> k[0, 0], {nh, 0, maxh}, {nc, 0, maxc}]
/. b -> bh, _c1, Simplify] /. ks] /. c1[z1_, z2_] :> Rationalize[c1[z1, z2]];
(* {k[0, 0] -> 0, k[0, 1] -> π, k[0, 2] -> 2 π, k[0, 3] -> 3 π, k[1, 0] -> π,
k[1, 1] -> Sqrt[2] π, k[1, 2] -> Sqrt[5] π, k[1, 3] -> Sqrt[10] π, k[2, 0] -> 2 π,
k[2, 1] -> Sqrt[5] π, k[2, 2] -> 2 Sqrt[2] π, k[2, 3] -> Sqrt[13] π,
k[3, 0] -> 3 π, k[3, 1] -> Sqrt[10] π, k[3, 2] -> Sqrt[13] π, k[3, 3] -> 3 Sqrt[2] π} *)
eql
the numericized version of eq
is too long to reproduce here. And, trying to solve eq
itself is far too slow. Next, compute the c1
and from them the solution.
Union@Cases[eql, _c1, Infinity];
coef = NSolve[Thread[eql == 0], %] // Flatten
sol = Total@Simplify[Flatten@Table[sz1 Cos[nh Pi x] Cos[nc Pi y] /.
Sinh[z k[0, 0]] -> z k[0, 0], {nh, 0, maxh}, {nc, 0, maxc}], Trig -> False] /. ks /. %;
(* {c1[0, 0] -> 0.3788, c1[0, 1] -> -0.0234913, c1[0, 2] -> -0.00123552,
c1[0, 3] -> -0.00109202, c1[1, 0] -> 0.00168554, c1[1, 1] -> -0.0000775391,
c1[1, 2] -> -5.40917*10^-6, c1[1, 3] -> -4.63996*10^-6, c1[2, 0] -> 4.19045*10^-6,
c1[2, 1] -> -1.24251*10^-7, c1[2, 2] -> -1.17696*10^-8, c1[2, 3] -> -1.02576*10^-8,
c1[3, 0] -> 1.65131*10^-7, c1[3, 1] -> -3.41814*10^-9, c1[3, 2] -> 3.86348*10^-10,
c1[3, 3] -> -3.48432*10^-10} *)
Here are several plots of the solution, beginning with a 3D contour plot.
ContourPlot3D[sol, {x, 0, 1}, {y, 0, 1}, {z, 0, 1}, Contours -> {.4, .5, .6},
ContourStyle -> Opacity[0.75], PlotLegends -> Placed[Automatic, {.9, .9}],
ImageSize -> Large, AxesLabel -> {x, y, z}, LabelStyle -> {15, Bold, Black}]
Next are slices through the solution at the ends and mid-point in z
. The second, at z = 1/2
, is similar to the seventh plot in the 2D thin slab approximation, even though the calculation here is for a cube.
Plot3D[sol /. z -> 0, {x, 0, 1}, {y, 0, 1}, ImageSize -> Large,
AxesLabel -> {x, y, "θw(z=0)"}, LabelStyle -> {15, Bold, Black}]
Plot3D[sol /. z -> 1/2, {x, 0, 1}, {y, 0, 1}, ImageSize -> Large,
AxesLabel -> {x, y, "θw(z=0)"}, LabelStyle -> {15, Bold, Black}]
Plot3D[sol /. z -> 1, {x, 0, 1}, {y, 0, 1}, ImageSize -> Large,
AxesLabel -> {x, y, "θw(z=0)"}, LabelStyle -> {15, Bold, Black}]
Finally, here are θwc
and θwh
, each computed in two distinct ways, by the expansion given above and by direct integration using the expansion of θw
. (They differ in that the latter does not employ the a
matrix.) The two methods agree very well except at the edges in y
and x
, respectively, where convergence of the cosine series is nonuniform. Increasing the number of modes reduces this modest disagreement but does not change sol
by more than 10^-4
.
Simplify[(sol - D[sol, z]/rc) /. z -> 0, Trig -> False];
DSolveValue[{θwc'[y] + bc (θwc[y] - sol /. z -> 0) == 0, θwc[0] == 0},
θwc[y], {y, 0, 1}] // Chop;
Plot3D[{%, %%}, {x, 0, 1}, {y, 0, 1}, ImageSize -> Large,
AxesLabel -> {x, y, θwc}, LabelStyle -> {15, Bold, Black}]
Simplify[(sol + D[sol, z]/rh) /. z -> 1, Trig -> False];
DSolveValue[{θwh'[x] + bh (θwh[x] - sol /. z -> 1) == 0, θwh[0] == 1},
θwh[x], {x, 0, 1}] // Chop;
Plot3D[{%, %%}, {x, 0, 1}, {y, 0, 1}, ImageSize -> Large,
AxesLabel -> {x, y, θwh}, LabelStyle -> {15, Bold, Black}]
The computation shown here required only a few minutes on my PC.
This is more of an extended comment than an answer, but it occurred to me that your solution is incomplete. You have a double $Cos$ series in $m$ and $n$, and unlike $Sin$ series you should need $m=0$ and $n=0$ terms.
You have computed your $T_{mn}$ series for $(m, n)$ going from $1$ to $\infty$ and it came out to be $0 $. You need to add a $T_{00}$ term for $(m, n)=0$ and two more series.
Add a $T_{m0}$ series for $n=0$ and $m$ going from $1$ to $\infty$ and a $T_{0n}$ series for $m=0$ and n going from $1$ to $\infty$.
It takes all four pieces to make a complete solution. I have not tried this on your problem yet, so I don't know if all the pieces will come out to be zero or not, but this will give you something else to try. Your solution would not be correct without all four pieces anyway.
At the OP's request I will include my code, even though it doesn't work very well.
Clear["Global`*"]
$Assumptions = n ∈ Integers && m ∈ Integers
pde = D[T[x, y, z], x, x] + D[T[x, y, z], y, y] + D[T[x, y, z], z, z] == 0
T[x_, y_, z_] = X[x] Y[y] Z[z]
pde = pde/T[x, y, z] // Expand
x0eq = X''[x]/X[x] == 0
DSolve[x0eq, X[x], x] // Flatten
X0 = X[x] /. % /. {C[1] -> c1, C[2] -> c2}
xeq = X''[x]/X[x] == -α1^2
DSolve[xeq, X[x], x] // Flatten
X1 = X[x] /. % /. {C[1] -> c3, C[2] -> c4}
y0eq = Y''[y]/Y[y] == 0
DSolve[y0eq, Y[y], y] // Flatten
Y0 = Y[y] /. % /. {C[1] -> c5, C[2] -> c6}
yeq = Y''[y]/Y[y] == -β1^2
DSolve[yeq, Y[y], y] // Flatten
Y1 = Y[y] /. % /. {C[1] -> c7, C[2] -> c8}
z0eq = pde /. X''[x]/X[x] -> 0 /. Y''[y]/Y[y] -> 0
DSolve[z0eq, Z[z], z] // Flatten
Z0 = Z[z] /. % /. {C[1] -> c9, C[2] -> c10}
zeq = pde /. X''[x]/X[x] -> -α1^2 /. Y''[y]/Y[y] -> -β1^2
DSolve[zeq, Z[z], z] // Flatten
Z1 = Z[z] /. % /. {C[1] -> c11, C[2] -> c12} // ExpToTrig // Collect[#, {Cosh[_], Sinh[_]}] &
Z1 = % /. {c11 - c12 -> c11, c11 + c12 -> c12}
T[x_, y_, z_] = X0 Y0 Z0 + X1 Y1 Z1
(D[T[x, y, z], x] /. x -> 0) == 0
c2 = 0;
c4 = 0;
T[x, y, z]
c1 = 1
c3 = 1
(D[T[x, y, z], x] /. x -> L) == 0
α1 = (n π)/L
(D[T[x, y, z], y] /. y -> 0) == 0
c6 = 0
c8 = 0
T[x, y, z]
c5 = 1
c7 = 1
(D[T[x, y, z], y] /. y -> l) == 0
β1 = (m π)/l
Tmn[x_, y_, z_] = T[x, y, z] /. {c9 -> 0, c10 -> 0}
T00[x_, y_, z_] = T[x, y, z] /. n -> 0 /. m -> 0
T00[x_, y_, z_] = % /. c9 -> 0 /. c12 -> c1200
Tm0[x_, y_, z_] = T[x, y, z] /. n -> 0
Tm0[x_, y_, z_] = % /. {c10 -> 0, c9 -> 0, c11 -> c11m0, c12 -> c12m0} // PowerExpand
T0n[x_, y_, z_] = T[x, y, z] /. m -> 0 // PowerExpand
T0n[x_, y_, z_] = % /. {c9 -> 0, c10 -> 0, c11 -> c110n, c12 -> c120n}
pdetcmn = D[tcmn[x, y], y] + (bc/l)*(tcmn[x, y] - Tmn[x, y, 0]) == 0
DSolve[pdetcmn, tcmn[x, y], {x, y}] // Flatten
tcmn[x_, y_] = tcmn[x, y] /. % /. C[1][x] -> 0
pdetc00 = D[tc00[x, y], y] + (bc/l)*(tc00[x, y] - T00[x, y, 0]) == 0
DSolve[{pdetc00, tc00[x, 0] == tci}, tc00[x, y], {x, y}] // Flatten // Simplify
tc00[x_, y_] = tc00[x, y] /. %
pdetcm0 = D[tcm0[x, y], y] + (bc/l)*(tcm0[x, y] - Tm0[x, y, 0]) == 0
DSolve[pdetcm0, tcm0[x, y], {x, y}] // Flatten
tcm0[x_, y_] = tcm0[x, y] /. % /. C[1][x] -> 0
pdetc0n = D[tc0n[x, y], y] + (bc/l)*(tc0n[x, y] - T0n[x, y, 0]) == 0
DSolve[pdetc0n, tc0n[x, y], {x, y}] // Flatten
tc0n[x_, y_] = tc0n[x, y] /. % /. C[1][x] -> 0
pdethmn = D[thmn[x, y], x] + (bh/L)*(thmn[x, y] - Tmn[x, y, 0]) == 0
DSolve[pdethmn, thmn[x, y], {x, y}] // Flatten
thmn[x_, y_] = thmn[x, y] /. % /. C[1][y] -> 0
pdeth00 = D[th00[x, y], x] + (bh/L)*(th00[x, y] - T00[x, y, 0]) == 0
DSolve[{pdeth00, th00[0, y] == thi}, th00[x, y], {x, y}] // Flatten
th00[x_, y_] = th00[x, y] /. %
pdethm0 = D[thm0[x, y], x] + (bh/L)*(thm0[x, y] - Tm0[x, y, 0]) == 0
DSolve[pdethm0, thm0[x, y], {x, y}] // Flatten
thm0[x_, y_] = thm0[x, y] /. % /. C[1][y] -> 0
pdeth0n = D[th0n[x, y], x] + (bh/L)*(th0n[x, y] - T0n[x, y, 0]) == 0
DSolve[pdeth0n, th0n[x, y], {x, y}] // Flatten
th0n[x_, y_] = th0n[x, y] /. % /. C[1][y] -> 0
bc100 = Simplify[(D[T00[x, y, z], z] /. z -> 0) == pc*(T00[x, y, 0] - tc00[x, y])]
orth100 = Integrate[bc100[[1]], {y, 0, l}, {x, 0, L}] == Integrate[bc100[[2]], {y, 0, l}, {x, 0, L}]
bc200 = Simplify[(D[T00[x, y, z], z] /. z -> w) == ph*(th00[x, y] - T00[x, y, w])]
orth200 = Integrate[bc200[[1]], {y, 0, l}, {x, 0, L}] == Integrate[bc200[[2]], {y, 0, l}, {x, 0, L}]
sol00 = Solve[{orth100, orth200}, {c10, c1200}] // Flatten // Simplify
c10 = c10 /. sol00
c1200 = c1200 /. sol00
T00[x, y, z]
tc00[x, y]
th00[x, y]
bc1m0 = Simplify[(D[Tm0[x, y, z], z] /. z -> 0) == pc*(Tm0[x, y, 0] - tcm0[x, y])]
orth1m0 = Integrate[bc1m0[[1]]*Cos[(m*Pi*y)/l], {y, 0, l}, {x, 0, L}] == Integrate[bc1m0[[2]]*Cos[(m*Pi*y)/l], {y, 0, l}, {x, 0, L}]
bc2m0 = Simplify[(D[Tm0[x, y, z], z] /. z -> w) == ph*(thm0[x, y] - Tm0[x, y, w])]
orth2m0 = Integrate[bc2m0[[1]]*Cos[(m*Pi*y)/l], {y, 0, l}, {x, 0, L}] == Integrate[bc2m0[[2]]*Cos[(m*Pi*y)/l], {y, 0, l}, {x, 0, L}]
solm0 = Solve[{orth1m0, orth2m0}, {c11m0, c12m0}] // Flatten // Simplify
bc10n = (D[T0n[x, y, z], z] /. z -> 0) == pc*(T0n[x, y, 0] - tc0n[x, y])
orth10n = Integrate[bc10n[[1]]*Cos[(Pi*n*x)/L], {y, 0, l}, {x, 0, L}] == Integrate[bc10n[[2]]*Cos[(Pi*n*x)/L], {y, 0, l}, {x, 0, L}]
bc20n = Simplify[(D[T0n[x, y, z], z] /. z -> w) == ph*(th0n[x, y] - T0n[x, y, w])]
orth20n = Integrate[bc20n[[1]]*Cos[(Pi*n*x)/L], {y, 0, l}, {x, 0, L}] == Integrate[bc20n[[2]]*Cos[(Pi*n*x)/L], {y, 0, l}, {x, 0, L}]
sol0n = Solve[{orth10n, orth20n}, {c110n, c120n}] // Flatten // Simplify
bc1mn = (D[Tmn[x, y, z], z] /. z -> 0) == pc*(Tmn[x, y, 0] - tcmn[x, y])
orth1mn = Integrate[bc1mn[[1]]*Cos[(m*Pi*y)/l]*Cos[(Pi*n*x)/L], {y, 0, l}, {x, 0, L}] == Integrate[bc10n[[2]]*Cos[(m*Pi*y)/l]*Cos[(Pi*n*x)/L], {y, 0, l}, {x, 0, L}]
bc2mn = Simplify[(D[Tmn[x, y, z], z] /. z -> w) == ph*(thmn[x, y] - Tmn[x, y, w])]
orth2mn = Integrate[bc2mn[[1]]*Cos[(m*Pi*y)/l]*Cos[(Pi*n*x)/L], {y, 0, l}, {x, 0, L}] == Integrate[bc2mn[[2]]*Cos[(m*Pi*y)/l]*Cos[(Pi*n*x)/L], {y, 0, l}, {x, 0, L}]
solmn = Solve[{orth1mn, orth2mn}, {c11, c12}] // Flatten // Simplify
All zeros except T00, and that solution does not satisfy the bc's. Have fun
Update for new bc's This is too numerically unstable to get to work, but this is what I did.
Clear["Global`*"]
pde = D[T[x, y, z], x, x] + D[T[x, y, z], y, y] + D[T[x, y, z], z, z] == 0
$Assumptions = n ∈ Integers && m ∈ Integers && l > 0 && w > 0 && L > 0
Case 1
x = 0, T = thi
x = L, dT/dx = 0
y = 0, T = 0
y = l, dT/dy = 0 Use exponential in x, sinusoidal in y and z. Start with
T[x_, y_, z_] = (c1 + c2 x) (c10 z + c9) (c5 + c6 y) + (c3 Cosh[Sqrt[α1^2 + β1^2] x] +
c4 Sinh[Sqrt[α1^2 + β1^2] x]) (c7 Cos[α1 y] + c8 Sin[α1 y]) (c11 Sin[β1 z] + c12 Cos[β1 z])
T[0, y, z] == thi
(D[T[x, y, z], x] /. x -> L) == 0
c2 = 0
Solve[(c3 Sqrt[α1^2 + β1^2]Sinh[L Sqrt[α1^2 + β1^2]] +
c4 Sqrt[α1^2 + β1^2] Cosh[L Sqrt[α1^2 + β1^2]]) == 0, c4] // Flatten
c4 = c4 /. %
c3 = 1
c1 = 1
Manually expand the Tanh and incorporate the (constant) common denominator with the other constants
Simplify[Cosh[L*Sqrt[α1^2 + β1^2]]*Cosh[x*Sqrt[α1^2 + β1^2]] - Sinh[L*Sqrt[α1^2 + β1^2]]*Sinh[x*Sqrt[α1^2 + β1^2]]]
T[x_, y_, z_] = T[x, y, z] /. (Cosh[x Sqrt[α1^2 + β1^2]] -
Tanh[L Sqrt[α1^2 + β1^2]] Sinh[ x Sqrt[α1^2 + β1^2]]) -> %
T[x, 0, z] == 0
c5 = 0
c7 = 0
c6 = 1
c8 = 1
Simplify[D[T[x, y, z], y] /. y -> l] == 0
c10 = 0
c9 = 0
α1 = ((2 n + 1) π)/(2 l)
Set
β1 = ((2 m + 1) π)/(2 w)
T1[x_, y_, z_] = T[x, y, z]
Case 2
x = 0, T = 0
x = L, dT/dx = 0
y = 0, T = tci
y = l, dT/dy = 0
Use exponential in x, sinusoidal in y and z and flip the y and z terms
T2[x_, y_, z_] =
Sin[(π (2 n + 1) x)/(2 L)] (c112 Sin[(π (2 m + 1) z)/(2 w)] +
c122 Cos[(π (2 m + 1) z)/(2 w)]) Cosh[(l - y) Sqrt[(π^2 (2 n + 1)^2)/(4 L^2) + (π^2 (2 m + 1)^2)/(4 w^2)]]
T[x_, y_, z_] = T1[x, y, z] + T2[x, y, z]
pdeth = D[th[x, y], x] + (bh/L)*(th[x, y] - T[x, y, w]) == 0
DSolve[{pdeth, th[0, y] == thi}, th[x, y], {x, y}] //
Flatten // Simplify
th[x_, y_] = th[x, y] /. % // Simplify
pdetc = Simplify[D[tc[x, y], y] + (bc/l)*(tc[x, y] - T[x, y, 0]) == 0]
DSolve[{pdetc, tc[x, 0] == tci}, tc[x, y], {x, y}] //
Flatten // Simplify
tc[x_, y_] = tc[x, y] /. %
bc1 = T[0, y, z] == thi
bc2 = T[x, 0, z] == tci
bc3 = Simplify[(D[T[x, y, z], z] /. z -> 0) == pc*(T[x, y, 0] - tc[x, y])]
bc4 = Simplify[(D[T[x, y, z], z] /. z -> w) == ph*(th[x, y] - T[x, y, w])]
bc1eq = Simplify[Integrate[(bc1[[1]] - bc1[[2]])*Sin[(Pi*(2*n + 1)*y)/(2*l)]*Sin[(Pi*(2*m + 1)*z)/(2*w)], {z, 0, w}, {y, 0, l}] == 0]
bc2eq = Simplify[Integrate[(bc2[[1]] - bc2[[2]])*Sin[(Pi*(2*n + 1)*x)/(2*L)]*Sin[(Pi*(2*m + 1)*z)/(2*w)], {z, 0, w}, {x, 0, L}] == 0]
bc3eq = Integrate[bc3[[1]]*Sin[(Pi*(2*n + 1)*y)/(2*l)]*Sin[(Pi*(2*n + 1)*x)/(2*L)], {y, 0, l}, {x, 0, L}] == 0
bc4eq = Integrate[bc4[[1]]*Sin[(Pi*(2*n + 1)*y)/(2*l)]*Sin[(Pi*(2*n + 1)*x)/(2*L)], {y, 0, l}, {x, 0, L}] == 0
Solve[bc1eq, c12] // Flatten // Simplify
c12 = c12 /. %
Solve[bc2eq, c122] // Flatten // Simplify
c122 = c122 /. %
Solve[bc4eq, c112] // Flatten;
c112 = c112 /. %
Solve[bc3eq, c11] // Flatten;
c11 = c11 /. %
values = {L -> 1/40, l -> 1/40, w -> 3/1000, bh -> 433/1000,
bc -> 433/1000, ph -> 6524/100, pc -> 6524/100, thi -> 120, tci -> 30};
C11 = Table[c11 /. values, {m, 0, 10}, {n, 0, 10}] // N[#, 50] &
C11 = Re[C11]
To get rid of the small imaginary component. Chop
wipes out the real part also.
C12 = Table[c12 /. values, {m, 0, 11}, {n, 0, 11}] // N[#, 50] &
C12 = Re[C12]
C112 = Table[c112 /. values, {m, 0, 11}, {n, 0, 11}] // N[#, 50] &
C112 = Re[C112]
C122 = Table[c122 /. values, {m, 0, 11}, {n, 0, 11}] // N[#, 50] &
C122 = Re[C122]
Put it all together
T[x_, y_, z_] := Sum[Sin[(Pi*(2*n + 1)*y)/(2*l)]*(C11[[m + 1,n + 1]]*Sin[(Pi*(2*m + 1)*z)/(2*w)] + C12[[m + 1,n + 1]]*Cos[(Pi*(2*m + 1)*z)/(2*w)])*
Cosh[(L - x)*Sqrt[(Pi^2*(2*n + 1)^2)/(4*l^2) + (Pi^2*(2*m + 1)^2)/(4*w^2)]] + Sin[(Pi*(2*n + 1)*x)/(2*L)]*
Cosh[(l - y)*Sqrt[(Pi^2*(2*n + 1)^2)/(4*L^2) + (Pi^2*(2*m + 1)^2)/(4*w^2)]]*(C112[[m + 1,n + 1]]*Sin[(Pi*(2*m + 1)*z)/(2*w)] +
C122[[m + 1,n + 1]]*Cos[(Pi*(2*m + 1)*z)/(2*w)]), {m, 0, 10}, {n, 0, 10}]
It took my computer days to compute all this and the values are way off. m,n of 10,10 are not enough terms, but I am not going any further. The values are still changing dramatically from m,n 9,10 to 10,10. Maybe the solution is wrong, or 50 decimals places is not enough, or it will take many more terms and many more days to even test the solution properly. Maybe your computer can do it faster, but my computer is 4 Ghz Intel i7 processor with 32 GB ram, so it is not a slow computer. Good luck.