2
$\begingroup$

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 : enter image description here

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]

enter image description here

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

$\endgroup$

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Browse other questions tagged or ask your own question.