Cálculo do "b" quando a pressão é imposta

Clear["Global`*"];
α=1;β=3;λ=1;η=1;ε=5/100;Wi=Sqrt[20];a=1/2;RR=1/(1-a);Pz=1;(*Print["ε*(Wi^2)=   ",ε*(Wi^2)];Print["((ε*(Wi^2)*(Pz^2))/2)=   ",((ε*(Wi^2)*(Pz^2))/2)]*)

(*shr[r_]:=((-Gamma[β]*Pz*b*R)/(2*η))*((b*R)/r-r/(b*R))*MittagLefflerE[α,β,((2*ε*(λ^2))/(η^2))*(((((Pz*b*R)/2)*((b*R)/r-r/(b*R))))^2)] (*shear rate with dimensions*);*)
shradi[r_]:=(Gamma[β]/2)*(((b^2)*(RR^2))/r-r)*MittagLefflerE[α,β,((ε*(Wi^2))/2)*(((((b^2)*(RR^2))/r-r))^2)](*dimensionless shear rate*);

(*Print[shradi[r]]*)
(*Print["RR=",RR];
Print["aR=",a*RR];
Print["ε*(Wi^2)=",ε*(Wi^2)]*)
monitoredFindRoot[args__] := Module[{s = 0, e = 0,j = 0},
{FindRoot[args, StepMonitor:>s++,EvaluationMonitor:>e++,Jacobian->{Automatic,EvaluationMonitor:>j++}],"Steps"->s,"Evaluations"->e,"Jacobian Evaluations"->j}];
bval=monitoredFindRoot[NIntegrate[shradi[r],{r,a*RR,RR}]==0,{b,0.71,0.72},Method->"Secant",MaxIterations->200,WorkingPrecision->20][[1]][[1]][[2]](*//Timing*)

(*Do[Print[(((((ε*(Wi^2)*(Pz^2))/2)))^i)*((1/(Gamma[α*i+β])))],{i,0,100,1}]
NIntegrate[shradi[r],{r,a*RR,RR}]*)

Cálculo numérico do perfil de velocidades

b=bval;
u[y_]:=NIntegrate[shradi[r],{r,a*RR,y},WorkingPrecision->20,AccuracyGoal->20];
Table[{i,u[i]},{i,1,2,0.01}]
ListPlot[%,Joined->True]

Do[Print[u[i]],{i,1,2,0.01}]

Obter velocidades para fazer gráficos no Excell

(*(*shear rate - slope*)
Clear["Global`*"];
b=0.7104;
α=0.5;β=1;λ=1;η=1;ε=5/100;Wi=10;a=1/2;RR=1/(1-a);Pz=-1;(*Print["ε*(Wi^2)=   ",ε*(Wi^2)];*)

shradi[r_]:=((Gamma[β])/2)*(((b^2)*(RR^2))/r-r)*MittagLefflerE[α,β,((ε*(Wi^2))/2)*(((((b^2)*(RR^2))/r-r))^2)](*dimensionless shear rate*);
Do[Print[shradi[i]],{i,1,2,0.01}]*)

(*Do[Print[u[i]],{i,1,2,0.01}]*)

(*Testar a solução usando uma série:
(1) taxa de corte
	(2) perfil de velocidades com integração
		(2) perfil de velocidades sem integração*)

(*Shear Rate*)

(*PointR=1.7; (*select a point in the range [aRR,RR]*)
Print["numerical solution:  ",shradi[PointR]];
shradisum[r_]:=((Gamma[β])/2)*(((b^2)*(RR^2))/r-r)*Sum[(((((ε*(Wi^2))/2)*(((((b^2)*(RR^2))/r-r))^2)))^k)/Gamma[α*k+β],{k,0,3}];
Print["analytical solution:  ",shradisum[PointR]];*)

(*Velocity Profile with an integral (for the tested cases, a k ranging from 0 to 4 allowed accurate results for Wi=1)*)

(*PointR=1.67; (*select a point in the range [aRR,RR]*)
Print["numerical solution:  ",u[PointR]];
uvel[r_]:=(((Gamma[β])/2))*Sum[((((((ε*(Wi^2))/2)))^k)/(Gamma[α*k+β]))*((∫_(a*RR)^r)((((((b^2)*(RR^2))/x)-x))^(2*k+1))\[DifferentialD]x),{k,0,4}];
Print["analytical solution:  ",uvel[PointR]];*)

(*Velocity Profile without the integral(for the tested cases, a k ranging from 0 to 4 allowed accurate results for Wi=1, for)*)

(*PointR=1.9; (*select a point in the range [aRR,RR]*)
Print["numerical solution:  ",u[PointR]];
f[m_,k_,r_]:=If[m<=k && m>=k,Log[r]-Log[a*RR],(((r^(2*(m-k)))-(((a*RR))^(2*(m-k))))/(2*(m-k)))];
uvel2[r_]:=(((-Gamma[β]*Pz)/2))*Sum[((((((ε*(Wi^2)*(Pz^2))/2)))^k)/(Gamma[α*k+β]))*(Sum[Binomial[2*k+1,m]*(((-1))^m)*((((((b^2)*(RR^2))/1)))^(2*k+1-m))*f[m,k,r],{m,0,2*k+1}]),{k,0,10}];
Print["analytical solution:  ",uvel2[PointR]];*)

Obter o "b"

Clear["Global`*"];

α=0.75;β=1;λ=1;η=1;ε=(5/100);WiU=Sqrt[5];a=(1/2);RR=(1/(1-a));Print["ε*(Wi^2)=   ",ε*(Wi^2)]
shradi[r_]:=(((Gamma[β])/2))*((((b^2)*(RR^2))/r)-r)*MittagLefflerE[α,β,(((ε*(Wi^2))/2))*((((((b^2)*(RR^2))/r)-r))^2)];
f[m_,k_,r_]:=If[m<=k && m>=k,Log[r]-Log[a*RR],(((r^(2*(m-k)))-(((a*RR))^(2*(m-k))))/(2*(m-k)))];
uvel2[r_]:=(((Gamma[β])/2))*Sum[((((((ε*(Wi^2))/2)))^k)/(Gamma[α*k+β]))*(Sum[Binomial[2*k+1,m]*(((-1))^m)*((((((b^2)*(RR^2))/1)))^(2*k+1-m))*f[m,k,r],{m,0,2*k+1}]),{k,0,100}];
(*bval2=FindRoot[{Integrate[shradi[r],{r,a*RR,RR}]==0,((2/((RR^2)*(1-(a^2)))))*Integrate[r*uvel2[r],{r,a*RR,RR}]-1==0},{{b,0.71,0.73}, ,{Pz,-5,-4}},MaxIterations->10,WorkingPrecision->12](*//Timing*)*)
(*bval2=FindRoot[{uvel2[RR]==0},{{b,0.72,0.73}},MaxIterations->100,WorkingPrecision->20]*)
bval2=FindRoot[{uvel2[RR]==0,((2/((RR^2)*(1-(a^2)))))*Integrate[r*uvel2[r],{r,a*RR,RR}]-(WiU/Wi)==0},{{b,0.71,0.73},{Wi,0.1,8.1}},MaxIterations->100,WorkingPrecision->12]

series=16
b=bval2[[1]][[2]]
Wi=bval2[[2]][[2]]
f[m_,k_,r_]:=If[m<=k && m>=k,Log[r]-Log[a*RR],(((r^(2*(m-k)))-(((a*RR))^(2*(m-k))))/(2*(m-k)))];
uvel2[r_]:=(((Gamma[β])/2))*Sum[((((((ε*(Wi^2))/2)))^k)/(Gamma[α*k+β]))*(Sum[Binomial[2*k+1,m]*(((-1))^m)*((((((b^2)*(RR^2))/1)))^(2*k+1-m))*f[m,k,r],{m,0,2*k+1}]),{k,0,series}];
Do[Print[uvel2[i]],{i,1,2,0.01}];
Table[{i,uvel2[i]},{i,1,2,0.01}]
ListPlot[%,Joined->True]

bb=bval2[[1]][[2]]
(*Pzz=bval2[[2]][[2]]*)
shradi[r_]:=(((Gamma[β])/2))*((((bb^2)*(RR^2))/r)-r)*MittagLefflerE[α,β,(((ε*(Wi^2))/2))*((((((bb^2)*(RR^2))/r)-r))^2)];
Do[Print[shradi[i]],{i,1,2,0.01}]
u[y_]:=NIntegrate[shradi[r],{r,a*RR,y}];
Table[{i,u[i]},{i,1,2,0.01}]
ListPlot[%,Joined->True]

Obter velocidades para fazer gráficos no Excell

Do[Print[u[i]],{i,1,2,0.01}]

Testes que foram feitos no desenvolvimento do prgrama (não correr isto)

Clear["Global`*"];
α=1;
β=1;
λ=1/1;
η=1;
ε=5/100;
Wi=1;
a=1/2;
RR=1/(1-a);
Pz=-1;

k=0;
Integrate[(((((((ε*(Wi^2)*(Pz^2))/2)))^k)*((((((b^2)*(RR^2))/r)-r))^(2*k+1)))/(Gamma[α*k+β])),r]

k=0;
Integrate[((((A/r)-r))^(2*k+1)),r]

k=1;
Integrate[((((A/r)-r))^(2*k+1)),r]

-((A^3)/(2 (r^2)))+((3 A (r^2))/2)-((r^4)/4)-3 (A^2) Log[r]