Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

I want to obtain the complex roots of some equations that are similar,but each of them has a different condition. this difference is the value of α in these equations. When I try to obtain the complex roots, just the real part is close to correct value, but the imaginary part is identical for all of the equations, and an error message was returned every time. What is the reason for this?

The coding has many special characters and fancy formatting, making it hard to post my code here, so I have posted images. The images show the main equation with α = .1 and the results for α = .1 α = .2 and α = .3, respectively, and the error message I got.

Here are the images:

enter image description here enter image description here enter image description here

And here is the code:

 Subscript[j, ν, 1][s_] = s*(SphericalBesselJ[0, s]) - 1*(SphericalBesselJ[1, s])
 Subscript[j, 1][s_] = SphericalBesselJ[1, s]
 Subscript[n, ν, 1][s_] = s*(SphericalBesselY[0, s]) - 1*(BesselY[1, s])
 Subscript[n, 1][s_] = SphericalBesselY[1, s]
 Subscript[h, 1][s_] = SphericalBesselJ[1, s] + I*(SphericalBesselY[1, s])
 Subscript[h, ν, 1][s_] = 
   s*(SphericalBesselJ[0, s] + I*(SphericalBesselY[0, s])) - 
   1*(SphericalBesselJ[1, s] + I*(SphericalBesselY[1, s]))
 α = .1
 β = .95
 Subscript[u, B][w_] = 
   .10114688*Sqrt[5.59` + 0.031098192`/((3.30216`- 0.000049206` I) - w)]
 Subscript[u, C][w_] = .10114688* w Sqrt[3.7` - 81/((0. + 0.01728` I) w + w^2)]
 Subscript[u, A][w_] = .10114688*Sqrt[1.777]*w
 Subscript[u, D][w_] = .10114688*w

 FindRoot[Det[{
   {Subscript[j, 1][α Subscript[u, D][w]], -Subscript[j, 1][α Subscript[u, C][w]], 
    -Subscript[n, 1][α Subscript[u, C][w]], 0, 0, 0}, 
   {((Subscript[u, C][w])^2)*Subscript[j, ν, 1][α Subscript[u, D][w]], 
    -((Subscript[u, D][w])^2)*Subscript[j, ν, 1][α Subscript[u, C][w]], 
    -((Subscript[u, D][w])^2)*Subscript[n, ν, 1][α Subscript[u, C][w]], 
    0, 0, 0}, 
   {0, Subscript[j, 1][β Subscript[u, C][w]], Subscript[n, 1][β Subscript[u, C][w]], 
    -Subscript[j, 1][β Subscript[u, B][w]], -Subscript[n, 1][β Subscript[u, B][w]], 0}, 
   {0, ((Subscript[u, B][w])^2)*Subscript[j, ν, 1][β Subscript[u, C][w]], 
    ((Subscript[u, B][w])^2)*Subscript[n, ν, 1][β Subscript[u, C][w]], 
    -((Subscript[u, C][w])^2)*Subscript[j, ν, 1][β Subscript[u, B][w]], 
    -((Subscript[u, C][w])^2)*Subscript[n, ν, 1][β Subscript[u, B][w]], 0}, 
   {0, 0, 0, Subscript[j, 1][Subscript[u, B][w]], 
    Subscript[n, 1][Subscript[u, B][w]], -Subscript[h, 1][Subscript[u, A][w]]}, 
   {0, 0, 0, ((Subscript[u, A][w])^2)*Subscript[j, ν, 1][Subscript[u, B][w]], 
    ((Subscript[u, A][w])^2)*Subscript[n, ν, 1][Subscript[u, B][w]], 
    -((Subscript[u, B][w])^2)*Subscript[h, ν, 1][Subscript[u, A][w]]}
  }] == 0, {w, 4.6}]
share|improve this question
    
Try to examine a method exploiting RootIntervals, e.g. see this answer First positive root, it works also for complex variables. This answer might be helpful as well. –  Artes Jun 20 at 15:38
    
@morteza - even after your revision I can't read anything –  eldo Jun 20 at 16:11
    
I am tring to embed the codes but how can I embed the codes with their basic form in mathematica? –  morteza Jun 20 at 16:24
    
@eldo-I do not this diagram, if you apply roots = FindRoot[det, {w, #}] & /@ Range[-5.1, 5.1, 1]; the error message is staied. –  morteza Jun 27 at 15:33
    
When I try to find the root of the equation the answer is the one that is accompany with an error .I'm sure this is not the right answer because I know that the real part of the root is about 4.4 and in this answer is about 4.6. I am looking for a way to give the correct answer to the equation and then use it for my next works diagrams,... . If the starting point is lower than 4.1, we give the right answer and no error message but in this new start point the solution is relevant to other problem that I do not want. –  morteza Jun 27 at 15:34
add comment

1 Answer 1

This is how far I came with your problem:

det = Det[{ ... }] == 0;

roots = FindRoot[det, {w, #}] & /@ Range[-5.1, 5.1, 1];

points = Point /@ 
  Union@Round[Flatten[roots /. Rule[_, Complex[a_, _]] :> {a, 0}, 1],0.0001]

{Point[{-4.679, 0.}], Point[{-3.0736, 0.}], Point[{3.0729, 0.}], Point[{4.6788, 0.}]}

fun = First@det;

Plot[{Re@fun, Im@fun}, {w, -5, 5}, PlotStyle -> {Red, Blue}, 
 ImageSize -> 600, Epilog -> {Green, PointSize@0.02, points}]

enter image description here

share|improve this answer
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.