Mathematica Asked on December 17, 2020
I want to derive a surface I interpolated which lies in 3D. However my use of Derivative does not seem to work and I don’t understand why.
What I want is to calculate and plot the derivative of this surface :
I tried to use :
DINHA = Flatten[
ParallelTable[{x, y,
Derivative[1, 0][INHA][x, y] + Derivative[0, 1][INHA][x, y]}, {x,
1, 201, 10}, {y, 1, 101, 10}], 1];
But it is taking a lot of memory and when I tried to reduce the number of points it gives me a pixelated result.
ListPlot3D[DINHA]
What do I do wrong ? Can’t I derive an interpolated surface which equal to a new interpolation which I can plot ?
You want to Plot the same surface: (Don’t be afraid by the length it is not complicated. There is a big matrix to define then I find the zeros of the determinant then I plot one of the two surface of zeros and this is this surface that I want to derive)
Mraw[ϵ_, δg_, δd_, U_, L_,
k_, κ0_] = ({{u[ϵ, δg]*
Exp[I*L/2*(k + κ[ϵ, κ0])],
v[ϵ, -δg]*
Exp[-I*L/2*(k - κ[ϵ, κ0])], -u[ϵ,
0]*Exp[-I*
L/2*(k + κ[ϵ, κ0])], -u[ϵ, 0]*
Exp[I*L/2*(k + κ[ϵ, κ0])], -v[ϵ,
0]*Exp[-I*
L/2*(k - κ[ϵ, κ0])], -v[ϵ, 0]*
Exp[I*L/2*(k - κ[ϵ, κ0])], 0,
0}, {v[ϵ, δg]*
Exp[I*L/2*(k + κ[ϵ, κ0])],
u[ϵ, -δg]*
Exp[-I*L/2*(k - κ[ϵ, κ0])], -v[ϵ,
0]*Exp[-I*
L/2*(k + κ[ϵ, κ0])], -v[ϵ, 0]*
Exp[I*L/2*(k + κ[ϵ, κ0])], -u[ϵ,
0]*Exp[-I*
L/2*(k - κ[ϵ, κ0])], -u[ϵ, 0]*
Exp[I*L/2*(k - κ[ϵ, κ0])], 0, 0}, {0,
0, -u[ϵ, 0]*
Exp[I*L/2*(k + κ[ϵ, κ0])], -u[ϵ,
0]*Exp[-I*
L/2*(k + κ[ϵ, κ0])], -v[ϵ, 0]*
Exp[I*L/2*(k - κ[ϵ, κ0])], -v[ϵ,
0]*Exp[-I*L/2*(k - κ[ϵ, κ0])],
u[ϵ, δd]*
Exp[I*L/2*(k + κ[ϵ, κ0])],
v[ϵ, -δd]*
Exp[-I*L/2*(k - κ[ϵ, κ0])]}, {0,
0, -v[ϵ, 0]*
Exp[I*L/2*(k + κ[ϵ, κ0])], -v[ϵ,
0]*Exp[-I*
L/2*(k + κ[ϵ, κ0])], -u[ϵ, 0]*
Exp[I*L/2*(k - κ[ϵ, κ0])], -u[ϵ,
0]*Exp[-I*L/2*(k - κ[ϵ, κ0])],
v[ϵ,
1. δd]*
Exp[I*L/2*(k + κ[ϵ, κ0])],
u[ϵ, -δd]*
Exp[-I*L/2*(k - κ[ϵ, κ0])]}, {(1 + I*U)*
u[ϵ, δg]*
Exp[I*L/2*(k + κ[ϵ, κ0])], (-1 + I*U)*
v[ϵ, -δg]*
Exp[-I*L/2*(k - κ[ϵ, κ0])], (1 + I*U)*
u[ϵ, 0]*
Exp[-I*L/2*(k + κ[ϵ, κ0])], (-1 + I*U)*
u[ϵ, 0]*
Exp[I*L/2*(k + κ[ϵ, κ0])], (1 + I*U)*
v[ϵ, 0]*
Exp[-I*L/2*(k - κ[ϵ, κ0])], (-1 + I*U)*
v[ϵ, 0]*
Exp[I*L/2*(k - κ[ϵ, κ0])], 0,
0}, {(1 + I*U)*v[ϵ, δg]*
Exp[I*L/2*(k + κ[ϵ, κ0])], (-1 + I*U)*
u[ϵ, -δg]*
Exp[-I*L/2*(k - κ[ϵ, κ0])], (1 + I*U)*
v[ϵ, 0]*
Exp[-I*L/2*(k + κ[ϵ, κ0])], (-1 + I*U)*
v[ϵ, 0]*
Exp[I*L/2*(k + κ[ϵ, κ0])], (1 + I*U)*
u[ϵ, 0]*
Exp[-I*L/2*(k - κ[ϵ, κ0])], (-1 + I*U)*
u[ϵ, 0]*
Exp[I*L/2*(k - κ[ϵ, κ0])], 0, 0}, {0,
0, (-1 + I*U)*u[ϵ, 0]*
Exp[I*L/2*(k + κ[ϵ, κ0])], (1 + I*U)*
u[ϵ, 0]*
Exp[-I*L/2*(k + κ[ϵ, κ0])], (-1 + I*U)*
v[ϵ, 0]*
Exp[I*L/2*(k - κ[ϵ, κ0])], (1 + I*U)*
v[ϵ, 0]*
Exp[-I*L/2*(k - κ[ϵ, κ0])], (1 + I*U)*
u[ϵ, δd]*
Exp[I*L/2*(k + κ[ϵ, κ0])], (-1 + I*U)*
v[ϵ, -δd]*
Exp[-I*L/2*(k - κ[ϵ, κ0])]}, {0,
0, (-1 + I*U)*v[ϵ, 0]*
Exp[I*L/2*(k + κ[ϵ, κ0])], (1 + I*U)*
v[ϵ, 0]*
Exp[-I*L/2*(k + κ[ϵ, κ0])], (-1 + I*U)*
u[ϵ, 0]*
Exp[I*L/2*(k - κ[ϵ, κ0])], (1 + I*U)*
u[ϵ, 0]*
Exp[-I*L/2*(k - κ[ϵ, κ0])], (1 + I*U)*
v[ϵ, δd]*
Exp[I*L/2*(k + κ[ϵ, κ0])], (-1 + I*U)*
u[ϵ, -δd]*
Exp[-I*L/2*(k - κ[ϵ, κ0])]}}); u[ϵ_, δ_] = (E^(I δ/2) Sqrt[
1 + Sqrt[1 - 1/ϵ^2]])/Sqrt[2]; v[ϵ_, δ_] = (E^(-I δ/2) Sqrt[
1 - Sqrt[1 - 1/ϵ^2]])/Sqrt[2]; κ[ϵ_, κ0_] = κ0*Sqrt[ϵ^2 - 1]; δd0 =.;
δg0 =.; U0 = 0.25; L0 = 0.5; Lmax = 10; k0 = (2 π/10^-4 +
π/2*0)/L0; κ00 = 1/1; δdstep = 0.01; δgstep
= 0.005; δstep = 0.01; ϵ0 =.; x0 = -L0/2; ϵstep = 0.01;
MyMrawDet[ϵ_, δg_, δd_, U_, L_, k_,
κ0_] := Det[Mraw[ϵ, δg, δd, U, L,
k, κ0]]; tempdet = ParallelTable[
MyMrawDet[ϵ0, δg0, δd0, U0, L0,
k0/L0, κ00], {ϵ0, 0 + ϵstep,
1 - ϵstep, ϵstep}, {δg0, 0, 2 π,
2 π*δgstep}, {δd0, 0, 2 π,
2 π*δdstep}];
AP = ParallelTable[ Sign[Re[tempdet]][[p + 1]] -
Sign[Re[tempdet]][[p]], {p, 1, First[Dimensions[tempdet]] - 1,
1}]; HighAP = DeleteDuplicates[ Position[Re[
AP], -2], #1[[2]] == #2[[2]] && #1[[3]] == #2[[3]] && #1[[1]] <
#2[[1]] &]; NHA = ParallelTable[ RotateLeft[HighAP[[x]]], {x, 1, First[Dimensions[HighAP]], 1}]; INHA = Interpolation[NHA]; Plot3D[
INHA[x, y], {x, 1, 201}, {y, 1, 101}]
Thank you for your help
Get help from others!
Recent Answers
Recent Questions
© 2024 TransWikia.com. All rights reserved. Sites we Love: PCI Database, UKBizDB, Menu Kuliner, Sharing RPP