(*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=strida*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);

TinNom=22;

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

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

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

rceNadBivalenci[Tout_]=dosrce/.{Tin->22,Pk->0};
Cases[rceNadBivalenci[0],_Symbol,∞]//Union
neznameNadBivalenci={{Qtop,0,(10^4)},{strida,0,1},{T3,37,58},{T4,35,60},{T5,37,57}};

rcePodBivalenci[Tout_]=dosrce/.{Tin->22,strida->1};
Cases[rcePodBivalenci[-3],_Symbol,∞]//Union
neznamePodBivalenci={{Pk,0,(10^4)},{Qtop,0,(10^4)},{T3,37,58},{T4,35,60},{T5,37,57}};

reseni[Tout_]:=Union[FindRoot[rceNadBivalenci[Tout],neznameNadBivalenci],{Pk->0}]/;Tout≥TeplotaBivalence
reseni[Tout_]:=Union[FindRoot[rcePodBivalenci[Tout],neznamePodBivalenci],{strida->1}]/;Tout<TeplotaBivalence

reseni[-12]

vykonKotle[Tout_]:=Pk/.reseni[Tout];
prikonCerpadla[Tout_]:=strida*Pel[Tout,T3]/.reseni[Tout];