Wolfram Cloud Document

In[]:=

$Version

Out[]=

14.1.0 for Microsoft Windows (64-bit) (July 16, 2024)

In[]:=

ClearAll["`*"];Remove["`*"];

Remove

:There are no symbols matching "`*.

In[]:=

235

1000

;q=1;Ki=910980;θe=90Degree;(*θeisavariablethattakesdifferentvalues*)(*Step2:Defineθ1andKf*)θ1=ArcCos[(Ki-kCos[θe])/Kf];Kf=Sqrt[Ki^2+k^2+k*Ki*Cos[θe]];(*Step3:DefinevectorsKf,Ki,andq*)KfVec={KfSin[θ1],0,KfCos[θ1]};KiVec={0,0,Ki};qVec=KiVec-KfVec;(*Vectorq*)kVec={kSin[θe],0,kCos[θe]};(*Step4:Calculatedotproducts*)KfDotKi=Dot[KfVec,KiVec];KfDotq=Dot[KfVec,qVec];qDotKi=Dot[qVec,KiVec];kDotq=Dot[qVec,kVec];θ2=ArcCos[kDotq/k*q];qprime=k^2+q^2-2*k*q*Cos[θ2];q2=Dot[KfVec,(kVec-qVec)];(*Step5:DefineA,B,C,D*)A=(q^2+λ^2)(k^2+β^2/4)x^2+(β(q^2+λ^2)+2λ(k^2+β^2/4))x+(qprime+(λ+β/2)^2);B=-2(IλKf-KfDotq)(k^2+β^2/4)x^2-2((β(IλKf-KfDotq)+I(k^2+β^2/4)Kf))x-2(q2+I(λ+β/2)Kf);cExpr=-2(k^2+Iβ/2k)(q^2+λ^2)x^2-2((2λ(k^2+Iβ/2k)+I(q^2+λ^2)k))x-2(k^2+I(λ+β/2)k-kDotq);dExpr=4Iλ(KfDotq)(k^2+Iβ/2k)x^2+4(I(k+β/2)kKf+IλKfDotq)x+(2*Dot[KfVec,kVec]-kKf);simplifiedA=Simplify[A];simplifiedB=Simplify[B];simplifiedcExpr=Simplify[cExpr];simplifieddExpr=Simplify[dExpr];(*Definetheintegrand*)mT=7*1873;(*amu*)mp=16*1873;(*amu*)μpT=(mT*mp)/(mT+mp);zp=6;zT=Rationalize[2.8683,0];αpT=μpT*zp*zT/Kf;αT1=Rationalize[1*2.8683/0.235,0];simplifiedA=Simplify[A];simplifiedB=Simplify[B];simplifiedcExpr=Simplify[cExpr];simplifieddExpr=Simplify[dExpr];integrand[β_,λ_,x_]=Simplify[(1/A)*((A/(A+B))^(-IαpT))*((A/(A+cExpr))^(-IαT1))*Hypergeometric2F1[-IαpT,-IαT1,1,(BcExpr-AdExpr)/((A+B)(A+cExpr))]];

(*Method1:-------------------------------------------------------------------------------------------------------------------------------------------------------------------*)

In[]:=

Needs["NumericalCalculus`"]

In[]:=

Func[β_?NumericQ,λ_?NumericQ]:=NIntegrate[integrand[β,λ,x],{x,0,Infinity},MaxRecursion->20,WorkingPrecision->20];

In[]:=

G[β_?NumericQ,λ_?NumericQ]:=ND[ND[Func[Beeta,Lambda],Beeta,β,Terms->1,Scale->10^-8,WorkingPrecision->Infinity],Lambda,λ,Terms->1,Scale->10^-8,WorkingPrecision->Infinity]

G[10,10^-19](*For:β=10andλ->0*)

Out[]=

-0.0053-0.0426

In[]:=

ReImPlot[G[β,10^-19],{β,2,10}]//Quiet(*Slow!*)

Out[]=

$Aborted

In[]:=

ListLinePlot[{Table[{β,Re[G[β,10^-19]]},{β,2,10,1/3}],Table[{β,Im[G[β,10^-19]]},{β,2,10,1/3}]},PlotStyle->{Blue,{Blue,Dashed}},PlotLegends{"Re","Im"}]

Out[]=

	Re
	Im

For more information about ND see here

In[]:=

FuncX[β_?NumericQ,λ_?NumericQ]:=NIntegrate[integrand[β,λ,x],{x,0,Infinity},MaxRecursion->20,WorkingPrecision->30];

In[]:=

G1[β_?NumericQ,λ_?NumericQ]:=ND[ND[FuncX[Beeta,Lambda],Beeta,β,Terms->1,Scale->10^-10,WorkingPrecision->Infinity],Lambda,λ,Terms->1,Scale->10^-10,WorkingPrecision->Infinity]

In[]:=

G1[10,10^-19](*For:β=10andλ->0*)

Out[]=

-0.0054379258-0.0424746990

(*Method2:-------------------------------------------------------------------------------------------------------------------------------------------------------------------*)

In[]:=

INT[β_,λ_,x_]=Evaluate[D[integrand[β,λ,x],β,λ]];

In[]:=

Func2[β_?NumericQ,λ_?NumericQ]:=NIntegrate[INT[β,λ,x],{x,0,Infinity},MaxRecursion->20];

In[]:=

Func2[10,10^-19](*For:β=10andλ->0*)

Out[]=

-0.00543943-0.0424736

In[]:=

ReImPlot[Func2[β,10^-19],{β,2,10}]//Quiet(*Slow!*)

Out[]=

$Aborted

In[]:=

ListLinePlot[{Table[{β,Re[Func2[β,10^-19]]},{β,2,10,1/3}],Table[{β,Im[Func2[β,10^-19]]},{β,2,10,1/3}]},PlotStyle->{Blue,{Blue,Dashed}},PlotLegends{"Re","Im"}]

Out[]=

	Re
	Im