(*https://www.qpro.cz/Psychrometricke-vypocty-Strana-3*)

Quiet@Remove["Global`*"];
SetDirectory[NotebookDirectory[]];
$HistoryLength=3;Off[Solve::"ifun",General::"spell1"]

xmax=25;hmax=50;teploty={t,0,70,5};

h=(1.0059*t+(2500.9+1.898*t)*x*(10^(-3)))-x*2.5;
pp=Exp[((1500.3+23.5*t)/(234+t))];
τ=1-((t+273.15)/647.096);
ppp=22.064*(10^6)*Exp[(1/(1-τ))*(-7.859518*τ+1.844083*(τ^1.5)-11.78665*(τ^3)+22.680741*(τ^3.5)-15.961872*(τ^4)+1.801225*(τ^7.5))];

tp=Solve[p==pp,t][[1]];

px=Solve[x==622*((φ*p)/((10^5)-φ*p)),p][[1]];

hφ=h/.tp/.px;

xv=622*((φ*p)/((10^5)-φ*p))/.p->pp;
xm=xv/.φ->1;

xmt=Table[{xm,t},Evaluate[teploty]];

pocett=Length[Split[Table[xmt[[i,1]]<xmax-3,{i,Length[xmt]}]][[1]]];

ht[x_,i_]:=(h/.(t->xmt[[i,2]]))/;(x≤xmt[[i,1]])
ht[x_,i_]:=(-2.5*x+2.5*xmt[[i,1]]+h/.(t->xmt[[i,2]]))/;(x>xmt[[i,1]])

xht[t_,φ_]={xv,h/.x->xv};

φxypom[q_]:={xmax-3,hφ/.{x->(xmax-3),φ->q}}
xpom=Table[x/.FindRoot[(hφ/.φ->k)==hmax-1,{x,1}],{k,.1,.9,.1}];
φxy[q_]:={xpom[[q*10]],hmax-1}/;φxypom[q][[2]]>(hmax-1)
φxy[q_]:=φxypom[q]/;φxypom[q][[2]]<=(hmax-1)

entalpy=Table[Plot[(k-2.5*x),{x,0,xmax},PlotRange->{0,hmax},DisplayFunction->Identity],{k,Round[(2.5*xmax+hmax)/10]*10,10,-10}];
izotermy=Table[Plot[ht[x,i],{x,0,xmax},PlotRange->{0,hmax},PlotStyle->{Red},DisplayFunction->Identity],{i,Length[xmt]}];
(*BODY KE ZOBRAZENÍ*)
body=Graphics[Table[{Green,PointSize[.05],Point[xht[Random[Real,{15,30}],Random[Real,{.2,.8}]]]},{k,5}]];
izoφ=Table[Plot[hφ,{x,0,xmax},PlotRange->{0,hmax},PlotStyle->{Blue},DisplayFunction->Identity],{φ,0.1,0.9,.1}];
φ1=Plot[hφ/.φ->1,{x,0,xmax},PlotRange->{0,hmax},PlotStyle->{Blue,Thickness[0.01]},DisplayFunction->Identity];
popisφ=Graphics[Table[{Blue,Text[φ,φxy[φ],Background->Automatic]},{φ,0.1,0.9,0.2}]];
popist=Graphics[Table[{Red,Text[xmt[[i,2]],{xmt[[i,1]]+2,(ht[xmt[[i,1]]+2,i])/.x->xmt[[i,1]]},Background->Automatic]},{i,pocett}]];

Show[entalpy,izotermy,body,izoφ,φ1,popisφ,popist,DisplayFunction->$DisplayFunction,AspectRatio->1.,ImageSize->300,AxesLabel->{"x","h"}]