unit Kinetika;

interface

uses GlType,GlProc,MathObj,Classes,SysUtils, MVTU_TLB;

function TPntKin (at,adt:RealType;var time,dtime:RealType;
                  var AU,AY:TPtrExt;var AX,ADX:array of RealType;
                  var CU,CY : TIntArray;var Prop:TPtrArray;var Vars:Pointer;
                  Action:Integer):Integer;export;
function TPntKinM(at,adt:RealType;var time,dtime:RealType;
                  var AU,AY:TPtrExt;var AX,ADX:array of RealType;
                  var CU,CY : TIntArray;var Prop:TPtrArray;var Vars:Pointer;
                  Action:Integer):Integer;export;
function TOstEn  (at,adt:RealType;var time,dtime:RealType;
                  var AU,AY:TPtrExt;var AX,ADX:array of RealType;
                  var CU,CY : TIntArray;var Prop:TPtrArray;var Vars:Pointer;
                  Action:Integer):Integer;export;
{-------------------------------------------------------------------------------------------------------}
               IMPLEMENTATION
{-------------------------------------------------------------------------------------------------------}
const
 OstN = 23;   {Американская ANSI}
 alf : array[0..OstN-1]of real=
      ( 0.65057,   0.51264,   0.24384,   0.1385,    0.05544,
        0.022225,  0.0033088, 9.3015e-4, 8.0943e-4, 1.9567e-4,
        3.2535e-5, 7.5595e-6, 2.5232e-6, 4.9948e-7, 1.8531e-7,
        2.6608e-8, 2.2398e-9, 8.1641e-12,8.7797e-11,2.5131e-14,
        3.2176e-16,4.5038e-17,7.4791e-17 );
 lam : array[0..OstN-1]of real=
       ( 22.138,    0.51587,   0.19594,   0.10314,   0.033656,
         0.011681,  0.003587,  0.001393,  6.263e-4,  1.8906e-4,
         5.4988e-5, 2.0958e-5, 1.001e-5,  2.5438e-6, 6.6361e-7,
         1.229e-7,  2.7213e-8, 4.3714e-9, 7.578e-10, 2.4786e-10,
         2.2384e-13,2.46e-14,  1.5699e-14 );
 Efgb = 183.9;

{----------------------------------------------------------------------}
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

                        Т О Ч Е Ч Н А Я    К И Н Е Т И К А

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
type
  TPntKin1Rec = record
   beta    : ^RealType;
   ro0     : ^RealType;
   l       : ^RealType;
   count   : ^Integer;
   bi      : TExtArray;
   lami    : TExtArray;
   norm    : ^Integer;
  end;
  pPntKin1Rec = ^TPntKin1Rec;

  TPntKin2Rec = record
   beta    : ^RealType;
   ro0     : ^RealType;
   count   : ^Integer;
   bi      : TExtArray;
   lami    : TExtArray;
   norm    : ^Integer;
  end;
  pPntKin2Rec = ^TPntKin2Rec;

  TOstEnRec = record
   Ost_t   : TExtArray;
   Ost_n   : TExtArray;
  end;
  pOstEnRec = ^TOstEnRec;

{---------------------------------------------------------------------------
Точечная кинетика
---------------------------------------------------------------------------}
function TPntKinConvert(Action:  integer;
                          Vars:    Pointer;
                          Prop:    TPtrArray;
                          PropStr: TStringList;
                          BlockId: integer;
                          var MVTU: IMVTU_Server):integer;
  const RecName:PChar = 'Точечная кинетика';
  var
      Res: integer;
begin
  case Action of
    //Возвращаем ссылку на имя записи в базе МВТУ-4
    cnv_GetRecName: Result:=integer(RecName);
    //Конвертируем и устанавливаем параметры при помощи интерфейса МВТУ
    cnv_Convert: with pPntKin1Rec(Prop.arr)^ do try
                   //Присваиваем параметры для блока
                   MVTU.SetBlockProp(BlockId,'beta',PChar(PropStr[0]),Res);
                   MVTU.SetBlockProp(BlockId,'ro0',PChar(PropStr[1]),Res);
                   MVTU.SetBlockProp(BlockId,'L',PChar(PropStr[2]),Res);
                   MVTU.SetBlockProp(BlockId,'bi',PChar(ConvertVector(PropStr[4])),Res);
                   MVTU.SetBlockProp(BlockId,'lami',PChar(ConvertVector(PropStr[5])),Res);
                   MVTU.SetBlockProp(BlockId,'norm',PChar(IntToStr(norm^)),Res);
                 finally
                 end;
  end;
end;

function TPntKin;
var  j   : Integer;
     x,s : RealType;
begin
 Result:=0;
 with pPntKin1Rec(Prop.arr)^ do
 case Action of
 f_GetConvertFuncAdr: Result:=integer(@TPntKinConvert);
 f_GetDeriCount  : Result:=Count^+1;
 f_GetInit       : Result:=1;
 f_GetCount   : begin CU.arr^[1]:=1;CY.arr^[0]:=1 end;
 f_InitState  : begin
                  for j:=0 to Count^ do AX[j]:=0;
                  if norm^=0 then AY.Ptr(0).arr^[0]:=1
                  else AY.Ptr(0).arr^[0]:=0;
                end;
 f_GetDeri    : begin
                  x:=AU.Ptr(0).arr^[0]/beta^;
                  s:=0;
                  for j:=1 to Count^ do s:=s+bi.arr^[j-1]*AX[j];
                  ADX[0]:=beta^/l^*((1+AX[0])*x-(ro0^+1)*AX[0]+ s);
                  for j:=1 to Count^ do ADX[j]:=lami.arr^[j-1]*(AX[0]-AX[j])
                end;
  f_GoodStep,
  f_RestoreOuts,
  f_UpdateJacoby,
  f_UpdateOuts : if norm^=0 then AY.Ptr(0).arr^[0]:=AX[0]+1 else AY.Ptr(0).arr^[0]:=AX[0];
 end
end;
{---------------------------------------------------------------------------
Точечная кинетика - мгновенный скачок
---------------------------------------------------------------------------}
function TPntKinMConvert(Action:  integer;
                          Vars:    Pointer;
                          Prop:    TPtrArray;
                          PropStr: TStringList;
                          BlockId: integer;
                          var MVTU: IMVTU_Server):integer;
  const RecName:PChar = 'Точечная кинетика (модель мгновенного скачка)';
  var
      Res: integer;
begin
  case Action of
    //Возвращаем ссылку на имя записи в базе МВТУ-4
    cnv_GetRecName: Result:=integer(RecName);
    //Конвертируем и устанавливаем параметры при помощи интерфейса МВТУ
    cnv_Convert: with pPntKin2Rec(Prop.arr)^ do try
                   //Присваиваем параметры для блока
                   MVTU.SetBlockProp(BlockId,'beta',PChar(PropStr[0]),Res);
                   MVTU.SetBlockProp(BlockId,'ro0',PChar(PropStr[1]),Res);
                   MVTU.SetBlockProp(BlockId,'bi',PChar(ConvertVector(PropStr[3])),Res);
                   MVTU.SetBlockProp(BlockId,'lami',PChar(ConvertVector(PropStr[4])),Res);
                   MVTU.SetBlockProp(BlockId,'norm',PChar(IntToStr(norm^)),Res);
                 finally
                 end;
  end;
end;

function TPntKinM;
var  j   : Integer;
     x,s : RealType;
begin
 Result:=0;
 with pPntKin2Rec(Prop.arr)^ do
 case Action of
  f_GetConvertFuncAdr: Result:=integer(@TPntKinMConvert);
  f_GetDeriCount  : Result:=Count^;
  f_GetInit       : Result:=1;
  f_GetCount   : begin CU.arr^[1]:=1;CY.arr^[0]:=1 end;
  f_InitState  : begin
		  for j:=0 to Count^-1 do AX[j]:=1;
		  if norm^=0 then AY.Ptr(0).arr^[0]:=1
                  else AY.Ptr(0).arr^[0]:=0;
		 end;
  f_GetDeri    : begin
		  x:=AU.Ptr(0).arr^[0]/beta^;
		  s:=0;
		  for j:=0 to Count^-1 do s:=s+bi.arr^[j]*AX[j];
		  s := (s+ro0^)/(1+ro0^-x);
		  for j:=0 to Count^-1 do ADX[j]:=lami.arr^[j]*(s-AX[j])
		 end;
  f_GoodStep,
  f_RestoreOuts,
  f_UpdateJacoby,
  f_UpdateOuts : begin
		  x:=AU.Ptr(0).arr^[0]/beta^;
		  s:=0;
		  for j:=0 to Count^-1 do s:=s+bi.arr^[j]*AX[j];
		  if norm^=0 then AY.Ptr(0).arr^[0]:=(s+ro0^)/(1+ro0^-x)
                  else AY.Ptr(0).arr^[0]:=(s+ro0^)/(1+ro0^-x)-1;
		 end;
 end
end;
{---------------------------------------------------------------------------
Остаточное энерговыделение
---------------------------------------------------------------------------}
function TOstEnConvert(Action:  integer;
                          Vars:    Pointer;
                          Prop:    TPtrArray;
                          PropStr: TStringList;
                          BlockId: integer;
                          var MVTU: IMVTU_Server):integer;
  const RecName:PChar = 'Остаточное энерговыделение (по ANSI)';
  var
      Res: integer;
begin
  case Action of
    //Возвращаем ссылку на имя записи в базе МВТУ-4
    cnv_GetRecName: Result:=integer(RecName);
    //Конвертируем и устанавливаем параметры при помощи интерфейса МВТУ
    cnv_Convert: with pOstEnRec(Prop.arr)^ do try
                   //Присваиваем параметры для блока
                   MVTU.SetBlockProp(BlockId,'ost_t',PChar(ConvertVector(PropStr[0])),Res);
                   MVTU.SetBlockProp(BlockId,'ost_n',PChar(ConvertVector(PropStr[1])),Res);
                 finally
                 end;
  end;
end;

function TOstEn;
var  j, i : Integer;
     x,s,y: RealType;
begin
 Result:=0;
 with pOstEnRec(Prop.arr)^ do
 case Action of
  f_GetConvertFuncAdr: Result:=integer(@TOstEnConvert);
  f_GetDeriCount  : Result:=OstN;
  f_GetCount   : begin CU.arr^[1]:=1;CY.arr^[0]:=1 end;
  f_InitState  : begin
		  for j:=0 to OstN-1 do begin
		    s:=0;
		    for i:=1 to Ost_t.Count-1 do begin
                      y := -lam[j]*(Ost_t.arr^[Ost_t.Count-1]-Ost_t.arr^[i]);
                      if y<-11355 then y := 0 else begin
                        x := -lam[j]*(Ost_t.arr^[i]-Ost_t.arr^[i-1]);
                        if x<-11355 then
                          s := s+Ost_n.arr^[i]*exp(y)
                        else
                          s := s+Ost_n.arr^[i]*(1-exp(x))*exp(y);
                      end;
                    end;
                    AX[j] := 0.936*s;
                  end;
                  s:=0;
		  for j:=0 to OstN-1 do s:=s+alf[j]/lam[j]*AX[j];
		  x:=AU.Ptr(0).arr^[0];
		  AY.Ptr(0).arr^[0]:=x+s/Efgb;
		 end;
  f_GetDeri    : begin
		  x:=0.936*AU.Ptr(0).arr^[0];
		  for j:=0 to OstN-1 do
                    ADX[j]:=lam[j]*(x-AX[j])
		 end;
  f_GoodStep,
  f_RestoreOuts,
  f_UpdateJacoby,
  f_UpdateOuts : begin
		  x:=AU.Ptr(0).arr^[0];
		  s:=0;
		  for j:=0 to OstN-1 do s:=s+alf[j]/lam[j]*AX[j];
		  AY.Ptr(0).arr^[0]:=x+s/Efgb;
		 end;
 end
end;

END.