Курсач / work_unit

{© С.А. Кириллов}
unit Work_unit;

interface
uses Math;

{функция удельной теплоты воды}
function Cp(T_in,S_in,P_in:single):single; {P - в барах}

{функция температуры замерзания}
function T_freeze(S_in,P_in:single):single; {P - в барах}

{функция потенциальной температуры}
function T_potential(T_in,S_in,P_in:single):single; {P - в барах}

{функция наклона плоскости}
function Slope_Inclination(X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3:single;
code:single):single;
{направление от горизонтали 180=горизонтально,
90=вертикально}

{функция направления плоскости}
function Slope_alpha(X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3:single;
code:single):single;
{направление от положительной X
отрицательное - по часовой
положительное - против}

{процедура интерполирования}
Function Interpolate(X_node,Y_node:single;
{Точка узла интерполяции}
Lon_in,Lat_in:array of single;
{Массивы координат входящих данных}
Radius,Degree:single;
{Радиус поиска и степень}
Data:array of single;
Number:integer; Code:single):single;
{Массив с данными, количество значимых
и код пропуска}

{Преобразование координат}
function Coor_Transh_X(f,al,Angle:single):single;
function Coor_Transh_Y(f,al,Angle:single):single;
{широта, долгота, угол}

{Обратное преобразование координат}
function Re_Coor_Transh_Lon(x1,y1,Angle:single):single;
function Re_Coor_Transh_Lat(x1,y1,Angle:single):single;
{х координата, у координата, угол}

{Определение коэффициента кросс-корреляции}
Function Correlation(Dim1,Dim2:array of single; lag, N1, M1,
Important:integer; Code:single):single;
{основной массив, смещающийся массив, смещение,
N1 начальный индекс 1-го и 2-го набора данных в массивах,
M1 конечный индекс 1-го и 2-го массива,
количество значимых, код пропуска

Массивы 1 и 2 должны иметь равную размерность N1 и M1}

{функция определения плотности по УС80}
Function US80(T_in,S_in,P_in:single):single; {P - в барах}

{функция определения коэффициента термического расширения}
Function dRo_dT(T_i,S_i,P_i:single):single; {P - в барах}

{функция определения коэффициента соленостного сжатия}
Function dRo_dS(T_i,S_i,P_i:single):single; {P - в барах}

{процедура определения амплитуд и фаз вектора}
Procedure Vortex(X_in,Y_in:array of single; Count:integer;
{X_in,Y_in - составляющие скорости, Count - количество членов ряда}
T,Period:single;
{T - временной шаг рядов скоростей, Period - исследуемый период в тех же единицах}
var A_plus,A_minus,E_plus,E_minus:single);
{выходные параметры амплитуд и фаз полож. и отриц. компонент}

{функция определения площади треугольника}
function Triangle_Square(X1,Y1,X2,Y2,X3,Y3:single):single;

{функции пересчета из электропроводности в соленость}
function a_cond(xt:single):single;
function b_cond(xt:single):single;
function c_cond(xp:single):single;
function rt35_cond(xt:single):single;
function sal_cond(Temperature, Conductivity, Pressure:single):single;

{коэффициент обмена теплом при солевых пальцах}
Function Koef_temp_sf(Ro_r,K_b:single):single;
{коэффициент обмена солью при солевых пальцах}
Function Koef_salt_sf(Ro_r,K_b:single):single;
{коэффициент обмена теплом при диффузионной конвекции}
function Koef_temp_dc(Ro_r,K_b:single):single;
{коэффициент обмена солью при диффузионной конвекции}
function Koef_salt_dc(Ro_r,K_b:single):single;

{проверка на принадлежность точки}
function inside_outside(N_contour:integer; X_bln,Y_bln:array of single; X_point,Y_point:single):integer;
{x_bln, y_bln должны начинаться с 1 и до N}

implementation

{функция температуры замерзания}
function T_freeze(S_in,P_in:single):single;
begin
T_freeze:=-0.0575*S_in+1.710523*1e-3*sqrt(S_in*S_in*S_in)-
2.154996*1e-4*sqr(S_in)-7.53*1e-4*P_in;
end;

{функция удельной теплоты воды}
function Cp(T_in,S_in,P_in:single):single;
var C_0T0, A_coef, B_coef, dCp1, dCp2: single;
begin
C_0T0:=4217.4 -3.720283 * T_in
+0.1412855 * T_in * T_in
-2.654387e-3 * T_in * T_in * T_in
+2.093236e-5 * sqr(sqr(T_in));

A_coef:=-7.643575+ 0.1072763 * T_in - 1.38385e-3 *sqr(T_in);
B_coef:=0.1770383- 4.07718e-3 * T_in + 5.148e-5 *sqr(T_in);

dCp1:=(-4.9592e-1 + 1.45747e-2 *T_in -3.13885e-4 *T_in*T_in +2.0357e-6 *T_in*T_in*T_in +1.7168e-8 *sqr(sqr(T_in)))*P_in+
( 2.4931e-4 - 1.08645e-5 *T_in +2.87533e-7 *T_in*T_in -4.0027e-9 *T_in*T_in*T_in +2.2956e-11 *sqr(sqr(T_in)))*P_in*P_in+
(-5.422e-8 + 2.638e-9 *T_in -6.5637e-11 *T_in*T_in +6.136e-13 *T_in*T_in*T_in)*P_in*P_in*P_in;

dCp2:= ((4.9247e-3-1.28315e-4*T_in+9.802e-7*T_in*T_in+2.5941e-8*T_in*T_in*T_in-2.9179e-10*sqr(sqr(T_in)))*S_in+
(-1.2331e-4-1.517e-6*T_in+3.122e-8*T_in*T_in)*sqrt(S_in*S_in*S_in))*P_in+
((-2.9558e-6+1.17054e-7*T_in-2.3905e-9*T_in*T_in+1.8448e-11*T_in*T_in*T_in)*S_in+
(9.971e-8)*sqrt(S_in*S_in*S_in))*P_in*P_in+
((5.54e-10-1.7682e-11*T_in+3.513e-13*T_in*T_in)*S_in+
(-1.43e-12*T_in)*sqrt(S_in*S_in*S_in))*P_in*P_in*P_in;

Cp:=C_0T0 + A_coef * S_in + B_coef * sqrt(S_in*S_in*S_in) + dCp1 + dCp2;
end;

{функция потенциальной температуры}
function T_potential(T_in,S_in,P_in:single):single;
begin
T_potential:=T_in-
P_in*(3.6504e-4+8.3198e-5*T_in-5.4065e-7*sqr(T_in)+4.0274e-9*T_in*T_in*T_in)-
P_in*(S_in-35)*(1.7439e-5-2.9778e-7*T_in)-
P_in*P_in*(8.9309e-7-3.1628e-8*T_in+2.1987e-10*sqr(T_in))+
4.1057e-9*(S_in-35)*sqr(P_in)-
sqr(P_in)*P_in*(-1.6056e-10+5.0484e-12*T_in);
end;

{функция наклона плоскости}
function Slope_Inclination(X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3:single; code:single):single;
var A_matrix,B_matrix,C_matrix:single;
begin
Slope_Inclination:=9999;

if (Z1<>Code) and (Z2<>Code) and (Z3<>Code) then
begin
A_matrix:=Y1*(Z2*1-Z3*1)-
Z1*(Y2*1-Y3*1)+
1*(Y2*Z3-Y3*Z2);
B_matrix:=Z1*(X2*1-X3*1)-
X1*(Z2*1-Z3*1)+
1*(Z2*X3-Z3*X2);
C_matrix:=X1*(Y2*1-Y3*1)-
Y1*(X2*1-X3*1)+
1*(X2*Y3-X3*Y2);

Slope_inclination:=180/Pi *arccos(C_matrix/
sqrt(sqr(A_matrix)+sqr(B_matrix)+sqr(C_matrix)));
end;
end;

{функция направления плоскости}
function Slope_alpha(X1,Y1,Z1,X2,Y2,Z2,X3,Y3,Z3:single; code:single):single;
var A_matrix,B_matrix,C_matrix:single;
begin
Slope_alpha:=9999;

if (Z1<>Code) and (Z2<>Code) and (Z3<>Code) then
begin
A_matrix:=Y1*(Z2*1-Z3*1)-
Z1*(Y2*1-Y3*1)+
1*(Y2*Z3-Y3*Z2);
B_matrix:=Z1*(X2*1-X3*1)-
X1*(Z2*1-Z3*1)+
1*(Z2*X3-Z3*X2);
C_matrix:=X1*(Y2*1-Y3*1)-
Y1*(X2*1-X3*1)+
1*(X2*Y3-X3*Y2);

Slope_alpha:= arctan2(B_matrix,A_matrix)*180/Pi;
end;
if (Z1=Z2) and (Z1=Z3) then Slope_alpha:= 9999;
end;

{процедура интерполирования}
Function Interpolate(X_node,Y_node:single;
Lon_in,Lat_in:array of single;
Radius,Degree:single;
Data:array of single;
Number:integer;
Code:single):single;
var sum_q, ds, W_out : single;
w_value,w_dist,q:array of single;
nn:integer;
a1:integer;
label ende,l1;

begin
nn:=-1;
sum_q:=0;

for a1:=Low(Lon_in) to High(Lat_in) do
begin
ds:=sqrt(sqr(Y_node-Lat_in[a1])+sqr(X_node-Lon_in[a1]));
if ds=0 then ds:=1e-10;
if (ds<=Radius) and (Code<>Data[a1]) then
begin
inc(nn);
SetLength(W_dist,nn+1);
SetLength(W_value,nn+1);
SetLength(Q,nn+1);

W_dist[nn]:=ds;
W_value[nn]:=Data[a1];
end;
end;

if (nn<Number) then {т.е. данных меньше, чем нужно для значимости}
begin
W_out:=Code;
goto ende;
end;

W_out:=0;
if nn>0 then
begin
for a1:=0 to nn do
begin
if (nn=0) then
begin
W_out:=W_value[0];
goto ende;
end;
q[a1]:=1/(exp(Degree*ln(w_dist[a1])));
sum_q:=sum_q+q[a1];
end;
for a1:=0 to nn do
begin
q[a1]:=q[a1]/sum_q;
W_out:=W_out+q[a1]*W_value[a1];
end;
end;

ende: Interpolate:=W_out;

end;

{Преобразование координат}
function Coor_Transh_X(f,al,Angle:single):single;
var alf,R,pp,YP,x,y:single;
begin
alf:=3.14*Angle/180;
if(al>180) then al:=al-360;
if(al<0) then al:=-1*al-(360-0)
else al:=0-al;

// rd:=f*(3.14159265/180);
R:=6371.116;
pp:=((90-f)*3.14159265/180)/2;
YP:=al*(3.14159265/180);
x:=2*R*sin(pp)*sin(YP);
x:=-x/10;

y:=2*R*sin(pp)*cos(YP);
y:=-y/10;
Coor_Transh_X:=x*cos(alf)+y*sin(alf);
end;

{Преобразование координат}
function Coor_Transh_Y(f,al,Angle:single):single;
var alf,R,pp,YP,x,y:single;
begin
alf:=3.14*Angle/180;
if(al>180) then al:=al-360;
if(al<0) then al:=-1*al-(360-0)
else al:=0-al;

//rd:=f*(3.14159265/180);
R:=6371.116;
pp:=((90-f)*3.14159265/180)/2;
YP:=al*(3.14159265/180);
x:=2*R*sin(pp)*sin(YP);
x:=-x/10;

y:=2*R*sin(pp)*cos(YP);
y:=-y/10;
Coor_Transh_Y:=y*cos(alf)-x*sin(alf);
end;

{Обратное преобразование координат}
function Re_Coor_Transh_Lon(x1,y1,Angle:single):single;
var alf,Cn,pp,YP,Sn:single;
begin
alf:=3.14*Angle/180;
Sn:=sin(alf);
Cn:=cos(alf);

//R:=6371.116;
pp:=(y1+x1*Sn/Cn)/(Cn+Sn*Sn/Cn);
YP:=(x1-pp*Sn)/Cn;

pp:=-pp*10;
yp:=yp*10;

pp:=arctan2(YP,pp);
Re_Coor_Transh_Lon:=pp*180/Pi;
end;

{Обратное преобразование координат}
function Re_Coor_Transh_Lat(x1,y1,Angle:single):single;
var alf,R,Cn,pp,YP,Sn:single;
begin
R:=6371.116;
Re_Coor_Transh_Lat:=90-2*180/Pi*arcsin(sqrt(x1*100*x1+y1*100*y1)/2/R);
end;

{Определение коэффициента кросс-корреляции}
Function Correlation(Dim1,Dim2:array of single; lag, N1, M1,
Important:integer; Code:single):single;
var T1, T2 : array of single;
Cross, Max, Min : integer;
A1, Counter : integer;
Cor, RMSD1, RMSD2, Mean1, Mean2 : single;
label label1;
begin

if lag>=0 then {поиск диапазона пересечения}
begin
Min:=N1+lag;
Max:=M1;
end
else
begin
Min:=N1;
Max:=M1+lag;
end;

if Max<Min then {на случай, если смещение слишком велико}
begin
Correlation:=2;
goto label1;
end;

Cross:=Max-Min;
Counter:=Cross;

SetLength(T1,Cross+1);
SetLength(T2,Cross+1);

for a1:=0 to Cross do
begin
T1[a1]:=Dim1[Min-N1+a1];
T2[a1]:=Dim2[Min-N1+a1-lag];
if (T1[a1]=Code) or (T2[a1]=Code) then dec(Counter);
end;

if Counter>=Important then
begin
Cor:=0;
RMSD1:=0;
RMSD2:=0;
Mean1:=0;
Mean2:=0;
{поиск среднего}
for a1:=0 to cross do
begin
if (T1[a1]<>Code) and (T2[a1]<>Code) then Mean1:=Mean1+T1[a1]/(counter+1);
if (T1[a1]<>Code) and (T2[a1]<>Code) then Mean2:=Mean2+T2[a1]/(counter+1);
end;
{поиск дисперсии}
for a1:=0 to cross do
begin
if (T1[a1]<>Code) and (T2[a1]<>Code) then RMSD1:=RMSD1+sqr(T1[a1]-Mean1);
if (T1[a1]<>Code) and (T2[a1]<>Code) then RMSD2:=RMSD2+sqr(T2[a1]-Mean2);
end;
RMSD1:=sqrt(RMSD1/(counter+1));
RMSD2:=sqrt(RMSD2/(counter+1));
{поиск корреляции}
for a1:=0 to cross do
if (T1[a1]<>Code) and (T2[a1]<>Code)
then Cor:=Cor+(T1[a1]-Mean1)*(T2[a1]-Mean2);
if (RMSD1<>0) and (RMSD2<>0)
then Correlation:=Cor/RMSD1/RMSD2/(counter+1)
else Correlation:=2;
end
else Correlation:=2;
label1:
end;

{функция определения плотности по УС80}

Function US80(T_in,S_in,P_in:single):single;
Var Bw,Aw,B1,A1,Al,Bl,Kp,Kts0,Kptsp,A_1,B_1,C_1,rop,rots0:real;
Begin
Bw:=8.50935e-5-6.12293e-6*T_in+5.2787e-8*T_in*T_in;
Aw:=3.239908+1.43713e-3*T_in+1.16092e-4*T_in*T_in-5.77905e-7*T_in*T_in*T_in;
B1:=Bw-(9.9348e-7-2.0816e-8*T_in-9.1697e-10*T_in*T_in)*S_in;
A1:=Aw+(2.2838e-3-1.0981e-5*T_in-1.6078e-6*T_in*T_in)*S_in+1.91075e-4*sqrt(S_in*S_in*S_in);

Bl:=7.944e-2+1.6483e-2*T_in-5.3009e-4*T_in*T_in;
Al:=54.6746-0.603459*T_in+1.09987e-2*T_in*T_in-6.61670e-5*T_in*T_in*T_in;
Kp:=19652.21+148.4206*T_in-2.327105*T_in*T_in+1.360477e-2*T_in*T_in*T_in-5.155288e-5*T_in*T_in*T_in*T_in;
Kts0:=Kp+Al*S_in+Bl*sqrt(S_in*S_in*S_in);

Kptsp:=Kts0+P_in*A1+B1*P_in*P_in;

A_1:=0.824493-4.0899e-3*T_in+7.6438e-5*T_in*T_in-8.2647e-7*T_in*T_in*T_in+5.3875e-9*T_in*T_in*T_in*T_in;
B_1:=5.72466e-3-1.0227e-4*T_in+1.6546e-6*T_in*T_in;
C_1:=4.8314e-4;
rop:=999.842594+6.793952e-2*T_in-9.09529e-3*T_in*T_in+1.001685e-4*T_in*T_in*T_in-1.120083e-6*T_in*T_in*T_in*T_in+6.536332e-9*T_in*T_in*T_in*T_in*T_in;
rots0:=rop+A_1*S_in-B_1*sqrt(S_in*S_in*S_in)+C_1*S_in*S_in;
US80:=rots0/(1-p_in/kptsp);
end;

{функция определения коэффициента термического расширения}

Function dRo_dT(T_i,S_i,P_i:single):single;
begin
dRo_dT:=(US80(T_i+0.02,S_i,P_i)-
US80(T_i-0.02,S_i,P_i))/0.04;
end;

{функция определения коэффициента соленостного сжатия}

Function dRo_dS(T_i,S_i,P_i:single):single;
begin
if S_i<0.02 then dRo_dS:=(US80(T_i,S_i+0.02,P_i)-US80(T_i,S_i,P_i))/0.02
else dRo_dS:=(US80(T_i,S_i+0.02,P_i)-US80(T_i,S_i-0.02,P_i))/0.04;
end;


{процедура определения амплитуд и фаз вектора}

procedure Vortex(X_in,Y_in:array of single; Count:integer;
{X_in,Y_in - составляющие скорости, Count - количество членов ряда}
T,Period:single;
{T - временной шаг рядов скоростей, Period - исследуемый период в тех же единицах}
var A_plus,A_minus,E_plus,E_minus:single);
{выходные параметры амплитуд и фаз полож. и отриц. компонент}
var Sum1,Sum2,W:single;
Ami_last,Apl_last:single;
Cycle:integer;
Argument:single;
begin
A_minus:=0; A_plus:=0; E_minus:=0; E_plus:=0;
W:=2*Pi*T/Period; {угловая частота}

repeat
Sum1:=0;
Sum2:=0;
for Cycle:=0 to Count-1 do begin
Sum1:=Sum1+A_minus*sin(2*W*Cycle-E_minus)+
X_in[Cycle]*sin(W*Cycle)-
Y_in[Cycle]*cos(W*Cycle);
Sum2:=Sum2+A_minus*cos(2*W*Cycle-E_minus)+
X_in[Cycle]*cos(W*Cycle)+
Y_in[Cycle]*sin(W*Cycle);
end;
Argument:=-Sum1/Sum2;
if (Argument=Pi/2) or (Argument=-Pi/2) then Argument:=Argument-0.0001;
E_plus:=arctan(Argument);
if E_plus<0 then E_Plus:=E_plus+Pi;

Sum1:=0;
Sum2:=0;
for Cycle:=0 to Count-1 do begin
Sum1:=Sum1+A_plus*sin(2*W*Cycle+E_plus)-
X_in[Cycle]*sin(W*Cycle)-
Y_in[Cycle]*cos(W*Cycle);
Sum2:=Sum2-A_plus*cos(2*W*Cycle+E_plus)+
X_in[Cycle]*cos(W*Cycle)-
Y_in[Cycle]*sin(W*Cycle);
end;
Argument:=-Sum1/Sum2;
if (Argument=Pi/2) or (Argument=-Pi/2) then Argument:=Argument-0.0001;
E_minus:=arctan(Argument);
if E_minus<0 then E_minus:=E_minus+Pi;

Apl_last:=A_plus;
Sum1:=0;
for Cycle:=0 to Count-1 do
Sum1:=Sum1+A_minus*cos(E_plus+2*W*Cycle-E_minus)-
X_in[Cycle]*cos(E_plus+W*Cycle)-
Y_in[Cycle]*sin(E_plus+W*Cycle);
A_plus:=-Sum1/Count;
if A_Plus<0 then
begin
E_plus:=E_plus+Pi;
A_Plus:=-A_Plus;
end;

Ami_last:=A_minus;
Sum1:=0;
for Cycle:=0 to Count-1 do
Sum1:=Sum1+A_plus*cos(E_plus+2*W*Cycle-E_minus)-
X_in[Cycle]*cos(E_minus-W*Cycle)-
Y_in[Cycle]*sin(E_minus-W*Cycle);
A_minus:=-Sum1/Count;
if A_Minus<0 then
begin
E_minus:=E_minus+Pi;
A_minus:=-A_minus;
end;
until abs(sqrt(sqr(A_minus)+sqr(A_plus))-
sqrt(sqr(Ami_last)+sqr(Apl_last)))<1e-4;
end;
{end of Vortex }

function Triangle_Square(X1,Y1,X2,Y2,X3,Y3:single):single;
var Length1,Length2,Angle1,Angle2,Angle3:single;
begin
Length1:=sqrt(sqr(X1-X3)+sqr(Y1-Y3));
Length2:=sqrt(sqr(X2-X3)+sqr(Y2-Y3));
angle1:=arctan2(y1-y3,x1-x3)*180/Pi;
angle2:=arctan2(y2-y3,x2-x3)*180/Pi;
angle3:=abs(angle1-angle2);
if angle3>=180 then angle3:=angle3-180;
Triangle_Square:=1/2*Length1*Length2*sin(angle3*Pi/180);
end;


{функции пересчета из электропроводности в соленость}
function a_cond(xt:single):single;
begin
a_cond:=-3.107e-3*xt+0.4215;
end;

function b_cond(xt:single):single;
begin
b_cond:=(4.464e-4*xt+3.426e-2)*xt+1;
end;

function c_cond(xp:single):single;
begin
c_cond:=((3.989e-15*xp-6.37e-10)*xp+2.07e-5)*xp;
end;

function rt35_cond(xt:single):single;
begin
rt35_cond:=(((1.0031e-9*xt-6.9698e-7)*xt+1.104259e-4)*xt+
2.00564e-2)*xt+0.6766097;
end;

function Sal_Cond(Temperature, Conductivity, Pressure:single):single;
var dt,r,nenner,rt:single;
begin
dt:=Temperature-15;
r:=Conductivity/42.914;
nenner:=rt35_cond(Temperature)*(1+c_cond(Pressure)/
(b_cond(Temperature)+a_cond(Temperature)*r));
rt:=sqrt(abs(r/nenner));
sal_cond:=((((2.7081*rt-7.0261)*rt+14.0941)*rt+25.3851)*rt-
0.1692)*rt+0.008+
(dt/(1+0.0162*dt))*(((((-0.0144*rt+
0.0636)*rt-0.0375)*rt-0.0066)*rt-0.0056)*rt+0.0005);
end;



{коэффициент обмена теплом при солевых пальцах}
Function Koef_temp_sf(Ro_r,K_b:single):single;
var Ro_critical,K_scale:single;
N:integer;
begin
Ro_critical:=1.6;
K_scale:=1e-4;
n:=6;

Koef_temp_sf:=0.7*K_scale/(1+exp(N*ln(Ro_r/Ro_critical)))+K_b;
end;

{коэффициент обмена солью при солевых пальцах}
Function Koef_salt_sf(Ro_r,K_b:single):single;
var Ro_critical,K_scale:single;
N:integer;
begin
Ro_critical:=1.6;
K_scale:=1e-4;
n:=6;

Koef_salt_sf:= K_scale/(1+exp(N*ln(Ro_r/Ro_critical)))+K_b;
end;

{коэффициент обмена теплом при диффузионной конвекции}
function Koef_temp_dc(Ro_r,K_b:single):single;
var Ra,K_scale,ca,Rf,kt:single;
N:integer;
begin
kt:=1.39*1e-7;

Ca:=0.0032*exp(4.8*exp(0.72*ln(Ro_r)));
Ra:=0.25*1e+9*exp(-1.1*ln(Ro_r));
Rf:=(1/Ro_r+1.4*exp(1.5*ln(1/Ro_r-1)))/
(1+14*exp(1.5*ln(1/Ro_r-1)));

Koef_temp_dc:=Ca*exp(0.333*ln(Ra))*kt+K_b;
end;

{коэффициент обмена солью при диффузионной конвекции}
function Koef_salt_dc(Ro_r,K_b:single):single;
var Ra,K_scale,ca,Rf,kt:single;
N:integer;
begin
kt:=1.39*1e-7;

Ca:=0.0032*exp(4.8*exp(0.72*ln(Ro_r)));
Ra:=0.25*1e+9*exp(-1.1*ln(Ro_r));
Rf:=(1/Ro_r+1.4*exp(1.5*ln(1/Ro_r-1)))/
(1+14*exp(1.5*ln(1/Ro_r-1)));

Koef_salt_dc:=Ro_r*Rf*Ca*exp(0.333*ln(Ra))*kt+K_b;
end;

{проверка на принадлежность точки}
function inside_outside(N_contour:integer; X_bln,Y_bln:array of single; X_point,Y_point:single):integer;
var a,b,c:integer;
k1,k2,m1,m2:single;
rez1,rez2:boolean;
rez3:single;
x,y,x_max,y_max:single;
count:single;
angle,x_pr,y_pr:single;
x_trans,y_trans:single;
x_in,y_in:array[1..10000] of single;
label Rotate,l1,l2,l3;
begin
angle:=0;

Rotate:
x_max:=-100000;
y_max:=-100000;

for b:=1 to N_contour do
begin
// y_in[b]:=Coor_Transh_Y(y_bln[b],x_bln[b],angle);
// x_in[b]:=Coor_Transh_X(y_bln[b],x_bln[b],angle);
y_in[b]:=y_bln[b]*cos(angle*Pi/180)+x_bln[b]*sin(angle*Pi/180);
x_in[b]:=y_bln[b]*sin(angle*Pi/180)+x_bln[b]*cos(angle*Pi/180);

if x_in[b]>x_max then x_max:=x_in[b];
if y_in[b]>y_max then y_max:=y_in[b];
end;

for b:=1 to N_contour-1 do
if (x_in[b]-x_in[b+1])=0 then
begin
angle:=angle+0.01;
goto Rotate;
end;

// X:=Coor_Transh_Y(Y_point,X_point,angle);
// Y:=Coor_Transh_X(Y_point,X_point,angle);
y:=y_point*cos(angle*Pi/180)+x_point*sin(angle*Pi/180);
x:=y_point*sin(angle*Pi/180)+x_point*cos(angle*Pi/180);

x_pr:=x_max+1;
y_pr:=y_max+1;

if x_pr=x then x_pr:=x_pr+1;
if y_pr=y then y_pr:=y_pr+1;

l1:
count:=0;
k1:=(y-y_pr)/(x-x_pr);
m1:=y_pr-x_pr*k1;

for b:=1 to N_contour-1 do
begin
rez1:=false;
rez2:=false;

k2:=(y_in[b]-y_in[b+1])/(x_in[b]-x_in[b+1]);
m2:=y_in[b+1]-x_in[b+1]*k2;
if k2=k1 then begin
x_pr:=x_pr+1;
goto l1;
end;
x_trans:=(m2-m1)/(k1-k2);
y_trans:=k1*x_trans+m1;

if ((y_trans>=y_in[b+1]) and (y_trans<y_in[b])
and (x_trans>=x_in[b+1]) and (x_trans<x_in[b])) or
((y_trans<=y_in[b+1]) and (y_trans>y_in[b])
and (x_trans>=x_in[b+1]) and (x_trans<x_in[b])) or
((y_trans<=y_in[b+1]) and (y_trans>y_in[b])
and (x_trans<=x_in[b+1]) and (x_trans>x_in[b])) or
((y_trans>=y_in[b+1]) and (y_trans<y_in[b])
and (x_trans<=x_in[b+1]) and (x_trans>x_in[b]))
then rez1:=true;

if ((y_trans>y_pr) and (y_trans<y)
and (x_trans>x_pr) and (x_trans<x)) or
((y_trans<y_pr) and (y_trans>y)
and (x_trans>x_pr) and (x_trans<x)) or
((y_trans<y_pr) and (y_trans>y)
and (x_trans<x_pr) and (x_trans>x)) or
((y_trans>y_pr) and (y_trans<y)
and (x_trans<x_pr) and (x_trans>x))
then rez2:=true;
if (rez1=true) and (rez2=true) then count:=count+1;

if ((x_in[b]=x) and (y_in[b]=y)) or
((x_in[b+1]=x) and (y_in[b+1]=y)) or
((abs(x_trans-x)<0.00001) and (abs(y_trans-y)<0.00001)
and (rez1=true)) then
begin
inside_outside:=2; {border}
goto l3;
end;
end;
l2:
rez3:=count/2-trunc(count/2);
if rez3=0.5 then
begin
inside_outside:=1; {inside}
goto l3;
end;

inside_outside:=3; {outside}
l3:
end;

end.