I have a function functionSL[0.01,zl,zh] where I want to find at which zl its minimum value occurs for each different zh. I already know at which zl is the minimum for each zh since I calculated it using FindMinimum for each one. The problem now is that I want to use Table to calculate them all at the same time.
My code is as follows
d = 3;
toroot[a_?NumericQ, t_?NumericQ, zl_?NumericQ, zh_?NumericQ] := a - ((2 zl Sqrt[(1 + t^2 (1 - (zl/zh)^(d + 1))^-1)^-1])/((d + 1) (zl/zh)^(d + 1))) NIntegrate[(x)/Sqrt[(1 - x^2) (1 - (((1 + t^2 (1 - (zl/zh)^(d + 1))^-1)^-1) (zl/zh)^-6) x^3)], {x, 0, (zl/zh)^2}, PrecisionGoal -> 6, Method -> "LocalAdaptive"]
tz[a_?NumericQ, zl_?NumericQ, zh_?NumericQ] := t /. FindRoot[toroot[a, t, zl, zh], {t, -15, -20, 0}, AccuracyGoal -> Automatic, AccuracyGoal -> 12, PrecisionGoal -> 12]
intSL1[a_?NumericQ, zl_?NumericQ, zh_?NumericQ] := ((-1/(d - 1)) (zl^(2 d) (1 + tz[a, zl, zh]^2 (1 - (zl/zh)^(d + 1))^-1))^-1 zl^(2 d))*NIntegrate[x^d ((1 - (zl/zh)^(d + 1) x^(d + 1))/(1 - (zl^(2 d) (1 + tz[a, zl, zh]^2 (1 - (zl/zh)^(d + 1))^-1))^-1 (zl x)^(2 d)))^(1/2), {x, 10^-8, 1}, MaxRecursion -> 20, PrecisionGoal -> 6, Method -> "GlobalAdaptive"]
intSL2[a_?NumericQ, zl_?NumericQ, zh_?NumericQ] := ((-(zl/zh)^(d + 1) (d + 1))/(2 (d - 1))) * NIntegrate[x ((1 - (zl^(2 d) (1 + tz[a, zl, zh]^2 (1 - (zl/zh)^(d + 1))^-1))^-1 (zl x)^(2 d))/(1 - (zl/zh)^(d + 1) x^(d + 1)))^(1/2), {x, 10^-8, 1}, MaxRecursion -> 20, PrecisionGoal -> 6, Method -> "GlobalAdaptive"]
intSL3[a_?NumericQ, zl_?NumericQ, zh_?NumericQ] := (zl/zh)^(d + 1) * NIntegrate[x/((1 - (zl/zh)^(d + 1) x^(d + 1)) (1 - (zl^(2 d) (1 + tz[a, zl, zh]^2 (1 - (zl/zh)^(d + 1))^-1))^-1 (zl x)^(2 d)))^(1/2), {x, 10^-8, 1}, MaxRecursion -> 20, PrecisionGoal -> 6, Method -> "GlobalAdaptive"]
functionSL[a_?NumericQ, zl_?NumericQ, zh_?NumericQ] := ((-((1 - (zl^(2 d) (1 + tz[a, zl, zh]^2 (1 - (zl/zh)^(d + 1))^-1))^-1 zl^(2 d)) (1 - (zl/zh)^(d + 1)))^(1/2)/(d - 1)) + intSL1[a, zl, zh] + intSL2[a, zl, zh] + intSL3[a, zl, zh] + 1)/(4 zl^(d - 1))
One issue is that every time I change zh I also need to change the parameter t in the FindRoot,
tz[a_?NumericQ, zl_?NumericQ, zh_?NumericQ] := t /. FindRoot[toroot[a, t, zl, zh], {t, -15, -20, 0}, AccuracyGoal -> Automatic, AccuracyGoal -> 12, PrecisionGoal -> 12]
I already know that the minimum always occurs around ~0.93*zh, an example would be, for zh=1 the minimum is at zl=0.930685. Now if you plot tz[0.01,zl,1] you will see the corresponding t you need to put in FindRoot for it to find a solution.
You can see that zl=0.930685 is around t=-15 so that is why I set that as the starting point in FindRoot. The same goes for all other zh.
The code for finding the minimum for zh=1 is,
FindMinimum[functionSL[0.01, zl, 1], {zl, 0.8, 1}, AccuracyGoal -> 10, PrecisionGoal -> 10, MaxIterations -> 100] // Quiet
{0.216556, {zl -> 0.930685}}
If I do it for all zh at the same time I have,
In[39]:= Zmin = Table[FindMinimum[{functionSL[0.01, zl, zh], zl <= zh}, {zl, 0.9, 0.8, 100}], {zh, {1, 5, 10, 50, 100}}] // Quiet // AbsoluteTiming
Out[39]= {268.65, {{0.216556, {zl -> 0.930685}}, {0.00866033, {zl -> 4.653}}, {0.00216507, {zl -> 9.30576}}, {0.0000874471, {zl -> 44.7789}}, {0.0000326264, {zl -> 64.6718}}}}
You see that for smaller zh I got the correct values for zl but for higher zh like zh=100 you see that the result is not correct. Also you see that I used 0.9 as a starting point. The problem has to do with what I put in FindRoot, I think.
FindRoot[toroot[a, t, zl, zh], {t, -15, -20, 0}, AccuracyGoal -> Automatic, AccuracyGoal -> 12, PrecisionGoal -> 12]
putting {t, -15, -20, 0} makes it more likely that I find the correct roots for lower zh, but not so for higher.
How should I resolve this?
