(*http://www.scinet.cz/wolfram-alpha-centralni-mozek-lidstva.html*)

SetDirectory["FileName"/.NotebookInformation[EvaluationNotebook[]]/.FrontEnd`FileName[d_List,nam_,___]:>ToFileName[d]];

struct=<<"struct";

Pel[Tvzduch_,Tvoda_]=struct[[1,1]];
Ptop[Tvzduch_,Tvoda_]=struct[[1,2]];
eps[Tvzduch_,Tvoda_]=struct[[1,3]];
Pel[Tvzduch,Tvoda][[2,0,1]]

Plot[Evaluate[Ptop[Tvzduch,#]&/@{35,50,60}],{Tvzduch,-20,25},PlotStyle->Thick]

c=4186;
rce1=Ptop[Tout,T3]==m1*c*(T3-T4);
rce3=m1*c*(T5-T3)==Pk;
rce4=m1*c*(T5-T4)==Qtop;
rce5=Qtop==kTop*(((T5+T4)/2)-Tin);
rce6=Qtop==kDum*(Tin-Tout);

rceStav={rce4,rce5,rce6};
Stav={Qtop->10000,Tout->-12,Tin->22,T5->40,T4->35};
dos=Solve[rceStav/.Stav][[1]]//N

dosrce={rce1,rce3,rce4,rce5,rce6}/.dos;
Length[dosrce]
Length@(Cases[dosrce,_Symbol,∞]//Union)
Cases[dosrce,_Symbol,∞]//Union

prores[Tin_,Tout_]=dosrce;
prores[24,-10]
%//Length
nezname=Cases[%%,_Symbol,∞]//Union
%//Length

Solve[prores[24,-5]]

tryRce=prores[24,-15];
resTry=FindRoot[prores[24,-15],{{Pk,0,(10^4)},{Qtop,0,(10^4)},{T3,35,60},{T4,35,60},{T5,35,60}},MaxIterations->(10^2)]

(tryRce/.Equal[a_,b_]:>((Abs[a-b])/(Abs[a+b])))/.resTry

rceMezBivalence=dosrce/.{Tin->24,Pk->0};
neznBivalence=Cases[%,_Symbol,∞]//Union;
resBivalence=FindRoot[rceMezBivalence,{{Qtop,0,(10^4)},{T3,35,60},{T4,35,60},{T5,35,60},{Tout,-15,20}},MaxIterations->(10^2)];
TeplotaBivalence=Tout/.resBivalence;
Print["mez bivalence je ",TeplotaBivalence," [°C]"]