Getting only real solutions

Question

I want to get real solutions $a$ and $b$ to the equation

    (2.40008*10^19 - 4.49878*10^19 I) E^(-2 I a - 
   2 b) ((0. + 0. I) - (4.5635*10^-23 + 8.15149*10^-23 I) E^(
     4 I a) - (1.12075*10^-23 + 1.24058*10^-22 I) E^(
     4 b) - (1.74844*10^-22 - 6.15711*10^-22 I) E^(
     3 I a + b) + (8.94669*10^-22 - 7.38525*10^-22 I) E^(
     2 I a + 2 b) - (3.46096*10^-22 - 6.52983*10^-22 I) E^(
     I a + 3 b)) == 0

I try to do it in this way

NSolve[(2.4000786897488364`*^19 - 
     4.498778537609138`*^19 I) E^(-2 I a - 
    2 b) ((0.` + 
       0.` I) - (4.563496732920858`*^-23 + 
        8.151489821720291`*^-23 I) E^(
      4 I a) - (1.120754493395002`*^-23 + 
        1.240575949143422`*^-22 I) E^(
      4 b) - (1.7484395154776395`*^-22 - 
        6.157113597162467`*^-22 I) E^(
      3 I a + b) + (8.9466944569964`*^-22 - 
        7.385245125236398`*^-22 I) E^(
      2 I a + 2 b) - (3.4609629128991235`*^-22 - 
        6.529826731694082`*^-22 I) E^(I a + 3 b)) == 0, {a, b}, Reals]

but it returns a warning that all coefficients in the equation must be real. Then I try

NSolve[(2.4000786897488364`*^19 - 
     4.498778537609138`*^19 I) E^(-2 I a - 
    2 b) ((0.` + 
       0.` I) - (4.563496732920858`*^-23 + 
        8.151489821720291`*^-23 I) E^(
      4 I a) - (1.120754493395002`*^-23 + 
        1.240575949143422`*^-22 I) E^(
      4 b) - (1.7484395154776395`*^-22 - 
        6.157113597162467`*^-22 I) E^(
      3 I a + b) + (8.9466944569964`*^-22 - 
        7.385245125236398`*^-22 I) E^(
      2 I a + 2 b) - (3.4609629128991235`*^-22 - 
        6.529826731694082`*^-22 I) E^(I a + 3 b)) == 0 && Im[a] == 0 && Im[b] == 0, {a, b}]

The output is It seems that it is still adding complex numbers to the solution. What can I do now to get purely real solutions?

If we plot the two regions where the real and imaginary parts of the LHS are greater than $0$. We have the following graph, which shows that we have discrete solutions (where the boundaries intersect), so there is a solution near $a=0.9, b=-1.2$, as well as its antipode.

Answer 1

This problem highlights that in version 13.0, ContourPlot shows multiple inputs in separate plot panels.

$Version

(* "13.0.0 for Mac OS X x86 (64-bit) (December 3, 2021)" *)

Clear["Global`*"]

expr = (2.40008*10^19 - 
      4.49878*10^19 I) E^(-2 I a - 
       2 b) ((0. + 
        0. I) - (4.5635*10^-23 + 
         8.15149*10^-23 I) E^(4 I a) - (1.12075*10^-23 + 
         1.24058*10^-22 I) E^(4 b) - (1.74844*10^-22 - 
         6.15711*10^-22 I) E^(3 I a + b) + (8.94669*10^-22 - 
         7.38525*10^-22 I) E^(2 I a + 2 b) - (3.46096*10^-22 - 
         6.52983*10^-22 I) E^(I a + 3 b)) /. c_Complex :> Rationalize[c, 0];

There are 32 periodic solutions

sol = Solve[
    Thread[(ReIm[expr] // ComplexExpand) == 0], {a, b}] /.
   {C[1] -> 0, 
    C[2] -> 0};

Length@sol

(* 32 *)

Selecting the real solutions

solR = Select[sol, Element[{a, b} /. #, Reals] &];

Length@solR

(* 4 *)

The approximate numeric values are

solRn = solR // N[#, 50] & // N

(* {{a -> -0.653269, b -> 1.05672}, {a -> -0.69882, b -> 1.10651}, 
    {a -> 0.88435, b -> -1.22117}, {a -> 0.888007, b -> -1.22976}} *)

In version 13.0, the default is now to show multiple inputs in separate panels

ContourPlot[Evaluate@ComplexExpand@ReIm@expr,
 {a, -1, 1.25}, {b, -1.75, 1.5},
 Contours -> {{0}},
 ContourShading -> None,
 PlotPoints -> 100,
 MaxRecursion -> 5,
 ImageSize -> Medium]

The option PlotLayout -> "Overlaid" must be added to show both contours in a single panel.

ContourPlot[Evaluate@ComplexExpand@ReIm@expr,
 {a, -1, 1.25}, {b, -1.75, 1.5},
 Contours -> {{0}},
 ContourShading -> None,
 PlotLayout -> "Overlaid",
 PlotPoints -> 100,
 MaxRecursion -> 5,
 ImageSize -> Medium,
 PlotLegends -> {Re == 0, Im == 0},
 Epilog -> {Red, AbsolutePointSize[4], Point[{a, b} /. solRn]}]

Zooming in on the lower right-hand corner to more clearly show the two roots there:

ContourPlot[Evaluate@ComplexExpand@ReIm@expr,
 {a, 0.7, 1.1}, {b, -1.3, -1.1},
 Contours -> {{0}},
 ContourShading -> None,
 PlotLayout -> "Overlaid",
 PlotPoints -> 100,
 MaxRecursion -> 5,
 ImageSize -> Medium,
 PlotLegends -> {Re == 0, Im == 0},
 Epilog -> {Red, AbsolutePointSize[4], Point[{a, b} /. solRn]}]

Answer 2

In Mathematica 13.0

NSolve[(2.40008*10^19 - 
  4.49878*10^19 I) E^(-2 I a - 
   2 b) ((0. + 
    0. I) - (4.5635*10^-23 + 
     8.15149*10^-23 I) E^(4 I a) - (1.12075*10^-23 + 
     1.24058*10^-22 I) E^(4 b) - (1.74844*10^-22 - 
     6.15711*10^-22 I) E^(3 I a + b) + (8.94669*10^-22 - 
     7.38525*10^-22 I) E^(2 I a + 2 b) - (3.46096*10^-22 - 
     6.52983*10^-22 I) E^(I a + 3 b)) == 0 && Element[a, Reals] &&
     Element[b, Reals], {a, b}]

Yields four solutions in terms of an integer constant C[1]. Setting that to zero:

% /. C[1] -> 0

yields four real solutions:

{{a -> -0.69882, b -> 1.10651 + 0. I}, 
{a -> -0.653269, b -> 1.05672 + 0. I}, 
{a -> 0.88435, b -> -1.22117 + 0. I}, 
{a -> 0.888007, b -> -1.22976 + 0. I}}

You may, of course, Chop off the 0. I parts.

And, if you Simplify the result of NSolve, you get more clearly real solutions in terms of C[1], as many as you want.