StreamPlot3d for the magnetic field of a loop

Question

I am trying to go beyond StreamPlot in the case of a current loop that produces a magnetic field. My code works for StreamPlot, but does not end when I use the same field expressions with StreamPlot3D. Code is as follows:

Clear["Global`*"]
$Assumptions={_Symbol \[Element]Reals};
radius=1;
element[theta_]:={radius Cos[theta],radius Sin[theta],0};
fieldPoint={x,y,z};
fpToElement=fieldPoint-element[theta];
modR2=fpToElement.fpToElement;
modR=Sqrt[modR2] //ExpandAll //FullSimplify;
unitVector=fpToElement/modR // FullSimplify;
tangent=D[element[theta],theta];

{dBx[x_,y_,z_,theta_],dBy[x_,y_,z_,theta_],dBz[x_,y_,z_,theta_]}=tangent\[Cross]unitVector/modR2//FullSimplify;

{Bx[x_,y_,z_],By[x_,y_,z_],Bz[x_,y_,z_]}:={
NIntegrate[dBx[x,y,z,theta],{theta,0,2\[Pi]}],
NIntegrate[dBy[x,y,z,theta],{theta,0,2\[Pi]}],
NIntegrate[dBz[x,y,z,theta],{theta,0,2\[Pi]}]
};

Print["\nSTREAMPLOT"]
(* This works in a few seconds*)
StreamPlot[{Bx[x,0,z],Bz[x,0,z]},{x,-1,1},{z,-1,1},ImageSize->Large, StreamPoints->Coarse]//AbsoluteTiming
(* This does not end *)
(*
StreamPlot3D[{Bx[x,y,z],By[x,y,z],Bz[x,y,z]},{x,-1,1},{y,-1,1},{z,-1,1},StreamPoints->Coarse]
*)

The results of StreamPlot are as expected:

However, if I comment out the StreamPlot[] code and uncomment the StreamPlot3D[] part (at the bottom), I get no results for hours beyond three indications that the third field component

has evaluated to non-numerical values for all sampling points in the region with boundaries...

Any help will be much appreciated.

Answer 1

If you prevent the definition of Bx, By, Bz to be evaluated for symbolic argument and and introduce "Thread" in their definition you can get a reasonable time for evaluation. Further note, that the plot is symmetrical in x,y,z around the origin. Therefore it is good enough to restrict the plot region to: {x,y,z} element {0,1}. With this:

Thread[{Bx[x_, y_, z_] /; NumericQ[x], By[x_, y_, z_] /; NumericQ[x], 
    Bz[x_, y_, z_] /; NumericQ[x]} := {NIntegrate[
     dBx[x, y, z, theta], {theta, 0, 2 \[Pi]}], 
    NIntegrate[dBy[x, y, z, theta], {theta, 0, 2 \[Pi]}], 
    NIntegrate[dBz[x, y, z, theta], {theta, 0, 2 \[Pi]}]}];

StreamPlot3D[{Bx[x, y, z], By[x, y, z], Bz[x, y, z]}, {x, 0, 1}, {y, 
   0, 1}, {z, 0, 1}, StreamPoints -> Coarse]

I get 3 minutes for evaluation.