{*******************************************************}
{                                                       }
{  SunWorld Library            by Sergey Mozharovsky    }
{  swFITS v.2019.06                                     }
{                                                       }
{  FITS module                                          }
{     Чтение/парсинг FITS файлов                        }
{     Расчёт H||с помощью норм.мометов СтоксПараметра V }
{     Вывод рассчитанных значений в FITS файлы          }
{                                                       }
{  (C) 2019 <SW>  http://uafo.ru/sw90/sw09vtoc.html     }
{                                                       }
{*******************************************************}

unit swFITS;

interface

uses Classes,Windows,Forms,swTy,swDir,Graphics,swGRAD,swPict16,swGLib,
     swGsFitI,
     swGsFitId0,
     swGsFitIV,
     swGsCurI,
     U_bi9
     ,UApp

     ;


const mAxis  = 4;(* максимально возможное число осей в "сыром" FITS файле *)
const mFine = 23;(* число типов карт, которые рассчитывает CalcSumsFine *)
const mFOE  =  8;(* число типов карт для расчёта шума *)

Type

(*======================================*)
(* типы описывают     *)
(*                    *)
(*                    *)
(*======================================*)

TPSesFltRec = ^TSesFltRec;
TSesFltRec = record
  na : string;
  v1,
  v2 : real;
  K  : integer; (* номер колонки *)
end;

TSesFltLst = class (TList) (* List of TSesFltRec *)
  function ToSL:TStringList;
  procedure setBySL(SL:TStringList);
  procedure Done;
end;


(*======================================*)
(*======================================*)
(*======================================*)

Type
{
TLFOS = class (TStringList)

end;
}

TFOScale = class (TObject)
  sNam : string;
  sDim : string; (* по умолчанию - пустая строка *)
  BSL  : TStringList; (* список границ *)
  CSL  : TStringList; (* синхронный список раскрасок *)


  procedure Add(sNa:string;sb : string);  (* корректируем LFOS *)
  function iMapScale(sNa:string):integer; (* ищем карту в LFOS *)



end;


var LFOS : TStringList;



(*======================================*)
(* типы, которые описывают FITS - оси   *)
(*======================================*)
Type

TAsAXIS = array[1..mAxis] of string;  (* названия и ед.измерения осей *)
TAiAXIS = array[1..mAxis] of integer; (* размерности осей *)
TA4In   = array[1..4]     of TAIn;    (* для оригинальных  профилей Стокса *)
TA4Re   = array[1..4]     of TARe;    (* для пересчитанных профилей Стокса *)
TALI    = array of LongInt;  (* для суммирования "сырых" интенсивностей *)
//TAMask= TAByBy;            (* для сохранения масок *)



(* вызываются из FITS_Common_Prof: *)
procedure FITSMaskListAdd(aMask:TAMask;var LAMask:TList);
function FITSMaskListGet(LAMask:TList;J:integer):TAMask;
(*-----------------------------------------------------*)
procedure FITSMaskListDone(var LAMask:TList);              (* не используется *)


(* раньше входила в LFIO *)
function NamList(kSoft0:integer;sDt0,sTi0:string):TStringList;
(* получить список имён карт заданной сессии для SW/ME/M2 *)
(*   данные берём из нужного FITS файла                   *)
(*   имя файла вычисляем из Dt Ti по изветному алгоритму  *)
(*
 * kSoft = 1/2/3 = SW/ME/M2
 * chN0  = Id сессии, который будет записан в FO
 * SLN   - список строк вида 'Name sVar'
 * QAll  - игнорировать SLN
*)



var nGrossData  : longint;
    nGrossCount : integer;

Type

(*=========================================*)
(* универсальные наборы массивов для TFITS *)
(*=========================================*)

//TAi2Any = array [1..mFine] of array [1..2] of TAIn;
//TAr2Any = array [1..mFine] of array [1..2] of TARe;
TArN2Are  = array [1..mFine] of array [1..2] of TARe;  (* mFine = 23 *)
TArErr    = array [1..mFOE]                  of TARe;  (* mFOE  =  8 *)




(*==============================================================*)
(*                                                              *)
(*     отдельные ГЛОБАЛЬНЫЕ процедуры                           *)
(*                                                              *)
(*==============================================================*)


(* извлечь вектор Стокса из 4-ки параметров Стокса *)
function A4GetStokes(A:TA4Re;ch:char):TARe;





(*------------------*)
(* МНЕМОНИКА FITS   *)
(*                  *)
(* Lam,L     - 1-ая размерность вдоль дисперсии (112 точек)        *)
(* Y         - 2-ая размерность вдоль щели, напр.S-N 512,768 точек *)
(* X         - по напр.Солнца E-W, по экземплярам FITS-ев          *)
(*   XP      - NSLITPOS, SLITINDX                                  *)
(*   XI      - порядк номера в списке FITS-ев                      *)
(* H         - HEADER                                              *)
(*                                                                 *)
(*                                                                 *)
(*                                                                 *)
(*-----------------------------------------------------------------*)

(*-----------------------------------------------------------------*)
(* единичное измерение - одно положение щели                       *)
(*                     - один FITS файл первого уровня             *)
(*                     - nY штук четвёрок профилей IQUV            *)
(*-----------------------------------------------------------------*)
Type

TFITS = class(TObject)
  Owner    : TObject;(* ссылка на TLFITS - весь сеанс наблюдений *)
  aData    : TAWd;   (* образ участка FITS файла с данными       *)
  HSL      : TStringList;                       (* строки хидера *)

  IXI      : integer;(* индекс в списке FITS файлов *)
  IXP      : integer;(* SLITINDX                    *)
  IXpos    : integer;(* SLITPOS                     *)

  (* стадия загрузки данных *)
  KStep    : word;   (* 1/2/4/8 = Link/Header/Data/Integral *)
                 (* бит 0 1 2 3   0    1      2    3        *)

                     (* 1 - IXI заполнен *)

  (*------- заполняются в процедуре чтения Хидера -------*)
  nsHead   : integer;(* число строк в хидере = HSL.Count *)
  nlHead   : integer;(* размер места под хидер в строках *)
  nbHead   : integer;(* размер хидера в байтах           *)
  nData    : integer;(* размер данных (одной записи) в nBITPIX-битных числах *)
  nbData   : integer;(* размер данных (одной записи) в байтах *)

  byteOrder : integer; (* 0 - как в FITS 1 - как в комп-рах IBM PC *)

  sPath    : string; (* папка файла (если FITS отдельный от LFITS) *)
  sFN      : string; (* имя файла (без Path)         *)
  sDtObs   : string; (* дата+время начала экспозиции *)


  DATA_LEV : integer; (* уровень данных 0 = исходные          *)
  nBITPIX  : integer; (* число бит в единице данных           *)
  nAXIS    : integer; (* число осей данных                    *)
  AnAX     : TAiAXIS; (* размерности осей данных NAXIS[1..10] *)
  ACTYPE   : TAsAXIS; (* типы                   *)
  ACUNIT   : TAsAXIS; (* единицы измерения осей *)

  iSPBSHFT : integer; (* bit-shift:0-нет, 1-сдвиг I, 2-I и V, 3-I,Q,U,V *)

(*---------------------------------------*)
(*  переместить в TLFITS  ???            *)
(*                                       *)

                                                             (*<<<--TFITS-->>>*)
  (*=======================================*)
  (*                                       *)
  (*      копия данных из FITS Хидера      *)
  (*                                       *)
  (*=======================================*)

  nLam     : integer;(* число точек на профиле        Ось 1 *)
  nY       : integer;(* число пикселей вдоль щели     Ось 2 *)
(*nStokes = 4                                         Ось 3 *)
  nXP      : integer;(* число положений щели NSLITPOS       *)
//nX       = LFITS.Count;
//iX  определяется порядковым номером в списке LFITS        *)

  rExpTime : real;  (* Экспозиция *)

  rLa0     : real;  (* =CRVAL1 = 6302.080 дл.волны точки привязки профиля*)
  rdLam    : real;  (* =CDELT1 = 0.021549 дисперсия A/пиксель *)
  rLamIdx0 : real;  (* =CRPIX1 = 56.5     индекс точки привязки профиля  *)
  dVlos    : real;  (* DOPVUSED          м/с *)
  dV_los   : real;  (* DOP_RCV           м/с *)
  //T_CCD    : real;  (* T_FGCCD   температура FG CCD со стороны камеры *)
  T_1      : real;  (* T_SPCCD *)
  T_2      : real;  (* T_FGCCD *)
  T_3      : real;  (* T_CTCCD *)
  T_4      : real;  (* T_SPCEB *)
  T_5      : real;  (* T_FGCEB *)
  T_6      : real;  (* T_CTCEB *)
  V_       : real;  (* средняя по всем Y скорость, взятая из карт *)
  V21      : real;  (* средняя по всем Y разность скоростей 2 и 1 *)


  {
YCEN+(IY-CRPIX2)*YSCALE
rY0+(IY-rYI)*rdY1
}


  rY0      : real;  (* *YCEN   = -238.0 heliocen.Y of slit center, arcsec *)
  rY1      : real;  (* *CRVAL2 = -245.493 Coord(Y) of the reference pixel in heliocentric reference frame *)
  rdY      : real;  (* =CDELT2 = 0.317    *)
  rdY1     : real;  (* =YSCALE = 0.1599.. *)
  rYI      : real;  (* =CRPIX2 = 256.5 номер референсного пикселя *)
  wdY      : real;  (* =FOVY  = 81.152    *)

  rX0      : real;  (* *XCEN   = 507.786   *)
  wdX      : real;  (* =FOVX  = 0.1476    *)
  rdX      : real;  (* =XSCALE *)
  rXI      : real;  (* = rX0 + (rdX1 * IXpos) ?????????     *)
  tMin     : real;  (* время начала экспозиции в минутах от начала дня *)


(*---------------------------------------*)

                                                             (*~~~~~TFITS~~~~~*)
  (*=================================================*)      (*<<<--TFITS-->>>*)
  (*                                                 *)
  (*   служебные данные, необходимые для расчёта     *)
  (*   - индексы граничных точек вдоль оси длин волн *)
  (*                                                 *)
  (*=================================================*)

  ic1,ic2  : integer; (* диапазон точек для расчета континуума *)
  ic3,ic4  : integer; (* диапазон точек для расчета континуума *)
  ic5,ic6  : integer; (* диапазон точек для расчета континуума *)

  il1,il2  : integer; (* граничные точки для линии 6301 *)
  il3,il4  : integer; (* граничные точки для линии 6302 *)
  il5,il6  : integer; (* граничные точки для линии 6302.05 *)

(*--------------*)

  (* уровни по которым профили считать     *)
  (* немагнитными, магнитными и смешанными *)

  k_VI1     : real;  (* примерно 0.1 *)
  k_VI2     : real;  (* примерно 0.4 *)

(*--------------*)


  (* внутри CalcSlitConts *)
  iIMax : integer; (* iX индекс макс.значения CONT *)
  iIMin : integer; (* iX индекс мин. значения CONT *)


  (* внутри CalcSums *)
  iVMax : integer;
  AbsVIMax : real;

                                                             (*~~~~~TFITS~~~~~*)
  (*==================================================*)
  (*--------------------------------------------------*)
  (*--------------------------------------------------*)
  (*                                                  *)
  (*                строка Карты                      *)
  (*    интегральные по iLam данные вдоль щели iY     *)
  (*           размерность nY                         *)
  (*                                                  *)
  (*--------------------------------------------------*)
  (*--------------------------------------------------*)
  (*==================================================*)

  ACnt : TARe; (* уровень континуума. Не нормировано! *)
               (* расчёт по наиболее высокой точке    *)
               (*   после сглаживания                 *)


  (* техологические, временные массивы *)

//ASI  : TALI; (* сумма значений I      по длинам волн array of LongInt *)

//  ASVM : TALI; (* сумма значений Abs(V) по длинам волн *)
//  ASQM : TALI; (* сумма значений Abs(V) по длинам волн *)
//  ASUM : TALI; (* сумма значений Abs(V) по длинам волн *)

//  AVC  : TARe; (* положения точки раздела V-профилей 6301 и 6302 *)
//  AIC  : TARe; (* положения точки раздела I-профилей 6301 и 6302 *)


                                                             (*<<<--TFITS-->>>*)


(*----------------------------------------------------------------------------*)
(*                                                                            *)
(*                                                                            *)
(*                                                                            *)
(*----------------------------------------------------------------------------*)

  (* универсальные массивы, которые будут работать в разных алгоритмах *)


  A2 : TArN2Are; // array [1..mFine=23] of array [1..2] of TARe; (TAre [1..n])

(*---- векторы вдоль длины волны ----*)                    (*<<<--TFITS-->>>*)

//ALam: TARe; (* вектор длин волн по точкам измерения NLam *)
//AI   : TARe;
//AV   : TARe;

  (*---- для текущего iY ----*)

  iY_cur : integer;

  AIpV : TARe;
  AImV : TARe;
  A_I  : TARe;

(*----------------------------------------------------------------------------*)
(*                                                                            *)
(*                                                                            *)
(*                                                                            *)
(*----------------------------------------------------------------------------*)



//AE : TArErr;   // array [1..8]  of TARe;

//  AiAny   : TAi2Any; (* array [1..mFine] of array [1..2] of TAIn   *)
//  ArAny   : TAr2Any; (* array [1..mFine] of array [1..2] of TARe   *)


  (* оценочные массивы *)
  AKVI : TARe; (* отношения W_abs(V)/W_I *)                  (*<<<--TFITS-->>>*)

  AI_d01: TAIn; (* центральная глубина в пикселах *)
  AI_d02: TAIn;
  AILd01: TAIn; (* полож.вершины линии 6301 в пикселах *)
  AILd02: TAIn; (* полож.вершины линии 6302 в пикселах *)
  (* основа для вычислений экв.ширин, положений центров тяжети I+V, I-V *)
  ALC52 : TARe; (* полож.бисектора .5 6302 в пикселах *)
  ALC51 : TARe; (* полож.бисектора .5 6301 в пикселах *)

(*ALC51,52 могут содержать 0, если трудно определить центр из-за магнитности *)


  (* основа для вычислений экв.ширин, положений центров тяжести I+V, I-V *)
  ALC1: TARe; (* полож.центра тяжести в пикселах для инт-ти 6301 *)
  ALC2: TARe; (* полож.центра тяжести в пикселах для инт-ти 6302 *)



                                                             (*~~~~~TFITS~~~~~*)
  (*======================================*)                 (*<<<--TFITS-->>>*)
  (*                                      *)
  (* Положения бисектора, вершины линий,  *)
  (* абсолютные ширины, глубины линий     *)
  (*    вычисляется внутри CalcBisec      *)
  (*                                      *)
  (*======================================*)
  (*-----------------------------------------------------*)
  (* ВСЕ ЦИФРЫ В ИСХОДНЫХ ШКАЛАХ ПИКСЕЛЕЙ И ОТСЧЁТОВ !!! *)
  (*-----------------------------------------------------*)

  AbiC1: TAreABisec; (* положения центров бисекторов *)
  AbiW1: TAreABisec; (* абсолютные ширины            *)
  AbiC2: TAreABisec; (* положения центров бисекторов *)
  AbiW2: TAreABisec; (* абсолютные ширины            *)

  A35C1: TARe3_5 ;   (* Lam0 *)
  A35I1: TARe3_5 ;   (* D0   *)
  A35D1: TARe3_5 ;   (* DLD  *)  (* TARe3_5 = array[3..5] of TARe; *)

  A35C2: TARe3_5 ;   (* Lam0 *)
  A35I2: TARe3_5 ;   (* D0   *)
  A35D2: TARe3_5 ;   (* DLD  *)  (* TARe3_5 = array[3..5] of TARe; *)

  (*--------------------------------------*)
  (*--------------------------------------*)                 (*<<<--TFITS-->>>*)

  (*======================================*)                 (*<<<--TFITS-->>>*)
  (*                                      *)
  (*    Рабочие массивы для расчёта       *)
  (*    аппроксимации профиля             *)
  (*    интенсивности гауссианой          *)
  (*                                      *)
  (*======================================*)

  AGa18   : TARe; (* к-т регресси "a" по 8 точкам для 6301 *)
  AGa16   : TARe;
  AGa141  : TARe;
  AGa142  : TARe;
  AGb18   : TARe;
  AGb16   : TARe;
  AGb141  : TARe;
  AGb142  : TARe; (* к-т регресси b по второй четвёрке точек *)
  AGa28   : TARe; (* к-т регресси a по 8 точкам для 6302 *)
  AGa26   : TARe;
  AGa241  : TARe;
  AGa242  : TARe;
  AGb28   : TARe;
  AGb26   : TARe;
  AGb241  : TARe;
  AGb242  : TARe; (* к-т регресси b по второй четвёрке точек *)

  AGD18   : TARe; (* допплеровская полуширина *)
  AGD16   : TARe;
  AGD141  : TARe;
  AGD142  : TARe;
  AGD28   : TARe; (* допплеровская полуширина *)
  AGD26   : TARe;
  AGD241  : TARe;
  AGD242  : TARe;

  AG1d0   : TARe;   (* => OuGDLDk *)                         (*<<<--TFITS-->>>*)
  AG2d0   : TARe;   (* => OuGDLDk *)
  AG1Dk   : TARe;   (* => OuGDLDk *)
  AG2Dk   : TARe;   (* => OuGDLDk *)
  AG1D    : TARe;   (* => OuGDLD  *)
  AG2D    : TARe;   (* => OuGDLD  *)

  AGL16   : TARe;   (* Lam0 для 6 точек для линии 6301 *)
  AGL14   : TARe;
  AGL26   : TARe;
  AGL24   : TARe;
  AGL10   : TARe;   (* дл.волны вершины *)
  AGL20   : TARe;   (* дл.волны вершины *)
  AGL1    : TARe;   (* gs.Lam0 *)
  AGL2    : TARe;   (*         *)



                                                             (*~~~~~TFITS~~~~~*)
  (*-----------------------------------------------------*)
  ANE : TABt; (* число экстремумов профиля интенсивности *)
  AN1 : TABt; (* число экстремумов интенсивности 6301    *)
  AN2 : TABt; (* число экстремумов интенсивности 6302    *)
  (*-----------------------------------------------------*)
                                                             (*~~~~~TFITS~~~~~*)
  (*-----------------------------------------------------*)
  (*    интегральные параметры линий                     *)
  (*-----------------------------------------------------*)

  AWI1: TARe; (* экв.ширина 6301 (поделена на AC4[1] и привед.к дл.волны *)
  AWI2: TARe; (* экв.ширина 6302 (поделена на AC4[1] и привед.к дл.волны *)
  AWI3: TARe; (* экв.ширина 6302.05   *)

  AMV1: TARe; (* ненормир.момент 6301 *)
  AMV2: TARe; (* ненормир.момент 6302 *)

  AHM1: TARe; (* продольное поле 6301 по моменту V параметра *)
  AHM2: TARe; (* продольное поле 6302 *)

  AHG1: TARe; (* продольное поле 6301 по методу центров тяжести *)
  AHG2: TARe; (* продольное поле 6302 *)

  (*-----------------------------------------------------*)
  (*-----------------------------------------------------*)

  (* временные массивы для входных данных *)                 (*<<<--TFITS-->>>*)

  AWk1 : TARe;
  AWk2 : TARe;
  AWk3 : TARe;
  AWk4 : TARe;

  (* временные массивы для выходных данных *)                (*<<<--TFITS-->>>*)

  AWo1 : TARe;
  AWo2 : TARe;
  AWo3 : TARe;
  AWo4 : TARe;
  AWo5 : TARe;
  AWo6 : TARe;
  AWo7 : TARe;
  AWo8 : TARe;


  (*----- интегральные по щели (ось Y) величины ---------*)
  (* средние значения, крайние значения и их iY индексы  *)

                  (*       берутся из карт VW_1 и VW_2      *)
  vx1_   : real;  (* усредненное значение v1_ для данного X *)
  vx2_   : real;  (* усредненное значение v2_ для данного X *)

                                                             (*~~~~~TFITS~~~~~*)
  CntMin : real;     (* мин. знач. инт-ти непрерывного спектра *)
  CntMax : real;     (* макс.знач. инт-ти непрерывного спектра *)
  iCntMin: integer;  (* индекс по оси Y *)
  iCntMax: integer;


  rLC1   : real;     (* среднее значение центра тяжести 6301 (в точках) *)
  rLC2   : real;     (* среднее значение центра тяжести 6302 (в точках) *)
  rLC3   : real;     (* среднее значение центра тяжести 6302.005 либо 0 *)
  nLC12  : integer;  (* "мощность" чисел rLC1,2                         *)
                     (* переменные rLC1 и rLC2 внутри LFITS даны в Ангс.*)
  rLC51  : real;     (* среднее значение бисектора 5 для 6301 *)
  rLC52  : real;


  wMin   : real;     (* минимальная  суммарная (W1+W2) экв.ширина *)
  wMax   : real;     (* максимальная суммарная (W1+W2) экв.ширина *)
  iwMin  : integer;  (*   значение iY мин. ширины W1+W2           *)
  iwMax  : integer;

  HMaxP  : real;     (* макс.значение продольного поля со знаком '+' *)
  HMaxM  : real;     (* макс.значение продольного поля со знаком '-' *)
  iHMaxP : integer;
  iHMaxM : integer;

  rCntH0 : real;     (* среднее значение континуума в немагнитных областях *)


(*============================================================================*)
(*============================================================================*)
(*============================================================================*)

                                                             (*~~~~~TFITS~~~~~*)
(*----------- ИНИЦИАЦИЯ ---------------*)
//procedure Link(sFN0:string;I0:integer;anOwner:TObject);
procedure Link(I0:integer;anOwner:TObject);
function fNam:string; (* имя файла (находим через LFITS) *)


(*---- "с внешней стороны" назначаем участки континуума и участки линий -----*)
procedure SetContArea(i1,i2,i3,i4,i5,i6:integer);
procedure DefaultContArea; (* интервалы дл.волн континуума *)
//procedure SetLinesArea(i1,i2,i3,i4,i5,i6:integer);
//procedure SetLinesArea2(iY:integer);

                                                             (*~~~~~TFITS~~~~~*)
(*---- ЧТЕНИЕ ЗАГОЛОВКА В СТРУКТУРУ HSL ----*)

procedure ReadHeader; overload;
procedure ReadHeader(sPath0,sFN0:string); overload;


(* Обслуживанеие чтения из Хидера *)                         (*<<<--TFITS-->>>*)
procedure SplitHeaderStr(S:string;var sKey,sVal:string);
//function GetKey(sKey:string):string; (* получить строковое значение по ключу *)
function GetKeyS(sKey:string):string; (* получить строковое значение по ключу *)
function GetKeyI(sKey:string):integer; (* получить целое значение по ключу *)
function GetKeyR(sKey:string):real; (* получить действительное число по ключу *)
function GetKeyVal(sKey:string):real;(* преобразовать в число по ключу *)

function sKeysList:string;


function GetAXIS(sKey:string):TAsAXIS;  (* масиив строк описания осей *)
function GetAXISi(sKey:string):TAiAXIS; (* масиив размерностей осей *)

procedure CalcVolume; (* вычислить объём данных для FITS nData, nbData *)

(* задать порядок байтов в Real4 *)
procedure byteReOrder(iDir:integer);


(*------------------------------------*)                     (*<<<--TFITS-->>>*)
(*    Загрузка данных                 *)

//procedure LoadData0;
procedure LoadData; (* чтение данных из sFN FITS-файла в буфер aData *)
procedure ClearData;(* освобождение памяти *)
procedure ClearAData;
procedure ClearMData; (* "map" data - строки интегральных карт *)
function nWorkData:longint;



function Check(sP:string):boolean;  (* = Check Assigned *)
function CheckI(sP:string):boolean; (* = Check Linked   *)
function CheckFN(sP:string):boolean;(* = sFN задано *)

//function fNam:string;


                                                             (*~~~~~TFITS~~~~~*)
(*----- служебные функции/преобразования --------*)

function ItoLam(ILam:real):real; (* индекс ILam -> дл.волны в ангстремах *)
function GetALam:TARe; (* вычислить вектор длин волн *)

function GetAI(iYA:integer):TARe; (* iY-вый нормированный профиль Ri *)
//function GetAI2(iY:integer):TARe; (* iY-вый профиль Ri *)
function GetAI0(iYA:integer):TARe; (* iY-вый профиль Ri *)
procedure GetAIV(iY:integer); overload;(*назначаем iY_cur, заполняем AIpV,AImV*)
procedure GetAIV(iY:integer;var A_IpV,A_ImV:TARe); overload;
procedure GetAIVI(iY:integer;var A_IpV,A_ImV,A_I:TARe);


function minIV(i1,L:integer):real;
function minIV1:real;    (*  1.. 56 *)
function minIV2:real;    (* 57..112 *)
function minIpV(i1,L:integer):real;
function minImV(i1,L:integer):real;
function minI(i1,L:integer):real;


procedure COGIV(i1,L:integer;r1:real;var Lp,Lm:real);
procedure COGIV1(r:real;var Lp,Lm:real);
procedure COGIV2(r:real;var Lp,Lm:real);
//function SlicedCOG(i1,i2:integer;y1,y2:real;A:TARe):real;
procedure SlicedCOGIV1(y1,y2:real;var Lp,Lm:real);
procedure SlicedCOGIV2(y1,y2:real;var Lp,Lm:real);



function GetAV(iY:integer):TARe; (* iY-вый нормированный профиль Rv *)
//function GetAV2(iY:integer):TARe; (* iY-вый профиль Rv *)
function iStokes(Ch:char):integer;  (* IQUV -> 1234 *)
function chStokes(i3:integer):char; (* 1234 -> IQUV *)

function GetFIT_SL(iY:integer;sStokes:string):TStringList;             overload;
function GetFIT_SL(iY:integer;sStokes:string;chI,chL:char):TStringList;overload;
function GetFITNorm_SL(iY:integer;sStokes:string):TStringList;
procedure GetFITARe(iY:integer;sStokes:string;var AX,AI,AQ,AU,AV:TARe);
procedure GetFITARe2(iY:integer;sStokes:string;
                        var AX,AXd,AI,AQ,AU,AV,AP,AD:TARe);   overload;
procedure GetFITARe2(iY:integer;sStokes:string;chI,chL:char;
                        rL0 : real; (* сдвиг нуля длин волн *)
                        var AX,AXd,AI,AQ,AU,AV,AP,AD:TARe);   overload;



procedure GetFITNormARe(iY:integer;sStokes:string;
                        rL0 : real;                 (* сдвиг нуля длин волн *)
                        var AX,AI,AQ,AU,AV:TARe);
procedure GetFITNormARe2(iY:integer;sStokes:string;
                         rL0 : real; (* сдвиг нуля длин волн *)
                         var AX,AXd,AI,AQ,AU,AV,AP,AD:TARe);


function GetFIT3(iYA:integer;sStokes:string):TA4In;          (*<<<--TFITS-->>>*)
procedure GetProfSum(AIY:TAIn;var A4S:TA4Re);
procedure VLOSedProfSum(AIY:TAIn;AVi:TARe;var A4S:TA4Re);
function GetContSum(AIY:TAIn):real;
function GetProfNormSum(AIY:TAIn):TA4Re;

procedure SumProfSum(AIY:TAIn;var ASum:TA4Re);
procedure SumVLOSedProf(AIY:TAIn;AVi:TARe;var ASum:TA4Re);
procedure SumContSum(AIY:TAIn;var Sum:real);


                                                             (*~~~~~TFITS~~~~~*)
(*---------- выдача инфрмации ---------------*)

function SLKeys:TStringList; (* выдать список ключей хидера *)
function SLVals:TStringList; (* выдать список значений хидера *)



function GetCol1(i2,i3:integer):TAIn; (* строка вдоль длины волны *)
function GetCol2(i1,i3:integer):TAIn; (* строка вдоль щели        *)
(* вложенные процедуры *)

(* выборка всех точек одного профиля - ЦЕЛЫЕ ЧИСЛА! *)
procedure GetCol3(i2,i3   :integer;var A:TAIn);(* вызывает GetCol4 *)
procedure GetCol4(i2,i3,k2:integer;var A:TAIn);(* c учётом сдвига бита в FITS *)


(*--- вычисление интегральных для iLam данных ----------*)


                                                             (*~~~~~TFITS~~~~~*)
(*--- вычисление для одной точки iY ------------*)

(*============================================================================*)
(*                                                                            *)
(*             вычисление уровней континуума  (1 точка)                       *)
(*                                                                            *)
(*============================================================================*)


(* I-Cont для точки iY и его индекс (дл.волны) - максимум после сглаж.Гауссом *)
procedure GetICont_01(iY:integer;var rC,lC:real); (* iY [0..nY-1] *)
procedure GetICont_00(iY:integer;var rC:real;var iC:integer);
procedure GetICont_02(iY,iGap:integer;var rC,rC2:real;var iC,iC2:integer);
function ContiY(iY:integer):real;



                                                             (*~~~~~TFITS~~~~~*)
(*--- вычисление массивов вдоль iY ------------*)

(*============================================================================*)
(*                                                                            *)
(*             вычисление уровней континуума  (вдоль щели)                    *)
(*                                                                            *)
(*============================================================================*)


//procedure GetSlitCont(S:char;var AC,AD:TARe);       (* ИЗ ОКОН континуума *)
//procedure CalcSlit4Conts; (* по заданным точкам *)  (* ИЗ ОКОН *)

                                                             (*~~~~~TFITS~~~~~*)

(*============================================================================*)
(*                                                                            *)
(*             расчёт центров тяжести  (1 точка)                              *)
(*                                                                            *)
(*============================================================================*)


  (*--------------------------------------------------------------*)
  (* расчёт для одного значения iY без установки ур-ня континуума *)

  (* профили могут быть "сложным" *)
  procedure CalcCGrav (iYA:integer;var l1,l2:real);
//procedure CalcCGravN(iYA:integer;var l1,l2:real);
(* вызывается из *)
(*   CalcH0             *)
(*   CalcCGravs         *)
(*   CalcCGravs_01      *)
(*   CalcCGravs1        *)


  (* две линии + три "промежутка" *)
  procedure CalcCGrav5(iYA:integer;var l1,l2:real;var AI:TAIn;var AE:TARe);

  (* расчёт для одного значения iY без установки ур-ня континуума *)
  (*--------------------------------------------------------------*)

                                                             (*<<<--TFITS-->>>*)
(*============================================================================*)
(*                                                                            *)
(*             расчёт центров тяжести  (вдоль щели)                           *)
(*                                                                            *)
(*============================================================================*)


(* расчет центров тяжести из ненормированных массивов *)
(* заполнение ALC1, ALC2 без знания континуума        *)
(*   CalcCGravs заполняет ANE - число вершин          *)
procedure CalcCGravs;   (* включает в себя CalcCGrav и CalcCGrav5 *)

(* версия для раздельного счёта *)
procedure CalcCGravs_01(var AL1,AL2:TARe);

(* чтобы можно было заполнить только то значения, для которых *)
(* профили достаточно просты и рассчитать для них среднее     *)
procedure CalcCGravs0;  (* <-CalcCGrav5, для точек в к-рых число вершин = 5 *)
procedure CalcCGravs1;  (* <-CalcCGrav, для точек в к-рых число вершин <> 5 *)


procedure CalcLW(var QErr:boolean;FOCB0:TObject);(* вычислить положение крыльев *)
procedure CalcIVcog(VW1,VW2 : real);
procedure CalcIVcog05(VW1,VW2 : real);
procedure Calc_LIV;
procedure Calc_W_Mom;


procedure CalcDFull;
procedure CalcDH;
procedure CalcC50;
procedure CalcCxx(d:real);       (* вычислить бисектор и FW на уровне d *)

                                                             (*<<<--TFITS-->>>*)
(*============================================================================*)
(*                                                                            *)
(*   расчёт точек разделения профилей 6302 и 6301 по I и по V (вдоль щели)    *)
(*                                                                            *)
(*============================================================================*)

//procedure CalcVCross;
//procedure CalcICenter; (* расчёт точек разделения I-профилей 6302 и 6302 *)



(*================================================================*)
(*                                                                *)
(*             все вычисления вместе для сырого FITS              *)
(*                                                                *)
(*================================================================*)



procedure CalcL5_1_2; (* для текущ.FITS расчёт среднего знач-я L5 *)
procedure ReturnSlitLC;                                      (*<<<--TFITS-->>>*)
function ReturnSlitLC50:boolean;
function ReturnSlitLWbr:boolean;
function ReturnSlitD0:boolean;
function ReturnSlitLd0:boolean;
function ReturnSlitMeanV:boolean; (* заполнить ALC51 и ALC52 скоростями *)
function ReturnMeanV:boolean;

procedure BigCalc; (* все вычисления вместе *)

(*-------------------------------*)
(* входят в BigCalc              *)


(* не требует загрузки профилей, требует карт *)
function ReturnSlitConts:boolean; (* вернуть Cont в FITS.ACnt из LFITS.OuCont *)
function ReturnAnyMapLine(sNa:string;var A:TARe):boolean;
function ReturnMid2MapsLine(sNa1,sNa2:string;var A:TARe;
                            var IErr:integer):boolean;


(* требует загрузки профилей *)
procedure CalcSlitConts;(* максимум после сглаж. I(Lam) Гауссом -> ACnt[iY] *)
procedure CalcSlitContsL;(* максимум после сглаж. I(Lam) Гауссом -> ACnt[iY] *)


procedure CalcSums; (* Суммы I, |V| для каждого iY, значение KVI *)
procedure CalcFilt(la1,la2:integer;sStokes:string;qAbs:boolean);


procedure CalcSumsFine(rC90:real;kCalcStep:integer);
(* версия для раздельного счёта *)
procedure CalcSlitConts_01(var AC,ACL:TARe;var ICMin,ICMax:integer);

procedure CalcEqw; (* AWI1, AWI2, AWI3, AMV1, AMV2, AHM1,AHM2,AHG1,AHG2 *)
procedure CalcBisec; (* AbiC1/2 AbiW1/2 A35C1/2 A35I1/2 A35D1/2 *)
procedure CalcCore(OFOH:TObject);


                                                            (*~~~~~TFITS~~~~~*)
(*--- вычисление интегральных для iY данных ------------*)

procedure MaxMinCont;
procedure MaxMinW;
procedure MaxH;
procedure MeanLamC;  (* ср.полож-я на щели *)
procedure MeanLamC0; (* ср.полож-я на щели без точек с магн.полем *)
procedure MeanContH0;


//procedure RawMeanContH0;
procedure CalcH0(iY:integer;dl1,dl2,kV,akRC:real;
                 var W1,W2,M1,M2,H1,H2,HG1,HG2,l1,l2,
                 l11,l12,l21,l22,ln1,ln2,
                 lIV1,lVI1,lIV2,lVI2:real);



                                                             (*~~~~~TFITS~~~~~*)
(*=============== для "второго прохода" ==============*)

//procedure GetCont2(iY,i3:integer;var rC,rD:real);
//procedure CalcCGravs2;
//procedure CalcSlitConts2;
//procedure CalcEqw2;

//procedure BigCalc2; (* все вычисления вместе *)

//procedure CalcEqw2;


(*--- вычисление интегральных для iX данных ------------*)

function HeadReport:string;                                  (*<<<--TFITS-->>>*)
function HeadHd:string;

function ListReport:string;
function ListRepHd:string;

function ValReport:string;
function ValRepHd:string;

function ReportIY(iY:integer):string;
function ReportHead:string;

//function ReportIntegrVal(i1,i2,i3,i4,i5,i6:integer):TStringList;
//function ReportIntegrVal2:TStringList;

(* используется внутри FillData - заполнение массивов LFITS *)
procedure GetIYData(iY:integer;
                    var H1,H2,HG1,HG2,Cnt,Dsp,Vc1,Vc2,W1,W2,kVI(*,II0,VV0*):real);

constructor Create;
procedure Done;


end; (* TFITS *)


(*---------------------*)
(* КОНЕЦ описания FITS *)
(*---------------------*)

(*============================================================================*)
(*============================================================================*)
(*============================================================================*)


(* сумма, усреднение набора сырых FITS         *)
(* должна быть размещена в каком-то списке     *)
(* может быть записана в виде отдельного файла *)
(* в отличие от FITS FITS1 содержит не набор профилей вдоль Y *)
(* а единственный профиль                      *)
(* который наследует параметры первого из FITS *)

TFITS1 = class(TFITS)
  ix1,ix2 : integer;
  iy1,iy2 : integer;
  SLF     : TStringList;  (* список фильтров, отбрасывающих данные *)
  SLS     : TStringList;  (* список фильтров, выбирающих данные *)

  AS4 : TA4Re; (* массив профилей Стокса *)
               (* в отличие от AC4,AD4 первая координата не iY, а ILam *)

  rCnt : real;  (* значение усреднённого континуума *)


//sPath    : string; (* папка файла (если FITS отдельный от LFITS) *)
//sFN      : string; (* имя файла (без Path)      *)

(*
 Задать папку и имя устредненного файла - это некоторая проблема
 Начальная часть имени папки совпадает с именем папки сырых FITS:
 '..\YYYY_MM\YYYYMMDD_hhmmss'
 к этому добавляется подчёрк


*)

end;

(*============================================================================*)
(*============================================================================*)
(*============================================================================*)

type


(*----------------------------------------------------------------------------*)
(* сильно облегчённый вариант TFIOut *)
(* который содержит только маску     *)
(* то есть битовый по сути, байтовый физически *)
(* массив, "параллельный" карте TFIOut(FO)     *)
TFIMask = Class(TObject)                         (* сейчас НЕ ИСПОЛЬЗУЕТСЯ!!! *)
  nX,nY    : integer; (* размер карты          *)
  aMask    : TAMask;  (* aMask ~ FO.aData      *)
  kLoad    : integer; (* =0 когда aMask не заполнена *)
end;
(*----------------------------------------------------------------------------*)

(* делаем для всех FIOut-ов размер данных REAL4 *)
(* используем как для наших расчитанных данных   *)
(* так и для загруженных из инверсии             *)

(*---------------------------------------------------------------*)
(* экземпляр выгружаемой карты  FO : TFIOut                      *)
(*   после 2021_11 перенесли FIOut из LFITS в список LFIOut      *)
(*   тип FIOut описывает ТОЛЬКО карты и имеет всегда один размер *)
(* объекты FO рождаются несколькими путями:                      *)
(*   1. При чтении из файлов ME и SW                             *)
(*   2. В процедурах Init, которые запускаются перед расчётом    *)
(*        у с т а р е л о :                                      *)
(*   3. В процедурах операций с картами как с переменными        *)
(* в третьем случае карты попадают в список LFIOtmp              *)
(*---------------------------------------------------------------*)


TFIOut = Class(TObject)
  kRun     : Cardinal; (* = $A5A55A5A *)
  Owner    : TObject; (* ссылка на свой TLFITS *)
                      (* позволяет извлечь данные из хидеров *)
                      (* сырых FITS                          *)
  sVar     : string;  (* временное 1 или 2 символьное имя карты *)
(*sId      : string;   =  Name+'|'+Dt+'_'+sTi  *)
  Name     : string;  (* назначение данных *)
  IH       : integer; (* индекс заголовка в файле (или 0) *)
  chN      : char;    (* "псевдоним" сеанса, к которому относится карта *)
                      (* поле УСТАРЕЛО, можно подставлять любой символ  *)
  sDt      : string;  (* '20191109' дата сеанса *)
  sTi      : string;  (* '1334'    время сеанса *)

  Comment  : string;  (* описание данных   *)
  Alg_Ver  : string;  (* версия алгоритма вычисления данных *)
//sDtTi    : string;  (* '20191109_1334' идентификатор сеанса *)
//sY_M     : string;  (* '2019_11' ид.года_месяца *)
//sFN      : string;  (* имя выходного файла получаем у Owner-а *)
  HSL      : TStringList; (* строки хидера *)

  (* если карта прочитана из файла *)
  (* то значение nb0 > 0, так как nb0=0 для ОБЩЕГО хидера *)
  (* если nb0 = 0 и (kLoad and $04) = IsBit(kLoad,2), это *)
  (* значит, что карту нужно сохранить и отвести для неё  *)
  (* место в файле (в его конце)                          *)

  nb0      : integer; (* позиция начала карты (её заголовка) *)
  nbHead   : integer; (* число байт под заголовок с учётом пустого места *)
  nbData0  : integer; (* позиция начала блока данных в файле *)
  nbData   : integer; (* объём данных в карте *)

  kSoft    : integer; (* 1/2/3 SunWorld/Merlin/TempData *)
                      (* версия FIOut                  *)
                      (*   версия этой программы (SunWorld) *)
                      (*   версия ME инверсии HINODE        *)
                      (*   другие данные                    *)
  nX,nY    : integer; (* размер карты                       *)

  (*--------------------------*)

    (* перенести в TFIPOut ? *)

  (*---------------------------*)
  (*     для работы с картой   *)


  rMin  : real;  (* крайние значения   *)
  rMax  : real;  (* элементов карты    *)
  rMean : real;  (* и среднее значение *)

  rMinAv  : real;  (* крайние значения после применения текущего фильтра *)
  rMaxAv  : real;  (* для элементов карты *)
  rMeanAv : real;  (* и среднее значение  *)

  rMaxAv3 : real;  (* Max для фильтра + значения в X-1,X+1 НЕ МАЛЫ! *)
  jXMa3,jYMa3 : integer; (* индексы крайних значений                *)




//ALvl  : TARe;  (* массив из 256 (512) уровней для раскраски карты *)

//rPmi  : real;  (* границы для масштабирования = Pict.dMi *)
//rPma  : real;  (* яркостей карты              = Pict.dMa *)

  chScale : char; (* режим отображения *)
                  (* N,E,L,H = Norm/Exp/Log/EqHist *)

  iXMi,iYMi,iXMa,iYMa : integer; (* индексы крайних значений                *)
  jXMi,jYMi,jXMa,jYMa : integer; (* индексы крайних значений в зоне фильтра *)
  iXFocus,iYFocus     : integer; (* точка проекции мыши на карту            *)




  (*--------------------------*)

  aData    : TAR4R4;
//qLoad    : boolean;  (* данные загружены *)
  kLoad    : integer;  (* 0/1/2/4/8
                             буфер свободен/
                        0 1  память выделена/
                        1 2  данные загружены/
                        2 4  данные рассчитаны (требуется сохранить)/
                        3 8  данные получены как производные от других
                       *)
  qTmp     : boolean;  (* карта временной переменной *)
                       (* размещается в LFIOtmp      *)

                                                            (*~~~~ TFIOut ~~~~*)

  (*-------------------------------*)
  (* управление отображением карты *)
  (*-------------------------------*)
  qHist    : boolean;  (* масштабировать на 0 255 по гистогамме? *)
  Pict     : TR4Pict;  (* Объект К А Р Т И Н К А , сделанная из TAR4R4 данных *)



//function Value(iX,iY) =  Self.aData[iX,iY]

constructor Create;
function QRun:boolean;

{
procedure Link(Nam0:string;k0:integer;anOwner:TObject);      overload;
procedure Link(Nam0,Com0:string;k0:integer;anOwner:TObject); overload;
procedure Link(Nam0,Com0:string;k0,nX0,nY0:integer;anOwner:TObject); overload;
procedure Link(Nam0,Com0,Ver:string;k0,nX0,nY0:integer;anOwner:TObject);
                                                                     overload;
}
procedure AssignMem(nx0,ny0:integer);
function sFn:string; (* имя файла ME или SW, который содержит карту *)
function sFOId:string;
function sY_M:string;
function s15:string;
function s13:string;
function s11:string;

procedure Done;
procedure ClearData;  (* сворачиваем крату, оставляеи толоько заголовок *)

procedure Save;                (* недописано 2021.11 *)
procedure Save2;
procedure LoadData(sFN:string;nb0:integer);

(* Fuse использовался на интерфейсной странице Start, он сейчас устарел *)
procedure Fuse(A,B:TFIOut;ChOp:char);

(* проверяем признак наличия данных в карте, если их нет *)
(* объявляем об ошибке и месте вызова                    *)
(* sFunc - место вызова проверки                         *)
function QLoad(sFunc:string;R:real):boolean; overload;
function QLoad(sFunc:string):boolean;        overload;


(* УНАРНЫЕ ОПЕРАЦИИ *)                                      (*~~~~ TFIOut ~~~~*)
(* используются на интерфейсной странице Start *)

procedure Mul(k:real);
procedure Log;
procedure Neg;
procedure Inv;
procedure Abs;


function CheckFill:boolean;                                 (*~~~~ TFIOut ~~~~*)
function CheckLoad:boolean;    (* CheckFill + LoadData *)
function RepMem:string;

procedure SetHSL(SrcSL:TStringList;ls0,ls1:integer);(*создаём HeaderStringList*)

procedure SWOUTHeader;      (* сформировать Хидер HSL *)

procedure LoadHeader(var NN1024:integer);
procedure UpDate; (* сводные хар-ки карты вывести на контролы *)
procedure SetFocusPoint;

(* Клонирование ЧАСТИ данных ради создания производной переменной *)
function Clone:TFIOut;
procedure CloneFrom(FO:TFIOut);


//procedure ReturnALvl(ALvl0:TAR4);


procedure MinMaxMean;
procedure FilteredMinMax;                 overload;
procedure FilteredMinMax(aMask:TAMask);   overload;
procedure MaskMax_Y3(aMask:TAMask;R3:real);


function AMeanX:TARe;
function AMeanY:TARe;
procedure MaskedMeanX(aMask:TAMask;var AiY,AX:TARe);
procedure MaskedMeanY(aMask:TAMask;var AiX,AY:TARe);
procedure MaskedMeanYt(aMask:TAMask;var AtX,AY:TARe);
procedure MaskedMeanYvO(aMask:TAMask;var AvOX,AY:TARe);
procedure MaskedMeanYK(aMask:TAMask;sKey:string;var AkX,AY:TARe);


procedure PictOff;
procedure PictOn;
procedure PictLinScale(nVal:integer;kMi0,kMa0:real);  (* 0,1  0.05,0.95 и т.п. *)
function MakeBitMap:boolean; (* [создаёт]+очищает BMP *)
procedure ShowData;
procedure ShowMask(aMask:TAMask);
function CheckForShow:boolean;




end; (* TFIOut *)
(*--------------------------------------------------------------------------*)

Type

  TAFOAny = array [1..mFine] of array [1..2] of TFIOut; // mFine=23
  TAFOErr = array [1..mFOE] of TFIOut;

(* УНАРНЫЕ ОПЕРАЦИИ *)

function fAbs(FI:TFIOut):TFIOut;
function fNeg(FI:TFIOut):TFIOut;
function fInv(FI:TFIOut):TFIOut;
function fLog(FI:TFIOut):TFIOut;
function fExp10(FI:TFIOut):TFIOut;
function fSig(FI:TFIOut):TFIOut;
function fSin(FI:TFIOut):TFIOut;
function fCos(FI:TFIOut):TFIOut;
function fSq (FI:TFIOut):TFIOut;
function fSqrt(FI:TFIOut):TFIOut;



(* ОПЕРАЦИИ С КОНСТАНТОЙ *)

function fMul(FI:TFIOut;k:real):TFIOut; overload;
function fRat(FI:TFIOut;k:real):TFIOut; overload;
function fAdd(FI:TFIOut;k:real):TFIOut; overload;
function fSub(FI:TFIOut;k:real):TFIOut; overload;


(* БИНАРНЫЕ ОПЕРАЦИИ *)
function fSub(FI1,FI2:TFIOut):TFIOut;  overload;

function fMid(FI1,FI2:TFIOut):TFIOut;  overload;
function fRat(FI1,FI2:TFIOut):TFIOut;  overload;
function fMul(FI1,FI2:TFIOut):TFIOut;  overload;
function fAdd(FI1,FI2:TFIOut):TFIOut;  overload;

(* БИНАРНЫЕ ОПЕРАЦИИ с параметром *)

function fCircSub(FI1,FI2:TFIOut;k:real):TFIOut;  //overload;


(* ОПЕРАЦИИ С тремя и четырьмя КАРТАМИ *)

function fMid(FI1,FI2,FI3:TFIOut):TFIOut;  overload;
function fMid(FI1,FI2,FI3,FI4:TFIOut):TFIOut;  overload;

(* универсальная бинарная операция *)
function fAny2(sFun,sV1,sV2:string):TFIOut;
(* универсальная операция с константой *)
function fAnyConst(sFun,sV1:string;k:real):TFIOut;

(* универсальная унарная операция *)
function fAny1(sFun,sV1:string):TFIOut;

function FIOutAny1(sFun:string;FI1:TFIOut):TFIOut;
function FIOutAny2(sFun:string;FI1,FI2:TFIOut):TFIOut;
function FIOutAnyC(sFun:string;FI1:TFIOut;k:real):TFIOut;
function FIOutAny2C(sFun:string;FI1,FI2:TFIOut;k:real):TFIOut;


(* извлечь "имя карты" из списка LFOP при известном значении iLFOP *)
function Get_sMap(var i,n:integer):string; overload;
function Get_sMap:string; overload;

(* вставить имя карты в LFOP (либо поменять iLFOP в соотв.с именем карты *)
procedure MapToLFOP(s:string);


(* получить карту по назначенному id из одного из двух списков *)
(*  - списку LFIO либо списку LFIOtmp (полученному из Memo)    *)
function FObysVar(sV:string):TFIOut;
(* получить список карт для всех сеансов по назначенному       *)
(* первому символу id из одного из двух списков                *)
(*  - списку LFIO либо списку LFIOtmp (полученному из Memo)    *)
function LFObychVar(chV:char):TList;

function LFO_by_Na(sNa:string):TList;
function LSes_by_Na(sNa:string):TStringList;








Type

TFITOutABisec = array [1..mBisec] of TFIOut; (* mBisec сейчас = 9 *)


(*=============================================*)
(*       Список карт, загруженных в память     *)
(* Это могут быть карты типов ME,SW и M2       *)
(*                                             *)
(* карты могут принадлежать разным сессиям     *)
(* за разное время (и, теоретически, дату)     *)
(*                                             *)
(* поэтому операции с картами требуют указания *)
(* sDt,sTi, а также sNam                       *)
(* параметр kSoft выбирает между SW,ME и M2    *)




TLFIOut = Class(TList)   (* List LFIO содержит элементы типа TFIOut *)
//sDBPath : string;
  HswSL   : TStringList; (* входной Хидер файлов SunWorld *)
  HmeSL   : TStringList; (* входной Хидер файлов MilnEdd  *)
  Hm2SL   : TStringList; (* входной Хидер файлов ME Level 2.1 *)

  (* список LFIO может содержать карты разных сеансов                        *)
  (* предполагается, что все 3 головных Header-а относятся к текущему сеансу *)


(* присоединение карты *)
(* либо присоединяем карту, которая уже есть в LFIO *)
(* либо создаём новый пустой экз-р, и тогда вносим в него параметры *)
function Link(sDtTi0,sNam,sCom,sVer:string;
              k0,nX,nY:integer;anOwner:TObject):TFIOut;

function GetChN:char;  (* из текущ.строки интерфейсного элемента *)


function GetFIOut(sDt0,sTi0,sNam,sVer:string):pointer; overload;
function GetFIOut(sDt0,sTi0,sNam:string):pointer;      overload;
function GetFIOut(sDaTi,sNam:string):pointer;          overload;
(* начинаем не с первой строки *)
function GetFIOut(sNam:string;I0:integer;var I1:integer):pointer; overload;
function GetFIOut(sId:string):pointer; overload;

function GetFOIdx(FO:TFIOut):integer;
procedure DeleteFO(FO:TFIOut);

function swHdVar(sN:string):real;


function GetFIOutI(sDt0,sTi0,sNam,sVer:string):integer; (* индекс в LFIO *)

function LoadSW(ChN0:char;sDt0,sTi0:string):boolean;  overload;
function LoadME(ChN0:char;sDt0,sTi0:string):boolean;  overload;
function LoadM2(ChN0:char;sDt0,sTi0:string):boolean;  overload;

function LoadSW(sDt0,sTi0:string):boolean;  overload;
function LoadSW(ChN0:char;sDt0,sTi0:string;
                 SLN:TStringList;QAll:boolean):boolean;  overload;
function LoadSW(sDt0,sTi0:string;
                 SLN:TStringList;QAll:boolean):boolean;  overload;

function LoadME(ChN0:char;sDt0,sTi0:string;
                 SLN:TStringList;QAll:boolean):boolean;  overload;
function LoadME(sDt0,sTi0:string;
                 SLN:TStringList;QAll:boolean):boolean;  overload;

function LoadM2(ChN0:char;sDt0,sTi0:string;
                 SLN:TStringList;QAll:boolean):boolean;  overload;
function LoadM2(sDt0,sTi0:string;
                 SLN:TStringList;QAll:boolean):boolean;  overload;




function Load(kSoft0:integer;chN0:char;sDt0,sTi0:string):boolean; overload;
function Load(kSoft0:integer;chN0:char;
               sDt0,sTi0:string;SLN:TStringList;QAll:boolean):boolean;overload;



function Load(kSoft0:integer;sDt0,sTi0:string):boolean;               overload;
function Load(kSoft0:integer;
               sDt0,sTi0:string;SLN:TStringList;QAll:boolean):boolean;overload;
function Load(kSoft0:integer;
               sDt0,sTi0:string;SLN:TStringList)             :boolean;overload;



function Load(kSoft0:integer;sDt0,sTi0,sN0:string):boolean; overload;
function Load(sDt0,sTi0,sN0:string):boolean;                overload;

procedure UpDate;
procedure ClearOneSession(ChN0:char);
procedure ClearAll;
function QOneSession:boolean;

function RepSL:TStringList;

(* добавить строку статистики к большому хидеру *)
procedure HSLAddStat(var HswSL:TStringList;
                             var NNN,nbH0,nbHead1,NN,NN1024;
                             KH:integer;
                             FO:TFIOut);


(* найти FO в списке "нужных" файлов, вернуть номер или -1 *)
function ListedFO(FO:TFIOut;SLN:TStringList):integer;


(* прочитать из SW/ME - FITS файла хидер ОЧЕРЕДНОЙ карты *)
(* создать из этого хидера карту FO                      *)
(* дополнить БОЛЬШОЙ ХИДЕР NmapSL                        *)
(* передать дальше следующую позицию в FITS файле NN1024 *)
procedure FITS2FO(var KH:integer;var FO:TFIOut;
                         var HmapSL:TStringList;
                         kSoft0:integer;
                         sDt0,sTi0,sB40,sB80:string;
                         var NN1024:integer);

procedure ReFineList; (* очистить список уже от выгруженных карт *)



function HmapSLDefine(kSoft:integer):TStringList;

end; (* TLFIOut *)


(* элемент таблицы выходных карт (с "расписанием" порядка их расчёта) *)
TPFIShed = ^TFIShed;
TFIShed = Class(TObject)
  Nam : string;  (* имя физического параметра - как в строке Header-а *)
  Com : string;  (* комментарий из строки хидера                      *)
  Ver : string;  (* строка версии *)
  Up  : TPFIShed;(* параметр предыдущего уровня, от которого зависит текущий *)

procedure Link(Na0,Co0,Ve0:string;FI0:TPFIShed);


end; (* TFIShed *)

TLFIShed = Class(TList)

procedure FillSWOrder_1;
procedure FillSWOrder_2;
procedure FillSWOrder_bi;

end; (* TLFIShed *)



(*============================================*)
(* набор FITS-ов для одной серии наблюдений   *)
(* = все FITS - файлы одного сеанса           *)
(* включает в себя интегральные карты TFIOut  *)
(*============================================*)

TLFITS = Class(TList)
  kRun  : cardinal;   (* индикатор "включенности"   *)
  FMap  : TForm;  (* ссылка на форму отрисовки карт *)
  FOwner: TForm;  (* ссылка на форму SunWorld       *)
//Shad  : TBitMap;(* место для картинки, к-рую рисуют экземпляры TFIOut *)
//qPict : boolean;(* оставлять ли место для данных картинки FIOut       *)

  SLOut : TStrings; (* ссылка на Memo.Lines для отладки *)
  QDebug: boolean;  (* для включения Dbg WarnMes -ов    *)



  sPath : string; (* путь папки сырых FITS, например, 20190622_164505 *)
  sPOut : string; (* путь папки с выходными FITS-ами: 20190622_1645   *)

  Dir   : TDirList;(* "коллекция файлов" сырых FITS       *)
  kDir  : integer; (* коллекция файлов загружена kDir = 1 *)
//  sFN   : string;(* имя выходного файла - совпадает с именем выходной папки *)
  sFSW  : string; (* имя выходного файла - совпадает с именем выходной папки *)
  sFME  : string; (* имя вых.файла команды HINODE - с МЕ инверсией *)
  sFM2  : string; (* имя второго вых.файла команды HINODE          *)

  sDtTi : string; (* 20191109_134405 !!! ИДЕНТИФИКАТОР ТЕК.СЕССИИ !!!*)


  chDat : char;   (* одновременно LFITS содержит только одну сессеию *)
                  (* ей приписан текущий индекс сессии chDt          *)
                  (* эквивалентен TFIOut.chN                         *)
  QSW   : boolean;(* SWFITS файл уже существует *)

                  (* 0 1 2 3 *)
  KStep : word;   (* 1/2/4/8 = Link/Header/LoadData/FillAReRe         *)
                  (* Link     = назначно имя                          *)
                  (* Header   = прочитаны хидеры FITS файлов уровня 1 *)
                  (* LoadData = прочитаны массивы данных aFITS        *)
                  (* FillAReRe= заполнены интегральные массивы LFITS  *)

  QLight   : boolean;(* "лёгкий" вариант - данные aFITS не храним     *)
  QRowData : boolean;(* данные только что загружены из FITS файлов    *)
  QCalcCont: boolean;(* мы внутри процедуры расчёта CONT              *)

  (*-------------------------------------------*)              (*=== LFITS ===*)
  (* глобальные переменные для анализа Хидеров *)

  nsHead   : integer;(* число строк в хидере = HSL.Count *)
  nlHead   : integer;(* размер места под хидер в строках *)
  nbHead   : integer;(* размер хидера в байтах *)
  nData    : integer;(* размер данных (одной записи) в nBITPIX-битных числах *)
  nbData   : integer;(* размер данных (одной записи) в байтах *)

  nData_s  : longint; (* суммарный размер данных в байтах *)
  nHead_s  : longint; (* суммарный размер строк заголовков в байтах *)

  (*--------------------------------------------*)             (*=== LFITS ===*)
  (* варианты Хидеров                           *)

  HSL      : TStringList; (* выходной Хидер 0-вой Хидер SWFits *)
  HmeSL    : TStringList; (* последовательность хидеров meINV файла *)
  Hm2SL    : TStringList; (* последовательность хидеров me.V2.1 файла *)
  HswSL    : TStringList; (* входной Хидер файлов SunWorld *)


  (*--------------------------------------------*)             (*=== LFITS ===*)
  (* для задания положений границ линий         *)
{
  il1,il2 : integer;
  il3,il4 : integer;
  il5,il6 : integer;
}

  (*-----------------------------------------------------*)
  (*                                                     *)
  (* определение вектора длин волн из данных сырого FITS *)
  (*                                                     *)
  (*-----------------------------------------------------*)

  (*---- данные можно получить из любого "сырого" FITS-а *)
  rLamIdx0 : real; (* CRPIX1 = 56.5 индекс точки привязки профиля *)
  rdLam    : real; (* CDELT1 = 0.021549 дисперсия A/пиксель *)
  rLa00    : real; (* CRVAL1 = 6302.080 дл.волны точки привязки профиля *)

  (*---- коррекция данных из сырого FITS ----------------*)
  (* иногда встречаются наблюдения, в которых в FITS указано обратное *)
  (* направление дисперсии (rdLam < 0 и rLam0=6302.00), но на самом   *)
  (* деле это ошибка и реальные параметры rdLam > 0 и rLam0=6302.08   *)
  (*   Для проверки заводим следующий ключ                            *)
  kLamChk  : integer;(* 0/1/2 надо_проверить/меняем_знак_rdLam/всё_OK *)

  ALam : TARe;       (*     вектор длин волн по точкам измерения NLam *)

  (*                                                     *)
  (*-----------------------------------------------------*)



  (*--------------------------------------------------------*) (*=== LFITS ===*)
  (*   ЭТО ВСЁ МОЖНО "стырить" из данных MERLIN             *)
  (* экспозиция *)
  rExpTime : real; (* HD EXPTIME *)
  (* координаты центра области на Солнце в угловых секундах *)
  xCenME : real;   (* HD XCEN *)
  yCen   : real;   (* HD YCEN *)
  (* радиус Солнца в угловых секундах *)
  R_Sun  : real;   (* HD SOLAR_RA *)
  (* угловых секунд на пиксель *)
  xScale : real;   (* HD XSCALE *)
  yScale : real;   (* HD YSCALE *)
  (* время начала/конца измерения *)
  sTStart: string; (* HD TSTART *)
  sTEnd  : string; (* HD TEND   *)
  (* ещё что-то (углы между гелиоцентрич.сист.коорд. и осями X и Y SOT/SP) *)
  p_Angle: real;   (* HD P_ANGLE *)
  b_Angle: real;   (* HD B_ANGLE *)


  (*------ интегральные величины ---------*)                   (*=== LFITS ===*)

  (* для контроля за возможным различием единиц измерения I и QUV *)
  iIMax : integer; (* HD ICNT_MA  макс.знач.инт-ти в отсчётах *)
  iIMin : integer; (* HD ICNT_MI  мин. знач.инт-ти в отсчётах *)
  iVMax : integer; (* HD IVABS_MA макс.знач.V-параметра в отсчётах *)
  AbsVIMax : real; (* HD VIABS_MA   = (V/CONT) Max            *)

  tMin0 : real; (* время начала сессии в минутах от начала суток *)
  tDura : real; (* продолжительность сессии в минутах *)
  tDay  : real; (* момент середины сессии в долях текущих суток *)
  Ts_1,Ts_2,Ts_3,Ts_4,Ts_5,Ts_6 : real; (* средние за время сесии температуры *)

  dVlosMi : real;  (* минимальное  значение DOP_RCV *)
  dVlosMa : real;  (* максимальное значение DOP_RCV *)
  tdVMi   : real;  (* время в минутах от начала сеанса минимума  dVlos *)
  tdVMa   : real;  (* время в минутах от начала сеанса максимума dVlos *)
                   (* tvVMi/Ma могут быть равны 0 и tDura, т.е.ложными *)


  rCntMH0 : real; (* HD CNT_H0 ср.знач.непр.спектра в немаг.обл.в ед.шкалы изм*)
  kCnt    : real; (* HD K_CONT коэф-т, к-рый приводит ср.знач.Cont к единице *)
                  (*     пока не используется                                *)

  ACnYH0  : TARe; (* массив значений rCntYH0 вдоль щели (вдоль оси Y)        *)
  ACnXH0  : TARe; (* массив значений rCntXH0 вдоль оси X                     *)
//AXP     : TAIn; (* от 1 массив SLITPOS вдоль оси X                         *)
  AXX     : TARe; (* от 1 массив координаты X (arcsec) вдоль оси X           *)
  AXT     : TARe; (* массив времен начала экспозиции в мин. от начала сеанса *)
  AXvO    : TARe; (* массив поправки за орбитальную скорость *)

  (*==== коэф-ты линейной регрессии изменения яркости вдоль осей Y и X ======*)
  rCntYA  : real; (* HD CNTH0_AY *)
  rCntYB  : real; (* HD CNTH0_BY  rCnt := rCntYA*iY      + rCntYB *)
  rCntXA  : real; (* HD CNTH0_AX *)
  rCntXB  : real; (* HD CNTH0_BX  rCnt := rCntXA*AXP[iY] + rCntXB *)


  (*-- рассчитывается внутри BigCalc2 --*)                     (*=== LFITS ===*)
  Gc1     : real; (* HD GC_1  среднее полож.цетнра тяжести 6301 в пикселах *)
  Gc2     : real; (* HD GC_2  среднее полож.цетнра тяжести 6302 в пикселах *)

  rLC1M   : real; (* HD LC_1 полож.ц.тяж. 6301 среднее по всей карте в ангстр.*)
  rLC2M   : real; (* HD LC_2 полож.ц.тяж. 6302 среднее по всей карте в ангстр.*)

  rLC51   : real; (* оценка rGC по центральному FITS для 6301 в пикселах *)
  rLC52   : real; (* оценка rGC по центральному FITS для 6302 в пикселах *)

  rVW1_0  : real; (* HD VW1 смещение нуля для 6301 (км/с) *)
  rVW2_0  : real; (* HD VW2 смещение нуля для 6302 (км/с) *)
  rCB0    : real; (* HD CB0 средняя интенсивность немагнитного континуума *)

  HNMa    : real; (* HD HL_N_MA макс.значение продольн.поля N - полярности *)
  HSMa    : real; (* HD HL_S_MA макс.значение продольн.поля S - полярности *)
  VRMa    : real; (* HD VL_R_MA макс.значение V_Los, направл.к наблюдателю *)
  VBMa    : real; (* HD VL_B_MA макс.знач.V_Los, от наблюдателя (6302+6301)/2 *)

//iCntMa  : integer;
//iCntMi  : integer;

  rCntMa  : real;  (* HD CNT_MA вычисляется внутри  BigCalc2 *)(*=== LFITS ===*)
  rCntMi  : real;  (* HD CNT_MI *)


  (* индексы точек *)

  iXHN    : integer; (* HD HLNMA_IX *)
  iYHN    : integer; (* HD HLNMA_IY *)
  iXHS    : integer; (* HD HLSMA_IX *)
  iYHS    : integer; (* HD HLSMA_IY *)

  iXVR    : integer; (* HD VLRMA_IX *)
  iYVR    : integer; (* HD VLRMA_IY *)
  iXVB    : integer; (* HD VLBMA_IX *)
  iYVB    : integer; (* HD VLBMA_IY *)

  iXCA    : integer; (* HD CMTMA_IX *)
  iYCA    : integer; (* HD CMTMA_IY *)
  iXCI    : integer; (* HD CMTMI_IX *)
  iYCI    : integer; (* HD CMTMI_IY *)


  (*-- "уточненные" длины волн 6301.500, 6302.493 и 6302.050 --  === LFITS ===*)

  rLa1    : real;
  rLa2    : real;
  rLa3    : real;

  (*----------------------------------------------------------------------*)
  (* интегральные для сессии значения, которые определяют положение линий *)


{
  boundL  : TrBounds3; (* граничные точки линий в виде смещений в ангстремах *)
  boundC  : TrBounds3; (* гран.точки опред.ур-ня конт.относ. (rLa1+rLa2)/2   *)
}


  dl6301  : real; (* HD DL6301  расстояние границы линии от её центра в mA *)
  dl6302  : real; (* HD DL6302    заданное вручную принудительно           *)



  (*------------------------------------------------------------------------*)
  (*    параметры для расчёта уровня континуума без учёта линий             *)


  kRC : real; (* величина порядка 1 (0.95-1.05) коррекция уровня континуума *)
              (* можем задавать из формы *)
     (* а может, будем рассчитывать автоматически, подбирая эту величину     *)
     (* до совпадения экв.ширин или напряженностей, найденных 2-мя способами *)

     (* kRC "работает" после, поверх загруженных aFITS.rCnt !!!! *)

  kRC0 : real; (* создадим kRC0, которая будет применяться *)
               (* на этапе создания aFITS.rCnt             *)



  lsmooth  : real;    (* ширина сглаж-я для расчёта CONT ~ 90 mA *)
//iXCur    : integer; (* текущий индекс iX, чтобы его знал aFITS *)


  (*-------------------------------------*)                    (*=== LFITS ===*)
  (* здесь использование массивов TAReRe *)
  (* нестандартно для системы SunWorld,  *)
  (* а именно, счёт элеиментов начина-   *)
  (* ется с нуля, а не с единицы!!!      *)

  nX,nY : integer; (* HD NAXIS1, NAXIS2 *)
  nXP   : integer; (* HD NSLITPOS *)

  aFilt : TAInIn; (* "маска" карты; если aFilt[ix,iy] = 0 эл-т не учитывается *)

  (*--- Для данных MERLIN-инверсии ---*)                       (*=== LFITS ===*)

  MeH     : TFIOut; (* Field_Strength *)
  MeGM    : TFIOut; (* Field_Inclination *)

  MeHL    : TFIOut; (* Longitudinal Field (производная величина) *)

  MeX     : TFIOut; (* X_Coordinate *)
  MeY     : TFIOut; (* Y_Coordinate *)

(*------------ используются в отчёте о ME ----------*)
{
  MeCI    : TFIOut; (* Continuum_Intensity *)
  MeCIO   : TFIOut; (* Original_Continuum_Intensity *)
  MeQUV   : TFIOut; (* Polarization *)
  MeXI    : TFIOut; (* Field_Azimuth *)
  MeVLo1  : TFIOut; (* Doppler_Shift1 *)
  MeVLo2  : TFIOut; (* Doppler_Shift2 *)
  MeLiSt  : TFIOut; (* Line_Strength  *)
  MeA     : TFIOut; (* Damping *)
  MeWD    : TFIOut; (* Doppler_Width *)
  MeVma   : TFIOut; (* Macro_Turbulence *)

  MeB0    : TFIOut; (* Source_Function  *)
  MeBeta  : TFIOut; (* Source_Function_Gradient *)

}
  (*--------------------------------------------------------------------*)
  (* с момента 2022_02 LFITS будет держать нужные ему карты             *)
  (* не в своём теле, а искать их в таблице LFIO                        *)
  (*--------------------------------------------------------------------*)

//OuCnt105: TFIOut; (* для перерасчёта Cont в единицах шкалы измерений *)


  OuAny1  : TFIOut; (* универсальная карта FO1 для расчёта 1*)
  OuAny2  : TFIOut; (* универсальная карта FO2 для расчёта *)
  OuAny3  : TFIOut; (* универсальная карта FO1 для расчёта 2*)
  OuAny4  : TFIOut; (* универсальная карта FO2 для расчёта *)
  OuAny5  : TFIOut; (* универсальная карта FO1 для расчёта 3*)
  OuAny6  : TFIOut; (* универсальная карта FO2 для расчёта *)
  OuAny7  : TFIOut; (* универсальная карта FO1 для расчёта 4*)
  OuAny8  : TFIOut; (* универсальная карта FO2 для расчёта *)
{
  OuAny9  : TFIOut; (* универсальная карта FO1 для расчёта 5*)
  ...........................................................
  OuAnyQ  : TFIOut; (* универсальная карта FO2 для расчёта *)
}
  OuAny   : TAFOAny; (* array [1..mFine] of array [1..2] of TFIOut //mFine=23 *)
  OuErr   : TAFOErr; (* array [1..mFine] of array [1..2] of TFIOut *)

  OuCB0   : TFIOut;


  (*--- Для первого прохода ---*)
  OuCont  : TFIOut; (* в единицах шкалы измерений *)
  OuCont2 : TFIOut; (* в единицах шкалы измерений *)

  OuGc1   : TFIOut; (* в пикселах  полож.центра тяжести *)
  OuGc2   : TFIOut; (* в пикселах *)
//OuSI    : TFIOut; (* не обязательно заполнять, тип DWORD *)
//OuSVA   : TFIOut; (* не обязательно заполнять, тип DWORD *)
  OuKVI   : TFIOut; (* индекс "магнитности" - отношение |Wv|/Wi *)
//OuII0   : TFIOut; (* в пикселах *)
//OuVV0   : TFIOut; (* в пикселах *)
  OuW1    : TFIOut;
  OuW2    : TFIOut;
//OuW3    : TFIOut; (* не обязательна *)
//OumV1   : TFIOut; (* ненормир.момент, не обязательно заполнять *)
//OumV2   : TFIOut; (* ненормир.момент, не обязательно заполнять *)
  OuH1    : TFIOut; (* значения H, рассчитанные с помощью Mv *)
  OuH2    : TFIOut;

  OuHG1   : TFIOut; (* значения H, рассчитанные методом COG  *)
  OuHG2   : TFIOut;


  Ou_d01  : TFIOut; (* глубина линии в пикселах (не в процентах к OuCont) *)
  Ou_d02  : TFIOut;
  Ou_c01  : TFIOut; (* в пикселах  полож.вершины линии *)
  Ou_c02  : TFIOut; (* в пикселах *)


  (* "главная" точка - это Ou35XY[3] *)                        (*=== LFITS ===*)
  Ou35C1  : array [3..5] of TFIOut; (* V_los (км/с) *)
  Ou35C2  : array [3..5] of TFIOut;
  Ou35I1  : array [3..5] of TFIOut; (* центральные глубины в % *)
  Ou35I2  : array [3..5] of TFIOut;
  Ou35D1  : array [3..5] of TFIOut; (* DLD в mA *)
  Ou35D2  : array [3..5] of TFIOut;

  OuBiC1  : array [1..MBiSec] of TFIOut;
  OuBiC2  : array [1..MBiSec] of TFIOut;
  OuBiW1  : array [1..MBiSec] of TFIOut;
  OuBiW2  : array [1..MBiSec] of TFIOut;




  (*--- после расчёта интегральных величин ---*)               (*=== LFITS ===*)
  OuCnt   : TFIOut; (* нормированный на средн.знач.в немагн.областях *)
//OuCnm   : TFIOut; (* CONT нормированный и исправленный к краю *)
  OuVc1   : TFIOut; (* положение центра, относительное в км/с OuGc => OuVc *)
  OuVc2   : TFIOut; (* положение центра, относительное в км/с *)

  Ou_dV   : TFIOut; (* карта поправки лучевой скорости *)


  OuGa18   : TFIOut; (* к-т регресси a по 8 точкам для 6301 *)
  OuGa16   : TFIOut;
  OuGa141  : TFIOut;
  OuGa142  : TFIOut;
  OuGb18   : TFIOut;
  OuGb16   : TFIOut;
  OuGb141  : TFIOut;
  OuGb142  : TFIOut; (* к-т регресси b по второй четвёрке точек *)
  OuGa28   : TFIOut; (* к-т регресси a по 8 точкам для 6302 *)
  OuGa26   : TFIOut;
  OuGa241  : TFIOut;
  OuGa242  : TFIOut;
  OuGb28   : TFIOut;
  OuGb26   : TFIOut;
  OuGb241  : TFIOut;
  OuGb242  : TFIOut; (* к-т регресси b по второй четвёрке точек *)

  OuGD18   : TFIOut; (* допплеровская полуширина *)
  OuGD16   : TFIOut;
  OuGD141  : TFIOut;
  OuGD142  : TFIOut;
  OuGD28   : TFIOut; (* допплеровская полуширина *)
  OuGD26   : TFIOut;
  OuGD241  : TFIOut;
  OuGD242  : TFIOut;

  OuG1d0   : TFIOut;   (* => OuGDLDk *)
  OuG2d0   : TFIOut;   (* => OuGDLDk *)
  OuG1Dk   : TFIOut;   (* => OuGDLDk *)
  OuG2Dk   : TFIOut;   (* => OuGDLDk *)
  OuG1D    : TFIOut;   (* => OuGDLD  *)
  OuG2D    : TFIOut;   (* => OuGDLD  *)

  OuGL16   : TFIOUT;   (* Lam0 для 6 точек для линии 6301 *)
  OuGL14   : TFIOUT;
  OuGL26   : TFIOUT;
  OuGL24   : TFIOUT;
  OuGL10   : TFIOUT;   (* дл.волны вершины *)
  OuGL20   : TFIOUT;   (* дл.волны вершины *)
  OuGL1    : TFIOUT;   (* gs.Lam0 *)
  OuGL2    : TFIOUT;   (*         *)

(*============================================================================*)
(*                                                                            *)
(*                                                                            *)
(*===                                LFITS                                 ===*)
(*                                                                            *)
(*                                                                            *)
(*============================================================================*)


{
function GetProfSum(AIY:TAIn):TA4Re;
function GetContSum(AIY:TAIn):real;
function GetProfNormSum(AIY:TAIn):TA4Re;
}




procedure MakeOutHeader; (* сформировать выходной HSL (нулевого уровня) *)
procedure UpDate; (* выгрузить данные в контролы *)

procedure Link(sPN0:string;FOwner0,Form0:TForm);
procedure SetDeltaRC(d01,d02,akRC,sm:real);
function fNam(iX:integer):string; (* имя входного iX файла *)
procedure LoadHeaders; (* загрузить хидеры "сырых" FITS-ев *)
procedure CollectPath;

function AKey(sKey:string):TARe;


function ItoLamLFI(ILam:real):real;
function ItoV1LFI(ILam:real):real;
function ItoV2LFI(ILam:real):real;


(* для загрузки данных SunWorld *)
function swFITSInit:boolean;
function swCont_KVI_Init:boolean;
function swCnt105_Init:boolean;
function swFilt_Init:boolean;
function swFine_Init:boolean;
function swFine2_Init:boolean;
function swErr_Init:boolean;
function swKVI2_Init:boolean;
function swKVI3_Init:boolean;
function swMV3_Init:boolean;
function swMQ3_Init:boolean;  // не нужная пока!
function swKQI2_Init:boolean;
function swKQI3_Init:boolean;
function swKUI2_Init:boolean;
function swKUI3_Init:boolean;
function swKWI_Init:boolean;
//function swKVQUI_Init(var Ou1,Ou2:TFIOut;sK,sKfine,sKC,sKCfine:string):boolean;
function swKI_Init(var Ou1,Ou2:TFIOut;
                             sN1,sN2,sCom1,sCom2:string):boolean;

function swKVQU_Init(var Ou1,Ou2,Ou3,Ou4:TFIOut;
           sN1,sN2,sN3,sN4,sCom1,sCom2,sCom3,sCom4:string):boolean;

function swA2_Init(var Ou:TAFOAny;
           sLN,sLCom:TStringList;IFO0:integer;sn9:string):boolean;
function swA2_Init1(var Ou:TAFOAny;
           sLN,sLCom:TStringList;IFO0:integer;sn9:string;iLi:integer):boolean;
function swAE_Init(var OuE:TAFOErr;sLN,sLCom:TStringList;s9:string):boolean;


function swK6_Init(var Ou1,Ou2,Ou3,Ou4,Ou5,Ou6:TFIOut;
           sN1,sN2,sN3,sN4,sN5,sN6,
           sCom1,sCom2,sCom3,sCom4,sCom5,sCom6:string):boolean;

function swGaussCore_Init:boolean;
function swGC1_GC2_Init:boolean;
function meH_GM_Init:boolean;
function meXY_Init:boolean;

procedure GaussCore_SetLength;


(* инициируем карты "второго прохода", т.е.после вычисл-я средних CONT и Vlos *)
function swFITSInit2:boolean;
function swVc1_Vc2_Init:boolean;
function swH1_H2_Init:boolean;
function swCnt_Init:boolean;
function swFITSInitBi:boolean;
function sw_dV_Init:boolean;

function OuAny_Init(var FO:TFIOut;sN,sC,sV:string):boolean;
function OuAny_Init0(var FO:TFIOut;sN,sC,sV:string):boolean;
function MeAny_Init(var FO:TFIOut;sN,sC:string):boolean;
function MeAny_Init0(var FO:TFIOut;sN,sC:string):boolean;
function FO_Init(kSoft:integer;var FO:TFIOut;sN,sC,sV:string):boolean;
function FO_Init0(kSoft:integer;var FO:TFIOut;sN,sC,sV:string):boolean;


(* для загрузки данных MERLIN *)
//procedure MeFITSInit;
procedure meHLInit;



//function LoadMEfit:boolean; (* загрузка хидера и данных *)


procedure LoadMEHeader0(var ls1,NAXIS,NN1024:integer);  overload;
procedure LoadMEHeader0; overload;           (* загрузка главного Хидера ME *)
procedure LoadSWHeader0(var ls1,NAXIS,NN1024:integer); overload;
procedure LoadSWHeader0; overload; (* загрузка главного Хидера SW *)

{
procedure LoadM2Header0(var ls1,NAXIS,NN1024:integer);  overload;
procedure LoadM2Header0; overload;           (* загрузка главного Хидера M2 *)
}

function LoadSWFITS:boolean;



procedure BigCalc2;(* получим OuVc1,2, нормир.OuCnt и ряд крайних знач-й *)



function CheckALam(ALam0:TARe):boolean; (* загрузить длины волн в LFITS *)
function CheckNY(nY0:integer):boolean;(* загрузить число точек на щели nY *)
//function CheckNYP(nY0:integer):boolean;(* загрузить NSLITPOS *)
function CheckNXP(nX0:integer):boolean;(* загрузить NSLITPOS *)
function CheckNXY(nX0,nY0:integer):boolean;(* получить nX,nY от ME или SW *)
function CheckExpTime(r0:real):boolean;


procedure CheckDataLength;


(*==================================================*)
(*                                                  *)
(*                                                  *)
(*                                                  *)
(*                                                  *)
(*==================================================*)

procedure LoadRowData;
procedure CalcCont;  (* отдельно рассчитываем OuCnt105      *)
procedure CalcCont0; (* отдельно рассчитываем CONT и LCONT  *)
procedure CalcC50;
procedure CalcLW;
procedure CalcDFull;
procedure CalcDH;  (* расчёт D_tilt, затем H *)
procedure CalcIV_COG;
procedure CalcIV_COG05;
procedure Calc_LIV;
procedure Calc_W_Mom;


procedure Init_Ou_d0(var Q4:boolean);
procedure Ou_d0_Fill(iX,iY:integer;aFITS : TFITS);
procedure Ou_d0_MaxMin;
procedure CalcCxx(d:real);
procedure CalcKVI(kCalcStep:integer); (* отдельно рассчитываем KVI и KVIfine *)
(* расчёт фильтрограммы *)
procedure CalcFilt(var iLi:integer);

procedure CalcCore(FOH:TFIOut);(* вычисляем параметры гауссиан при вершинах линий *)









(*==================================================*)
(*  вывод в SWFITS файл                             *)
(*                                                  *)
(*                                                  *)
(*                                                  *)
(*==================================================*)

procedure MakeSWOutFile; (* пакутный вывод для старой версии расчёта *)
procedure SWHeaderSave;(* создать SWFITS файл и выгрузить в него нулевой хидер*)



procedure RowFITSRun1; (* первый проход загрузки данных в SW-FITS файл *)

(*==================================================*)
(*                                                  *)
(*                                                  *)
(*                                                  *)
(*                                                  *)
(*==================================================*)



function GetFIT_SL(iX,iY:integer;sStokes:string):TStringList;          overload;
function GetFIT_SL(iX,iY:integer;sStokes:string;chI,chL:char):TStringList;
                                                                       overload;

procedure GetFITARe(iX,iY:integer;sStokes:string;var AX,AI,AQ,AU,AV:TARe;
                    var Cont:real);
procedure GetFITARe2(iX,iY:integer;sStokes:string;
                     var AX,AXb,AI,AQ,AU,AV,AP,AD:TARe;
                     var Cont:real);                             overload;
procedure GetFITARe2(iX,iY:integer;sStokes:string;chI,chL:char;
                     rL0 : real; (* сдвиг нуля длин волн *)
                     var AX,AXb,AI,AQ,AU,AV,AP,AD:TARe;
                     var Cont:real);                             overload;



procedure GetFIT9ARe(iX,iY:integer;sStokes:string;
                     var AX,AI,AQ,AU,AV:TARe;var Cont:real);
procedure GetFIT9ARe2(iX,iY:integer;sStokes:string;
                      var AX,AXd,AI,AQ,AU,AV,AP,AD:TARe;var Cont:real);



function GetFITNorm_SL(iX,iY:integer;sStokes:string):TStringList;
procedure GetFITNormARe(iX,iY:integer;sStokes:string;
                        rL0:real;
                        var AX,AI,AQ,AU,AV:TARe);
procedure GetFITNormARe2(iX,iY:integer;sStokes:string;
                        rL0:real;
                        var AX,AXd,AI,AQ,AU,AV,AP,AD:TARe);
function GetFIT9_SL(iX,iY:integer;sStokes:string):TStringList;
function GetFIT9Norm_SL(iX,iY:integer;sStokes:string):TStringList;
procedure GetFITNorm9ARe(iX,iY:integer;sStokes:string;var AX,AI,AQ,AU,AV:TARe);
procedure GetFITNorm9ARe2(iX,iY:integer;sStokes:string;
                          rL0:real;
                          var AX,AXd,AI,AQ,AU,AV,AP,AD:TARe);


function HeadersDiff:TStringList; (* число_точек_на_щели + 1 строка *)
function HeadersEqw:TStringList;  (* две строки *)
function HeaderGross:TStringList;
function HeaderList:TStringList;
procedure GetDuration;
procedure Get_dVlos;

function GetXHeader(iX:integer):TStringList;
//function GetXIntegrVal(iX:integer):TStringList;
function ReportIntegrVals:TStringList;
function Report:TStringList;


//procedure CalcParts(sDaTi:string;var pLimb,pU,ppu,minC:real);
procedure CalcParts(sDaTi:string;p07_1,p07_2:real;
                           var pLimb,pU,ppu,minC,pB077,pB007:real);

procedure CalcBML(sDaTi:string;
                           var maxBML1,maxBML2,maxBIV,minBIV:real);

{
function MEiXSL(iX:integer):TStringList;
procedure MEiXSL0(var SL:TStringList;iX:integer); (* без заголовка *)
}

function sME_HEAD:string;
//function ME_SL:TStringList;

function RepMem:TStringList;



{
procedure SWiXSL0(var SL:TStringList;iX:integer); (* без заголовка *)
function SWiXSL(iX:integer):TStringList;
}

function sSW_HEAD:string;
//function SW_SL:TStringList;

function FITSbyIX(ix0:integer):TFITS;

function sAny_HEAD:string;


//procedure SWOUTHeader; (* сформировать хидер для выходной SunWorld записи *)

procedure FillData;
procedure LoadData;
procedure RawMeanContH0;
procedure MaxMinCont; (* => rCntMa, rCntMi, iXCA,iXCI,iYCA,iYCI *)
procedure VRBMax; (* => VRMA, VBMA, iXVR,iXVB,iYVR,iYVB *)
procedure HNSMax; (* => VRMA, VBMA, iXVR,iXVB,iYVR,iYVB *)
procedure CalcIntegrVal;

procedure MeanContH0;(* расчёт среднего по карте значения rCntMH0 = HD CNT_H0 *)
procedure CalcLC12;  (*   =>  rLC1M, rLC2M *)
procedure CalcVC12;
procedure CalcME_HL;
procedure Calc_dV;(*MeX,MeY => Ou_dV расчёт поправок луч.скорости за вращ.С-ца*)
procedure CalcContH0; (* приведение карты CONT к значению ContH0 *)
procedure NormVCore;
procedure NormVBiseq; (* пересчёт VBiseq из пикселей в скорости *)


//procedure SetLinesArea(i1,i2,i3,i4,i5,i6:integer);
procedure CalcH0(iX,iY:integer;dl1,dl2,kV,akRC:real;
                        var W1,W2,M1,M2,H1,H2,HG1,HG2,l1,l2,
                        l11,l12,l21,l22,ln1,ln2,
                        lIV1,lVI1,lIV2,lVI2:real);

procedure AverageH1onH2(dH:real;var AHM2,AHM1:TARe);

procedure GetXFOARe(FO:TFIOut;iX:integer;var A:TARe);

constructor Create;
procedure Done;   (* чистит TFITS(Self.Items) + OuDone *)
procedure OuDone; (* чистит объекты "Ou"               *)


(*
 * kSoft = 1/2/3 = SW/ME/M2
 * chN0  = Id сессии, который будет записан в FO
 * SLN   - список строк вида 'Name sVar'
 * QAll  - игнорировать SLN
*)



end; (* TLFITS *)

(*                                                                            *)
(*                                                                            *)
(*                                 TLFITS                                     *)
(*                                                                            *)
(*============================================================================*)

procedure LeWi(ic:integer;AY:TAIn;var i1,i2:integer);
procedure RiWi(ic:integer;AY:TAIn;var i1,i2:integer);

function ipolLeWi(i1,ic:integer;var ii:integer;AY:TAIn;y:real):real;
                                                               overload;
function ipolLeWi(i1,i2:integer;var ii:integer;AX,AY:TARe;y:real):real;
                                                               overload;
function ipolRiWi(ic,i2:integer;var ii:integer;AY:TAIn;y:real):real;
                                                               overload;
function ipolRiWi(i1,i2:integer;var ii:integer;AX,AY:TARe;y:real):real;
                                                               overload;
function RiPoLeWi(ii:integer;AY:TAIn;y:real):real; overload;
function RiPoLeWi(ii:integer;AX,AY:TARe;y:real):real; overload;
function LePoRiWi(ii:integer;AY:TAIn;y:real):real; overload;
function LePoRiWi(ii:integer;AX,AY:TARe;y:real):real; overload;

procedure RiWiPP(var axs,ays:TARe;AY:TAIn;var j,ii,iMin:integer;y1,y2:real);
                                                               overload;
procedure RiWiPP(var axs,ays:TARe;AX,AY:TARe;var j,ii,iMin:integer;y1,y2:real);
                                                               overload;
procedure LeWiPP(var axs,ays:TARe;AY:TAIn;var j,ii,iMin:integer;y1,y2:real);
                                                               overload;
procedure LeWiPP(var axs,ays:TARe;AX,AY:TARe;var j,ii,iMin:integer;y1,y2:real);
                                                               overload;

(*===================================================*)
(*                                                   *)
(*           Запись ЛЮБОГО Хидера в файл             *)
(*                                                   *)
(*===================================================*)
(* записать строки SL в файл с именем sFN, начиная со смещения ib0 *)
procedure WriteHeader(sFN:string;ib0:longint;SL:TStringList);


(*======================================================================*)
(*                                                                      *)
(*                     работа с Header-ами FITS файлов                  *)
(*                                                                      *)
(*======================================================================*)


procedure HeaderReField(var hSL:TStringList;sKey,S:string);            overload;
procedure HeaderReField(var hSL:TStringList;sKey,S:string;var QWr:boolean);
                                                                       overload;
procedure HeaderEraseField(hSL:TStringList;sKey:string);

function MakeHdStr(sKey,sVal,sCom:string):string;
function MakeHdIS(sKey:string;iVal:integer;sCom:string):string;
function MakeHdES(sKey:string;rVal:real;NDig:integer;sCom:string):string;
function MakeHdFS(sKey:string;rVal:real;NDig:integer;sCom:string):string;
function MakeHdQS(sKey,sVal,sCom:string):string;

function GetFITsVal(sHd:string):string;// из Head строки извлечь sVal часть

function GetFITKeyI(sKey:string;HSL:TStringList;i1,i2:integer):integer;overload;
function GetFITKeyR(sKey:string;HSL:TStringList;i1,i2:integer):real;   overload;
function GetFITKeyR(sKey:string;HSL:TStringList;r0:real;i1,i2:integer):real;
                                                                       overload;
function GetFITKey(sKey:string;HSL:TStringList;i1,i2:integer):string;  overload;
function GetFITKey(s80:string):string;                                 overload;
function GetFITVal(s80:string):string;
function GetFITCom(s80:string):string;

function rdHdVar(sKey:string;var R:real):boolean;


function GetFITKeyI(sKey:string;HSL:TStringList):integer;overload;
function GetFITKeyR(sKey:string;HSL:TStringList):real;   overload;
function GetFITKeyR(sKey:string;r0:real;HSL:TStringList):real;   overload;
function GetFITKey (sKey:string;HSL:TStringList):string; overload;

function GetFITKeyS80(sKey:string;HSL:TStringList;i1,i2:integer):string;
                                                                       overload;
function GetFITKeyS80(sKey:string;HSL:TStringList):string;             overload;

function GetFITName(kSoft:integer;sDt,sTi:string):string;
procedure GetFITSHead(sFN:string;nbH0:integer;
                      var NS:integer;var SL:TStringList);



procedure LFITS_SaveKVI;
procedure LFITS_Ou_d0_Init(var Q4:boolean);


function FITS0_sFN(s15:string):string;        (* имя 0-го файла сырого FITS *)
function FITS_IX_sFN(s15:string;IX:integer):string;(* имя файла сырого FITS *)
function sSrcPath(s15:string):string;


(* ИСПОЛЬЗУЕМ LFIO.HswSL. Он должен быть загружен! *)
procedure GetswFITKey(sKey:string;var sVal:string);
function GetRswFITKey(sKey:string;R0:real):real;
function GetQswFITKey(sKey:string):boolean;


(*==============================*)
(* глобальные переменные swFITS *)
(*==============================*)
var QExport : boolean; (* определяет вывод real чисел в формате с E *)
                       (* 10^-10 выводится как 10E-10 иначе 10-10   *)

    sDBFITSpath : string; (* подстрока, которая задаёт путь БД *)
    LFOP    : TStringList; (* список sId карт, которые рисуем *)
    iLFOP   : integer; (* индекс текущей карты - от 0 до LFOP.Count - 1 *)

    LFIOtmp : TList;   (* множество карт, связанных с виртуальными переменными*)
    LFIO    : TLFIOut; (* множество "выходных" карт              *)
//  LFOP    : TLFIOut; (* список (стек?) карт, которые рисуем *)

//  CurFO   : TFIOut;  (* текущая последняя карта, которая отображается на стр*)
//  MapFO   : TFIOut;  (* карта, к-рую сейчас видно (часто совпадает с CurFO) *)
//  MapFo2  : TFIOut;  (* карта, к-рая "наплывает" на MapFO *)
    MapsId  : string;
    MapsId2 : string;
    FITS1   : TFITS1;  (* для сбора профилей из множества FITS *)
    CurI    : TCurI;   (*текущий профиль Стокса I для аппроксимации гауссианой*)
    aIV     : TCurIV;

    Shad  : TBitMap; (* место для картинки, к-рую рисуют экземпляры TFIOut *)
//  kMapScale : integer; (* целое число - кратность размера картинки *)
    rMapScale : real;    (* кратность размера картинки *)

    SLFun1: TStringList;  (* список унарных  функций *)
    SLFun : TStringList;  (* список бинарных функций *)
    SLFunC: TStringList;  (* список операций с константой *)
    SLFun2C:TStringList;  (* бинарные функции + параметр  *)

    SLMaps: TStringList;  (* загружаемый список производных карт *)
    SLFOna: TStringList;  (* список имён этих   производных карт *)

    NCutFO: integer; (* старый вариант 512, правильный 320 *)
    QFITS320 : boolean; (* "стандартный" FITS файл *)


implementation

uses SysUtils,math,
swFile,swSayer,swStr,swARe,
uPMAS,PHYS,SetBit,swFunc,f90_Profiling,
swEd,swTimer,swDate,
swMapFilt
(*-----------------------*)
,Usw09,UFMap;
(*-----------------------*)






{
  sNam : string;
  sDim : string; (* по умолчанию - пустая строка *)
  BSL  : TStringList; (* список границ *)
  CSL  : TStringList; (* синхронный список раскрасок *)
}


(* добавляем (или уточняем) описатель масштаба карты *)
(* строку типа 'CB0 [0.8 1.2] [0.06 1.1]'            *)
procedure TFOScale.Add(sNa:string;sb : string);
var i,j,N : integer; S,S1,w : string;
begin
  if Not Assigned (LFOS) then begin
    LFOS := TStringList.Create;
    LFOS.Sorted := true;
  end;

  sb := Trim(swStr.TrimDublChar(sb,' '));

  i := iMapScale(sNa);          (* такая карта описана? *)
  if i < 0 then begin              (* нет *)
    S := sNa + ' ['+Trim(sb)+']';
    LFOS.Add(S);
  end
  else begin                       (* описана *)
    S1 := LFOS.Strings[i];

    BSL := TStringList.Create;
    N := swStr.GetNBraketWord(S1,'[',']');
    for j := 1 to N do begin
      w := swStr.GetBraketWordN(S1,j,'[',']');
      w := swStr.TrimDublChar(w,' ');  // пробелов оставить по 1 для сравнения
      BSL.Add(w);
    end;

    (* меняем порядок *)
    (* либо вставляем границы sb на первое место *)
    i := -1;
    for j := 0 to N-1 do begin
      if (BSL.Strings[j] = sb) then i := j;
    end;

    if i >= 0 then BSL.Delete(i);
    BSL.Insert(0,sb);

    S := sNa;
    for j := 0 to BSL.Count-1 do begin
      S := S + ' ['+BSL.Strings[j]+']';
    end;

    LFOS.Strings[i] := S;
  end;

end;


function TFOScale.iMapScale(sNa:string):integer;
var i : integer; S : string;
begin
  result := -1;
  if Not Assigned (LFOS) then Exit;
  for i := 0 to LFOS.Count do begin
    S := LFOS.Strings[i];
    S := swStr.GetWordN(S,1);
    S := swStr.left(S,'|');
    if S = sNa then begin result := i; Exit end;
  end;
end;




function TSesFltLst.ToSL:TStringList;
var SL : TStringList; I : integer; S : string; fr : TPSesFltRec;
begin
  SL := TStringList.Create;
  if Assigned(Self) then begin
    for I := 0 to Self.Count-1 do begin
      fr := TPSesFltRec(Self.Items[I]);
      S := fr^.na + ' ' + EFSt0(fr^.v1,6) + ' ' + EFSt0(fr^.v2,6) + ' ' +
           ISt(fr^.K);
      SL.Add(S);
    end;
  end;
  result := SL;
end;


procedure TSesFltLst.setBySL(SL:TStringList);
var I,IErr : integer; S,w : string; fr : TPSesFltRec;
begin
  if Not Assigned(Self) then begin
    WarnAbs('TSesFltLst Not Assigned!');
    Exit;
  end;
  Self.Done;
  for I := 0 to SL.Count-1 do begin
    S := SL.Strings[I];
    New(fr);
    GetMem(fr,SizeOf(TSesFltRec));
    w := swStr.GetWordN(S,1); fr^.na := w;
    w := swStr.GetWordN(S,2); fr^.v1 := swStr.ValReal(w,IErr);
    if iErr = 0 then begin
      w := swStr.GetWordN(S,3); fr^.v2 := swStr.ValReal(w,IErr);
    end;
    if iErr = 0 then begin
      w := swStr.GetWordN(S,4); fr^.K := swStr.ValInt(w,IErr);
    end;
    if iErr = 0 then Self.Add(fr);
  end;
end;


procedure TSesFltLst.Done;
var I : integer; fr : TPSesFltRec;
begin
  if Not Assigned(Self) then Exit;
  for I := Self.Count - 1 downto 0 do begin
    fr := Self.Items[I];
    fr^.na := ''; fr^.v1 := 0; fr^.v2 := 0; fr^.K := 0;
    FreeMem(Self.Items[I],SizeOf(TSesFltRec));
    Self.Delete(I);
  end;
end;





procedure FITSMaskListAdd(aMask:TAMask;var LAMask:TList);
var PAMask : ^TAMask; nx,ny,ix,iy : integer;
begin
  if Not Assigned(aMask) then Exit;
  nx := length(aMask);
  ny := length(aMask[0]);
  if nx*ny = 0 then Exit;
  if Not Assigned(LAMask) then LAMask := TList.Create;
  (*--------------------------------------*)
  (* складываем маски в список по сессиям *)
  (*--------------------------------------*)
  New(PAMask);
  SetLength(PAMask^,nx,ny);
  for ix := 0 to nx-1 do
    for iy := 0 to ny-1 do
      PAMask^[ix,iy] := aMask[ix,iy];
  LAMask.Add(PAMask);
  (*--------------------------------------*)
//WarnAbs('LAMask.Count='+ISt(LAMask.Count));
end;

function FITSMaskListGet(LAMask:TList;J:integer):TAMask;
var PAMask : ^TAMask; nx,ny,ix,iy : integer; aMask : TAMask;
begin
  result := Nil;
  if Not Assigned(LAMask) then Exit;
  if LAMask.Count <= J then Exit;
  (*---------------------------------------*)
  (* извлекаем маску из списока по сессиям *)
  (*---------------------------------------*)
  PAMask := LAMask.Items[J];
  nx := length(PAMask^);
  ny := length(PAMask^[0]);
  SetLength(aMask,nx,ny);
  for ix := 0 to nx-1 do
    for iy := 0 to ny-1 do
      aMask[ix,iy] := PAMask^[ix,iy];
  (*---------------------------------------*)
  result := aMask;
end;


procedure FITSMaskListDone(var LAMask:TList);
var i : integer; PAMask : ^TAMask;
begin
  if Not Assigned(LAMask) then Exit;
  for i := LAMask.Count-1 downto 0 do begin
    PAMask := LAMask.Items[i];
    Finalize(PAMask^);
    LAMask.Delete(i);
  end;
  FreeAndNIL(LAMask);
end;







function sSrcPath(s15:string):string;
var S : string;
begin
  S := swStr.left(s15,4)+'_'+swStr.CopyFromTo(s15,5,6)+'\'+S;
  S := DirAndName(swFITS.sDBFITSpath,S);
  sSrcPath := DirAndName(S,s15);
end;

(* используем LFIO.HswSL *)
function GetRswFITKey(sKey:string;R0:real):real;
var sVal : string; IErr : integer; R : real;
begin
  result := R0;
  GetswFITKey(sKey,sVal);
  if sVal = '' then Exit;

  Val(sVal,R,IErr);
  if IErr <> 0 then begin
    WarnAbs('GetRswFITKey('+sKey+') Err: ошибка числа в строке'+
    #13#10+sVal);
    Exit;
  end;
  result := R;
end;

(* используем LFIO.HswSL *)
(* значение по ключу присутствует и не равно нулю *)
function GetQswFITKey(sKey:string):boolean;
var sVal : string; IErr : integer; R : real;
begin
  result := false;
  GetswFITKey(sKey,sVal);
  if sVal = '' then Exit;

  Val(sVal,R,IErr);
  if (IErr = 0) and (R = 0) then Exit;
  result := true;
end;




(* LFIO.HswSL должен быть загружен! *)
procedure GetswFITKey(sKey:string;var sVal:string);
var nh : integer;
begin
  sVal := '';
  if Not Assigned(LFIO) then begin
    WarnAbs('GetswFITKey('+sKey+') Err: LFIO Not Assigned!');
    Exit;
  end;
  if Not Assigned(LFIO.HswSL) then begin
    WarnAbs('GetswFITKey('+sKey+') Err: LFIO.HswSL Not Assigned!');
    Exit;
  end;
  nh := LFIO.HswSL.Count;
  if (nh < 6) then begin    (* < 36 *)
    WarnAbs('GetswFITKey('+sKey+') Err: LFIO.HswSL.Count = '+
            ISt(LFIO.HswSL.Count));
    Exit;
  end;
  if nh > 72 then nh := 72;

  sVal := GetFITKey(sKey,LFIO.HswSL,0,nh-1);
end;

(* имя файла сырого FITS i-го по списку *)
function FITS_IX_sFN(s15:string;IX:integer):string;
var sFN,sPath : string;
  Dir : TDirList;
  aDir : TDirRec;
begin
  sFN := '';

  sPath := sSrcPath(s15);  (* путь всех "сырых FITS-ев" + \YYYY_MM\ + s15 *)
                           (* S:\Z\ASTRO\HINODE\sot\ + *)
                           (* 2006_11\20061104_035016\ *)

  Dir := TDirList.Create;
  Dir.CollectExt(sPath,'fits');
  Dir.SortInsideExt;

  if IX < Dir.Count then aDir := Dir.Get(IX)
                    else aDir := Dir.Get(0);
  sFN := aDir.Name;

  Dir.Done;
  result := sFN;
end;

(* имя файла сырого FITS первого по списку *)
function FITS0_sFN(s15:string):string;
begin
  result := FITS_IX_sFN(s15,0);
end;



(*==========================================================*)
(*                                                          *)
(*             АНАЛИЗ ПРОФИЛЕЙ (ИНТЕНСИВНОСТИ)              *)
(*                                                          *)
(*==========================================================*)


(* поиск непрерывного фрагмента левого крыла профиля  *)
(* результат - граничные индексы непрерывного участка *)
procedure LeWi(ic:integer;AY:TAIn;var i1,i2:integer);
var i,i0,i21,i22,ib0,ibb,ibe,ic0,icd : integer;
  Q : boolean;
  kRat,kRat21 : real; (* отношение отрезков *)
const lwmax = 18; (* предельная длина крыла 21.549*(18-1) = 366 mA *)

begin
  (* длина крыла должна быть не более 14 точек для 6302 *)
  (*                       и не более 10 точек для 6301 *)

  (* для первоначальной отладки ограничим крыло *)
  (* 18-ю точками, считая от центра линии *)

  (* монотонный отрезок не должен начинаться далее, чем в 8 *)
  (* точках от центра *)

  (* монотонный отрезок не должен нач-ся далее, чем в ib0 точках от центра*)
  if ic < 60 then begin ib0 := 8;  ic0 := 30; ibe := 15 end
             else begin ib0 := 11; ic0 := 76; ibe := 59 end;

//i0 := ic-lwmax;
  i0 := 1;
  i := ic;

  (* если в точке ic профиль не минимален, смещаемся влево *)
  while ((i-1) > i0) and   (* пока не вышли за край и *)
        (AY[i-1] <= AY[i]) (* не добрались до отрицательного пика *)
  do dec(i);

  (* теперь ищем смену знака - момент убывания *)
{
  i2 := i;
  while ((i-1) > i0) and   (* пока не вышли за край и *)
        (AY[i-1] >= AY[i]) (* не добрались до отрицательного пика *)
  do dec(i);
  i1 := i;
}

  i2 := i;
  Q := false;
  while ((i-2) > i0) and   (* пока не вышли за край и *)
        (not Q) (* не добрались до положительного пика (максимума) *)
  do begin
    if (AY[i-1] < AY[i]) and
       (AY[i-2] < AY[i])
    then Q := true
    else dec(i);
  end;
  i1 := i;
  kRat := 0.66;
  icd := ic - ic0;
  if icd > 0 then kRat := kRat + 0.34*icd/9;

  (* монотонный диапазон [i1..i2] найден *)
  (* но возможно, это не крыло, а центральная ПИ-компонента *)
  (* Попробуем найти ещё один отрезок *)

  i21 := 0; i22 := 0;
  if (ic < ic0) then ibb := ic - ib0 else ibb := ic0 - ib0;
  if ibb < ibe then ibb := ibe;
  while (i >= ibb) do begin
    (* ищем очередной минимум *)
    dec(i);
    while ((i-1) > i0) and   (* пока не вышли за край и *)
          (AY[i-1] <= AY[i]) (* не добрались до отрицательного пика *)
    do dec(i);

    if (i >= ibb)  (* крыло всё ещё может начаться *)
    then begin
      (* ищем смену знака - момент убывания *)


{
      i22 := i;
      while ((i-1) > i0) and   (* пока не вышли за край и *)
            (AY[i-1] >= AY[i]) (* не добрались до отрицательного пика *)
      do dec(i);
      i21 := i;
}
      i22 := i;
      Q := false;
      while ((i-2) > i0) and   (* пока не вышли за край и *)
            (not Q) (* не добрались до положительного пика (максимума) *)
      do begin
        if (AY[i-1] < AY[i]) and
           (AY[i-2] < AY[i])
        then Q := true
        else dec(i);
      end;
      i21 := i;

    end;
    if (i21 <> 0) and (i22>i21) then begin
      kRat21 := (AY[i22]-AY[i21]) / (AY[i2]-AY[i1]);


      if (abs(i22-ic0)<3) or  // предыдущая ветвь была правым сигма компонентом

        (* сравнение двух отрезков *)
        (* сравниваем разницу длин *)
        (* отношение перепадов и   *)
        (* расположение отрезков   *)

        ((((i22-i21+1)>=(i2-i1)) or
         ((i22-i21) > kRat*(i2-i1))
         or ((i22-i21)>=5) )
        and  (*фрагмент не должен быть заметно короче*)
                                    (* и не должен быть пологим *)
        (
        abs(AY[i22]-AY[i21]) > kRat*abs(AY[i2]-AY[i1])
        )) then begin
          i1 := i21;
          i2 := i22;
          ic := i22;(* Передумали по поводу главного отрезка - сместим и центр*)
          if (ic < ic0) then begin
            ibb := ic - ib0;
            kRat := 1; (* третий отрезок не должен быть короче второго *)
          end
          else ibb := ic0 - ib0;
          if ibb < ibe then ibb := ibe;
        end;
    end;

  end;

end;


(* поиск непрерывного фрагмента правого крыла профиля  *)
(* результат - граничные индексы непрерывного участка *)
procedure RiWi(ic:integer;AY:TAIn;var i1,i2:integer);
var i,i0,i21,i22,ib0,ibb,ibe : integer;
  Q : boolean; (* событие смены знака производной *)
  ic0,icd : integer;
  kRat : real; (* отношение отрезков *)

const lwmax = 18; (* предельная длина крыла 21.549*(18-1) = 366 mA *)

begin
  (* длина крыла должна быть не более 14 точек для 6302 *)
  (*                       и не более 10 точек для 6301 *)

  (* для первоначальной отладки ограничим крыло *)
  (* 18-ю точками, считая от центра линии *)

  (* монотонный отрезок не должен начинаться далее, чем в 8 *)
  (* точках от центра *)

  (* монотонный отрезок не должен нач-ся далее, чем в ib0 точках от центра*)
  if ic < 60 then begin ib0 := 8;  ic0 := 30; ibe := 45 end
             else begin ib0 := 11; ic0 := 76; ibe := 93 end;


//i0 := ic+lwmax;
  i0 := 112;
  i := ic;

  (* если в точке ic профиль не минимален, смещаемся вправо *)
  while ((i+1) < i0) and   (* пока не вышли за край и *)
        (AY[i+1] <= AY[i]) (* не добрались до отрицательного пика *)
  do inc(i);

  (* теперь ищем смену знака - момент убывания *)
  i1 := i;
  Q := false;
  while ((i+2) < i0) and   (* пока не вышли за край и *)
        (not Q) (* не добрались до положительного пика (максимума) *)
  do begin
    if (AY[i+1] < AY[i]) and
       (AY[i+2] < AY[i])
    then Q := true
    else inc(i);
  end;
  i2 := i;
  kRat := 0.66;
  icd := ic - ic0;
  if icd > 0 then kRat := kRat + 0.34*icd/9;

  (* монотонный диапазон [i1..i2] найден *)
  (* но возможно, это не крыло, а центральная ПИ-компонента *)
  (* Попробуем найти ещё один отрезок *)

  i21 := 0; i22 := 0;
  if (ic > ic0) then ibb := ic + ib0 else ibb := ic0 + ib0;
  if ibb > ibe then ibb := ibe;
  while (i <= ibb) do begin

    (* в прошлой точке повернулись и теперь идём вниз *)
    inc(i);
    (* ищем момент, когда снова повернём вверх *)
    while ((i+1) < i0) and   (* пока не вышли за край и *)
          (AY[i+1] <= AY[i]) (* не добрались до отрицательного пика *)
    do inc(i);

    if (i <= ibb)  (* крыло всё ещё может начаться *)
    then begin
      (* ищем смену знака - момент убывания *)
      i21 := i;
      Q := false;
      while ((i+2) < i0) and   (* пока не вышли за край и *)
            (Not Q)            (* не добрались до отрицательного пика *)
      do begin
        if (AY[i+1] < AY[i]) and
           (AY[i+2] < AY[i])
        then Q := true
        else inc(i);
      end;
      i22 := i;
    end;
    if (i21 <> 0) and (i22>i21) then begin
      if (abs(i21-ic0)<3) or // предыдущая ветвь была левым сигма компонентом
         ((((i22-i21+1)>=(i2-i1)) or
         ((i22-i21) > kRat*(i2-i1))  (*фрагмент не должен быть заметно короче*)
         or ((i22-i21)>=5) )
        and
                                    (* и не должен быть пологим *)
        (abs(AY[i22]-AY[i21]) > kRat*abs(AY[i2]-AY[i1])))
        then begin
          i1 := i21;
          i2 := i22;
          ic := i21;(* Передумали по поводу главного отрезка - сместим и центр*)
          if (ic > ic0) then begin
            ibb := ic + ib0;
            kRat := 1; (* третий отрезок не должен быть короче второго *)
          end
          else ibb := ic0 + ib0;
          if ibb > ibe then ibb := ibe;
        end;
    end;
  end;

end; (* RiWi *)




(* interpolLeftWing *)
(* AY - профиль интенсивности линии *)
(* i1 - индекс левой границы данной линии *)
(* i2 - индекс центра линии               *)
(* y  - уровень интенсивности, на котором ищем пересечение с профилем *)
(* ii - результат, индекс перовой точки правее пересечения с y *)
(* result - значение X-координаты пересечения = лин-ая и-пол-я 2-х точек *)

function ipolLeWi(i1,ic:integer;var ii:integer;AY:TAIn;y:real):real;
var y_1,y_2 : integer; x1 : real;
  ii2,ii3 : integer; q2 : boolean;
const n2Max = 8; (* максимальное расстояние второго пика от первого *)
begin

  (* пример:   k=6 то есть сегмент 0.2 = [0.1 .. 0.3] *)
  (* находим x1 линейной интерполяцией                *)

  (* двигаемся от центра, то есть от точки ic к краю профиля           *)
  (*                                                                   *)
  (* возможно "ложное срабатывание", когда профиль, например, триплет, *)
  (* а уровень 'y' задан ниже, чем точка разделения зубцов триплета    *)
  (*                                                                   *)
  (* кроме того, двигаясь в крыло мы можем найти линию-бленду          *)
  (*                                                                   *)
  (* расстояние от центрпльного пик до второстепенного не может        *)
  (*  5 точек (половина расщепления 6302 при поле 5000Гс)              *)


{
  ii := i1;    (* индекс текущих операций с AY *)
  while (AY[ii] > y) and (ii < ic)
    do inc(ii); (* меняем ii пока AY[ii] не станет меньше y *)
  if (ii = ic) then begin
    WarnAbs('LineMetrix.ipolLeWi-ERROR!!!');
  end;
}

  ii2 := 0;
  ii := ic; (* индекс текущих операций с AY *)

  (*---------------------------------------------*)
  (* центральная точка должна быть "ниже планки" *)
  (* если это не так ищем фрагмент ниже планки   *)
  (*---------------------------------------------*)
  while (AY[ii] > y) and (ii > i1)
    do dec(ii); (* меняем ii пока AY[ii] не станет меньше y *)

  (*                                             *)
  (*---------------------------------------------*)



  while (AY[ii] < y) and (ii > i1)
    do dec(ii); (* меняем ii пока AY[ii] не станет больше y *)


  if (ii = i1) and (AY[ii] < y) then begin
    WarnAbs('LineMetrix.ipolLeWi-ERROR!'+
            #10#13+
            'На уровне I='+
            EFSt0(y,4)+
            ' не найдено пересечение с левым крылом профиля'+
            #10#13+
            'I(край)['+ISt(i1)+']='+ISt(AY[i1])+
            ' I(центр)['+ISt(ic)+']='+ISt(AY[ic])
            );
    result := ic;
    Exit;
  end
  else begin (* всё ОК, нашли пересечение *)

   (* попробуем найти ещё одно пересечение на небольшом расстоянии от первого *)
   (*          n2max = 8         *)
    ii2 := ii;
    ii3 := ii2-n2max; if ii3 < i1 then ii3 := i1;
    q2 := false;
    While (ii2>ii3) and (Not q2) do begin
      dec(ii2);
      q2 := (AY[ii2]<y);
    end;
    if q2 then begin
      ii3 := ii2-n2max; if ii3 < i1 then ii3 := i1;// сдвинуть границу ещё?
      while (AY[ii2] < y) and (ii2 > ii3)
        do dec(ii2); (* меняем ii пока AY[ii] не станет больше y *)
      if Not (AY[ii2] >= y) then ii2 := 0;
    end
    else ii2 := 0;
  end;

  if ii2 > 0 then ii := ii2;
{
  y_2 := AY[ii];
  y_1 := AY[ii-1];
  if y_1 = y_2 then x1 := ii - 0.5
               else x1 := ii - 1   + (y-y_1)/(y_2-y_1);
}

  ii := ii+1;
  y_1 := AY[ii-1]; (* выше y *)
  y_2 := AY[ii];   (* ниже y *)
  if y_1 = y_2 then x1 := ii - 0.5
               else x1 := ii - 1   + (y_1-y)/(y_1-y_2);

  result := x1;
end; (* function ipolLeWi *)



(* interpolLeftWing интерполяция при неравномерном шаге профиля *)
function ipolLeWi(i1,i2:integer;var ii:integer;AX,AY:TARe;y:real):real;
var y_1,y_2 : real; x1,x2,xx,dx : real;
begin

  (* пример:   k=6 то есть сегмент 0.2 = [0.1 .. 0.3] *)
  (* находим x1 линейной интерполяцией                *)
  ii := i1;    (* индекс текущих операций с AY *)
  while (AY[ii] > y) and (ii < i2)
    do inc(ii); (* меняем ii пока AY[ii] не станет меньше y *)
  if (ii = i2) then begin
    WarnAbs('LineMetrix.ipolLeWi-ERROR!!!');
  end;

  y_2 := AY[ii];
  y_1 := AY[ii-1];
  x2  := AX[ii];
  x1  := AX[ii-1];
  dx  := x2-x1;

  if y_1 = y_2 then xx := x2 - dx/2
               else xx := x1 + (y-y_1)/(y_2-y_1)*dx;
  result := xx;
end; (* function ipolLeWi *)


(* interpolLeftWing *)
(* AY - профиль интенсивности линии *)
(* i1 - индекс центра линии                *)
(* i2 - индекс правой границы данной линии *)
(* y  - уровень интенсивности, на котором ищем пересечение с профилем *)
(* ii - результат, индекс перовой точки левее пересечения с y *)


(* interpolRightWing *)
function ipolRiWi(ic,i2:integer;var ii:integer;AY:TAIn;y:real):real;
var y_1,y_2 : integer; x1 : real;
  ii2,ii3 : integer; q2 : boolean;
const n2Max = 8; (* максимальное расстояние второго пика от первого *)
begin
{
  ii := i2;    (* индекс текущих операций с AY *)
  while (AY[ii] > y) and (ii > ic)
    do dec(ii); (* меняем ii пока AY[ii] не станет меньше y *)
  if (ii = ic) then begin
    WarnAbs('LineMetrix.ipolRiWi-ERROR!!!');
  end;
  y_2 := AY[ii];
  y_1 := AY[ii+1];        (* предыдущая по "спуску" точка *)
  if y_1 = y_2 then x1 := ii + 0.5
               else x1 := ii + 1   - (y-y_1)/(y_2-y_1);
  result := x1;
}



  ii2 := 0;

  ii := ic; (* индекс текущих операций с AY *)

  (*---------------------------------------------*)
  (* центральная точка должна быть "ниже планки" *)
  (* если это не так ущем фрагмент ниже планки   *)
  (*---------------------------------------------*)
  while (AY[ii] > y) and (ii < i2)
    do inc(ii); (* меняем ii пока AY[ii] не станет меньше y *)

  (*                                             *)
  (*---------------------------------------------*)



  while (AY[ii] < y) and (ii < i2)
    do inc(ii); (* меняем ii пока AY[ii] не станет больше y *)
  if (ii = i2) and (AY[ii] < y) then begin
    WarnAbs('LineMetrix.ipolRiWi-ERROR!'+#10#13+
            'На уровне I='+EFSt0(y,4)+
            ' не найдено пересечение с правым крылом профиля'+#10#13+
            'I(центр)['+ISt(ic)+']='+ISt(AY[ic])+
            ' I(край)['+ISt(i2)+']='+ISt(AY[i2]));
    result := ic;
    Exit;
  end
  else begin (* всё ОК, нашли пересечение *)

   (* попробуем найти ещё одно пересечение на небольшом расстоянии от первого *)
    ii2 := ii;
    ii3 := ii2+n2max; if ii3 > i2 then ii3 := i2;
    q2 := false;
    While (ii2<ii3) and (Not q2) do begin
      inc(ii2);
      q2 := (AY[ii2]<y);
    end;
    if q2 then begin
      ii3 := ii2+n2max; if ii3 > i2 then ii3 := i2;// сдвинуть границу ещё?
      while (AY[ii2] < y) and (ii2 < ii3)
        do inc(ii2); (* меняем ii пока AY[ii] не станет больше y *)
      if Not (AY[ii2] >= y) then ii2 := 0;
    end
    else ii2 := 0;
  end;

  if ii2 > 0 then ii := ii2;
{
  y_2 := AY[ii];
  y_1 := AY[ii-1];
  if y_1 = y_2 then x1 := ii - 0.5
               else x1 := ii - 1   + (y-y_1)/(y_2-y_1);
}

  ii := ii-1; (* вернёмся на точку ПЕРЕД пересечением *)
  y_1 := AY[ii];   (* ниже y *)
  y_2 := AY[ii+1]; (* выше y *)
  if y_1 = y_2 then x1 := ii + 0.5
               else x1 := ii + 1   - (y_2-y)/(y_2-y_1);

  result := x1;





end; (* function ipolRiWi *)

(* interpolRightWing *)
function ipolRiWi(i1,i2:integer;var ii:integer;AX,AY:TARe;y:real):real;
var y_1,y_2 : real; xx,x1,x2,dx : real;
begin
  ii := i2;    (* индекс текущих операций с AY *)
  while (AY[ii] > y) and (ii > i1)
    do dec(ii); (* меняем ii пока AY[ii] не станет меньше y *)
  if (ii = i1) then begin
    WarnAbs('LineMetrix.ipolRiWi-ERROR!!!');
  end;
  y_2 := AY[ii];
  y_1 := AY[ii+1];        (* предыдущая по "спуску" точка *)
  x2  := AX[ii];
  x1  := AX[ii+1];        (* предыдущая по "спуску" точка *)
  dx  := x2-x1;
  if y_1 = y_2 then xx := x2 - dx/2  (* dx < 0 *)
               else xx := x1 + (y-y_1)/(y_2-y_1)*dx;
  result := xx;
end; (* function ipolRiWi *)






(* RightPointLeftWing *)
function RiPoLeWi(ii:integer;AY:TAIn;y:real):real;
var y_1,y_2 : integer;
begin
  y_1 := AY[ii-1]; y_2 := AY[ii]; (* движемся вправо y_2 < y_1 *)
  if (y < y_2) then begin
    WarnAbs('LineMetrix-RiPoLeWi_I СБОЙ ii='+ISt(ii)+
      ' y='+EFSt0(y,4)+' < y2='+EFSt0(y_2,4)+' y1='+EFSt0(y_1,4));
  end;
  if (y > y_1) then begin
    WarnAbs('LineMetrix-RiPoLeWi_I СБОЙ ii='+ISt(ii)+
      ' y='+EFSt0(y,4)+' > y1='+EFSt0(y_1,4)+' y2='+EFSt0(y_2,4));
  end;
  if (y_1 = y_2) then result := ii - 0.5
                 else result := ii-1+(y-y_1)/(y_2-y_1);
end;

(* RightPointLeftWing *)
function RiPoLeWi(ii:integer;AX,AY:TARe;y:real):real;
var y_1,y_2 : real; xx,x1,x2,dx : real;
begin
  y_1 := AY[ii-1]; y_2 := AY[ii]; (* движемся вправо y_2 < y_1 *)
  if (y < y_2) then begin
    WarnAbs('LineMetrix-RiPoLeWi_R СБОЙ ii='+ISt(ii)+
      ' y='+EFSt0(y,4)+' < y2='+EFSt0(y_2,4)+' y1='+EFSt0(y_1,4));
  end;
  if (y > y_1) then begin
    WarnAbs('LineMetrix-RiPoLeWi_R СБОЙ ii='+ISt(ii)+
      ' y='+EFSt0(y,4)+' > y1='+EFSt0(y_1,4)+' y2='+EFSt0(y_2,4));
  end;
  x1 := AX[ii-1];
  x2 := AX[ii];
  dx := x2 - x1; (* dx > 0 *)

  if (y_1 = y_2) then result := x2 - dx/2
                 else result := x1 + (y-y_1)/(y_2-y_1)*dx;
end;





(* LeftPointRightWing *)
function LePoRiWi(ii:integer;AY:TAIn;y:real):real;
var y_1,y_2 : integer;
begin
  y_1 := AY[ii+1]; y_2 := AY[ii]; (* движемся влево y_2 < y_1 *)
  if (y < y_2) then begin
    WarnAbs('LineMetrix-LePoRiWi СБОЙ ii='+ISt(ii)+
      ' y='+EFSt0(y,4)+' < y2='+EFSt0(y_2,4)+' y1='+EFSt0(y_1,4));
  end;
  if (y > y_1) then begin
    WarnAbs('LineMetrix-LePoRiWi СБОЙ ii='+ISt(ii)+
      ' y='+EFSt0(y,4)+' > y1='+EFSt0(y_1,4)+' y2='+EFSt0(y_2,4));
  end;
  if (y_1 = y_2) then result := ii + 0.5
                 else result := ii+1-(y-y_1)/(y_2-y_1);
end;


(* LeftPointRightWing *)
function LePoRiWi(ii:integer;AX,AY:TARe;y:real):real;
var y_1,y_2 : real; xx,x1,x2,dx : real;
begin
  y_1 := AY[ii+1]; y_2 := AY[ii]; (* движемся влево y_2 < y_1 *)
  if (y < y_2) then begin
    WarnAbs('LineMetrix-LePoRiWi СБОЙ ii='+ISt(ii)+
      ' y='+EFSt0(y,4)+' < y2='+EFSt0(y_2,4)+' y1='+EFSt0(y_1,4));
  end;
  if (y > y_1) then begin
    WarnAbs('LineMetrix-LePoRiWi СБОЙ ii='+ISt(ii)+
      ' y='+EFSt0(y,4)+' > y1='+EFSt0(y_1,4)+' y2='+EFSt0(y_2,4));
  end;
  x1 := AX[ii+1];
  x2 := AX[ii];
  dx := x2-x1;  (* dx < 0 *)
                                            (* ######### ЗНАК dx ??????? *)
  if (y_1 = y_2) then xx := x2 - dx/2
                 else xx := x1 + (y-y_1)/(y_2-y_1)*dx;
  result := xx;
end;


procedure LeWiPP(var axs,ays:TARe;AY:TAIn;var j,ii,iMin:integer;y1,y2:real);
begin
  if (AY[ii] = y1) then inc(ii); (* пропускаем, не вносим в axs,ays *)
  while (AY[ii] > y2) and (ii < iMin) do begin
    inc(j);
    axs[j] := ii;
    ays[j] := AY[ii];
    inc(ii);
  end;
end;

procedure LeWiPP(var axs,ays:TARe;AX,AY:TARe;var j,ii,iMin:integer;y1,y2:real);
begin
  if (AY[ii] = y1) then inc(ii); (* пропускаем, не вносим в axs,ays *)
  while (AY[ii] > y2) and (ii < iMin) do begin
    inc(j);
    axs[j] := AX[ii];
    ays[j] := AY[ii];
    inc(ii);
  end;
end;


procedure RiWiPP(var axs,ays:TARe;AY:TAIn;var j,ii,iMin:integer;y1,y2:real);
begin
  if (AY[ii] = y1) then dec(ii); (* пропускаем, не вносим в axs,ays *)
  while (AY[ii] > y2) and (ii > iMin) do begin
    inc(j);
    axs[j] := ii;
    ays[j] := AY[ii];
    dec(ii);
  end;
end;

procedure RiWiPP(var axs,ays:TARe;AX,AY:TARe;var j,ii,iMin:integer;y1,y2:real);
begin
  if (AY[ii] = y1) then dec(ii); (* пропускаем, не вносим в axs,ays *)
  while (AY[ii] > y2) and (ii > iMin) do begin
    inc(j);
    axs[j] := AX[ii];
    ays[j] := AY[ii];
    dec(ii);
  end;
end;



(*   на входе:
 * профиль интенсивности A
 * уровень Cont
 * глубина d (в долях d0) на к-рой надо искать пересечение профиля
 *   на выходе
 * ic1 , ic2   - интенсивности наиболее глубоких точек
 * id01, id02  - номера пикселей (в спектре) с самыми глубокими точками
 * rС501,rC502 - положения бисекторов на уровне d
 *)
(* размерность массива всегда 112, профиль делим пополам *)
(* id01 и id02 нужны, чтобы отличить 6301 от 6302 *)
procedure GetCd012(A:TAIn;Cont,d:real;var rC501,rC502:real;
                   var ic1,ic2,id01,id02:integer);
var
  ii : integer; d_x : real;
  c11,c12,c21,c22 : real;
begin
  (* найдём наиболее глубокие точки профилей *)
  AInMinPoint(A, 1, 56,ic1,id01);
  AInMinPoint(A,57,112,ic2,id02);

  (* найдём пересечения с крыльями на заданном уровне d *)
  d_x := d*(Cont-id01)+id01;
  c11 := ipolLeWi(  1,ic1,ii,A,d_x);
  c12 := ipolRiWi(ic1,56 ,ii,A,d_x);
  d_x := d*(Cont-id02)+id02;
  c21 := ipolLeWi( 57,ic2,ii,A,d_x);
  c22 := ipolRiWi(ic2,112,ii,A,d_x);

  rC501 := (c11+c12)/2;
  rC502 := (c21+c22)/2;
end;

procedure GetCd012_(A:TAIn;i:integer;Cont,d:real;var rC501,rC502:real;
                   var Ad1,Ad2,Ac1,Ac2:TAIn);
var
  ii : integer; d_x : real;
  c11,c12,c21,c22 : real;
  id1,id2,ic1,ic2 : integer;
begin
  (* найдём пересечения с крыльями на заданном уровне d *)
  id1:=Ad1[i];
  id2:=Ad2[i];
  ic1:=Ac1[i];
  ic2:=Ac2[i];

  d_x := d*(Cont-id1)+id1;
  c11 := ipolLeWi(  1,ic1,ii,A,d_x);
  c12 := ipolRiWi(ic1,56 ,ii,A,d_x);
  d_x := d*(Cont-id2)+id2;
  c21 := ipolLeWi( 57,ic2,ii,A,d_x);
  c22 := ipolRiWi(ic2,112,ii,A,d_x);
  rC501 := (c11+c12)/2;
  rC502 := (c21+c22)/2;
end;



(*===============================================================*)
(*                                                               *)
(*                                                               *)
(*   проект оценки скорости по бисекторам разных сегментов       *)
(*              на профиле интенсивности                         *)
(*                                                               *)
(*                                                               *)
(*===============================================================*)

{

(*------------------------------*)
(* из профиля интенсивности AY  *)
(* из его фрагмента от i1 до i2 *)
(* kp - направление дисперсии 1/2 <-> прямое/обратное *)
(* dc - уровень конгтинуума          *)
(* y1 - заданный уровень пересечения *)
(*-----------------------------------*)
(* yy1 - фактический уровень пересечения *)
(* x1  - левый "индекс" пересечения      *)
(* x2  - правый "индекс" пересечения     *)

procedure GetSegmentP(AY:TAIn;i1,i2,k,kp:integer;dc,y1:real;
                       var ii : integer; var x1,x2,yy1:real);
var iii : integer;
begin
    (*==========================================*)
    (* первая точка описателей сегмента axs,ays *)
    (* правая (первая) точка правого крыла      *)

    case k of
    1 : begin        (* крайний сегмент - особый случай *)
          case kp of
          1 : iii := i1;   (* левая граница  *)
          2 : iii := i2;   (* правая граница *)
          end;

          x1  := iii;     (* x-граница "фрейма" текущего сегмента *)
          yy1 := AY[iii]; (* может БЫТЬ < dc *)

          if dc < yy1 then begin (* точка AY[i1] оказалась выше континуума *)
            yy1 := dc;
            case kp of
              1 : x1 := ipolLeWi(i1,i2,ii,AY,yy1);
              2 : x1 := ipolRiWi(i1,i2,ii,AY,yy1);
                  (* ipolLe/RiWi возвращает индекс ii в массиве AY!*)
            end;
          end
          else ii := iii;
        end;
        (*-------------------------*)
 2..5,7..9 : begin
          yy1 := y1;
          case kp of
          1 : x1 := ipolLeWi(i1,i2,ii,AY,yy1); (* interpolLeftWing  *)
          2 : x1 := ipolRiWi(i1,i2,ii,AY,yy1); (* interpolRightWing *)
          end;
          if (abs(x1-x2) > 0.001) then begin
            WarnAbs('LineMetrix-WARN левая гран.сегмента '+ISt(k)+'='+
            EFSt0(x1,6)+' <> '+EFSt0(x2,6)+' прав.гран.предыдущ.сегмента!');
          end;
          x1  := x2; (* первая точка = наследство последней точки для k-1 *)
                     (* первая точка = верхняя=правая точка *)
        end;
        (*-------------------------*)
    6 : begin
          yy1 := y1;
          case kp of
          1 : x1 := ipolLeWi(i1,i2,ii,AY,yy1);
          2 : x1 := ipolRiWi(i1,i2,ii,AY,yy1);
          end;
      end;
    end;  (* case *)
    (*------------------------------------------*)
end; (* GetSegmentP *)

procedure GetSegmentP(AX,AY:TARe;i1,i2,k,kp:integer;dc,y1:real;
                       var ii : integer; var x1,x2,yy1:real);
var iii : integer;
begin

    (* 1  :   0 ..  20%  *)
    (* 2  :  20 ..  40%  *)
    (* 3  :  40 ..  60%  *)
    (* 4  :  60 ..  80%  *)
    (* 5  :  80 .. 100%  *)
                                     // ПРИ МЕР НО !!!
    (* 6  :  10 ..  30%  *)
    (* 7  :  30 ..  50%  *)
    (* 8  :  50 ..  70%  *)
    (* 9  :  70 ..  90%  *)

    (*==========================================*)
    (* первая точка описателей сегмента axs,ays *)
    (* правая (первая) точка правого крыла      *)

    case k of
    1 : begin        (* крайний сегмент - особый случай *)
          case kp of
          1 : iii := i1;   (* левая граница  *)
          2 : iii := i2;   (* правая граница *)
          end;

          x1  := AX[iii]; (* x-граница "фрейма" текущего сегмента *)
          yy1 := AY[iii]; (* может БЫТЬ < dc *)

          if dc < yy1 then begin (* точка AY[i1] оказалась выше континуума *)
            yy1 := dc;
            case kp of
              1 : x1 := ipolLeWi(i1,i2,ii,AX,AY,yy1);
              2 : x1 := ipolRiWi(i1,i2,ii,AX,AY,yy1);
                  (* ipolLe/RiWi возвращает индекс ii в массиве AY!*)
            end;
          end
          else ii := iii;
        end;
        (*-------------------------*)
 2..5,7..9 : begin
          yy1 := y1;
          case kp of
          1 : x1 := ipolLeWi(i1,i2,ii,AX,AY,yy1);
          2 : x1 := ipolRiWi(i1,i2,ii,AX,AY,yy1);
          end;
          if (abs(x1-x2) > 0.001) then begin
            WarnAbs('LineMetrix-WARN левая гран.сегмента '+ISt(k)+'='+
            EFSt0(x1,6)+' <> '+EFSt0(x2,6)+' прав.гран.предыдущ.сегмента!');
          end;
          x1  := x2; (* первая точка = наследство последней точки для k-1 *)
                     (* первая точка = верхняя=правая точка *)
        end;
        (*-------------------------*)
    6 : begin
          yy1 := y1;
          case kp of
          1 : x1 := ipolLeWi(i1,i2,ii,AX,AY,yy1);
          2 : x1 := ipolRiWi(i1,i2,ii,AX,AY,yy1);
          end;
      end;
    end;  (* case *)
    (*------------------------------------------*)
end; (* GetSegmentP *)



procedure GetSegmentP2(AY:TAIn;i1,i2,k,kp:integer;dc,y1:real;
                       var ii,j,iMin : integer; var x1,x2,yy1,y2,yy2:real;
                       var axs,ays:TARe);
begin

    (* kp = 2 правое крыло                *)
    (*====================================*)
    (*    далее ищем x2, y2               *)
    (*------------------------------------*)
    (* левая (вторая) точка правого крыла *)
    (*====================================*)

    (* kp = 1 левое крыло *)
    (*==========================================================*)
    (*    далее ищем x2, y2 (правая точка левого крыла)         *)
    (* параллельно собираем точки в axs,ays для расчёта площади *)
    (*==========================================================*)


    case k of
     5 : begin (* отдельно обрабатываем крайний нижний сегмент *)
           case kp of
           2 : RiWiPP(axs,ays,AY,j,ii,iMin,yy1,y2);
           1 : LeWiPP(axs,ays,AY,j,ii,iMin,yy1,y2);
           end; (* case *)
           (* назначение последней точки сегмента *)
           x2  := iMin;
           yy2 := AY[iMin];
         end;

1..4,6..9 : begin  (* это не последний сегмент *)
           case kp of
           1 : LeWiPP(axs,ays,AY,j,ii,iMin,yy1,y2); (* сбор точек для суммирования *)
           2 : RiWiPP(axs,ays,AY,j,ii,iMin,yy1,y2); (* сбор точек для суммирования *)
           end; (* case *)

           if ((kp = 2) and (ii >= i2)) or
              ((kp = 1) and (ii <= 1 )) then begin
             WarnAbs('LineMetrix СБОЙ ii='+ISt(II)+' k='+ISt(k)+
             ' y1='+EFSt0(yy1,4)+' y2='+EFSt0(y2,4)+' j='+ISt(j)+
             ' iMin='+ISt(iMin)
             );
           end;

           (* назначение последней точки сегмента *)
           case kp of
           1 : x2 := RiPoLeWi(ii,AY,y2);
           2 : x2 := LePoRiWi(ii,AY,y2);
           end; (* case *)
           yy2 := y2;
         end;
    end; (* case *)
end; (* GetSegmentP2 *)

procedure GetSegmentP2(AX,AY:TARe;i1,i2,k,kp:integer;dc,y1:real;
                       var ii,j,iMin : integer; var x1,x2,yy1,y2,yy2:real;
                       var axs,ays:TARe);
begin

    (* kp = 2 правое крыло                *)
    (*====================================*)
    (*    далее ищем x2, y2               *)
    (*------------------------------------*)
    (* левая (вторая) точка правого крыла *)
    (*====================================*)

    (* kp = 1 левое крыло *)
    (*==========================================================*)
    (*    далее ищем x2, y2 (правая точка левого крыла)         *)
    (* параллельно собираем точки в axs,ays для расчёта площади *)
    (*==========================================================*)


    case k of
     5 : begin (* отдельно обрабатываем крайний нижний сегмент *)
           case kp of
           2 : RiWiPP(axs,ays,AX,AY,j,ii,iMin,yy1,y2);
           1 : LeWiPP(axs,ays,AX,AY,j,ii,iMin,yy1,y2);
           end; (* case *)
           (* назначение последней точки сегмента *)
           x2  := AX[iMin];
           yy2 := AY[iMin];
         end;

1..4,6..9 : begin  (* это не последний сегмент *)
           case kp of
           1 : LeWiPP(axs,ays,AX,AY,j,ii,iMin,yy1,y2); (* сбор точек для суммирования *)
           2 : RiWiPP(axs,ays,AX,AY,j,ii,iMin,yy1,y2); (* сбор точек для суммирования *)
           end; (* case *)

           if ((kp = 2) and (ii >= i2)) or
              ((kp = 1) and (ii <= 1 )) then begin
             WarnAbs('LineMetrix СБОЙ ii='+ISt(II)+' k='+ISt(k)+
             ' y1='+EFSt0(yy1,4)+' y2='+EFSt0(y2,4)+' j='+ISt(j)+
             ' iMin='+ISt(iMin)
             );
           end;

           (* назначение последней точки сегмента *)
           case kp of
           1 : x2 := RiPoLeWi(ii,AX,AY,y2);
           2 : x2 := LePoRiWi(ii,AX,AY,y2);
           end; (* case *)
           yy2 := y2;
         end;
    end; (* case *)
end; (* GetSegmentP2 *)




procedure FillSegmentPoints(AY:TAIn;
            k,kside,i1,i2:integer;dc,dd5:real;
            var nj:integer;var axs,ays:TARe;
            var  x1,y1,x2,y2 : real;
            var  ii,iMin : integer
            );
var
  yy1,yy2 : real;
//k  : integer; (* индекс сегмента (не совпадает с номером!) *)
  j  : integer;
//ms : integer;
begin
  GetSegmentYY(k,dc,dd5,y1,y2);
  GetSegmentP(AY,i1,i2,k,kside,dc,y1,ii,x1,x2,yy1);

  j := 0; inc(j);
  axs[j] := x1;
  ays[j] := yy1;

  (*====================================*)
  (*    далее ищем x2, y2               *)
  (*------------------------------------*)
  (* левая (вторая) точка правого крыла *)
  (*====================================*)

  GetSegmentP2(AY,i1,i2,k,kside,dc,y1,ii,j,iMin,x1,x2,yy1,y2,yy2,axs,ays);

  (* внесём последнюю точку сегмента в axs,ays *)
  inc(j);
  axs[j] := x2;
  ays[j] := yy2;
  nj := j;
end; (* FillSegmentPoints *)


procedure FillSegmentPoints(AX,AY:TARe;
            k,kside,i1,i2:integer;dc,dd5:real;
            var nj:integer;var axs,ays:TARe;
            var  x1,y1,x2,y2 : real;
            var  ii,iMin : integer
            );
var
  yy1,yy2 : real;
//k  : integer; (* индекс сегмента (не совпадает с номером!) *)
  j  : integer;
//ms : integer;
begin
  GetSegmentYY(k,dc,dd5,y1,y2);
  GetSegmentP(AX,AY,i1,i2,k,kside,dc,y1,ii,x1,x2,yy1);

  j := 0; inc(j);
  axs[j] := x1;
  ays[j] := yy1;

  (*====================================*)
  (*    далее ищем x2, y2               *)
  (*------------------------------------*)
  (* левая (вторая) точка правого крыла *)
  (*====================================*)

  GetSegmentP2(AX,AY,i1,i2,k,kside,dc,y1,ii,j,iMin,x1,x2,yy1,y2,yy2,axs,ays);

  (* внесём последнюю точку сегмента в axs,ays *)
  inc(j);
  axs[j] := x2;
  ays[j] := yy2;
  nj := j;
end; (* FillSegmentPoints *)
}


(*                                                          *)
(*             АНАЛИЗ ПРОФИЛЕЙ (ИНТЕНСИВНОСТИ)              *)
(*                                                          *)
(*==========================================================*)


{
(*==========================================================*)
(*                                                          *)
(*                   РАСЧЁТ БИСЕКТОРОВ                      *)
(*                                                          *)
(*==========================================================*)


(* бывшая LineMetrix, но без вычисления вершин *)
(* просто получаем d0 и lam0 как параметры *)
procedure CalcBisec9(i1,i2:integer;AY:TAIn;dc:real;
//                   var dld,lam0,d0:real;
                         var lam0,d0:real;
//                   var SL:TStringList;
                     var AC5,AW5:TABisec;       (* [1..mBisec] of real *)
//                   var AD3,AC3,AI3 : TA3_5;
                     var ABL,ABR:TABisec; (* массивы левой и правой границ *)
                     var NE:integer);
var

//ABL,ABR : TABisec; (* [1..mBisec] of real - массивы левой и правой границ *)

  DeltaY,dd5 : real; (* разница dc - d0 и её 1/5 часть в исх.ед-цах Cont *)

  k   : integer; (* счётчик точек бисектора (могут быть не по порядку!) *)
  i   : integer;
  ii  : integer;

  y1,y2 : real;   (* границы сегмента 1..mBisec *)
  yy1   : real;   (* = ays1[1]      - первая    реальная точка сегмента *)
  yy2   : real;   (* = ays1[mBisec] - последняя реальная точка сегмента *)


(*
  yy1 может отличаться от y1 в первом    сегменте
  yy2 может отличаться от y2 в последнем сегменте
*)

  y       : real;
  y_1,y_2 : real;

// Временно на период отладки
//  SL : TStringList;

  ix1,ix2 : integer; (* индексы для прохода через сегмент *)

  x1,x2 : real;
  (* в первом сегменте x1 может совпадать с i1 *)
  (* либо с позицией первого пересечения с dc  *)
  (* в последнем сегменте x2 совпадает с iMin  *)

  axs,ays : TARe;  (* массивы для точек сегментов *)
  ms : integer;    (* макс. теоретический размер массивов axs,ays *)
  kkk : integer;

  j  : integer; (* индекс для массивов axs, ays *)
  nj : integer;

  ss : real; (* сумма площадей трапеций сегмета *)
  ds : real;
  s2 : real; (* площадь "фрейма" *)

  iMin : integer;
  kMin : integer;
//NE   : integer;


  S : string;

  DLD0 : real; (* начальное приближение доплеровской ширины (в точках) *)
  ddld : real; (* начальный шаг подгонки DLD *)
  dlam : real;
  d_d0 : real; (* в единицах континуума dc *)

  i1_0,i2_0 : integer; (* начальные краницы сегмента - до коррекции *)

  kside : integer;

begin
  Time_routine('CalcBisec9',true);
  (*==================================================================*)
  (*==================================================================*)
  (*==================================================================*)
  (*==================================================================*)
  (*==================================================================*)
  (*==================================================================*)

//GetMonoExtremum(AY,i1,i2,lam0,d0,iMin,NE);

  (* число вершин(экстремумов) во фрагменте массива AY без учёта мелких пиков *)
  NE := ExtremumsSmoothedN(AY,i1,i2,0.1);

  (* ослабим условие минимальных пиков до 0.2(=20%) от амплитуды *)
  if NE > 4 then NE := ExtremumsSmoothedN(AY,i1,i2,0.2);



  if NE > 4 then begin

  (*------------------------------------------*)
  (* ДО вызова процедуры надо быть уверенным  *)
  (* что отрезок профиля содержит только одну *)
  (* вершину (не считая пичков < 10% или 20%) *)
  (* иначе процедура выдаёт вместо бисекторов *)
  (* нули                                     *)
  (*------------------------------------------*)

    for k := 1 to mBisec do begin
      AC5[k] := 0;
      AW5[k] := 0;
    end;
//  d0 := 100*d0/dc;

    Time_routine('CalcBisec9',false);
    Exit;   (* для "сложных" профилей бисекторы не рассчитываем *)
  end;


//SL := TStringList.Create;

//d0 := AI3[3]; (* d0 для 3-х точек *)


  Time_routine('CalcBisec9_2',true);

  (*-----------------------------------------------------------------*)
  (* корректируем i1,i2 так, чтобы внутри профиля не оказались точки *)
  (* выше уровня континуума                                          *)
  (*-----------------------------------------------------------------*)
  i1_0 := i1; i2_0 := i2;

  (* уточнить границы, выбрав область "монотонного минимума"    *)
  ReFineMinBounds(AY,dc,i1_0,i2_0,i1,i2);
  (* данная операция может сделать стороны несимметричными      *)
  (* и таким образом гарантировать ошибочное значение бисектора *)

  (*                                                                 *)
  (*-----------------------------------------------------------------*)

  AInMinPoint(AY,i1,i2,iMin,kMin);
  d0   := kMin;
  lam0 := iMin;

  DeltaY := dc - d0;
  dd5 := DeltaY/5; (* d/5 *)
  ms := (i2-i1+1); (* размерность подмассива профиля, к-рый режем на сегменты *)
                   (* число точек для одного сегмента в среднем = ms/5        *)
  SetLength(axs,ms+1);
  SetLength(ays,ms+1);

//y1 := dc;
  x2 := i1; (* i1 граница под-массива проф.Стокса I внутри к-рого идёт расчёт *)

  kside := 1; (* левое крыло *)
  for k := 1 to mBisec do begin

    (* операцию выполняем для левой и правой половины             *)
    (* независимо друг от друга                                   *)

    (* сначала заполняем массивы для точек сегментов *)

    FillSegmentPoints(AY,k,kside,i1,i2,dc,dd5,nj,axs,ays,
    x1,y1,x2,y2,
    ii,iMin);


    (*========================================*)
    (*========================================*)
    (* здесь массивы ays,axs заполнены -      *)
    (*   вычисляем СРЕДНЕЕ X сегмента         *)
    (* как сумму площадей трапеция, делённую  *)
    (*   на площадь "фрейма"                  *)

    ss := 0;
    s2 := (y2-y1)*(x2-x1);  (* площадь фрейма *)

    for j := 2 to nj do begin
      ds := (ays[j]-ays[j-1])*(((axs[j]-x1)+(axs[j-1]-x1))/2);
//    ds := (ays[j]-ays[j-1])*(( axs[j]    + axs[j-1])    /2);
      ss := ss + ds;
    end;
    ABL[k] := x1 + (x2-x1) * ss/s2;

  (*--------------------------------------------------------------------------*)
  end; (* for k *)



  Time_routine('CalcBisec9_2',false);



  (*======================================*)
  (*======================================*)
  (*======================================*)
  (* всё то же самое но для правого крыла *)
  (*======================================*)
  (*======================================*)
  (*======================================*)


  Time_routine('CalcBisec9_3',true);


  kside := 2; (* правое крыло *)
  x2 := i2;
  for k := 1 to mBisec do begin
    FillSegmentPoints(AY,k,kside,i1,i2,dc,dd5,nj,axs,ays,
    x1,y1,x2,y2,
    ii,iMin);

    (*========================================*)
    (*========================================*)
    (* здесь массивы ays,axs заполнены -      *)
    (*   вычисляем СРЕДНЕЕ X сегмента         *)
    (* как сумму площадей трапеция, делённую  *)
    (*   на площадь "фрейма"                  *)

    ss := 0;
    s2 := (y2-y1)*(x2-x1);

    if (s2 = 0) then begin
      WarnAbs('CalcBisec9-ERR: площадь сегмента '+ISt(k)+'=0 '+
      ' x1='+EFSt0(x1,4)+' x2='+EFSt0(x2,4)+' y1='+EFSt0(y1,4)+
      ' y2='+EFSt0(y2,4));
      Exit;
    end;

    for j := 2 to nj do begin
      ds := (ays[j]-ays[j-1])*(((axs[j]-x1)+(axs[j-1]-x1))/2);
      ss := ss + ds;
    end;
    ABR[k] := x1 + (x2-x1) * ss/s2;




  end; (* for k *)

  Time_routine('CalcBisec9_3',false);

  for k := 1 to mBisec do begin
    AC5[k] := (ABL[k] + ABR[k])/2;
    AW5[k] := (ABR[k] - ABL[k]);
  end;

  finalize(axs);
  finalize(ays);

  Time_routine('CalcBisec9',false);




end; (* CalcBisec9 *)



procedure CalcBisec9(i1,i2:integer;AX,AY:TARe;dc:real;
                         var lam0,d0:real;
                     var AC5,AW5:TABisec;       (* [1..mBisec] of real *)
                     var ABL,ABR:TABisec; (* массивы левой и правой границ *)
                     var NE:integer);
var
  DeltaY,dd5 : real; (* разница dc - d0 и её 1/5 часть в исх.ед-цах Cont *)
  k   : integer; (* счётчик точек бисектора (могут быть не по порядку!) *)
  i   : integer;
  ii  : integer;
  y1,y2 : real;   (* границы сегмента 1..mBisec *)
  yy1   : real;   (* = ays1[1]      - первая    реальная точка сегмента *)
  yy2   : real;   (* = ays1[mBisec] - последняя реальная точка сегмента *)
  y       : real;
  y_1,y_2 : real;
  ix1,ix2 : integer; (* индексы для прохода через сегмент *)
  x1,x2 : real;
  axs,ays : TARe;  (* массивы для точек сегментов *)
  ms : integer;    (* макс. теоретический размер массивов axs,ays *)
  kkk : integer;
  j  : integer; (* индекс для массивов axs, ays *)
  nj : integer;
  ss : real; (* сумма площадей трапеций сегмета *)
  ds : real;
  s2 : real; (* площадь "фрейма" *)
  iMin : integer;
  rMin : real;
  S : string;
  DLD0 : real; (* начальное приближение доплеровской ширины (в точках) *)
  ddld : real; (* начальный шаг подгонки DLD *)
  dlam : real;
  d_d0 : real; (* в единицах континуума dc *)
  i1_0,i2_0 : integer; (* начальные краницы сегмента - до коррекции *)
  kside : integer;

  AI : Array [1..9] of integer;
begin

  AI[1] := 1;
  AI[2] := 3;
  AI[3] := 5;
  AI[4] := 7;
  AI[5] := 9;
  AI[6] := 2;
  AI[7] := 4;
  AI[8] := 6;
  AI[9] := 8;


  Time_routine('CalcBisec9',true);

  (* число вершин(экстремумов) во фрагменте массива AY без учёта мелких пиков *)
  NE := ExtremumsSmoothedN(AY,i1,i2,0.1);

  (* ослабим условие минимальных пиков до 0.2(=20%) от амплитуды *)
  if NE > 4 then NE := ExtremumsSmoothedN(AY,i1,i2,0.2);
  if NE > 4 then begin
  (*------------------------------------------*)
  (* ДО вызова процедуры надо быть уверенным  *)
  (* что отрезок профиля содержит только одну *)
  (* вершину (не считая пичков < 10% или 20%) *)
  (* иначе процедура выдаёт вместо бисекторов *)
  (* нули                                     *)
  (*------------------------------------------*)
    for k := 1 to mBisec do begin
      AC5[k] := 0;
      AW5[k] := 0;
    end;
    Time_routine('CalcBisec9',false);
    Exit;   (* для "сложных" профилей бисекторы не рассчитываем *)
  end;

  Time_routine('CalcBisec9_2',true);

  (*-----------------------------------------------------------------*)
  (* корректируем i1,i2 так, чтобы внутри профиля не оказались точки *)
  (* выше уровня континуума                                          *)
  (*-----------------------------------------------------------------*)
  i1_0 := i1; i2_0 := i2;

  (* уточнить границы, выбрав область "монотонного минимума"    *)
  ReFineMinBounds(AY,dc,i1_0,i2_0,i1,i2);
  (* данная операция может сделать стороны несимметричными      *)
  (* и таким образом гарантировать ошибочное значение бисектора *)

  (*                                                                 *)
  (*-----------------------------------------------------------------*)

  AReMinPoint(AY,i1,i2,iMin,rMin);
  d0   := rMin;
  lam0 := AX[iMin];

  DeltaY := dc - d0;
  dd5 := DeltaY/5; (* d/5 *)
  ms := (i2-i1+1); (* размерность подмассива профиля, к-рый режем на сегменты *)
                   (* число точек для одного сегмента в среднем = ms/5        *)
  SetLength(axs,ms+1);
  SetLength(ays,ms+1);

//y1 := dc;
  x2 := i1; (* i1 граница под-массива проф.Стокса I внутри к-рого идёт расчёт *)

  kside := 1; (* левое крыло *)
  for k := 1 to mBisec do begin

    (* операцию выполняем для левой и правой половины             *)
    (* независимо друг от друга                                   *)

    (* сначала заполняем массивы для точек сегментов *)

    FillSegmentPoints(AX,AY,k,kside,i1,i2,dc,dd5,nj,axs,ays,
    x1,y1,x2,y2,
    ii,iMin);


    (*========================================*)
    (*========================================*)
    (* здесь массивы ays,axs заполнены -      *)
    (*   вычисляем СРЕДНЕЕ X сегмента         *)
    (* как сумму площадей трапеция, делённую  *)
    (*   на площадь "фрейма"                  *)

    ss := 0;
    s2 := (y2-y1)*(x2-x1);  (* площадь фрейма *)

    for j := 2 to nj do begin
      ds := (ays[j]-ays[j-1])*(((axs[j]-x1)+(axs[j-1]-x1))/2);
//    ds := (ays[j]-ays[j-1])*(( axs[j]    + axs[j-1])    /2);
      ss := ss + ds;
    end;
    ABL[AI[k]] := x1 + (x2-x1) * ss/s2;

  (*--------------------------------------------------------------------------*)
  end; (* for k *)



  Time_routine('CalcBisec9_2',false);



  (*======================================*)
  (*======================================*)
  (*======================================*)
  (* всё то же самое но для правого крыла *)
  (*======================================*)
  (*======================================*)
  (*======================================*)


  Time_routine('CalcBisec9_3',true);


  kside := 2; (* правое крыло *)
  x2 := i2;
  for k := 1 to mBisec do begin
    FillSegmentPoints(AX,AY,k,kside,i1,i2,dc,dd5,nj,axs,ays,
    x1,y1,x2,y2,
    ii,iMin);

    (*========================================*)
    (*========================================*)
    (* здесь массивы ays,axs заполнены -      *)
    (*   вычисляем СРЕДНЕЕ X сегмента         *)
    (* как сумму площадей трапеция, делённую  *)
    (*   на площадь "фрейма"                  *)

    ss := 0;
    s2 := (y2-y1)*(x2-x1);

    if (s2 = 0) then begin
      WarnAbs('CalcBisec9-ERR: площадь сегмента '+ISt(k)+'=0 '+
      ' x1='+EFSt0(x1,4)+' x2='+EFSt0(x2,4)+' y1='+EFSt0(y1,4)+
      ' y2='+EFSt0(y2,4));
      Exit;
    end;

    for j := 2 to nj do begin
      ds := (ays[j]-ays[j-1])*(((axs[j]-x1)+(axs[j-1]-x1))/2);
      ss := ss + ds;
    end;
    ABR[AI[k]] := x1 + (x2-x1) * ss/s2;



  end; (* for k *)

  Time_routine('CalcBisec9_3',false);

  for k := 1 to mBisec do begin
    AC5[k] := (ABL[k] + ABR[k])/2;
    AW5[k] := (ABR[k] - ABL[k]);
  end;

  finalize(axs);
  finalize(ays);

  Time_routine('CalcBisec9',false);
end; (* CalcBisec9 *)


(*                                                          *)
(*                   РАСЧЁТ БИСЕКТОРОВ                      *)
(*                                                          *)
(*==========================================================*)

}







{
(*===================================================*)
(* процедура сделана по аналогии с LineCenter1_IR    *)
(* на входе - целочисленный массив интенсивностей AY *)
(* i1,i2 - границы массива внутри к-рых идет расчёт  *)
(* при этом AY[i1 или i2]- экстремумы (края)         *)
(* значение dc определяет уровень континуума         *)
(* сначала находим центральный минимум -             *)
(* его уровень d0 и его положение c0                 *)
(* затем делим область от dc до d0 на 5(9) частей    *)
(*                                                   *)
(* для каждой из частей определяем центр тяжести   - *)
(*  сначала ищем крайние значения x11,x12 и x21,x22  *)
(*  сегментов крыла                                  *)

procedure LineMetrix(i1,i2:integer;AY:TAIn;dc:real;
                     var dld,lam0,d0:real;
//                   var SL:TStringList;
                     var AC5,AW5:TABisec;       (* [1..mBisec] of real *)
                     var AD3,AC3,AI3 : TA3_5;
                     var NE:integer);
var
  ABL,ABR : TABisec; (* [1..mBisec] of real - массивы левой и правой границ *)
  iMin : integer;
  DLD0 : real; (* начальное приближение доплеровской ширины (в точках) *)
  ddld : real; (* начальный шаг подгонки DLD *)
  dlam : real;
  d_d0 : real; (* в единицах континуума dc *)
begin
  Time_routine('LineMetrix',true);

  WarnAbs('Процедура LineMetrix вызывет устаревший способ расчёта гауссианы!');

  (*-------------------------------------------------------*)
  (* сначала находим положение точки вершины профиля c0,d0 *)
  (* AY - целочисленный массив профиля интенсивности       *)
  (*-------------------------------------------------------*)
  DLD0 := 5.0; ddld := 0.2; dlam := 0.1; d_d0 := -0.01*dc;
  Get3GaussPar(AY,i1,i2,dc,
               DLD0,ddld,dlam,d_d0,AD3,AC3,AI3,iMin,NE);

  (* ------------------------ *)
  (* далее используется d0,   *)
  (* найденный по 4-ём точкам *)
  (* ------------------------ *)
  d0   := AI3[3];
  Lam0 := AC3[3];

  CalcBisec9(i1,i2,AY,dc,lam0,d0,AC5,AW5,ABL,ABR,NE);
  d0 := d0/dc*100;

  Time_routine('LineMetrix',false);
end;



(*                                                   *)
(*                 Line  Metrix                      *)
(*                                                   *)
(*===================================================*)
}






(*===================================================*)
(*                                                   *)
(*           Запись ЛЮБОГО Хидера в файл             *)
(*                                                   *)
(*===================================================*)



(* записать строки SL в файл с именем sFN, начиная со смещения ib0 *)
(* число строк SL делается кратным 36                              *)
(* (при необходимости дополняем пустыми строками)                  *)
procedure WriteHeader(sFN:string;ib0:longint;SL:TStringList);
const nStr = 80;
var B80 : array [1..nStr] of char;
  S : string;
  I,J : integer;
begin

  S := SSt('',80);

  I := SL.Count-1;
  while (pos('END',SL.Strings[I]) <> 1) and (I>0) do dec(I);

  if I <=0 then begin
    WarnAbs('WriteHeader '+sFN+#13#10+
    'не найдена строка "END"');
    Exit;
  end;

  J := I;
  for I := J+1 to (SL.Count - 1) do SL.Strings[I] := S;

  (*--- дополним Header пустыми строками до числа строк, кратного 36 ---*)

  while (SL.Count mod 36) <> 0 do SL.Add(S);

  for I := 0 to SL.Count-1 do begin
    S := SL.Strings[I];
    S := SSt(S,80);     (* дополним строку пробелами до 80 символов *)
    for J := 1 to 80 do B80[J] := S[J];    (* перенесём в буфер B80 *)

    (* FileWrRec - это запись в режиме прямого доступа *)
    (* запись начинается с позиции ib0 + (I+1)*80      *)
    (* ib0  = HeadSize *)
    (* nStr = RecSize  *)
    (* I+1  = iRec     *)
    if Not swFile.FileWrRec(sFN,ib0,nStr,I+1,B80) then begin
      WarnAbs('Ошибка при записи блока в файл '+#13#10+
      '<'+sFN+'>'+#13#10+
      'I = '+ISt(I)+' nb0='+ISt(ib0)+', LStr=80'+#13#10+
      'IOResult of Reset = '+ISt(swFile.IOResultLast)+#13#10+
      'ErrLast=<'+swFile.sErrLast+'>');
    end;
  end; (* for I *)
end;


(*===================================================*)
(*                                                   *)
(*           Запись Блока данных в файл              *)
(*                                                   *)
(*===================================================*)


procedure WriteAR4R4(sFN:string;ib0:longint;aData:TAR4R4);
var
  iX,iY,nX,nY,N,J : integer;
  aDataB : TABt; // array of byte;

  B4 : array[1..4] of byte;
  R4 : Real4 absolute B4;

begin
  nX := Length(aData);
  nY := Length(aData[0]);
  N := nX*nY*4;

  SetLength(ADataB,N);

//SetLength(aData,nX,nY);
  (*----- надо поменять местами байты в элементах aData типа Real4 --*)
  J := -1;
  for iY := 0 to nY-1 do begin    (* УСЛОВНАЯ КОЛОНКА ДАННЫХ *)
    for iX := 0 to nX-1 do begin  (* УСЛОВНАЯ СТРОКА ДАННЫХ *)
      R4 := aData[iX,iY];
      inc(J); aDataB[J] := B4[4]; (* сначала четвертый байт *)
      inc(J); aDataB[J] := B4[3]; (* потом третий           *)
      inc(J); aDataB[J] := B4[2]; (* потом второй           *)
      inc(J); aDataB[J] := B4[1]; (* потом первый           *)
    end;
  end;

  if Not FileWrRec1(sFN,ib0,N,1,aDataB) then begin
    WarnAbs('Ошибка при записи блока в файл '+#13#10+
    '<'+sFN+'>'+#13#10+
    'I=1, nb0='+ISt(ib0)+', LStr=80'+#13#10+
    'IOResult of Reset = '+ISt(swFile.IOResultLast)+#13#10+
    'ErrLast=<'+swFile.sErrLast+'>');
  end;

  Finalize(aDataB);

end;


(*===================================================*)
(*                                                   *)
(*               Анализ строк Хидера                 *)
(*                                                   *)
(*===================================================*)



(* извлечь комментарий из строки хидера *)
function GetFITCom(s80:string):string;
var S : string;
begin
  S := RightFrom(s80,32);
  S := RightFrom(S,'/');
  result := Trim(S);
end;

(* извлечь строковое значение из строки хидера *)
function GetFITVal(s80:string):string;
var S,w : string;
begin
  S := swStr.right(s80,'=');
  w := RightFrom(S,23);
  S := Trim(swStr.left(S,22) + swStr.left(w,'/'));
  S := swStr.TrimAnyQuot(S,#39);
  result := Trim(S);
end;

function rdHdVar(sKey:string;var R:real):boolean;
var IErr : integer; S : string;
begin
  IErr := 0;
  if Not Assigned(LFIO) then begin
    WarnAbs('rdHdVar('+sKey+') LFIO ещё не создан!');
    result := false;
    Exit;
  end;
  S := GetFITKey(sKey,LFIO.HswSL,0,72);
  if S = '' then S := GetFITKey(sKey,LFIO.HmeSL,0,72);
  if S = '' then R := 0 else
    Val(S,R,IErr);    (* пытаемся интерпретировать как число *)
  if IErr <> 0 then begin
    WarnAbs('В Header-е sw(me)-FITS файла в переменной '+sKey+#13#10+
            ' найдена некорректная запись для числа'+#13#10+
            '<'+S+'>');
    result := false;
  end
  else result := true;
end;



(* извлечь ключ из строки хидера *)
function GetFITKey(s80:string):string;
var S : string;
begin
  S := swStr.left(s80,'=');
  result := Trim(S);
end;


(* заменить в хидере строку, котрая соответствует ключу *)
(* если ключ есть, а значения новое и старое совпадают - вернуть False *)
(* если ключа нет - попытаться заменить строку с альтернативным ключом *)
(* если альтернативного нет - добавить ещё одну строку в хидер *)
(*    HSL содержит нужный хидер целиком *)
function ChangeFITKey(sKey,sKeyOld,sVal,sCom:string;
                      var HSL:TStringList
                      ):boolean;
var S : string;
begin
  S := GetFITKey(sKey,HSL);
end;


function GetFITsVal(sHd:string):string;
var S,w : string;
begin
  result := '';
  if sHd = '' then Exit;
  S := swStr.right(sHd,'=');           (* "откусить" ключ *)
  w := RightFrom(S,23);
  S := Trim(swStr.left(S,22)           (* всегда брать первые 22 знака *)
                       + swStr.left(w,'/')); (* + далее до символа '/' *)
  S := swStr.TrimAnyQuot(S,#39); (* раскрыть кавычки, если есть *)
  S := Trim(S);                  (* выкусть пробелы и табуляции *)
  Result := S;
end;





(* получить строковое значение, которое соответствует ключу, либо '' *)
function GetFITKey(sKey:string;HSL:TStringList;i1,i2:integer):string;
var S,w,sKey0 : string; I : integer;
begin
  result := '';
  if Not Assigned (HSL) then begin
    WarnAbs(
    'Вызов GetFITKey('+sKey+') ДО создания списка строк Хидера'+#13#10+
    '- проверьте программу!');
    Exit;
  end;
  if i2 >= HSL.Count then i2 := HSL.Count - 1;
  S := GetFITKeyS80(sKey,HSL,i1,i2); (* найти строку по ключу или '' *)
  Result := GetFITsVal(S);
end;


(* найти строку по ключу в заданных границах от i1 до i2 *)
(* возвращает '', если ключ не найден                    *)
function GetFITKeyS80(sKey:string;HSL:TStringList;i1,i2:integer):string;
var S,w,sKey0 : string; I : integer;
begin
  if (i1 < 0) or (i2 < 0) or (i1 >= HSL.Count) or (i2 >= HSL.Count) or
     (i2 < i1) then begin
      WarnAbs('GetFITKeyS80 ERROR: для ключа <'+sKey+'> '+#13#10+
      'заданы недопустиме граничные индексы!'+#13#10+
      'i1='+ISt(i1)+' i2='+ISt(i2)+' SL.Count='+ISt(HSL.Count)
      );
    result := '';
    Exit;
  end;

  I := i1;                  //  I1 := 0;
  while (I <= i2) do begin  // (I <= nsHead-1)
    sKey0 := Trim(left(HSL.Strings[I],8));
    if (sKey = sKey0) then begin
      result := HSL.Strings[I];
      Exit;
    end;
    inc(I);
  end;
  result := '';
end;

function GetFITKeyS80(sKey:string;HSL:TStringList):string;
begin result := GetFITKeyS80(sKey,HSL,0,HSL.Count-1) end;


function GetFITKeyI(sKey:string;HSL:TStringList;i1,i2:integer):integer;
var I : integer; IErr : integer; S : string;
begin
  I := 0;
  S := GetFITKey(sKey,HSL,i1,i2);
  if S = '' then begin
    WarnAbs('GetFITKeyI WARNING: Key <'+sKey+'> Not Found!'+#13#10+
    'i1='+ISt(i1)+' i2='+ISt(i2)+' SL.Count='+ISt(HSL.Count));
  end
  else begin
    Val(S,I,IErr);
    if IErr <> 0 then begin
      WarnAbs('GetFITKeyI WARNING: для ключа <'+sKey+'> '+#13#10+
      'найдено недопустимое целое значение <'+S+'> !!!'+#13#10+
      'i1='+ISt(i1)+' i2='+ISt(i2)+' SL.Count='+ISt(HSL.Count)
      );
    end;
  end;
  result := I;
end;

function GetFITKeyI(sKey:string;HSL:TStringList):integer;
begin result := GetFITKeyI(sKey,HSL,0,HSL.Count-1); end;

function GetFITKeyR(sKey:string;HSL:TStringList):real;
begin result := GetFITKeyR(sKey,HSL,0,HSL.Count-1); end;

function GetFITKeyR(sKey:string;r0:real;HSL:TStringList):real;
begin result := GetFITKeyR(sKey,HSL,r0,0,HSL.Count-1); end;


function GetFITKey (sKey:string;HSL:TStringList):string;
begin result := GetFITKey (sKey,HSL,0,HSL.Count-1); end;





function GetFITKeyR(sKey:string;HSL:TStringList;i1,i2:integer):real;
var R : real; IErr : integer; S : string;
begin
  R := 0;
  S := GetFITKey(sKey,HSL,i1,i2);
  if S = '' then begin
    WarnAbs('GetFITKeyR WARNING: Key <'+sKey+'> Not Found!'+#13#10+
    'i1='+ISt(i1)+' i2='+ISt(i2)+' SL.Count='+ISt(HSL.Count));
  end
  else begin
    Val(S,R,IErr);
    if IErr <> 0 then begin
      WarnAbs('GetFITKeyR WARNING: для ключа <'+sKey+'> '+#13#10+
      'найдено недопустимое значение <'+S+'> !!!'+#13#10+
      'i1='+ISt(i1)+' i2='+ISt(i2)+' SL.Count='+ISt(HSL.Count)
      );
    end;
  end;
  result := R;
end;

function GetFITKeyR(sKey:string;HSL:TStringList;r0:real;i1,i2:integer):real;
var R : real; IErr : integer; S : string;
begin
  R := r0;
  S := GetFITKey(sKey,HSL,i1,i2);
  if S = '' then begin
    result := r0;
    Exit;
  end
  else begin
    Val(S,R,IErr);
    if IErr <> 0 then begin
      WarnAbs('GetFITKeyR WARNING: для ключа <'+sKey+'> '+#13#10+
      'найдено недопустимое значение <'+S+'> !!!'+#13#10+
      'i1='+ISt(i1)+' i2='+ISt(i2)+' SL.Count='+ISt(HSL.Count)
      );
    end;
  end;
  result := R;
end;


(*                                                   *)
(*               Анализ строк Хидера                 *)
(*                                                   *)
(*===================================================*)






(*===================================================*)
(*                                                   *)
(*                   Сырые FITS                      *)
(*                                                   *)
(*===================================================*)


procedure TFITS.MaxMinCont;
var iY : integer; i0,i1 : integer; r0,r1,r : real;
begin
  iY := 1; i0 := iY; i1 := iY; r0 := ACnt[iY]; r1 := r0;
  for iY := 2 to nY do begin
    r := ACnt[iY];
    if r < r0 then begin r0 := r; i0 := iY end else
    if r > r1 then begin r1 := r; i1 := iY end;
  end;
  CntMin := r0; CntMax := r1; iCntMin := i0; iCntMax := i1;
end;


procedure TFITS.MaxMinW;
var iY : integer; i0,i1 : integer; r0,r1,r : real;
begin
  iY := 1; i0 := iY; i1 := iY; r0 := AWI1[iY]+AWI2[iY]; r1 := r0;
  for iY := 2 to nY do begin
    r := AWI1[iY]+AWI2[iY];
    if r < r0 then begin r0 := r; i0 := iY end else
    if r > r1 then begin r1 := r; i1 := iY end;
  end;
  wMin := r0; wMax := r1; iwMin := i0; iwMax := i1;
end;


(* вычисляет среднюю для всх профилей щели длину волны (в пикселах) *)
(* без учёта искажённых/не_искажённых магнитным полем профилей      *)
procedure TFITS.MeanLamC;
var iYA : integer; r1,r2 : real;
begin
  r1 := 0; r2 := 0;
  for iYA := 1 to nY do begin
    r1 := r1 + ALC1[iYA]; r2 := r2 + ALC2[iYA];
  end;
  rLC1 := r1/nY; rLC2 := r2/nY;
end;


(* вычисляет среднюю для всх профилей щели длину волны (в пикселах) *)
(* (только для профилей не искажённых магнитным полем )             *)
procedure TFITS.MeanLamC0;
var iYA,n : integer; r1,r2 : real;
begin
  r1 := 0; r2 := 0;
  n := 0;
  for iYA := 1 to nY do begin
    if ANE[iYA] = 5 then begin  (* число экстремумов профиля инт-ти     *)
                                (* 5 - значит форма профиля - буква "W" *)
      inc(n); r1 := r1 + ALC1[iYA]; r2 := r2 + ALC2[iYA];
    end;
  end;

  Self.nLC12 := n;  (* "значимость" чисел rLC1,rLC2 *)
  if n=0 then begin (* на щели нет ни одного гладкого профиля *)
    MeanLamC;
  end
  else begin
    rLC1 := r1/n; rLC2 := r2/n;
  end;
end;


(*---------- для единичного FITS - одного положения щели -------------*)

procedure TFITS.MeanContH0;
var J,K,iYA : integer; N0 : integer; Y,LC0,KVI0,A,B : real;
  A10 : TARe; AN10 : TARe; AX,AY : TARe;
begin
//SetLength(A10 ,12+1);
//SetLength(AN10,12+1);
  SetLength(AX  ,12+1);
  SetLength(AY  ,12+1);

  K := 0;
  for J := 1 to 12 do begin
    KVI0 := J * 0.005;
    N0 := 0; LC0 := 0;
    for iYA := 1 to nY do begin
      if AKVI[iYA] < KVI0 then begin
        inc(N0); LC0 := LC0 + ACnt[iYA];
      end;
    end;
    if N0 > 0 then begin
                Y := LC0 / N0;
//              A10[J] := Y;
                inc(K);
                AX[K] := N0;
                AY[K] := Y;
              end
//            else A10[J] := 0
              ;
 // AN10[J] := N0;
  end;

  SetLength(AX  ,K+1);
  SetLength(AY  ,K+1);

  LinRegress(AX,AY,A,B);

  Finalize(AX); Finalize(AY);

  rCntH0 := B;  (* среднее значение континуума в немагнитных областях *)
end; (* TFITS.MeanContH0 *)


procedure TFITS.MaxH;
var iY : integer; i0,i1 : integer; r0,r1,r : real;
begin
  iY := 1; i0 := iY; i1 := iY; r0 := (AHM1[iY]+AHM2[iY])/2; r1 := r0;
  for iY := 2 to nY do begin
    r := (AHM1[iY]+AHM2[iY])/2;
    if r < r0 then begin r0 := r; i0 := iY end else
    if r > r1 then begin r1 := r; i1 := iY end;
  end;
  HMaxM := r0; HMaxP := r1; iHMaxM := i0; iHMaxP := i1;
end;


function TFITS.ItoLam(ILam:real):real;
begin
  result := (ILam - Self.rLamIdx0) *                 (* rLamIdx0 = 56.5 *)
             Self.rdLam +       (* rdLam = 0.021549 дисперсия A/пиксель *)
             Self.rLa0;                              (* rLa0 = 6302.080 *)
end;



function TFITS.GetALam:TARe; (* вычислить вектор длин волн *)
                             (* по данным из FITS          *)  
var A : TARe; R,DeltaLam,l6301,l6302,la1,la2 : real; I : integer; Q : boolean;
begin

  (*----------------------------------------------------*)
  (* в хидере могут быть указаны неправильные параметры *)
  (* поэтому перед заполнением массива длин волн надо   *)
  (* произвести проверку - загрузить данные FITS-а и    *)
  (* определить длины волн 6301 и 6302, если они не     *)
  (* корректны - установить ключ поправки               *)
  (*----------------------------------------------------*)

  Time_routine('FITS.GetALam',true);

  Q := false; (* необходимость проверки *)
  if rdLam < 0 then begin
    if Assigned(Self.Owner) then begin
      if TLFITS(Owner).kLamChk = 1 then begin
        rdLam := - rdLam;
        rLa0  := 6302.080;
      end else
      if TLFITS(Owner).kLamChk = 0 then Q := true;
      (* иначе (kLamChk = 0) rdLam на самом деле < 0 *)
    end
    else Q := true; (* Owner-а нет, надо проверять *)
  end;

  if Q then begin
    (* выяснили, что нужно проверять корректность задания *)
    (* rdLam и rLam0 в FITS - файле                       *)

    LoadData;            (* загрузим профили Стокса *)
    SetBit.BISB(KStep,2);(*отметим, что данные загружены 0=Link,1=Header,2=Data*)

    SetLength(ALC1,nY+1);
    SetLength(ALC2,nY+1);
    SetLength(ANE,nY+1);

    CalcCGravs0; (* находим массивы ALC1, ALC2 (без знания континуума) *)
    MeanLamC0;   (* ALC1, ALC2 => находим rLC1, rLC2 *)
    l6301 := Self.ItoLam(rLC1); (* вычисляем дл.волн, зная rdLam и rLam0 *)
    l6302 := Self.ItoLam(rLC2);

    if Assigned(Owner) then begin
      la1 := TLFITS(Owner).rLa1;
      la2 := TLFITS(Owner).rLa2;
    end
    else begin
      la1 := 6301.5008;
      la2 := 6302.4932;
    end;

    DeltaLam := (Abs(l6301 - la1) + Abs(l6302 - la2))/2;

    if DeltaLam > 0.050 then begin
      (*-------------*)
      if DeltaLam < 0.5 then begin
        (* выдаём сообщение, только если ошибка явно недотягивает *)
        (* до одного ангстрема                                    *)
        WarnAbs('FITS.GetALam Warning ОШИБКА в длинах волн'+#13#10+
                '6301.5 <> '+FSt0(l6301,3)+' 6302.5 <> '+FSt0(l6302,3)+#13#10+
                'отменяем отрицательный rdLam = '+EFSt0(rdLam,6)+'!');
      end;
      (*-------------*)
      if Assigned (Owner) then TLFITS(Owner).kLamChk := 1;
      rdLam := - rdLam;
      rLa0  := 6302.080;
    end
    else if Assigned (Owner) then TLFITS(Owner).kLamChk := 2; (* принимаем *)
                                           (* отрицательное значение rdLam *)
  end;

  SetLength(A,Self.nLam+1);
  for I := 1 to nLam do begin
//  R := (I - Self.rLamIdx0) * Self.rdLam + Self.rLam0;
//  A[I] := R;
    A[I] := Self.ItoLam(I);
  end;
  result := A;
  Time_routine('FITS.GetALam',false);
end; (* TFITS.GetALam:TARe *)



function TFITS.GetProfNormSum(AIY:TAIn):TA4Re;
var A4S : TA4Re; CONT : real; i4,iy : integer;
begin
          GetProfSum(AIY,A4S);
  CONT := GetContSum(AIY);
  for i4 := 1 to 4 do
    for iy := 0 to ny-1 do A4S[i4,iy] := A4S[i4,iy] / CONT;
  result := A4S;
end;


(* ASum - 4 массива TARe *)
(* AIY - вектор маски (вектор единичек) *)
procedure TFITS.SumProfSum(AIY:TAIn;var ASum:TA4Re);
var BSum:TA4Re;  (* накапливает данные по iY для текущего iX *)
    L,i4,I : integer;
begin

(*
  if Assigned (Self.ALC51) then begin
    WarnAbs('IX='+ISt(Self.IXI)+' ALC51-length='+ISt(length(ALC51)));
  end
  else begin
    WarnAbs('IX='+ISt(Self.IXI)+' ALC51 Not Assigned!');
  end;
*)

  L := length(ASum[1]);  (* L = 112 *)
  for i4 := 1 to 4 do SetLength(BSum[i4],L);
  GetProfSum(AIY,BSum);
  for i4 := 1 to 4 do
    for I := 0 to L-1 do ASum[i4,I] := ASum[i4,I] + BSum[i4,I];
end;




procedure TFITS.SumVLOSedProf(AIY:TAIn;AVi:TARe;var ASum:TA4Re);
var BSum:TA4Re;  (* накапливает данные по iY для текущего iX *)
    L,i4,I : integer;
begin
  L := length(ASum[1]);  (* L = 112 *)
  for i4 := 1 to 4 do SetLength(BSum[i4],L);
  VLOSedProfSum(AIY,AVi,ASum);
  for i4 := 1 to 4 do
    for I := 0 to L-1 do ASum[i4,I] := ASum[i4,I] + BSum[i4,I];
end;




(*------------------------------------------------*)
(* получить суммарный профиль по маске            *)
(* массив AIY - это маска (вектор вдоль Y)        *)
(* просто складываем интенсивности без учёта фона *)
(*------------------------------------------------*)
procedure TFITS.GetProfSum(AIY:TAIn;var A4S:TA4Re);
var i4,iy,iYA,iLam : integer; AI:TAIn;
begin
  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TFITS.GetProfSum ERROR!'+#13#10+
    'Header Not Loaded Yet!!!');
    Exit;
  end;

  if Not SetBit.IsBit(Self.KStep,2) then Self.LoadData;

{
  for i4 := 1 to 4 do SetLength(A4S[i4],Self.nLam+1);
  (* обнуляем массив *)
  for i4 := 1 to 4 do for iy := 0 to Self.nLam do A4S[i4,iy] := 0;
}

  for iy := 0 to Self.nY-1 do begin
    iYA := iy + 1;
    if AIY[iy] > 0 then begin         (* AIY 0..ny-1 *)
      for i4 := 1 to 4 do begin
        GetCol3(iYA,i4,AI);   (* AI - 112 точек. В GetCol3 счёт Y идёт от 1 *)

        for iLam := 1 to Self.nLam do
          A4S[i4,iLam] := A4S[i4,iLam] + AI[iLam];

      end;
    end;
  end;


  if TLFITS(Self.Owner).QLight then begin
    Self.ClearAData;
//  Self.ClearMData;
    SetBit.BICB(Self.KStep,2);
  end;


end;




(* AIY - вектор-маска для суммирования *)
(* AVi - вектор смещений профиля по оси длин волн в ед.индексов *)
(* A4S - накопитель профилей Стокса *)
procedure TFITS.VLOSedProfSum(AIY:TAIn;AVi:TARe;var A4S:TA4Re);
var i4,iy,iYA,iLam : integer; AI:TAIn; AR:TARe;
begin
  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TFITS.GetProfSum ERROR!'+#13#10+
    'Header Not Loaded Yet!!!');
    Exit;
  end;

  if Not SetBit.IsBit(Self.KStep,2) then Self.LoadData;

(*----------------------------*)
(* вынести из цикла по iX !!! *)

//  for i4 := 1 to 4 do SetLength(A4S[i4],Self.nLam+1);
  (* обнуляем массив *)
//  for i4 := 1 to 4 do for iy := 0 to Self.nLam do A4S[i4,iy] := 0;

(* вынести из цикла по iX !!! *)
(*----------------------------*)


  for iy := 0 to Self.nY-1 do begin
    iYA := iy + 1;
    if AIY[iy] > 0 then begin         (* AIY 0..ny-1 *)
      for i4 := 1 to 4 do begin
        GetCol3(iYA,i4,AI);   (* AI - 112 точек. В GetCol3 счёт Y идёт от 1 *)

        AReShift(AI,AVi[iY],AR);

        for iLam := 1 to Self.nLam do
          A4S[i4,iLam] := A4S[i4,iLam] + AR[iLam];

      end;
    end;
  end;

end;















(* суммируем целые значения CONT    *)
(* для маски - вектора единичек AIY *)
function TFITS.GetContSum(AIY:TAIn):real;
var R : real; iy : integer;
begin
  (* проверки не делаем *)

  if length(ACnt) = 0 then
    CalcSlitConts;

  R := 0;
  for iy := 0 to Self.nY-1 do
    if AIY[iy] > 0 then begin
      R := R + Self.ACnt[iy+1]; (* в ACnt счёт Y начинается от 1 *)
    end;
  result := R;
end;

(* сумма значений континуума для вектора-маски AIY *)
procedure TFITS.SumContSum(AIY:TAIn;var Sum:real);
begin
  Sum := Sum + GetContSum(AIY);
end;

(* извлечь вектор Стокса из 4-ки параметров Стокса *)
function A4GetStokes(A:TA4Re;ch:char):TARe;
var L,i4,I : integer; B : TARe;
begin
  L := length(A[1]);
  setlength(B,L);
  case upcase(ch) of
  'Q' : i4 := 2;
  'U' : i4 := 3;
  'V' : i4 := 4;
  else (* case *) i4 := 1;
  end; (* case *)
  for I := 0 to L-1 do B[I] := A[i4,I]; (* работаем от 0 в обоих массивах *)
  result := B;
end;




(* получить три смежных профиля и просуммировать их *)
(* первый индекс массива TA4In это параметр Стокса  *)
function TFITS.GetFIT3(iYA:integer;sStokes:string):TA4In;
var A41,A42,A43,A4S : TA4In; iL,I4:integer; S : string;
    Q4 : array[1..4] of boolean;
begin

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TFITS.GetFIT3 ERROR!'+#13#10+
    'Header Not Loaded Yet!!!');
    Exit;
  end;

  if Not SetBit.IsBit(Self.KStep,2) then Self.LoadData;

  Q4[1] := (pos('I',sStokes) > 0);
  Q4[2] := (pos('Q',sStokes) > 0);
  Q4[3] := (pos('U',sStokes) > 0);
  Q4[4] := (pos('V',sStokes) > 0);

  if (pos('P',sStokes) > 0) then begin Q4[2] := true; Q4[3] := true; end;
  if (pos('D',sStokes) > 0) then       Q4[1] := true;

  for I4 := 1 to 4 do if Q4[I4] then begin

    SetLength(A41[I4],nLam+1);
    SetLength(A42[I4],nLam+1);
    SetLength(A43[I4],nLam+1);

    GetCol3(iYA-1,I4,A41[I4]);
    GetCol3(iYA  ,I4,A42[I4]);
    GetCol3(iYA+1,I4,A43[I4]);

    SetLength(A4S[I4],nLam+1);
  end;

  for iL := 1 to Self.nLam do begin
    for I4 := 1 to 4 do if Q4[I4] then
      A4S[I4,iL] := A41[I4,iL] + A42[I4,iL] + A43[I4,iL];
  end;

  for I4 := 1 to 4 do if Q4[I4] then begin
    finalize(A41[I4]);
    finalize(A42[I4]);
    finalize(A43[I4]);
  end;

  result := A4S;

end; (* TFITS.GetFIT3 *)


procedure TFITS.GetFITARe(iY:integer;sStokes:string;var AX,AI,AQ,AU,AV:TARe);
var A4 : TA4In; (* array [1..4] of TAIn => 1-ый индекс I4 = iStokes *)
                (* второй индекс = iL                               *)
    iYA,iL,I4:integer; //S : string; LL : TStringList;
    Q4 : array[1..4] of boolean;
begin

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TFITS.GetFIT_SL ERROR!'+#13#10+
    'Header Not Loaded Yet!!!');
    Exit;
  end;

  (* aCnt понадобится потом *)
//CalcSlitConts;   (* ny штук континуумов (после сглаж 90mA) *)



  iYA := iY + 1;

  if Not SetBit.IsBit(Self.KStep,2)
    then Self.LoadData;

  Q4[1] := (pos('I',sStokes) > 0);
  Q4[2] := (pos('Q',sStokes) > 0);
  Q4[3] := (pos('U',sStokes) > 0);
  Q4[4] := (pos('V',sStokes) > 0);

  if (sStokes = 'QXi') or (sStokes = 'UXi') then begin
    Q4[2] := true;
    Q4[3] := true;
  end;


  for I4 := 1 to 4 do if Q4[I4] then begin
    SetLength(A4[I4],nLam+1); GetCol3(iYA,I4,A4[I4]);
  end;

  SetLength(AX,nLam+1);
  if Q4[1] then SetLength(AI,nLam+1);
  if Q4[2] then SetLength(AQ,nLam+1);
  if Q4[3] then SetLength(AU,nLam+1);
  if Q4[4] then SetLength(AV,nLam+1);



{
  LL := TStringList.Create;

  S := 'L ';
  if Q4[1] then S := S + 'I ';
  if Q4[2] then S := S + 'Q ';
  if Q4[3] then S := S + 'U ';
  if Q4[4] then S := S + 'V ';
  LL.Add(S);
}


  for iL := 1 to Self.nLam do begin
    AX[iL] := iL;
    if Q4[1] then AI[iL] := A4[1,iL];
    if Q4[2] then AQ[iL] := A4[2,iL];
    if Q4[3] then AU[iL] := A4[3,iL];
    if Q4[4] then AV[iL] := A4[4,iL];
  end;

end; (* TFITS.GetFITARe *)


procedure TFITS.GetFITARe2(iY:integer;sStokes:string;
                        var AX,AXd,AI,AQ,AU,AV,AP,AD:TARe);
(*
    векторы:
 AX  - дл.волны
 AXd - дл.волны для значений  dI/dLambda
 A[I,Q,U,V] - параметры Стокса
 AP  - величина по модулю линйной поляризации SQRT(Q*Q+U*U)
 AD  - dI/dLambda
 *)

var A4 : TA4In; (* array [1..4] of TAIn => 1-ый индекс I4 = iStokes *)
                (* второй индекс = iL                               *)
    iL,I4:integer; //S : string; LL : TStringList;
    Q4 : array[1..6] of boolean; Q,Q1 : boolean;
    rI,rQ,rU,rV : real;
    rL1,rI0 : real;
begin

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TFITS.GetFITARe2 ERROR!'+#13#10+
    'Header Not Loaded Yet!!!');
    Exit;
  end;

  if Not SetBit.IsBit(Self.KStep,2)
    then Self.LoadData;


  Q4[1] := (pos('I',sStokes) > 0);
  Q4[2] := (pos('Q',sStokes) > 0);
  Q4[3] := (pos('U',sStokes) > 0);
  Q4[4] := (pos('V',sStokes) > 0);
  Q4[5] := (pos('P',sStokes) > 0);
  Q4[6] := (pos('D',sStokes) > 0);
  Q1 := false;

  if (sStokes = 'QXi') or (sStokes = 'UXi') then begin
    Q4[2] := true;
    Q4[3] := true;
  end;

  if pos('D',sStokes) > 0 then begin Q4[1] := true; Q1 := true; end;
  if pos('P',sStokes) > 0 then begin Q4[2] := true; Q4[3] := true end;

  Q := false;
  for I4 := 1 to 4 do if Q4[I4] then begin (* цикл по 4-м векторам Стокса *)
    SetLength(A4[I4],nLam+1);   (* 4 вектора длиной nLam - отводим память *)
    GetCol3(iY+1,I4,A4[I4]); (* выборка всех точек одного профиля *)
    Q := true;
  end;


  if Q     then SetLength(AX,nLam+1);
  if Q4[1] then SetLength(AI,nLam+1);
  if Q4[2] then SetLength(AQ,nLam+1);
  if Q4[3] then SetLength(AU,nLam+1);
  if Q4[4] then SetLength(AV,nLam+1);
  if Q4[5] then SetLength(AP,nLam+1);
  if Q4[6] then SetLength(AD ,nLam);
  if Q1    then SetLength(AXd,nLam);


  (* aCnt понадобится потом ???????????? *)
  (*   для версии усреднения 9-ти точек  *)
  CalcSlitConts;   (* ny штук континуумов (после сглаж 90mA) *)

  if Q1    then rL1 := 1;
  if Q4[6] then rI0 := A4[1,1];

  for iL := 1 to Self.nLam-1 do begin
    if Q     then AX [iL] := iL;
    if Q1    then AXd[iL] := iL+0.5;

    if Q4[1] then begin rI := A4[1,iL]; AI[iL] := rI; end;
    if Q4[2] then begin rQ := A4[2,iL]; AQ[iL] := rQ; end;
    if Q4[3] then begin rU := A4[3,iL]; AU[iL] := rU; end;
    if Q4[4] then AV[iL] := A4[4,iL];
    if Q4[5] then begin AP[iL] := SQRT(rQ*rQ+rU*rU);  end;
    if Q4[6] then begin AD[iL] := (rI-rI0); rI0 := rI end;
  end;

  iL := nLam;
  begin
    if Q     then AX[iL] := iL;
    if Q4[1] then begin rI := A4[1,iL]; AI[iL] := rI; end;
    if Q4[2] then begin rQ := A4[2,iL]; AQ[iL] := rQ; end;
    if Q4[3] then begin rU := A4[3,iL]; AU[iL] := rU; end;
    if Q4[4] then AV[iL] := A4[4,iL];
    if Q4[5] then begin AP[iL] := SQRT(rQ*rQ+rU*rU);  end;
  end;

end; (* TFITS.GetFITARe2 *)


procedure TFITS.GetFITARe2(iY:integer;sStokes:string;chI,chL:char;
                        rL0 : real; (* сдвиг нуля длин волн *)
                        var AX,AXd,AI,AQ,AU,AV,AP,AD:TARe);
var A4 : TA4In; (* array [1..4] of TAIn => 1-ый индекс I4 = iStokes *)
                (* второй индекс = iL                               *)
    A4r: TA4Re;
    iL,I4:integer; //S : string; LL : TStringList;
    Q4 : array[1..6] of boolean; Q,Q1 : boolean;
    rI,rQ,rU,rV : real;
    rL1,rI0 : real;
    rCont : real;
    iYA : integer; (* iYA - в aCnt, чтобы отличать от iY в aData *)
(*----------------*)
function GetAX(rL:real):real;
begin
  case chL of
  'p' : result := rL;
  'n' : result := TLFITS(Owner).ItoLamLFI(rL)-rL0;
  '1' : result := TLFITS(Owner).ItoV1LFI(rL);
  '2' : result := TLFITS(Owner).ItoV2LFI(rL);
  end;

end;
(*===============*)
begin

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TFITS.GetFITARe2 ERROR!'+#13#10+
    'Header Not Loaded Yet!!!');
    Exit;
  end;

  iYA := iY + 1;

  if Not SetBit.IsBit(Self.KStep,2)
    then Self.LoadData;

  if chI = 'n' then begin
    if length(ACnt) = 0 then CalcSlitConts;
    rCONT := Self.ACnt[iYA] * TLFITS(Owner).kRC;
    if rCONT = 0 then rCONT := 1; (* для областей за краем диска *)
  end;

  Q4[1] := (pos('I',sStokes) > 0);
  Q4[2] := (pos('Q',sStokes) > 0);
  Q4[3] := (pos('U',sStokes) > 0);
  Q4[4] := (pos('V',sStokes) > 0);
  Q4[5] := (pos('P',sStokes) > 0);
  Q4[6] := (pos('D',sStokes) > 0);
  Q1 := false;

  if (sStokes = 'QXi') or (sStokes = 'UXi') then begin
    Q4[2] := true;
    Q4[3] := true;
  end;

  if pos('D',sStokes) > 0 then begin Q4[1] := true; Q1 := true; end;
  if pos('P',sStokes) > 0 then begin Q4[2] := true; Q4[3] := true end;

  Q := false;
  for I4 := 1 to 4 do if Q4[I4] then begin
    SetLength(A4[I4],nLam+1); GetCol3(iYA,I4,A4[I4]);
    if chI = 'n' then begin
      SetLength(A4r[I4],nLam+1);
      for iL := 0 to Self.nLam do A4r[I4,iL] := A4[I4,iL]/rCont;
    end;
    Q := true;
  end;


  if Q     then SetLength(AX,nLam+1);
  if Q4[1] then SetLength(AI,nLam+1);
  if Q4[2] then SetLength(AQ,nLam+1);
  if Q4[3] then SetLength(AU,nLam+1);
  if Q4[4] then SetLength(AV,nLam+1);
  if Q4[5] then SetLength(AP,nLam+1);
  if Q4[6] then SetLength(AD ,nLam);
  if Q1    then SetLength(AXd,nLam);


  (* aCnt понадобится потом ???????????? *)
  (*   для версии усреднения 9-ти точек  *)
  CalcSlitConts;   (* ny штук континуумов (после сглаж 90mA) *)

  if Q1    then rL1 := 1;
  if Q4[6] then rI0 := A4[1,1];

  for iL := 1 to Self.nLam-1 do begin
    if Q     then AX[iL]  := GetAX(iL); // AX[iL] := iL;
    if Q1    then AXd[iL] := GetAX(iL+0.5);

    if chI = 'p' then begin
      if Q4[1] then begin rI := A4[1,iL]; AI[iL] := rI; end;
      if Q4[2] then begin rQ := A4[2,iL]; AQ[iL] := rQ; end;
      if Q4[3] then begin rU := A4[3,iL]; AU[iL] := rU; end;
      if Q4[4] then AV[iL]   := A4[4,iL];
      if Q4[5] then begin AP[iL] := SQRT(rQ*rQ+rU*rU);  end;
      if Q4[6] then begin AD[iL] := (rI-rI0); rI0 := rI end;
    end;
    if chI = 'n' then begin
      if Q4[1] then begin rI := A4r[1,iL]; AI[iL] := rI; end;
      if Q4[2] then begin rQ := A4r[2,iL]; AQ[iL] := rQ; end;
      if Q4[3] then begin rU := A4r[3,iL]; AU[iL] := rU; end;
      if Q4[4] then AV[iL]   := A4r[4,iL];
      if Q4[5] then begin AP[iL] := SQRT(rQ*rQ+rU*rU);  end;
      if Q4[6] then begin AD[iL] := (rI-rI0); rI0 := rI end;
    end;
  end;


  iL := nLam;
  begin
    if Q     then AX[iL] := GetAX(iL);


    if chI = 'p' then begin
      if Q4[1] then begin rI := A4[1,iL]; AI[iL] := rI; end;
      if Q4[2] then begin rQ := A4[2,iL]; AQ[iL] := rQ; end;
      if Q4[3] then begin rU := A4[3,iL]; AU[iL] := rU; end;
      if Q4[4] then AV[iL] := A4[4,iL];
      if Q4[5] then begin AP[iL] := SQRT(rQ*rQ+rU*rU);  end;
    end;
    if chI = 'n' then begin
      if Q4[1] then begin rI := A4r[1,iL]; AI[iL] := rI; end;
      if Q4[2] then begin rQ := A4r[2,iL]; AQ[iL] := rQ; end;
      if Q4[3] then begin rU := A4r[3,iL]; AU[iL] := rU; end;
      if Q4[4] then AV[iL] := A4r[4,iL];
      if Q4[5] then begin AP[iL] := SQRT(rQ*rQ+rU*rU);  end;
    end;

  end;

end; (* TFITS.GetFITARe2 *)





(* Выдаёт в колонки StringList длину волны и запрошенные параметры Стокса *)
function TFITS.GetFIT_SL(iY:integer;sStokes:string;chI,chL:char):TStringList;
var A4 : TA4In; (* array [1..4] of TAIn => 1-ый индекс I4 = iStokes *)
                (* второй индекс = iL                               *)
    iYA,iL,I4:integer; S : string; LL : TStringList;
    Q4 : array[1..4] of boolean;
    rCont : real;
begin
  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TFITS.GetFIT_SL ERROR!'+#13#10+
    'Header Not Loaded Yet!!!');
    Exit;
  end;

  iYA := iY + 1;

  if Not SetBit.IsBit(Self.KStep,2) then Self.LoadData;

  Q4[1] := (pos('I',sStokes) > 0);
  Q4[2] := (pos('Q',sStokes) > 0);
  Q4[3] := (pos('U',sStokes) > 0);
  Q4[4] := (pos('V',sStokes) > 0);

  if (sStokes = 'QXi') or (sStokes = 'UXi') then begin
    Q4[2] := true;
    Q4[3] := true;
  end;



  for I4 := 1 to 4 do if Q4[I4] then begin
    SetLength(A4[I4],nLam+1); GetCol3(iYA,I4,A4[I4]);
  end;

  rCONT := Self.ACnt[iYA] * TLFITS(Owner).kRC;
  if rCONT = 0 then rCONT := 1; (* для областей за краем диска *)

  LL := TStringList.Create;

  case chL of
  'n' : S := 'Lam';
  'p' : S := 'nL';
  '1' : S := 'V1';
  '2' : S := 'V2';
  end; (* case *)
  S := S + ' ';

  if Q4[1] then S := S + 'I ';
  if Q4[2] then S := S + 'Q ';
  if Q4[3] then S := S + 'U ';
  if Q4[4] then S := S + 'V ';
  LL.Add(S);

  for iL := 1 to Self.nLam do begin
    case chL of
    'n' : S := S + ISt(iL);
    'p' : S := S + FSt(TLFITS(Owner).ItoLamLFI(iL),4);
    '1' : S := S + FSt(TLFITS(Owner).ItoV1LFI(iL),3);
    '2' : S := S + FSt(TLFITS(Owner).ItoV2LFI(iL),3);
    end; (* case *)
    S := S + ' ';

    case chI of
    'n' : for I4:=1 to 4 do if Q4[I4] then S:=S+EFSt0((A4[I4,iL]/rCONT),6)+' ';
    'p' : for I4:=1 to 4 do if Q4[I4] then S:=S+ISt(A4[I4,iL]) + ' ';
    end; (* case *)

    LL.Add(S);
  end;

  swStr.LineTabStrings(LL,1);
  result := LL;
end; (* TFITS.GetFIT_SL *)





(* Выдаёт в колонки StringList длину волны и запрошенные параметры Стокса *)
function TFITS.GetFIT_SL(iY:integer;sStokes:string):TStringList;
var A4 : TA4In; (* array [1..4] of TAIn => 1-ый индекс I4 = iStokes *)
                (* второй индекс = iL                               *)
    iYA,iL,I4:integer; S : string; LL : TStringList;
    Q4 : array[1..4] of boolean;
begin

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TFITS.GetFIT_SL ERROR!'+#13#10+
    'Header Not Loaded Yet!!!');
    Exit;
  end;
  Time_routine('FITS.GetFIT_SL',true);

  iYA := iY + 1;

  if Not SetBit.IsBit(Self.KStep,2)
    then Self.LoadData;

  Q4[1] := (pos('I',sStokes) > 0);
  Q4[2] := (pos('Q',sStokes) > 0);
  Q4[3] := (pos('U',sStokes) > 0);
  Q4[4] := (pos('V',sStokes) > 0);

  if (sStokes = 'QXi') or (sStokes = 'UXi') then begin
    Q4[2] := true;
    Q4[3] := true;
  end;


  for I4 := 1 to 4 do if Q4[I4] then begin
    SetLength(A4[I4],nLam+1); GetCol3(iYA,I4,A4[I4]);
  end;

  LL := TStringList.Create;

  S := 'L ';
  if Q4[1] then S := S + 'I ';
  if Q4[2] then S := S + 'Q ';
  if Q4[3] then S := S + 'U ';
  if Q4[4] then S := S + 'V ';
  LL.Add(S);

  for iL := 1 to Self.nLam do begin
    S := ISt(iL) + ' ';
    for I4 := 1 to 4 do if Q4[I4] then S := S + ISt(A4[I4,iL]) + ' ';
    LL.Add(S);
  end;

  swStr.LineTabStrings(LL,1);
  result := LL;
  Time_routine('FITS.GetFIT_SL',false);
end; (* TFITS.GetFIT_SL *)

procedure TFITS.GetFITNormARe(iY:integer;sStokes:string;
                              rL0 : real; (* сдвиг нуля длин волн *)
                              var AX,AI,AQ,AU,AV:TARe);
var A4 : TA4In; iYA,iL,I4:integer;
    Q4 : array[1..4] of boolean;
    rCONT : real;
begin

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TFITS.GetFITNorm_SL ERROR!'+#13#10+
    'Header Not Loaded Yet!!!');
    Exit;
  end;

  iYA := iY + 1;

  if Not SetBit.IsBit(Self.KStep,2) then Self.LoadData;

  Q4[1] := (pos('I',sStokes) > 0);
  Q4[2] := (pos('Q',sStokes) > 0);
  Q4[3] := (pos('U',sStokes) > 0);
  Q4[4] := (pos('V',sStokes) > 0);

  if (sStokes = 'QXi') or (sStokes = 'UXi') then begin
    Q4[2] := true;
    Q4[3] := true;
  end;


  for I4 := 1 to 4 do if Q4[I4] then begin
    SetLength(A4[I4],nLam+1); GetCol3(iYA,I4,A4[I4]);
  end;

//Self.ALam := Self.GetALam;
//  DefaultContArea; (* интервалы дл.волн континуума *)
  CalcSlitConts;   (* ny штук континуумов (после сглаж 90mA) *)
//CalcSlit4Conts;

{
  LL := TStringList.Create;
  S := 'L ';
  if Q4[1] then S := S + 'I ';
  if Q4[2] then S := S + 'Q ';
  if Q4[3] then S := S + 'U ';
  if Q4[4] then S := S + 'V ';
  LL.Add(S);
}

  rCONT := Self.ACnt[iYA] * TLFITS(Owner).kRC;
  if rCONT = 0 then rCONT := 1; (* для областей за краем диска *)

  SetLength(AX,nLam+1);
  if Q4[1] then SetLength(AI,nLam+1);
  if Q4[2] then SetLength(AQ,nLam+1);
  if Q4[3] then SetLength(AU,nLam+1);
  if Q4[4] then SetLength(AV,nLam+1);

  for iL := 1 to Self.nLam do begin
    AX[iL] := TLFITS(Owner).ALam[iL] - rL0; // 6301.5;
    if Q4[1] then AI[iL] := A4[1,iL]/rCONT;
    if Q4[2] then AQ[iL] := A4[2,iL]/rCONT;
    if Q4[3] then AU[iL] := A4[3,iL]/rCONT;
    if Q4[4] then AV[iL] := A4[4,iL]/rCONT;
  end;

end; (* TFITS.GetFITNormARe *)


procedure TFITS.GetFITNormARe2(iY:integer;sStokes:string;
                              rL0 : real; (* сдвиг нуля длин волн *)
                              var AX,AXd,AI,AQ,AU,AV,AP,AD:TARe);
var A4 : TA4In; iYA,iL,I4:integer;
    Q4 : array[1..6] of boolean; Q,Q1 : boolean; (* наличие AXd массива *)
    rCONT   : real;
    rL1,rL2,rI,rQ,rU,rV,rI0 : real;
begin

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TFITS.GetFITNorm_SL ERROR!'+#13#10+
    'Header Not Loaded Yet!!!');
    Exit;
  end;

  iYA := iY + 1;

  if Not SetBit.IsBit(Self.KStep,2) then Self.LoadData;

  Q4[1] := (pos('I',sStokes) > 0);
  Q4[2] := (pos('Q',sStokes) > 0);
  Q4[3] := (pos('U',sStokes) > 0);
  Q4[4] := (pos('V',sStokes) > 0);
  Q4[5] := (pos('P',sStokes) > 0);
  Q4[6] := (pos('D',sStokes) > 0);
  Q1 := false;

  if (sStokes = 'QXi') or (sStokes = 'UXi') then begin
    Q4[2] := true;
    Q4[3] := true;
  end;


  if pos('D',sStokes) > 0 then begin Q4[1] := true; Q1 := true; end;
  if pos('P',sStokes) > 0 then begin Q4[2] := true; Q4[3] := true end;

  Q := false;
  for I4 := 1 to 4 do if Q4[I4] then begin
    SetLength(A4[I4],nLam+1); GetCol3(iYA,I4,A4[I4]);
    Q := true;
  end;

  CalcSlitConts;   (* ny штук континуумов (после сглаж 90mA) *)

  rCONT := Self.ACnt[iYA] * TLFITS(Owner).kRC;
  if rCONT = 0 then rCONT := 1; (* для областей за краем диска *)

  if Q     then SetLength(AX,nLam+1);
  if Q4[1] then SetLength(AI,nLam+1);
  if Q4[2] then SetLength(AQ,nLam+1);
  if Q4[3] then SetLength(AU,nLam+1);
  if Q4[4] then SetLength(AV,nLam+1);
  if Q4[5] then SetLength(AP,nLam+1);
  if Q4[6] then SetLength(AD ,nLam);
  if Q1    then SetLength(AXd,nLam);


  if Q1    then rL1 := TLFITS(Owner).ALam[1] - rL0;
  if Q4[6] then rI0 := A4[1,1]/rCONT;

  for iL := 1 to Self.nLam-1 do begin
    if Q     then AX[iL] := TLFITS(Owner).ALam[iL] - rL0; // 6301.5;
    if Q1    then begin
               rL2 := TLFITS(Owner).ALam[iL+1] - rL0;
               AXd[iL] := (rL2 + rL1)/2;
             end;
    if Q4[1] then begin rI := A4[1,iL]/rCONT; AI[iL] := rI; end;
    if Q4[2] then begin rQ := A4[2,iL]/rCONT; AQ[iL] := rQ; end;
    if Q4[3] then begin rU := A4[3,iL]/rCONT; AU[iL] := rU; end;
    if Q4[4] then begin rV := A4[4,iL]/rCONT; AV[iL] := rV; end;
    if Q4[5] then begin AP[iL] := SQRT(rQ*rQ+rU*rU);        end;
    if Q4[6] then begin AD[iL] := (rI-rI0)/(rL2-rL1);
                        rI0 := rI; rL1 := rL2;              end;
  end;

  iL := nLam;
  begin
    if Q     then AX[iL] := TLFITS(Owner).ALam[iL] - rL0;
    if Q4[1] then begin rI := A4[1,iL]/rCONT; AI[iL] := rI; end;
    if Q4[2] then begin rQ := A4[2,iL]/rCONT; AQ[iL] := rQ; end;
    if Q4[3] then begin rU := A4[3,iL]/rCONT; AU[iL] := rU; end;
    if Q4[4] then begin rV := A4[4,iL]/rCONT; AV[iL] := rV; end;
    if Q4[5] then begin AP[iL] := SQRT(rQ*rQ+rU*rU);        end;
  end;


end; (* TFITS.GetFITNormARe2 *)






(* нормализованный профиль Стокса *)
(* на входе iY от 0 до nY-1 *)
function TFITS.GetFITNorm_SL(iY:integer;sStokes:string):TStringList;
var A4 : TA4In; iYA,iL,I4:integer; S : string; LL : TStringList;
    Q4 : array[1..4] of boolean;
    rCONT : real;
begin

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TFITS.GetFITNorm_SL ERROR!'+#13#10+
    'Header Not Loaded Yet!!!');
    Exit;
  end;

  iYA := iY + 1;

  if Not SetBit.IsBit(Self.KStep,2) then Self.LoadData;

  Q4[1] := (pos('I',sStokes) > 0);
  Q4[2] := (pos('Q',sStokes) > 0);
  Q4[3] := (pos('U',sStokes) > 0);
  Q4[4] := (pos('V',sStokes) > 0);

  if (sStokes = 'QXi') or (sStokes = 'UXi') then begin
    Q4[2] := true;
    Q4[3] := true;
  end;


  for I4 := 1 to 4 do if Q4[I4] then begin
    SetLength(A4[I4],nLam+1); GetCol3(iYA,I4,A4[I4]);
  end;

//Self.ALam := Self.GetALam;
  DefaultContArea; (* интервалы дл.волн для Cont (устарела) *)
  CalcSlitConts;   (* заполняем массив ACnt[1..nY] *)
//CalcSlit4Conts;

  LL := TStringList.Create;

  S := 'L ';
  if Q4[1] then S := S + 'I ';
  if Q4[2] then S := S + 'Q ';
  if Q4[3] then S := S + 'U ';
  if Q4[4] then S := S + 'V ';
  LL.Add(S);

  rCONT := Self.ACnt[iYA] * TLFITS(Owner).kRC;
  if rCONT = 0 then rCONT := 1; (* для областей за краем диска *)

  for iL := 1 to Self.nLam do begin
    S := EFSt0(TLFITS(Owner).ALam[iL],9) + ' ';
    for I4 := 1 to 4 do if Q4[I4] then
      S := S + EFSt0((A4[I4,iL]/rCONT),6)+ ' ';
    LL.Add(S);
  end;

  swStr.LineTabStrings(LL,1);
  result := LL;
end; (* TFITS.GetFITNorm_SL *)




(* получить делённую на CONT интенсивность вдоль длины волны *)
(* iY от 1 до nY *)
function TFITS.GetAI(iYA:integer):TARe;
var A : TARe; AI : TAIn; C,R : real; I,i3 : integer;
begin
  Time_routine('FITS.GetAI',true);
  SetLength(A,Self.nLam+1);

  C := ACnt[iYA] * TLFITS(Owner).kRC; (* kRC = 0.95 .. 1.05 *)
  if C = 0 then C := 1; (* для областей за краем диска *)

  i3 := 1;
  GetCol3(iYA,i3,AI);
  for I := 1 to nLam do begin
    (* ############# здесь произошло Invalid Floating Point Operation *)
    A[I] := AI[I]/C;
  end;
  Finalize(AI);
  result := A;
  Time_routine('FITS.GetAI',false);
end;


(* получить интенсивность вдоль длины волны в формате ARe *)
(* iY от 1 до nY *)
function TFITS.GetAI0(iYA:integer):TARe;
var A : TARe; AI : TAIn; I,i3 : integer;
begin
  SetLength(A,Self.nLam+1);
  i3 := 1; (* IStockes <- 'I' *)
  GetCol3(iYA,i3,AI);
  for I := 1 to nLam do begin
    A[I] := AI[I]/1;
  end;
  Finalize(AI);
  result := A;
end;

(* назначаем iY и заполняем массивы A_IpV и A_ImV *)
procedure TFITS.GetAIV(iY:integer;var A_IpV,A_ImV:TARe);
var AI,AV : TAIn; I,iYA,i3 : integer;
begin
  SetLength(A_IpV,Self.nLam+1);
  SetLength(A_ImV,Self.nLam+1);
  iYA := iY + 1;
  i3 := 1; GetCol3(iYA,i3,AI); (* IStockes <- 'I' *)
  i3 := 4; GetCol3(iYA,i3,AV); (* IStockes <- 'V' *)

  for I := 1 to nLam do begin
    A_IpV[I] := AI[I]+AV[I];
    A_ImV[I] := AI[I]-AV[I];
  end;
  Finalize(AI);
  Finalize(AV);
end;

(* назначаем iY и заполняем массивы A_IpV и A_ImV и A_I *)
procedure TFITS.GetAIVI(iY:integer;var A_IpV,A_ImV,A_I:TARe);
var AI,AV : TAIn; I,iYA,i3 : integer;
begin
  SetLength(A_IpV,Self.nLam+1);
  SetLength(A_ImV,Self.nLam+1);
  SetLength(A_I  ,Self.nLam+1);
  iYA := iY + 1;
  i3 := 1; GetCol3(iYA,i3,AI); (* IStockes <- 'I' *)
  i3 := 4; GetCol3(iYA,i3,AV); (* IStockes <- 'V' *)

  for I := 1 to nLam do begin
    A_IpV[I] := AI[I]+AV[I];
    A_ImV[I] := AI[I]-AV[I];
    A_I[I]   := AI[I]; // целое -> real
  end;
  Finalize(AI);
  Finalize(AV);
end;




function TFITS.minIV1:real;
begin
  result := minIV(1,56);
end;
function TFITS.minIV2:real;
begin
  result := minIV(57,56);
end;

function TFITS.minIV(i1,L:integer):real;
var iL : integer; mp,mm : real;
begin
  (* пока без проверок *)
  mp := AIpV[i1]; mm := AImV[i1];
  for iL := i1+1 to L+i1-1 do begin
    if AIpV[iL] < mp then mp := AIpV[iL];
    if AImV[iL] < mm then mm := AImV[iL];
  end;
  result := (mp+mm)/2;
end;


function TFITS.minIpV(i1,L:integer):real;
var iL : integer; m : real;
begin
  m := AIpV[i1];
  for iL := i1+1 to L+i1-1 do if AIpV[iL] < m then m := AIpV[iL];
  result := m;
end;

function TFITS.minImV(i1,L:integer):real;
var iL : integer; m : real;
begin
  m := AImV[i1];
  for iL := i1+1 to L+i1-1 do if AImV[iL] < m then m := AImV[iL];
  result := m;
end;

function TFITS.minI(i1,L:integer):real;
var iL : integer; m : real;
begin
  m := A_I[i1];
  for iL := i1+1 to L+i1-1 do if A_I[iL] < m then m := A_I[iL];
  result := m;
end;



procedure TFITS.COGIV1(r:real;var Lp,Lm:real);
begin
  COGIV(1,52,r,Lp,Lm);
end;

procedure TFITS.SlicedCOGIV1(y1,y2:real;var Lp,Lm:real);
var sW : real; (* ширина сегмента [текущей] трапеции, для к-рой считаем COG *)
begin
  Lp := swARe.SlicedCOG(1,52,y1,y2,AIpV,sW);
  Lm := swARe.SlicedCOG(1,52,y1,y2,AImV,sW);
end;

procedure TFITS.SlicedCOGIV2(y1,y2:real;var Lp,Lm:real);
var sW : real; (* ширина сегмента [текущей] трапеции, для к-рой считаем COG *)
begin
  Lp := swARe.SlicedCOG(59,112,y1,y2,AIpV,sW);
  Lm := swARe.SlicedCOG(59,112,y1,y2,AImV,sW);
end;



procedure TFITS.COGIV2(r:real;var Lp,Lm:real);
begin
  COGIV(59,54,r,Lp,Lm);
end;


procedure TFITS.COGIV(i1,L:integer;r1:real;var Lp,Lm:real);
var iL : integer;
  dm,dp : real;
  sm,sp,sLm,sLp : real;
begin
  sm := 0; sp := 0; sLm := 0; sLp := 0;
  for iL := i1 to L+i1-1 do begin   (* 1..56 или 57..112 *)
    dm := (AImV[iL]-r1); if dm < 0 then dm := -dm else dm := 0;
    dp := (AIpV[iL]-r1); if dp < 0 then dp := -dp else dp := 0;
    sm := sm + dm; sLm := sLm + dm*iL;
    sp := sp + dp; sLp := sLp + dp*iL;
  end;
  Lm := sLm / sm;
  Lp := sLp / sp;
end;


{
(* центр тяжести вырезанной трапеции *)
//procedure TFITS.SlicedCOG(i1,i2:integer;y1,y2:real;var Lp,Lm:real);
(* i1 начальный индекс *)
(* L  число элементов  *)
(* y1,y2 - нижний и верхний уровни отсечения *)
(* массив с профилем линии поглощения *)
function TFITS.SlicedCOG(i1,L:integer;y1,y2:real;A:TARe):real;
var iL : integer; (* индекс текущего элемента вектора I+V или I-V *)
    ii : integer; (* индекс лев.граници анализир-го элемента, обычно ii=iL-1 *)
ss,sLs : real;

  y0 : real; (* значение A[ii] *)
  y,dy : real;
//  ry : real;  (* текущая разница y2-y с обратным знаком обрезанная по y1 и y2 *)
  rx : real;  (* центр тяжести элемента вдоль X *)
  rs : real;  (* площадь элемента *)
  r1,r2 : real;
  x1, x2, x0, dx, dx0 : real;
  k0,k : integer;
  s1,s2:real;
begin   // 0
  dy := y2 - y1;  (* верхняя y2 и нижняя y1 границы трапеции *)

  ss := 0; sLs := 0;

  iL := i1;
  ii := iL;
  y0 := A[ii];
  if (y0 - y2) >= 0 then k0 := -1 else
  if (y0 - y1) <= 0 then k0 :=  1 else k0 := 0;


  for iL := i1+1 to L+i1-1 do begin   (* (1+1)..56 или (57+1)..112 *) // 1
    y := A[iL];


    (*------------------------------------------------------------------*)
    if (y - y2) >= 0 then (* выше верхней границы сегмента *)
    begin        // 2
      k := -1;
      if (k = k0) then begin  // 3
       (*--- k0 = -1 / k = -1 ---*)
        rx := 0; rs := 0;
      end                     // 3
    (*------------------------------------------------------------------*)
      else begin              // 3
        if k0 = 0 then begin             // 4
          (*--- k0 = 0 / k = -1 ---*)
          (* пришли из точки внутри трапеции в точку выше *)
          x1 := ii;
          x2 := x1 + (y2-y0)/(y-y0);
          dx := x2 - x1;
          s1 := dx*(y2-y0)/2;
          s2 := dx*(y0-y1);
          rs := s1 + s2;
          rx := x1 + dx*(2*s1/3 + s2/2)/rs;
        end                              // 4
    (*------------------------------------------------------------------*)
        else begin  (* k0 = 1 *)         // 4
          (*--- k0 = 1 / k = -1 ---*)
          (* пришли из точки ниже трапеции в точку выше трапеции *)
          (* фигура - слева от линии *)
//        x1  := ii;
          dx0 := (y1-y0)/(y-y0);
//        x0 := ii + dx0;  (* точка пересечения для входа в трап. *)
//        x2 := ii + (y2-y0)/(y-y0);
          s1 := dx0*dy;
          r1 := dx0/2;
//        dx := x2 - x0;
          dx := (y2-y0)/(y-y0) - dx0;
          s2 := dx*dx/2;
          r2 := (ii+dx0)+dx/3;
          rs := s1+s2;
          rx := (r1*s1+r2*s2)/rs;
        end                              // 4
      end;                    // 3
      k0 := k;
    end               // 2
    (*------------------------------------------------------------------*)
    else begin        // 2
      if (y1 - y) >= 0 then (* ниже нижней границы сегмента *)
      begin                   // 3
        k := 1;
        if (k = k0) then begin           // 4
         (*--- k0 = 1 / k = 1 ---*)
          rx := ii + 0.5;
          rs := dy; (*==   *(x2-x1) = *1   ==*)
        end                              // 4
    (*------------------------------------------------------------------*)
        else begin                       // 4
          if k0 = 0 then begin                 // 5
            (*--- k0 = 0 / k = 1 ---*)
            (* пришли из точки внутри трапеции в точку ниже *)
            x1 := ii;
            x2 := x1 + (y0-y1)/(y0-y);
            dx := x2 - x1;
            s1 := dx*(y0-y1)/2;
            s2 := dx*(y2-y0);
            rs := s1 + s2;
            rx := x1 + dx*(2*s1/3 + s2/2)/rs;
          end                                 // 5
    (*------------------------------------------------------------------*)
          else begin (* k0 = -1 *)            // 5
            (*--- k0 = -1 / k = 1 ---*)
            (* пришли из точки выше трапеции в точку ниже трапеции *)
            (* фигура - справа от линии *)
            (* сначала треугольник, за ним прямоугольник *)
            x1 := ii + (y0-y2)/(y0-y);
            x0 := ii + (y0-y1)/(y0-y);
            x2 := iL;
            dx := x0 - x1;
            s1 := dx*dy/2;
            r1 := x1 + 2*dx/3;

            dx := x2 - x0;
            s2 := dx*dy;
            r2 := x2 - dx/2;

            rs := s1+s2;
            rx := (r1*s1+r2*s2)/rs;
          end;                                // 5
        end;                             // 4
        k0 := k;
      end                     // 3
    (*------------------------------------------------------------------*)
      else begin              // 3
        (* теперь мы внутри сегмента *)
        k := 0;
        if (k = k0) then begin          // 4
          (*--- k0 = 0 / k = 0 ---*)
          if (y0 > y) then begin             // 5
            s1 := (y0-y )/2;
            s2 := (y2-y0);
            rs := s1 + s2;
            rx := ii + (2/3*s1+s2/2)/rs;
          end                                // 5
          else begin                         // 5
            s1 := (y -y0)/2;
            s2 := (y2-y);
            rs := s1 + s2;
            rx := ii + (1/3*s1+s2/2)/rs;
          end;                               // 5
        end                             // 4
    (*------------------------------------------------------------------*)
        else begin                      // 4
          if k0 = -1 then begin              // 5
            (*--- k0 = -1 / k = 0 ---*)
            (* пришли из точки выше трапеции в точку внутри *)
            x1 := ii + (y0-y2)/(y0-y);
            x2 := iL;
            dx := x2 - x1;
            rs := dx*(y2-y)/2;
            rx := x2 - dx/3;
          end                                // 5
    (*------------------------------------------------------------------*)
          else begin                         // 5
            (*--- k0 = 1 / k = 0 ---*)
            (* пришли из точки ниже трапеции в точку внутри *)
            x1 := ii + (y1-y0)/(y-y0);
            x2 := iL;
            dx := x2 - x1;
            s1 := dx*(y-y1)/2;
            s2 := dx*(y2-y);
            rs := s1 + s2;
            rx := x1 + (dx/3*s1 + dx/2*s2)/rs;
          end;                               // 5
        end;                            // 4
      end;                    // 3
    end;              // 2

    ss  := ss  + rs;
    sLs := sLs + rx*rs;

    ii := iL;
    y0 := y;
    k0 := k;

  end;         // 1
  result := sLs / ss;
end;
}
(* назначаем iY_cur, заполняем AIpV,AImV - глобальные переменные *)
procedure TFITS.GetAIV(iY:integer);
begin
  if (iY = iY_cur) then if length(AIpV) = (Self.nLam+1)
                   then Exit; (* по-видимуму, массивы уже загружены *)
  Self.iY_cur := iY;
  GetAIVI(iY,AIpV,AImV,A_I);  (* AIpV,AImV,A_I - глобальные переменные *)
end;



(* iY [0..nY-1] *)
(* получить V-профиль, нормализованный на I_CONT *)
function TFITS.GetAV(iY:integer):TARe;
var A : TARe; AV : TAIn; C,R : real; I,iYA,i3 : integer;
begin
  SetLength(A,Self.nLam+1);

  iYA := iY + 1;

  C := ACnt[iYA] * TLFITS(Owner).kRC;
  if C = 0 then C := 1; (* для областей за краем диска *)

  i3 := 4;
  GetCol3(iYA,i3,AV);

  for I := 1 to nLam do begin
    A[I] := AV[I]/C;
  end;
  Finalize(AV);

  result := A;
end;



procedure TFITS.DefaultContArea;
begin SetContArea(1,7,108,112,0,0) end;

procedure TFITS.SetContArea(i1,i2,i3,i4,i5,i6:integer);
begin ic1 := i1; ic2 := i2; ic3 := i3; ic4 := i4; ic5 := i5; ic6 := i6 end;

{
procedure TFITS.SetLinesArea(i1,i2,i3,i4,i5,i6:integer);
begin il1 := i1; il2 := i2; il3 := i3; il4 := i4; il5 := i5; il6 := i6 end;
}

{
procedure TFITS.SetLinesArea2(iY:integer);
var i0 : integer;
begin
  if Not SetBit.IsBit(Self.KStep,3) then begin
    Self.BigCalc;
  end;

  if Not SetBit.IsBit(Self.KStep,3) then begin
    WarnAbs('TFITS.SetLinesArea2 ERROR!'+#13#10+
    'First level of integral data not calculated yet!!!');
    Exit;
  end;

  if Length(Self.ALC1) <> (nY+1) then begin
    WarnAbs('TFITS.SetLinesArea2 ERROR!'+#13#10+
    'Длина массива ALC1= '+ISt(Length(ALC1))+' <> NY='+ISt(nY)+' +1)' );
    Exit;
  end;

  i0 := Round(ALC1[iY]);
  bl2.b1.b := i0 - 15;
  bl2.b1.r := i0 + 15;

  i0 := Round(ALC2[iY]);
  bl2.b2.b := i0 - 15;
  bl2.b2.r := i0 + 15;

  bl2.b3.b := bl2.b1.r;  (* необходима проверка! *)
  bl2.b3.r := bl2.b2.b;

  bc2.b1.b := 1;
  bc2.b1.r := bl2.b1.b;

  bc2.b2.b := bl2.b2.r;
  bc2.b2.r := nLam;

  bc2.b3.b := 0;
  bc2.b3.r := 0;

end;
}




(*===================================================*)
(*                                                   *)
(*               Список сырых FITS                   *)
(*                                                   *)
(*===================================================*)


(* получить ContMax и ContMin из загруженного списка FITS *)
(* используем только список Header-ов                     *)
procedure TLFITS.MaxMinCont; (* => rCntMa, rCntMi, iXCA,iXCI,iYCA,iYCI *)
var iX : integer; aFITS : TFITS;
begin
  if Self.Count = 0 then begin
    WarnAbs('LFITS.MaxMinCont ERR: Список FITS не заполнен!');
    Exit;
  end;
  iX := 0; aFITS := TFITS(Self.Items[iX]);

  (* расчёт параметров головного Хидера SW: *)
  (* CNT_MA интенсивность в отсчётах самой яркой  точки *)
  (* CNT_MI интенсивность в отсчётах самой тёмной точки *)

  rCntMa  := aFITS.CntMax; iYCA := aFITS.iCntMax; iXCA := iX;
  rCntMi  := aFITS.CntMin; iYCI := aFITS.iCntMin; iXCI := iX;
  for iX := 1 to Self.Count-1 do begin
    aFITS := TFITS(Self.Items[iX]);
    if aFITS.CntMax > rCntMa then begin
      rCntMa  := aFITS.CntMax; iYCA := aFITS.iCntMax; iXCA := iX;
    end;
    if aFITS.CntMin < rCntMi then begin
      rCntMi  := aFITS.CntMin; iYCI := aFITS.iCntMin; iXCI := iX;
    end;
  end;
end;



procedure TLFITS.VRBMax; (* => VRMA, VBMA, iXVR,iXVB,iYVR,iYVB *)
var iX,iY : integer; V : real;
begin
  (*-----------------------------------------------------*)
  (* находим максимальные/минимальные значения скоростей *)

  if (Not Assigned(OuVc1)) or
    (length(OuVc1.aData) = 0) then if Not swVc1_Vc2_Init then Exit;


  if Not Assigned(OuVc1) then begin
    WarnAbs('LFITS.VRBMax ERR в LFITS не инициирована OuVc1!'+#13#10+
            'Надо вызвать LFITS.swFITSInit2');
    Exit;
  end;

  if OuVc1.kLoad < 2 then OuVc1.LoadData(OuVc1.sFn,OuVc1.nbData0);
  if OuVc2.kLoad < 2 then OuVc2.LoadData(OuVc2.sFn,OuVc2.nbData0);

  VRMa := (OuVc1.aData[0,0] + OuVc2.aData[0,0])/2;
  VBMa := VRMa;
  for iX := 0 to nX-1 do begin
    for iY := 0 to nY-1 do begin
      (* максимальные скорости, направленные ОТ и К наблюдателю VRMa, VBMa *)
      V := (OuVc1.aData[iX,iY] + OuVc2.aData[iX,iY])/2;
      if V > VRMa then begin
        VRMa := V; iXVR := iX; iYVR := iY;
      end else if V < VBMa then begin
        VBMa := V; iXVB := iX; iYVB := iY;
      end;
    end;
  end;
end;

procedure TLFITS.HNSMax; (* => HNMA, HSMA, iXNH,iXNS,iYNH,iYNS *)
var iX,iY : integer; H : real;
begin
  (*-------------------------------------------------*)
  (* находим максимальные/минимальные значения полей *)

  if (Not Assigned(OuH1)) or
    (length(OuH1.aData) = 0) then if Not swH1_H2_Init then Exit;


  if Not Assigned(OuH1) then begin
    WarnAbs('LFITS.HNSMax ERR в LFITS не инициирована OuH1!'+#13#10+
            'Надо вызвать LFITS.swFITSInit');
    Exit;
  end;

  if OuH1.kLoad < 2 then OuH1.LoadData(OuH1.sFn,OuH1.nbData0);
  if OuH2.kLoad < 2 then OuH2.LoadData(OuH2.sFn,OuH2.nbData0);

  HNMa := (OuH1.aData[0,0]  + OuH2.aData[0,0]) /2;
  HSMa := HNMa;

  for iX := 0 to nX-1 do begin
    for iY := 0 to nY-1 do begin
      (* максимальное магнитное поле северной и южной полярности HNMa HSMa *)
      H := (OuH1.aData[iX,iY]  + OuH2.aData[iX,iY]) /2;
      if H > HNMa then begin
        HNMa := H; iXHN := iX; iYHN := iY;
      end else if H < HSMa then begin
        HSMa := H; iXHS := iX; iYHS := iY;
      end;
    end;
  end;
end;





procedure TLFITS.Calc_dV;(* MeX,MeY => Ou_dV расчёт поправок луч.скорости за вращ.С-ца*)
var iX,iY : integer; rx,ry,rgX,rgY,dV : real;
  aFITS : TFITS;
begin
  (*!!!!!!!!!!!!!! использует MeX, MeY *)

  if Not Assigned(MeX) then Self.meXY_Init;

  if MeX.kLoad < 2 then MeX.LoadData(MeX.sFn,MeX.nbData0);
  if MeX.kLoad < 2 then Exit;

  if MeY.kLoad < 2 then MeY.LoadData(MeY.sFn,MeY.nbData0);

  if Not Self.sw_dV_Init then Exit;

  (* Нам нужны величины из FITS.Head, в частности R_Sun *)
  (* поэтому хотя бы 1 FITS должен быть загружен        *)

  if Self.R_Sun = 0 then LoadMEHeader0;

  SetLength(Ou_dV.aData,nX+1,nY+1);
  for iX := 0 to nX-1 do begin
    for iY := 0 to nY-1 do begin
      rX := MeX.aData[iX,iY];
      rY := MeY.aData[iX,iY];
      (* видимые координаты в угловых секундах от видимого радиуса Солнца *)

//      rgX := arccos(rX/R_Sun)/PI*180;
//      rgY := arccos(rY/R_Sun)/PI*180;

      rgX := arcsin(rX/R_Sun)/PI*180 + 90;
      rgY := arcsin(rY/R_Sun)/PI*180;

      dV := ph_Sun_VDFiL(rgY,rgX);

      Ou_dV.aData[iX,iY] := dV;
    end;
  end;
  SetBit.BISB(Ou_dV.kLoad,3);  (* бит 3 - производные данные *)
  Ou_dV.MinMaxMean;
end;




procedure TLFITS.CalcME_HL;
var iX,iY : integer;
begin
  (*!!!!!!!!!!!!!! использует MeH, MeGM *)

  if Not Assigned(MeH) then Self.meH_GM_Init;
{
  if MeH.nbData0=0 then begin
    LFIO.LoadME(Self.chDat,swStr.left(sDtTi,8),swStr.rightfrom(sDtTi,'_'));

    if Not Self.LoadMEfit then begin
      WarnAbs('LFITS.CalcMT_HL ERR: не удалось загрузить ME FITS!');
      Exit;
    end;
  end;
}
  if MeH.kLoad  < 2 then MeH.LoadData (MeH.sFn ,MeH.nbData0);
  if MeH.kLoad  < 2 then Exit;

  if MeGM.kLoad < 2 then MeGM.LoadData(MeGM.sFn,MeGM.nbData0);

  Self.meHLInit;
  SetLength(MeHL.aData,nX+1,nY+1);
  for iX := 0 to nX-1 do begin
    for iY := 0 to nY-1 do begin
      MeHL.aData[iX,iY] := MeH.aData[iX,iY]*cos(MeGM.aData[iX,iY]*C_PI180);
    end;
  end;
  SetBit.BISB(MeHL.kLoad,3);  (* бит 3 - производные данные *)
  MeHL.MinMaxMean;
end;



procedure TLFITS.CalcVC12;
var iX,iY : integer; V1,V2 : real;
begin
  if (rLC1M = 0) or (rLC2M = 0) then begin
    WarnAbs('LFITS.CalcVC12 ERR средние значения rLC1, rLC2 ещё не расчитаны'+
    #13#10+'Надо сперва запускать расчёт LFITS.CalcLC12');
    Exit;
  end;

  (*--------------------------------------------------------------*)
  (* заполняем массивы абсолютных значений скоростей OuVc1, OuVc2 *)
  (* и значение нормированной интенсивности континуума OuCnt      *)

  if (Not Assigned(OuVc1)) or
    (length(OuVc1.aData) = 0) then if Not swVc1_Vc2_Init then Exit;

  if length(OuVc1.aData) = 0 then begin
    SetLength(OuVc1.aData,nX,nY);
    SetLength(OuVc2.aData,nX,nY);
    SetBit.BISB(OuVc1.kLoad,0);  (* младший бит - память распределена *)
    SetBit.BISB(OuVc2.kLoad,0);
  end;
  (*----------------*)


  for iX := 0 to nX-1 do begin
    for iY := 0 to nY-1 do begin
      V1 := IToLamLFI(Self.OuGc1.aData[iX,iY])-rLC1M;
      V2 := IToLamLFI(Self.OuGc2.aData[iX,iY])-rLC2M;
      V1 := V1/6301.5*(PHYS.C_c/100/1000);  (* в километрах в секунду *)
      V2 := V2/6302.5*(PHYS.C_c/100/1000);

      OuVc1.aData[iX,iY] := V1;
      OuVc2.aData[iX,iY] := V2;
    end;
  end;

  SetBit.BISB(OuVc1.kLoad,3);  (* бит 3 - производные данные *)
  SetBit.BISB(OuVc2.kLoad,3);
  OuVc1.MinMaxMean;
  OuVc2.MinMaxMean;

end; (* TLFITS.CalcVC12 *)


procedure TLFITS.NormVCore; (* пересчёт VCore из пикселей в скорости *)
var iX,iY,k : integer; var V1,V2 : real;
begin
  for iX := 0 to nX-1 do begin
    for iY := 0 to nY-1 do begin
      for k := 3 to 5 do begin
        V1 := IToLamLFI(Ou35C1[k].aData[iX,iY])-rLC1M;
        V2 := IToLamLFI(Ou35C2[k].aData[iX,iY])-rLC2M;
        Ou35C1[k].aData[iX,iY] := V1/6301.5*(PHYS.C_c/100/1000); (* в км/с *)
        Ou35C2[k].aData[iX,iY] := V2/6302.5*(PHYS.C_c/100/1000); (* в км/с *)
      end;
    end;
  end;
end;

procedure TLFITS.NormVBiseq; (* пересчёт VBiseq из пикселей в скорости *)
var iX,iY,k : integer; var V1,V2 : real;
begin
  for iX := 0 to nX-1 do begin
    for iY := 0 to nY-1 do begin
      for k := 1 to MBiSec do begin
        V1 := IToLamLFI(OuBiC1[k].aData[iX,iY])-rLC1M;
        V2 := IToLamLFI(OuBiC2[k].aData[iX,iY])-rLC2M;
        OuBiC1[k].aData[iX,iY] := V1/6301.5*(PHYS.C_c/100/1000); (* в км/с *)
        OuBiC2[k].aData[iX,iY] := V2/6302.5*(PHYS.C_c/100/1000); (* в км/с *)
      end;
    end;
  end;
end;





procedure TLFITS.CalcContH0; (* приведение карты CONT к значению ContH0 *)
var iX,iY : integer; rContMean : real;
    sV : string;
begin
  if (rCntMH0 = 0)  then begin
    WarnAbs('LFITS.CalcContH0 ERR среднее значение rCntH0 ещё не расчитано'+
    #13#10+'Надо сперва запускать расчёт LFITS. ');
    Exit;
  end;

//  ###


  sV := '2022';
  if (Not Assigned(OuCnt)) or
    (length(OuCnt.aData) = 0) then
//  if Not swCnt_Init then Exit;
    if Not OuAny_Init(OuCnt,'Cont_H0',
                            'Cont Normalized to NonMagnetic Regions',sV)
      then Exit;

  kCnt := 1;

  (*---------------------------------------------------*)
  (* заполняем массивы значений                        *)
  (* нормированной интенсивности континуума OuCnt      *)

  if length(OuCnt.aData) = 0 then begin
    SetLength(OuCnt.aData,nX,nY);
    SetBit.BISB(OuCnt.kLoad,0); (* младший бит - память распределена *)
  end;
  (*----------------*)
                                  (* rCntH0 считаем в процедуре MeanContH0 *)
  rContMean := rCntMH0 / kCnt;     (* kCnt пока = 1 *)
  for iX := 0 to nX-1 do begin
    for iY := 0 to nY-1 do begin
      OuCnt.aData[iX,iY] := ouCont.aData[iX,iY]/rContMean;
//    CntK := rCntAY*iY + rCntBY;
//    OuCnm.aData[iX,iY] := ouCont.aData[iX,iY] / (rCntYA*iY + rCntYB);
    end;
  end;
  SetBit.BISB(OuCnt.kLoad,3);  (* бит 3 - производные данные *)
  OuCnt.MinMaxMean;
end;











procedure TLFITS.CalcLC12;  (*   =>  rLC1M, rLC2M *)
var iX,iY,N : integer; rSC1,rSC2 : Double;
{
    H,V,C,V1,V2 : real;
  sCnt      : real;
  rContMean : real; (* коэф-т взамен rCntH0, к-рый сделает средний CONT=1 *)
  k : integer;
}
begin
  (*!!!!!!!!!!!!!! использует ouGc1, ouGc2 *)
  if Not Assigned(OuGc1) then Self.swGC1_GC2_Init; //Self.swFITSInit;


  if OuGc1.kLoad < 2 then begin
    OuGc1.LoadData(OuGc1.sFn,OuGc1.nbData0);
  end;

  if OuGc2.kLoad < 2 then begin
    OuGc2.LoadData(OuGc2.sFn,OuGc2.nbData0);
  end;

  N := nX*nY;
  rSC1 := 0; rSC2 := 0;
  (* рассчитываем среднее полож.центра тяжести 6301/02 в пикселах *)
  for iX := 0 to nX-1 do begin
    for iY := 0 to nY-1 do begin
      rSC1 := rSC1 + Self.OuGc1.aData[iX,iY];
      rSC2 := rSC2 + Self.OuGc2.aData[iX,iY];
    end;
  end;
  Gc1 := rSC1 / N; (* центр тяжести 6301 средний по всему полю в пикселах *)
  Gc2 := rSC2 / N; (* центр тяжести 6302 средний по всему полю в пикселах *)

//не забыть считать переменные для процедуры IToLam
  rLC1M := IToLamLFI(Gc1); (* ср.значение дл.волны 6301 *)
  rLC2M := IToLamLFI(Gc2); (* ср.значение дл.волны 6302 *)
  (*-------------------------------------*)
end;



(* заполним массив значений "магнитности" опеределёнными числами *)
(* это независимая процедура, недоступная вне модуля             *)
procedure AkVI_Fill(var AX : TARe;k:real);
var xx : real; J : integer;
begin
  (* массиве AX 70 + 1 элемент *)
  AX[0] := 0;

  xx := 0.005*k;

  AX[1] := xx;

  for J := 2 to 31 do begin
    xx := xx + 0.0005*k;         (* 0.0055 0.006 0.0065 ... 0.0205 *)
    AX[J] := xx;                 (*                         0.0200    до 31 *)
  end;
  for J := 32 to 41 do begin     (* 0.0215 0.0225 ... 0.0305 *)
    xx := xx + 0.001*k;          (* 0.021             0.0300    от 32 до 41 *)
    AX[J] := xx;
  end;
  for J := 42 to 55 do begin     (* 0.0355 0.0405 ... 0.1005 *)
    xx := xx + 0.005*k;          (* 0.035             0.100    от 42 до 55 *)
    AX[J] := xx;
  end;
  for J := 56 to 60 do begin     (* 0.1205 0.1405 ... 0.2205 *)
    xx := xx + 0.02*k;           (* 0.120  0.140  ... 0.200    от 56 до 60 *)
    AX[J] := xx;
  end;
  for J := 61 to 70 do begin     (* 0.1205 0.1405 ... 0.2205 *)
    xx := xx + 0.05*k;           (* 0.120  0.140  ... 0.200    от 61 до 70 *)
    AX[J] := xx;
  end;
end;







(*====================================================*)
(* среднее значение континуума в немагнитных областях *)
(* -------------------------------------------------- *)
  (* находим среднее значение по всему массиву данных *)
  (* а также распределение яркости континуума         *)
  (*    - вдоль оси X и                               *)
  (*    - вдоль оси Y                                 *)
  (*  использует карты CONT и abs(KVI)                *)
  (*                                                  *)
  (*    вызывается из BigCalc2                        *)
  (*--------------------------------------------------*)
procedure TLFITS.MeanContH0;
var J,K,iY,iYA,iX : integer; N0 : integer; Y,LC0,KVI0,KVI1,A,B,C : real;
  nr : integer; (* размерность массива для вычисления регрессии *)

  A10 : TARe; AN10 : TARe;


  AX,AY : TARe; AN : TARe;


  (* двумерные массивы *)
  ACX : array [1..12] of TARe; AIX : array [1..12] of TAIn;
  ACY : array [1..12] of TARe; AIY : array [1..12] of TAIn;

  C_threshold : real;

  aFITS : TFITS; (* текущий FITS (для перебора по всем FITS) *)

  FOkH : TFIOut; (* временная карта для абс.значения магнитности *)
  FO1  : TFIOut;
  FO2  : TFIOut;

  //DEBUG
  S : string;
begin
  if Not Assigned(Self) then begin
    WarnAbs('LFITS.MeanContH0-ERR: LFITS не инициирован!');
    Exit;
  end;
  if Not Assigned(OuKVI) then Self.swCont_KVI_Init;

  if OuCont.kLoad < 2 then OuCont.LoadData(OuCont.sFn,OuCont.nbData0);
  if OuKVI.kLoad  < 2 then OuKVI.LoadData (OuKVI.sFn, OuKVI.nbData0);

  if OuKVI.kLoad < 2 then Exit; (* карта KVI не найдена, нечего вычислять *)


  FOkH := fAbs(OuKVI);
{
  FOkH := fMul(FOkH,1.0);

  FO1 := LFIO.GetFIOut(Self.sDtTi,'KQI');
  FO1 := fAbs(FO1);
  FO2 := LFIO.GetFIOut(Self.sDtTi,'KUI');
  FO2 := fAbs(FO2);
  FO1 := fMid(FO1,FO2);

  FOkH := fMid(FO1,FOkH);
}

{
  nr := 70+1;

  SetLength(AX0,nr);(* массив последоват.значений "магнитности" *)
  SetLength(AX,nr); (* среднее знач-е "магнитности" в интервале *)
  SetLength(AY,nr); (* среднее значение CONT в интервале        *)
  SetLength(AN,nr); (* плотность точек в интервале              *)

  (*-----------------------------------------------------------------*)
  (* надо оградить себя от попадания в область за краем диска Солнца *)
  (* для этого пробежим по центру X и центру Y  и определим          *)
  (*   точку с самой большой яркостью C_Max                          *)
  (*-----------------------------------------------------------------*)
  if OuCont.rMax = 0 then OuCont.MinMaxMean;


  C_threshold := OuCont.rMax*0.20; (* если попадётся тень пятна, её  *)
                                   (* всё равно надо будет отбросить *)


  (* находим среднее значение по всему массиву данных *)

  (* а также распределение яркости континуума         *)
  (*    - вдоль оси X и                               *)
  (*    - вдоль оси Y                                 *)

  AkVI_Fill(AX0);

  (*--------------------------------------------------------------------*)
  (* ИСПОЛЬЗУЕМ РАНЕЕ ЗАПОЛНЕННЫЕ КАРТЫ CONT и KVI
                                                                        *)

  (* строим гистограмму (со столбцами переменной ширины)                *)


  KVI0 := 0;
  for J := 1 to nr do begin
    KVI1 := KVI0;
    KVI0 := AX0[J];    (* меняем KVI0 от 0.005 до 0.2 *)
    N0   := 0; (* для подсчёта числа точек в столбце гистограммы *)
    LC0  := 0; (* для суммирования их интенсивностей *)


    for iY := 0 to nY-1 do begin
      for iX := 0 to nX-1 do begin
        (* выбираем области с определенной круговой поляризацией *)
        if (FOkH.aData[iX,iY] <  KVI0)
           and (FOkH.aData[iX,iY] >= KVI1)
        then begin
          C := Self.OuCont.aData[iX,iY];
          if C > C_threshold then begin (* если не попали за край диска *)
            inc(N0); LC0 := LC0 + C;
          end;
        end;
      end;
    end;


//  AX[J] := N0;


    if N0 > 0 then AY[J] := LC0 / N0  (* среднее значение CONT на интервале  *)
              else AY[J] := 0;        (* если ни одной точки в интервале нет *)

    AN[J] := N0/(KVI0-KVI1)/1000; (* число точек делим на интервал и на 1000 *)
    AX[J] := (KVI0+KVI1)/2;       (* положение столбца на шкале KVI *)
  end;





  (*========================================================*)
  (* вывод зависимости                                      *)
  (*   значение CONT - "магнитность"                        *)
  (* и гистограммы распределения частот для разных значений *)
  (* "магнитности" от 0 до 0.2 с шагом 0.005                *)
  (*========================================================*)
(*
  Self.SLOut.Add('--- Cont='+EFSt0(A,7));
  for J := 1 to 61 do begin
    S := ISt(J)+' '+EFSt0(AX[J],4)+' '+EFSt0(AN[J],6)+' '+EFSt0(AY[J],7);
    Self.SLOut.Add(S);
  end;
*)



}








  K := 0;
  for J := 1 to 12 do begin
    (* подготовим массивы для вычисления прямой лиейной регрессии *)
    SetLength(ACX[J],nY);
    SetLength(AIX[J],nY);
    SetLength(ACY[J],nX);
    SetLength(AIY[J],nX);

    (*============================*)
    KVI0 := J * 0.005;(* уровень интеграла абс.значения круговой поляризации *)
                      (* меняем KVI0 от 0.005 до 0.06 *)

    N0 := 0; LC0 := 0;





    (* идём вдоль щели (для определения клиновидности + потемнения к полюсу) *)
    for iY := 0 to nY-1 do begin
      ACX[J,iY] := 0;
      AIX[J,iY] := 0;
      for iX := 0 to nX-1 do begin
        (* исключаем области с большой круговой поляризацией *)
        if (Self.OuKVI.aData[iX,iY] <  KVI0)
//         and (Self.OuKVI.aData[iX,iY] >= KVI1)
        then begin

          C := Self.OuCont.aData[iX,iY];
          if C > C_threshold then begin (* если не попали за край диска *)
            inc(AIX[J,iY]); ACX[J,iY] := ACX[J,iY] + C;
{
            if (Self.OuKVI.aData[iX,iY] >= KVI1) then begin
              (* дополнительно считаем для среднего по всей поверхности *)
              (*--------------------*)
              inc(N0); LC0 := LC0 + C;
              (*--------------------*)
            end;
}
          end; (* if C > C_threshold *)

        end; (* if OuKVI.aData[iX,iY] < KVI0 *)
      end; (* for iX *)
    end; (* for iY *)


    (* идём по положениям щели (для определения потемнения к краю по широте) *)
    for iX := 0 to nX-1 do begin
      ACY[J,iX] := 0;
      AIY[J,iX] := 0;
      for iY := 0 to nY-1 do begin
        (* исключаем области с большой круговой поляризацией *)
        if Self.OuKVI.aData[iX,iY] < KVI0 then begin

          C := Self.OuCont.aData[iX,iY];
          if C > C_threshold then begin
            inc(AIY[J,iX]); ACY[J,iX] := ACY[J,iX] + C;
          end;
        end;
      end;
    end;

    (*=============================*)

{
    if N0 > 0 then begin
                Y := LC0 / N0;
                inc(K);
                AX[K] := N0;
                AY[K] := Y;
              end;
}
  end; (* for J := 1 to 12 *)


  (* предполагается, что чем меньше значение kVI0, тем больше яркость *)
  (* мы находим значения яркости для 12 значений kVI0 и строим прямую *)
  (* которая упрётся в точку kVI0 = 0, значение ярксоти в этой точке  *)
  (* мы и примем за истинную яркость невозмущенного континуума        *)

{
  SetLength(AX  ,K+1);
  SetLength(AY  ,K+1);
  LinRegress(AX,AY,A,B);
}




{
    S := swStr.AReSt(AX,5); Self.SLOut.Add(S);
    S := swStr.AReSt(AY,5); Self.SLOut.Add(S);
}
{
  rCntH0 := B;  (* среднее значение континуума в немагнитных областях *)
                (* в значениях отсчётов прибора *)
  rCntH0 := rCntH0 * 0.95;
}




















  (*=========================================*)
  (*=========================================*)
  (*=========================================*)
  (*=========================================*)
  (*=========================================*)

  SetLength(ACnYH0,nY+1);

  (*=================*)
  (*   цикл по iY    *)
  (*=================*)
  for iY := 0 to nY - 1 do begin
    SetLength(AX,12+1); for J := 0 to 12 do AX[J] := 0;
    SetLength(AY,12+1); for J := 0 to 12 do AY[J] := 0;

    K := 0;
    for J := 1 to 12 do begin
      if AIX[J,iY] > 0 then begin
        N0:= AIX[J,iY];
        Y := ACX[J,iY] / N0;
        inc(K);
        AX[K] := N0;
        AY[K] := Y;
      end;
    end;

    SetLength(AX  ,K+1);
    SetLength(AY  ,K+1);
    LinRegress(AX,AY,A,B);

    iYA := iY + 1;
    ACnYH0[iYA] := B; (* среднее значение континуума в немагнитных областях *)
  end;


  SetLength(AX,nY+1); for iYA := 1 to nY do AX[iYA] := iYA;
  LinRegress(AX,ACnYH0,A,B);

  rCntYA := A;
  rCntYB := B;

  (*=========================================*)





  SetLength(ACnXH0,nX+1);

  (*=================*)
  (*   цикл по iX    *)
  (*=================*)
  for iX := 0 to nX - 1 do begin
    SetLength(AX,12+1); for J := 0 to 12 do AX[J] := 0;
    SetLength(AY,12+1); for J := 0 to 12 do AY[J] := 0;

    K := 0;
    for J := 1 to 12 do begin
      if AIY[J,iX] > 0 then begin
        N0:= AIY[J,iX];
        Y := ACY[J,iX] / N0;
        inc(K);
        AX[K] := N0;
        AY[K] := Y;
      end;
    end;

    SetLength(AX  ,K+1);
    SetLength(AY  ,K+1);
    LinRegress(AX,AY,A,B);

    ACnXH0[iX+1] := B; (* среднее значение континуума в немагнитных областях *)
  end;







  if Self.Count < nX then begin
    WarnAbs('LFITS.Count='+ISt(Self.Count)+'<>nX='+ISt(nX));
  end;

  SetLength(AX,nX+1);
  for iX := 1 to nX do begin
    aFITS := TFITS(Self.Items[iX-1]);
    AX[iX] := aFITS.iXP;(* координата X в arcsec для вычисления ContH0 вдоль X*)
//  AX[iX] := Self.AXP[iX];   (* AXP - номера позиций SLITPOS *)
  end;
  LinRegress(AX,ACnXH0,A,B);

  rCntXA := A;
  rCntXB := B;

  (*=========================================*)



  Finalize(AX); Finalize(AY);
  for J := 1 to 12 do begin
    Finalize(AIX[J]);
    Finalize(ACX[J]);
    Finalize(AIY[J]);
    Finalize(ACY[J]);
  end;


end; (* TLFITS.MeanContH0 *)




(*---------- для сеанса LFITS  -----------------------*)
(* среднее значение континуума в немагнитных областях *)
(*   LFITS.rCntH0 (в точках)                          *)
(*     пересчитывается в BigCalc2.MeanContH0          *)
(* - вычисляем когда загружены все сырые FITSы        *)
(* aFITS.AKVI[iY] = abs(AKV1)/AKW1 + abs(AKV2)/AKW2   *)
(*    должны быть рассчитаны до вызова                *)

procedure TLFITS.RawMeanContH0;
var J,K,iYA,iX : integer; N0 : integer; Y,LC0,KVI0,KVI1,A,B : real;
  A10 : TARe; AN10 : TARe; AX,AY : TARe;
  aFITS : TFITS;
begin
//SetLength(A10 ,12+1);
//SetLength(AN10,12+1);
  SetLength(AX  ,12+1);
  SetLength(AY  ,12+1);

  K := 0;
  for J := 1 to 12 do begin


    (*============================*)
    KVI0 :=       J * 0.005;
    KVI1 := (J -1 ) * 0.005;
    N0 := 0; LC0 := 0;
    for iX := 0 to Self.Count-1 do begin
      aFITS := TFITS(Self.Items[iX]);

      for iYA := 1 to aFITS.nY do begin
        if (aFITS.AKVI[iYA] < KVI0) and
           (aFITS.AKVI[iYA] >= KVI1)
        then begin
          inc(N0); LC0 := LC0 + aFITS.ACnt[iYA];
        end;
      end;
    end;
    (*=============================*)


    if N0 > 0 then begin
                Y := LC0 / N0;
//              A10[J] := Y;
                inc(K);
                AX[K] := N0;
                AY[K] := Y;
              end
//            else A10[J] := 0
              ;
 // AN10[J] := N0;
  end;

  SetLength(AX  ,K+1);
  SetLength(AY  ,K+1);
  LinRegress(AX,AY,A,B);

  Finalize(AX); Finalize(AY);
  rCntMH0 := B;  (* среднее значение континуума в немагнитных областях *)
end; (* TLFITS.RawMeanContH0 *)






function TLFITS.ItoLamLFI(ILam:real):real;
begin
  result := (ILam - Self.rLamIdx0) * Self.rdLam + Self.rLa00;
end;

function TLFITS.ItoV1LFI(ILam:real):real;
var rL,dL,v0 : real;
begin
  rL := ItoLamLFI(ILam);
  dL := rL - Self.rLa1;
  v0 := (dL / rLa1) * (PHYS.C_c_km);
  result := v0 - Self.rVW1_0;
end;

function TLFITS.ItoV2LFI(ILam:real):real;
var rL,dL,v0 : real;
begin
  rL := ItoLamLFI(ILam);
  dL := rL - Self.rLa2;
  v0 := (dL / rLa1) * PHYS.C_c_km;
  result := v0 - Self.rVW2_0;
end;


{
procedure TLFITS.SetLinesArea(i1,i2,i3,i4,i5,i6:integer);
begin
  if Not Assigned(Self) then begin
    WarnAbs('Вызов LFITS.SetLinesArea ДО LFITS.Create!');
    Exit;
  end;
  il1 := i1; il2 := i2; il3 := i3; il4 := i4; il5 := i5; il6 := i6
end;
}



(*===================================================*)
(*                                                   *)
(*               Карта выходных данных               *)
(*                         и                         *)
(*   карта выходных данных для рисования картинки    *)
(*                                                   *)
(*===================================================*)


constructor TFIOut.Create;
begin
  inherited Create;
  Self.kRun  := $A5A55A5A;
  HSL := TStringList.Create;
  kLoad      := 0;
  Self.rMin  := 0;
  Self.rMax  := 0;
  Self.rMean := 0;
  jXMa3 := 0; (* индексы точки с макс.значением          *)
  jYMa3 := 0; (* после того, как отфильтрованы артефакты *)
end;

function TFIOut.QRun:boolean;
begin
  if Not Assigned(Self) then result := false
                        else result := (kRun = $A5A55A5A)
end;


{
constructor TFIPOut.Create;
begin
  inherited Create;
  Pict := TR4Pict.Create;
end;
}

procedure TFIOut.Done;
begin
  if Not Assigned(Self) then Exit;
  if Not Self.QRun then Exit; (* Not (kRun = $A5A55A5A) *)
  PictOff;
  Finalize(Self.aData);
  if assigned(HSL) then HSL.Clear;
  kLoad := 0;
  kRun  := 0;
end;

{
procedure TFIPOut.Done;
begin
  if Not Assigned(Self) then Exit;
  inherited Done;
  Pict.Done;
end;
}


(* получить средние по X значения (nY штук) в виде вектора *)
(* (простой вариант - без условий!)                        *)
function TFIOut.AMeanX:TARe;
var A : TARe; R : real; iX,iY,iA : integer;
begin
  result := NIL;
  if Not Assigned(Self) then Exit;
  if kLoad < 2 then begin
    WarnAbs('Вызов FO.AMeanX('+
             Self.Name+') когда массив не заполнен, kLoad='+ISt(kLoad));
    Exit;
  end;
  SetLength (A,nY+1);
  for iY := 0 to nY - 1 do begin
    iA := iY + 1;
    R := 0;
    for iX := 0 to nX - 1 do begin
      R := R + aData[iX,iY];
    end;
    A[iA] := R / nX;
  end;
  result := A;
end;

procedure TFIOut.MaskedMeanX(aMask:TAMask;var AiY,AX:TARe);
var R : real; iX,iY,iA,nn : integer;
begin
  Finalize(AiY);
  Finalize(AX);

  if Not Assigned(Self) then Exit;
  if kLoad < 2 then begin
    WarnAbs('Вызов FO.MaskedAMeanX('+
             Self.Name+') когда массив не заполнен, kLoad='+ISt(kLoad));
    Exit;
  end;
  SetLength (AiY,nY+1);
  SetLength (AX ,nY+1);

  iA := 0; AiY[iA] := 0; AX[iA] := 0;

  for iY := 0 to nY - 1 do begin
    R  := 0;
    nn := 0;
    for iX := 0 to nX - 1 do begin
      if aMask[iX,iY] <> 0 then begin
        inc(nn);
        R := R + aData[iX,iY];
      end;
    end;
    if nn > 0 then begin
      inc(iA);
      AX[iA] := R / nn;
      AiY[iA] := iY;
    end;
  end;

  SetLength(AX, iA+1);
  SetLength(AiY,iA+1);
end; (* TFIOut.MaskedMeanX *)


(* получить средние по Y значения (nX штук) в виде вектора *)
(* (простой вариант - без условий!)                        *)
function TFIOut.AMeanY:TARe;
var A : TARe; R : real; iX,iY,iA : integer;
begin
  result := NIL;
  if Not Assigned(Self) then Exit;
  if kLoad < 2 then begin
    WarnAbs('Вызов FO.AMeanY('+
             Self.Name+') когда массив не заполнен, kLoad='+ISt(kLoad));
    Exit;
  end;
  SetLength (A,nX+1);
  for iX := 0 to nX - 1 do begin
    iA := iX + 1;
    R := 0;
    for iY := 0 to nY - 1 do begin
      R := R + aData[iX,iY];
    end;
    A[iA] := R / nY;
  end;
  result := A;
end;

procedure TFIOut.MaskedMeanY(aMask:TAMask;var AiX,AY:TARe);
var R : real; iX,iY,iA,nn : integer;
begin
  // получаем nX штук усреднений по оси Y

  Finalize(AiX);
  Finalize(AY);

  if Not Assigned(Self) then Exit;
  if kLoad < 2 then begin
    WarnAbs('Вызов FO.MaskedAMeanY('+
             Self.Name+') когда массив не заполнен, kLoad='+ISt(kLoad));
    Exit;
  end;
  SetLength (AiX,nX+1);
  SetLength (AY ,nX+1);

  iA := 0; AiX[iA] := 0; AY[iA] := 0;

  for iX := 0 to nX - 1 do begin
    R  := 0;
    nn := 0;
    for iY := 0 to nY - 1 do begin
      if aMask[iX,iY] <> 0 then begin
        inc(nn);
        R := R + aData[iX,iY];
      end;
    end;
    if nn > 0 then begin
      inc(iA);
      AY[iA] := R / nn;
      AiX[iA] := iX;
    end;
  end;

  SetLength(AY, iA+1);
  SetLength(AiX,iA+1);
end; (* TFIOut.MaskedMeanY *)


(* AtX время нач.экспозиции в мин.? AY - среднее по маске *)
procedure TFIOut.MaskedMeanYt(aMask:TAMask;var AtX,AY:TARe);
var R : real; iX,iY,iA,nn : integer;
begin
  // получаем nX штук усреднений по оси Y

  Finalize(AtX);
  Finalize(AY);

  if Not Assigned (TLFITS(Owner)) then begin
    WarnAbs('FO.MaskedMeanYt-ERR: TLFITS(Owner) Not Assigned!');
    Exit;
  end;

  if Length(TLFITS(Owner).AXT) <> (Self.nX+1) then begin
    WarnAbs('FO.MaskedMeanYt-ERR: length(LFITS.AXT)='+
      ISt(Length(TLFITS(Owner).AXT))+' <> nX='+ISt(nX));
    Exit;
  end;


  if Not Assigned(Self) then Exit;
  if kLoad < 2 then begin
    WarnAbs('Вызов FO.MaskedAMeanYt('+
             Self.Name+') когда массив не заполнен, kLoad='+ISt(kLoad));
    Exit;
  end;
  SetLength (AtX,nX+1);
  SetLength (AY ,nX+1);

  iA := 0; AtX[iA] := 0; AY[iA] := 0;

  for iX := 0 to nX - 1 do begin
    R  := 0;
    nn := 0;
    for iY := 0 to nY - 1 do begin
      if aMask[iX,iY] <> 0 then begin
        inc(nn);
        R := R + aData[iX,iY];
      end;
    end;
    if nn > 0 then begin
      inc(iA);
      AY[iA]  := R / nn;
      AtX[iA] := TLFITS(Owner).AXT[iX];
    end;
  end;

  SetLength(AY, iA+1);
  SetLength(AtX,iA+1);
end; (* TFIOut.MaskedMeanYt *)



procedure TFIOut.MaskedMeanYK(aMask:TAMask;sKey:string;var AkX,AY:TARe);
var R : real; iX,iY,iA,nn : integer; aFITS : TFITS;
begin
  // получаем nX штук усреднений по оси Y

  Finalize(AkX);
  Finalize(AY);

  if Not Assigned (TLFITS(Owner)) then begin
    WarnAbs('FO.MaskedMeanYt-ERR: TLFITS(Owner) Not Assigned!');
    Exit;
  end;

  if Length(TLFITS(Owner).AXT) <> (Self.nX+1) then begin
    WarnAbs('FO.MaskedMeanYt-ERR: length(LFITS.AXT)='+
      ISt(Length(TLFITS(Owner).AXT))+' <> nX='+ISt(nX));
    Exit;
  end;


  if Not Assigned(Self) then Exit;
  if kLoad < 2 then begin
    WarnAbs('Вызов FO.MaskedAMeanYt('+
             Self.Name+') когда массив не заполнен, kLoad='+ISt(kLoad));
    Exit;
  end;
  SetLength (AkX,nX+1);
  SetLength (AY ,nX+1);

  iA := 0; AkX[iA] := 0; AY[iA] := 0;

  for iX := 0 to nX - 1 do begin
    R  := 0;
    nn := 0;
    for iY := 0 to nY - 1 do begin
      if aMask[iX,iY] <> 0 then begin
        inc(nn);
        R := R + aData[iX,iY];
      end;
    end;


    if nn > 0 then begin
      inc(iA);
      AY[iA]  := R / nn;
      aFITS   := TFITS(TLFITS(Owner).Items[iX]);
      AkX[iA] := aFITS.GetKeyVal(sKey);
    end;
  end;

  SetLength(AY, iA+1);
  SetLength(AkX,iA+1);
end; (* TFIOut.MaskedMeanYK *)




procedure TFIOut.MaskedMeanYvO(aMask:TAMask;var AvOX,AY:TARe);
var R : real; iX,iY,iA,nn : integer;
begin
  // получаем nX штук усреднений по оси Y

  Finalize(AvOX);
  Finalize(AY);

  if Not Assigned (TLFITS(Owner)) then begin
    WarnAbs('FO.MaskedMeanYvO-ERR: TLFITS(Owner) Not Assigned!');
    Exit;
  end;

  if Length(TLFITS(Owner).AXvO) <> (Self.nX+1) then begin
    WarnAbs('FO.MaskedMeanYvO-ERR: length(LFITS.AXvO)='+
      ISt(Length(TLFITS(Owner).AXvO))+' <> nX='+ISt(nX));
    Exit;
  end;


  if Not Assigned(Self) then Exit;
  if kLoad < 2 then begin
    WarnAbs('Вызов FO.MaskedAMeanYvO('+
             Self.Name+') когда массив не заполнен, kLoad='+ISt(kLoad));
    Exit;
  end;
  SetLength (AvOX,nX+1);
  SetLength (AY  ,nX+1);

  iA := 0; AvOX[iA] := 0; AY[iA] := 0;

  for iX := 0 to nX - 1 do begin
    R  := 0;
    nn := 0;
    for iY := 0 to nY - 1 do begin
      if aMask[iX,iY] <> 0 then begin
        inc(nn);
        R := R + aData[iX,iY];
      end;
    end;
    if nn > 0 then begin
      inc(iA);
      AY[iA]  := R / nn;
      AvOX[iA] := TLFITS(Owner).AXvO[iX];
    end;
  end;

  SetLength(AY, iA+1);
  SetLength(AvOX,iA+1);
end; (* TFIOut.MaskedMeanYvO *)




{
procedure TFIOut.ReturnALvl(ALvl0:TAR4);
var i : integer;
begin
  if Length(ALvl0)=256 then begin
    SetLength(Self.ALvl,256);
    for i := 0 to 255 do ALvl[i] := ALvl0[i];
  end;
end;
}


(* Клонирование ЧАСТИ данных ради создания производной переменной *)
function TFIOut.Clone:TFIOut;
var iX,iY : integer; FO : TFIOut;
begin
  result := NIL;
  if Not Assigned(Self) then Exit;

  if Not Assigned(Self.aData) then begin
    WarnAbs('FIOut.Clone - ERR: в клонируемом файле не заполнена карта!');
    Exit;
  end;

  FO := TFIOut.Create;

  FO.Owner   := Self.Owner;
//FO.sVar    := Self.sVar;     (* это точно поменяем *)
  FO.Name    := Self.Name;     (* это тоже всё равно поменяем *)
//FO.Comment := Self.Comment;   пропускаем
  FO.Alg_Ver := Self.Alg_Ver;
  FO.sDt     := Self.sDt;
  FO.sTi     := Self.sTi;
  FO.chN     := Self.chN;
  FO.nb0     := 0;        (* клонированная катра не связана с файлом *)

//FO.HSL
(*--------
  FO.nb0     := Self.nb0;            Это здесь лишнее!
  FO.nbHead  := Self.nbHead;
  FO.nbData0 := Self.nbData0;
  FO.nbData  := Self.nbData;
 -------*)
  FO.kSoft   := 7; (* это уже не будет не SW не ME не M2 *)
  FO.nX      := Self.nX;
  FO.nY      := Self.nY;
(*-----------------------
  FO.rMin    := Self.rMin;         Всё равно будет пересчитано
  FO.rMax    := Self.rMax;
  FO.rMean   := Self.rMean;
  FO.iXMi    := Self.iXMi;
  FO.iYMi    := Self.iYMi;
  FO.iXMa    := Self.iXMa;
  FO.iYMa    := Self.iYMa;
--------------------------*)

//nX := Length(FO.aData);
//nY := Length(FO.aData[0]);
  SetLength(FO.aData,nX,nY);
  FO.kLoad := 1;       (* память выделена, но данные не загружены *)

  FO.qTmp := true;      (* это должна быть временная карта *)

(*----------------------------      Клонируем ради изменения данных!
  for iX := 0 to nX-1 do
    for iY := 0 to nY-1 do
      Self.aData[iX,iY] := FO.aData[iX,iY];
-----------------------------*)

  result := FO;
end; (* function TFIOut.Clone *)


procedure TFIOut.CloneFrom(FO:TFIOut);
var iX,iY,i : integer;
begin
  if Not Assigned(FO) then Exit;
  if Not Assigned(Self) then Exit; (* Self := TFIPOut.Create *)

  if Not Assigned(FO.aData) then begin
    WarnAbs('FIOut.CloneFrom - ERR: во водном файле не заполнена карта!');
    Exit;
  end;

  Self.Owner   := FO.Owner;
  Self.sVar    := FO.sVar;
  Self.Name    := FO.Name;
  Self.Comment := FO.Comment;
  Self.Alg_Ver := FO.Alg_Ver;
  Self.sDt     := FO.sDt;
  Self.sTi     := FO.sTi;
  Self.chN     := FO.chN;
//  FO.HSL
  Self.nb0     := FO.nb0;
  Self.nbHead  := FO.nbHead;
  Self.nbData0 := FO.nbData0;
  Self.nbData  := FO.nbData;
  Self.kSoft   := FO.kSoft;
  Self.nX      := FO.nX;
  Self.nY      := FO.nY;
(*-----------------------*)
  Self.rMin    := FO.rMin;   (* минимальное  значение для карты *)
  Self.rMax    := FO.rMax;   (* максимальное значение для карты *)
  Self.rMean   := FO.rMean;
  Self.iXMi    := FO.iXMi;
  Self.iYMi    := FO.iYMi;
  Self.iXMa    := FO.iXMa;
  Self.iYMa    := FO.iYMa;

  Self.rMinAv  := FO.rMinAv;   (* минимальное значение для карты      *)
  Self.rMaxAv  := FO.rMaxAv;   (* для точек, отфильтрованных по маске *)
  Self.rMeanAv := FO.rMeanAv;
  Self.jXMi    := FO.jXMi;
  Self.jYMi    := FO.jYMi;
  Self.jXMa    := FO.jXMa;
  Self.jYMa    := FO.jYMa;

  Self.chScale := FO.chScale; (* N/E/L/H *)

(*--------------------------*)

  Self.kLoad   := FO.kLoad;


//nX := Length(FO.aData);
//nY := Length(FO.aData[0]);
  SetLength(Self.aData,nX,nY);

  for iX := 0 to nX-1 do
    for iY := 0 to nY-1 do
      Self.aData[iX,iY] := FO.aData[iX,iY];

{
  if Length(FO.ALvl)=256 then begin
    if Not Assigned(Self.Pict) then Self.Pict := TR4Pict.Create;
    SetLength(Pict.aLvl,256);
    for i := 0 to 255 do Pict.aLvl[i] := FO.ALvl[i];
  end;
}

end;



{
procedure TFIPOut.CloneFrom(FO:TFIOut);
var iX,iY,i : integer;
begin
  if Not Assigned(FO) then Exit;
  if Not Assigned(Self) then Exit; (* Self := TFIPOut.Create *)

  if Not Assigned(FO.aData) then begin
    WarnAbs('FIPOut.CloneFrom - ERR: во водном файле не заполнена карта!');
    Exit;
  end;

  Self.Owner := FO.Owner;
  Self.sVar    := FO.sVar;
  Self.Name    := FO.Name;
  Self.Comment := FO.Comment;
  Self.Alg_Ver := FO.Alg_Ver;
  Self.sDt     := FO.sDt;
  Self.sTi     := FO.sTi;
  Self.chN     := FO.chN;
//  FO.HSL
  Self.nb0     := FO.nb0;
  Self.nbHead  := FO.nbHead;
  Self.nbData0 := FO.nbData0;
  Self.nbData  := FO.nbData;
  Self.kSoft   := FO.kSoft;
  Self.nX      := FO.nX;
  Self.nY      := FO.nY;
(*-----------------------*)
  Self.rMin    := FO.rMin;   (* минимальное  значение для карты *)
  Self.rMax    := FO.rMax;   (* максимальное значение для карты *)
  Self.rMean   := FO.rMean;
  Self.iXMi    := FO.iXMi;
  Self.iYMi    := FO.iYMi;
  Self.iXMa    := FO.iXMa;
  Self.iYMa    := FO.iYMa;

//  Self.rPmi    := FO.rPmi;   (* значение, к-рое соответствует яркости   0 *)
//  Self.rPma    := FO.rPma;   (* значение, к-рое соответствует яркости 255 *)

  Self.chScale := FO.chScale; (* N/E/L/H *)

(*--------------------------*)

  Self.kLoad   := FO.kLoad;


//nX := Length(FO.aData);
//nY := Length(FO.aData[0]);
  SetLength(Self.aData,nX,nY);

  for iX := 0 to nX-1 do
    for iY := 0 to nY-1 do
      Self.aData[iX,iY] := FO.aData[iX,iY];

  if Length(FO.ALvl)=256 then begin
    if Not Assigned(Self.Pict) then Self.Pict := TR4Pict.Create;
    SetLength(Pict.aLvl,256);
    for i := 0 to 255 do Pict.aLvl[i] := FO.ALvl[i];
  end;

end;

procedure TFIPOut.PictOff;
begin
  if Not Assigned(Self) then Exit;
  Pict.Done;
//qPict := false;
end;
}

procedure TFIOut.PictOff;
begin
  if Not Assigned(Self) then Exit;
  if Assigned(Pict) then begin Pict.Done; FreeAndNIL(Pict) end;
//qPict := false;
end;


procedure TFIOut.PictOn;
begin
  if Not Assigned(Self) then Exit;
  if Not Assigned(Pict) then Pict := TR4Pict.Create;
  Pict.Init(aData); (* по умолчанию - режим qHist = true *)
end;


{
procedure TFIPOut.PictOn;
begin
  if Not Assigned(Self) then Exit;
  Pict.Init(aData); (* по умолчанию - режим qHist = true *)
end;
}


(* отчёт об объёме памяти, который занимает FIOut *)
function TFIOut.RepMem:string;
var S : string; N : integer;
begin
  if Not Assigned(Self) then begin result := '-'; Exit end;
  N := 0;
          // +Comment
  S := 'FIT '+Name+' k='+ISt(kSoft)+' ['+ISt(nx)+','+ISt(ny)+
        '] header ';
  if Assigned(HSL) then begin
    S := S + ISt(HSL.Count)+'str ';
    N := N + HSL.Count * 80;
  end;

  S := S + 'aData[';

  if assigned(aData) then begin
    S := S + ISt(length(aData))+','+ISt(length(aData[0]))+'] ';
    N := N + length(aData)*length(aData[0])*4;
  end
  else begin
    S := S + 'NAN] ';
  end;
  S := S + ' Total='+ISt(N);
  result := S;
end; (* TFIOut.RepMem *)


{
(*----------------------------------------
  Name  - имя "карты"
  kSoft = 1/2/3 = SunWorld/Merlin/TempData
  Owner - ссылка на LFITS
 ----------------------------------------*)
procedure TFIOut.Link(Nam0:string;k0:integer;anOwner:TObject);
begin
  Self.Name  := Nam0;
  Self.kSoft := k0;
  Self.kLoad := 0;   (* память не распределена *)
  Self.Owner := anOwner;
end;




procedure TFIOut.Link(Nam0,Com0:string;k0:integer;anOwner:TObject);
begin
  Self.Comment := Com0;
  Link(Nam0,k0,anOwner);
end;

procedure TFIOut.Link(Nam0,Com0:string;k0,nX0,nY0:integer;anOwner:TObject);
begin
  Self.nX := nX0; Self.nY := nY0; Link(Nam0,Com0,k0,anOwner);
end;

procedure TFIOut.Link(Nam0,Com0,Ver:string;k0,nX0,nY0:integer;anOwner:TObject);
begin
  Self.Alg_Ver := Ver; Link(Nam0,Com0,k0,nX0,nY0,anOwner);
end;
}


(* создаём Header String List *)
procedure TFIOut.SetHSL(SrcSL:TStringList;ls0,ls1:integer);
var S : string; nX0,nY0 : integer;
begin
  if Not Assigned(Self.HSL) then Self.HSL := TStringList.Create
                            else Self.HSL.Clear;
  swStr.slCopy(SrcSL,Self.HSL,ls0,ls1);

  Self.nX := GetFITKeyI('NAXIS1',HSL);
  Self.nY := GetFITKeyI('NAXIS2',HSL);

  if (nX=0) or (nY=0) then begin
    S := 'TFIOut.SetHSL ERR в Хидере не найдены ключи NAXIS1 и 2!';
    HSL.Insert(0,S);
    WarnAbs(HSL);
    Exit;
  end;

  if Not Assigned(Owner) then Exit;

  (* возвращаем nX,nY в Owner *)
  nX0 := TLFITS(Owner).nX;
  nY0 := TLFITS(Owner).nY;
  if Not TLFITS(Owner).CheckNXY(nX,nY) then begin
    WarnAbs('FIOut['+Name+':'+Comment+
            '].SetHSL ERR Нестыковка в размере nX='
             +ISt(nX)+'<>LFITS.nX='+ISt(nX0)+' или nY='
             +ISt(nY)+'<>LFITS.nY='+ISt(nY0)  );
  end;

end; (* TFIOut.SetHSL *)




(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
(*                                                     *)
(*     процедуры, которые предполагаются к удалению    *)
(*                                                     *)
(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)


(* + = полусумма *)
(* - = разность  *)
procedure TFIOut.Fuse(A,B:TFIOut;ChOp:char);
var iX,iY : integer; R4 : real4;
begin
  Time_routine('FIOut.Fuse',true);

  Self.Name  := A.Name+ChOp+B.Name;
  Self.kSoft := 3;        (* 3 = TempData 1=SW,2=ME *)
  Self.Owner := A.Owner;  (* ссылка на TLFITS *)
  Self.qTmp  := true;
  if A.chN = B.chN then Self.chN := A.chN;


  Self.nX := A.nX; Self.nY := A.nY;

  SetLength(aData,nX,nY);
  Self.kLoad := 1;         (* память выделена *)

  Case ChOp of

  '/' :
  for iY := 0 to nY-1 do begin
    for iX := 0 to nX-1 do begin
      R4 := B.aData[iX,iY];
      if R4 = 0 then aData[iX,iY] := A.aData[iX,iY]
                else aData[iX,iY] := A.aData[iX,iY]/R4;
    end;
  end;
  '+' :
  for iY := 0 to nY-1 do
    for iX := 0 to nX-1 do
      aData[iX,iY] := (A.aData[iX,iY] + B.aData[iX,iY])/2;
  '-' :
  for iY := 0 to nY-1 do
    for iX := 0 to nX-1 do
      aData[iX,iY] := A.aData[iX,iY] - B.aData[iX,iY];

  end; (* case *)

  Self.kLoad := 8; (* данные получены как производные от других *)

//  Pict.Init(aData,A.Pict.qHist);
  Time_routine('FIOut.Fuse',false);
end; (* TFIOut.Fuse *)




(* проверяем признак наличия данных в карте, если их нет *)
(* объявляем об ошибке и месте вызова                    *)
(* sFunc - место вызова проверки                         *)
function TFIOut.QLoad(sFunc:string;R:real):boolean;
var S : string;
begin
  result := true;
  if kLoad >= 2  (* данные загружены/рассчитаны/получены из других карт *)
  then Exit;     (* всё ОК - выходим *)

  S := sFunc+' ('+EFSt0(R,4)+')';
  result := QLoad(S);
end;

function TFIOut.QLoad(sFunc:string):boolean;
var S : string;
begin
  result := true; if kLoad >= 2 then Exit;
  result := false;
  S := 'FIOut ' + sFunc;
  if kLoad = 0 then WarnAbs(S+' память не выделена');
  if kLoad = 1 then WarnAbs(S+' данные не загружены');
end;







(*-------------------------------------------------------------*)
(*                                                             *)
(* получить карту по назначенному id из одного из двух списков *)
(*  - списку LFIO либо списку LFIOtmp (полученному из Memo)    *)
(*    без проверки на длину sId                                *)
(*-------------------------------------------------------------*)

function FObysVar0(sV:string):TFIOut;
var FO,FI : TFIOut; I : integer; QDone : boolean;
begin
  FO := NIL;

  (* длина Id может быть любой  *)
  (* ищем переменную            *)
  (* сначала среди переменных, заданных в Memo *)
  I := 0;
  QDone := false;
  while (I < LFIOtmp.Count) and (Not QDone) do begin
    FI := TFIOut(LFIOtmp.Items[I]);
    if FI.QRun then begin
      if FI.sVar = sV then begin FO := FI; QDone := true end;
    end;
    inc(I);
  end;

  (* затем среди загруженных карт *)
  I := 0;
  while (Not QDone) and (I < LFIO.Count) do begin
    FI := TFIOut(LFIO.Items[I]);
    if FI.QRun then begin
      if FI.sVar = sV then begin FO := FI; QDone := true end;
    end;
    inc(I);
  end;

  result := FO;
end;



(*-------------------------------------------------------------*)
(*                                                             *)
(* получить карту по назначенному id из одного из двух списков *)
(*  - списку LFIO либо списку LFIOtmp (полученному из Memo)    *)
(*                                                             *)
(*-------------------------------------------------------------*)

function FObysVar(sV:string):TFIOut;
var FO,FI : TFIOut; I,n : integer; QDone : boolean;
    chN : char; sV1 : string;
begin
  result := NIL;
  n := length(sV);

  (* если n=1, то это может быть переменная из поля MemoFIOP *)
  (* тогда надо расширять имя номером сессии и искать по     *)
  (* двухбуквенному Id                                       *)
  if n = 1 then begin
    chN := '0';
    repeat
      sV1 := sV + chN;
      FO := FObysVar(sV1); (* рекурсия *)
      inc(chN);
    until (Assigned(FO) or (chN > '9'));
    if Assigned(FO) then begin
      result := FO;
      Exit;
    end;
  end;

  if (n > 2) or (n < 1) then begin
    WarnAbs('FObysVar-ERR длина НикНэйм-а карты <'+sV+
            '> (в поле Pict) должна быть равна 2');
    Exit;
  end;

  FO := FObysVar0(sV);
  result := FO;
end;



(*-------------------------------------------------------------*)
(*                                                             *)
(* получить список карт для всех сеансов по назначенному       *)
(* первому символу id из одного из двух списков                *)
(*  - списку LFIO либо списку LFIOtmp (полученному из Memo)    *)
(*                                                             *)
(*-------------------------------------------------------------*)
function LFObychVar(chV:char):TList;
var LFO : TList; FO : TFIOut; I : integer;
begin
  result := NIL;
  if Not Assigned(LFIO) then begin
    WarnAbs('Список карт LFIO не сформирован!');
    Exit;
  end;
  LFO := TList.Create;
  for I := 0 to LFIOtmp.Count-1 do begin
    FO := TFIOut(LFIOtmp.Items[I]);
    if FO.QRun then
    if (FO.sVar <> '') then if FO.sVar[1] = chV then LFO.Add(FO);
  end;
  for I := 0 to LFIO.Count-1 do begin
    FO := TFIOut(LFIO.Items[I]);
    if FO.QRun then
    if (FO.sVar <> '') then
      if FO.sVar[1] = chV then
        LFO.Add(FO);
  end;
  result := LFO;
end;

(*-------------------------------------------------------------*)
(*                                                             *)
(* получить список карт для всех сеансов по назначенному       *)
(* имени карты из одного из двух списков                       *)
(*  - списку LFIO либо списку LFIOtmp (полученному из Memo)    *)
(*                                                             *)
(*-------------------------------------------------------------*)
function LFO_by_Na(sNa:string):TList;
var LFO : TList; FO : TFIOut; I : integer;
begin
  result := NIL;
  if Not Assigned(LFIO) then begin
    WarnAbs('Список карт LFIO не сформирован!');
    Exit;
  end;
  LFO := TList.Create;
  for I := 0 to LFIOtmp.Count-1 do begin
    FO := TFIOut(LFIOtmp.Items[I]);
    if FO.QRun then
    if (FO.Name = sNa) then LFO.Add(FO);
  end;
  for I := 0 to LFIO.Count-1 do begin
    FO := TFIOut(LFIO.Items[I]);
    if FO.QRun then
    if (FO.Name = sNa) then LFO.Add(FO);
  end;
  result := LFO;
end;


(*-------------------------------------------------------------*)
(*                                                             *)
(* получить список сеансов по назначенному                     *)
(* имени карты из одного из списка LFIO                        *)
(*                                                             *)
(*-------------------------------------------------------------*)
function LSes_by_Na(sNa:string):TStringList;
var LS : TStringList; FO : TFIOut; I : integer;
begin
  result := NIL;
  if Not Assigned(LFIO) then begin
    WarnAbs('LSes_by_Na - Список карт LFIO не сформирован!');
    Exit;
  end;
  LS := TStringList.Create;
  if assigned(LFIOtmp) then
  for I := 0 to LFIOtmp.Count-1 do begin
    FO := TFIOut(LFIOtmp.Items[I]);
    if FO.QRun then
    if (FO.Name = sNa) then LS.Add(FO.s15);
  end;
  for I := 0 to LFIO.Count-1 do begin
    FO := TFIOut(LFIO.Items[I]);
    if FO.QRun then
    if (FO.Name = sNa) then LS.Add(FO.s15);
  end;
  result := LS;
end;





function fAny1(sFun,sV1:string):TFIOut;
var FI,FI1,FO : TFIOut; I,IFun : integer; QDone : boolean;
begin
  result := NIL; FO := NIL;

  IFun := swStr.CaseStr(sFun,SLFun1);
  if IFun < 0 then Exit;

  FI1 := NIL;

  QDone := false;
  I := 0;
  while (I < LFIOtmp.Count) and (Not QDone) do begin
    FI := TFIOut(LFIOtmp.Items[I]);
    if FI.QRun then begin
      if FI.sVar = sV1 then FI1 := FI;
      if Assigned(FI1) then QDone := true;
    end;
    inc(I);
  end;

  I := 0;
  while (Not QDone) and (I < LFIO.Count) do begin
    FI := TFIOut(LFIO.Items[I]);
    if Not FI.QRun then begin
      inc(I);
      Continue;
    end;
    if Not Assigned(FI1)
    then begin if FI.sVar = sV1
      then begin
        FI1 := FI;
        if Not FI1.CheckLoad then begin
          WarnAbs('fAny1 ERR Данные карты '+FI1.Name+' не найдены в файле!');
          Exit;
        end;
      end;
    end;
    if Assigned(FI1) then QDone := true;
    inc(I);
  end;

  if Not QDone then begin
    if Not Assigned(FI1) then begin
      WarnAbs('FIOut.fAny2-ERR не присвоена карта переменной '+sV1);
    end;
    Exit;
  end;

{
  Case IFun of
  0 : FO := fAbs(FI1);
  1 : FO := fNeg(FI1);
  2 : FO := fInv(FI1);
  3 : FO := fLog(FI1);
  4 : FO := fExp10(FI1);
  end;

  result := FO;
}
  result := FIOutAny1(sFun,FI1);

end;

function FIOutAny2C(sFun:string;FI1,FI2:TFIOut;k:real):TFIOut;
var FO : TFIOut; IFun : integer;
begin
  result := NIL;
  IFun := swStr.CaseStr(sFun,SLFun2C); 
  if IFun < 0 then begin
    WarnAbs('Функции '+sFun+'(FO1,FO2) не существует!');
    Exit;
  end;

  if (Not Assigned (FI1)) or (Not Assigned (FI2)) then begin
    WarnAbs('Вызвана функция <'+sFun+' с неопределёнными аргументами!');
    Exit;
  end;

  if Not FI1.CheckLoad then begin
    WarnAbs('FIOutAnyC2 ERR Данные карты '+FI1.Name+' не найдены в файле!');
    Exit;
  end;

  if Not FI1.CheckLoad then begin
    WarnAbs('FIOutAnyC2 ERR Данные карты '+FI2.Name+' не найдены в файле!');
    Exit;
  end;

  Case IFun of
  0 : FO := fCircSub(FI1,FI2,k);
  end;
  result := FO;
end;



function FIOutAny2(sFun:string;FI1,FI2:TFIOut):TFIOut;
var FO : TFIOut; IFun : integer;
begin
  result := NIL;
  IFun := swStr.CaseStr(sFun,SLFun);
  if IFun < 0 then begin
    WarnAbs('Функции '+sFun+'(FO1,FO2) не существует!');
    Exit;
  end;

  if (Not Assigned (FI1)) or (Not Assigned (FI2)) then begin
    WarnAbs('Вызвана функция <'+sFun+' с неопределёнными аргументами!');
    Exit;
  end;

  if Not FI1.CheckLoad then begin
    WarnAbs('FIOutAny2 ERR Данные карты '+FI1.Name+' не найдены в файле!');
    Exit;
  end;

  if Not FI2.CheckLoad then begin
    WarnAbs('FIOutAny2 ERR Данные карты '+FI2.Name+' не найдены в файле!');
    Exit;
  end;

  Case IFun of
  0 : FO := fAdd(FI1,FI2);
  1 : FO := fMid(FI1,FI2);
  2 : FO := fSub(FI1,FI2);
  3 : FO := fRat(FI1,FI2);
  4 : FO := fMul(FI1,FI2);
  end;
  result := FO;

end;

function FIOutAnyC(sFun:string;FI1:TFIOut;k:real):TFIOut;
var FO : TFIOut; IFun : integer;
begin
  result := NIL;
  IFun := swStr.CaseStr(sFun,SLFunC);
  if IFun < 0 then begin
    WarnAbs('Функции '+sFun+'(FO1,R) не существует!');
    Exit;
  end;

  if Not FI1.CheckLoad then begin
    WarnAbs('FIOutAnyC ERR Данные карты '+FI1.Name+' не найдены в файле!');
    Exit;
  end;

  Case IFun of
  0 : FO := fAdd(FI1,k);
  1 : FO := fMul(FI1,k);
  2 : FO := fSub(FI1,k);
  3 : FO := fRat(FI1,k);
  end;
  result := FO;

end;



function FIOutAny1(sFun:string;FI1:TFIOut):TFIOut;
var FO : TFIOut; IFun : integer;
begin
  result := NIL;
  IFun := swStr.CaseStr(sFun,SLFun1);
  if IFun < 0 then begin
    WarnAbs('Функции '+sFun+'(FO) не существует!');
    Exit;
  end;

  if Not FI1.CheckLoad then begin
    WarnAbs('FIOutAny1 ERR Данные карты '+FI1.Name+' не найдены в файле!');
    Exit;
  end;

  Case IFun of
  0 : FO := fAbs(FI1);    // abs
  1 : FO := fNeg(FI1);    // neg
  2 : FO := fInv(FI1);    // inv  = 1/X
  3 : FO := fLog(FI1);    // log  = log10
  4 : FO := fExp10(FI1);  // exp10
  5 : FO := fSig(FI1);    // Signum (1,0,-1)
  6 : FO := fSin(FI1);    // sin
  7 : FO := fCos(FI1);    // cos
  8 : FO := fSq(FI1);     // Square квадрат
  9 : FO := fSqrt(FI1);   // SQuart корень
  end;
  result := FO;
end;




function fAny2(sFun,sV1,sV2:string):TFIOut;
var FI,FI1,FI2,FO : TFIOut; I,IFun : integer; QDone : boolean;
begin
  result := NIL; FO := NIL;

  IFun := swStr.CaseStr(sFun,SLFun);
  if IFun < 0 then Exit;

  FI1 := NIL;
  FI2 := NIL;

  QDone := false;
  I := 0;
  while (I < LFIOtmp.Count) and (Not QDone) do begin
    FI := TFIOut(LFIOtmp.Items[I]);
    if FI.sVar = sV1 then FI1 := FI else
    if FI.sVar = sV2 then FI2 := FI;
    if (Assigned(FI1) and Assigned(FI2)) then QDone := true;
    inc(I);
  end;

  I := 0;
  while (Not QDone) and (I < LFIO.Count) do begin
    FI := TFIOut(LFIO.Items[I]);
    if Not Assigned(FI1)
    then begin if FI.sVar = sV1
      then begin
        FI1 := FI;
        if Not FI1.CheckLoad then begin
          WarnAbs('fAny2 ERR Данные карты '+FI1.Name+' не найдены в файле!');
          Exit;
        end;
      end;
    end;
    if Not Assigned(FI2)
    then begin if FI.sVar = sV2
      then begin
        FI2 := FI;
        if Not FI2.CheckLoad then begin
          WarnAbs('fAny2 ERR Данные карты '+FI2.Name+' не найдены в файле!');
          Exit;
        end;
      end;
    end;
    if (Assigned(FI1) and Assigned(FI2)) then QDone := true;
    inc(I);
  end;

  if Not QDone then begin
    if Not Assigned(FI1) then begin
      WarnAbs('FIOut.fAny2-ERR не присвоена карта переменной '+sV1);
    end;
    if Not Assigned(FI2) then begin
      WarnAbs('FIOut.fAny2-ERR не присвоена карта переменной '+sV2);
    end;
    Exit;
  end;

(*
  Case IFun of
  0 : FO := fAdd(FI1,FI2);
  1 : FO := fMid(FI1,FI2);
  2 : FO := fSub(FI1,FI2);
  3 : FO := fRat(FI1,FI2);
  4 : FO := fMul(FI1,FI2);
  end;
*)

  result := FIOutAny2(sFun,FI1,FI2);
end;

function fAnyConst(sFun,sV1:string;k:real):TFIOut;
var FI,FI1,FO : TFIOut; I,IFun : integer; QDone : boolean;
begin
  result := NIL; FO := NIL;

  IFun := swStr.CaseStr(sFun,SLFunC);
  if IFun < 0 then Exit;

  FI1 := NIL;

  QDone := false;
  I := 0;
  while (I < LFIOtmp.Count) and (Not QDone) do begin
    FI := TFIOut(LFIOtmp.Items[I]);
    if FI.QRun then begin
      if FI.sVar = sV1 then FI1 := FI;
      if Assigned(FI1) then QDone := true;
    end;
    inc(I);
  end;

  I := 0;
  while (Not QDone) and (I < LFIO.Count) do begin
    FI := TFIOut(LFIO.Items[I]);
    if Not FI.QRun then begin
      Inc(I);
      Continue;
    end;
    if Not Assigned(FI1)
    then begin if FI.sVar = sV1
      then begin
        FI1 := FI;
        if Not FI1.CheckLoad then begin
          WarnAbs('fAnyConst ERR Данные карты '+FI1.Name+' не найдены в файле!');
          Exit;
        end;
      end;
    end;
    if Assigned(FI1) then QDone := true;
    inc(I);
  end;

  if Not QDone then begin
    if Not Assigned(FI1) then begin
      WarnAbs('FIOut.fAny2-ERR не присвоена карта переменной '+sV1);
    end;
    Exit;
  end;

  Case IFun of
  0 : FO := fAdd(FI1,k);
  1 : FO := fMul(FI1,k);
  end;

  result := FO;
end;



(* извлечь "имя карты" из списка LFOP при известном значении iLFOP *)
(* n - объём списка LFOP *)
(* i - порядковый номер iLFOP, если считать начиная от единицы *)
function Get_sMap(var i,n:integer):string;
begin
  i := 0; n := 0;

  if Not Assigned(LFOP)
  then begin result := 'Err:Список LFOP Not Assigned!'; exit end;

  n := LFOP.Count;
  if n < 1
  then begin result :='Err:Список LFOP имеет '+ISt(n)+' элементов!'; exit end;

  i := iLFOP + 1;
  if (i > n) or (i < 1) then begin
  result :='Err:Запрошен '+ISt(i)+'-ой/ый из '+ISt(n)+' элементов!'; Exit end;

  result := LFOP.Strings[i-1];
end;

function Get_sMap:string;
var i,n : integer;
begin result := Get_sMap(i,n); end;


(* процедура работает с глобальными переменными *)
(* LFOP   - список отображаемых карт            *)
(* iLFOP  - номер текущей карты в LFOP          *)
procedure MapToLFOP(s:string);
var i : integer;
begin
  if Not Assigned (LFOP) then LFOP := TStringList.Create;
  i := swStr.SLFindSubString(s,LFOP);
  if i < 0 then begin
    i := LFOP.Count; LFOP.Add(s);
  end;
  iLFOP := i;
end;



function fAny2LFO(sFun,chV1,chV2:char):TList;
var FI,FI1,FI2,FO : TFIOut; I,IFun : integer; QDone : boolean;
   LFO : TList;
begin

  WarnAbs('Надо проверить номера функций!');

  result := NIL; FO := NIL;

  LFO := TList.Create;

  IFun := swStr.CaseStr(sFun,SLFun);
  if IFun < 0 then Exit;


  FI1 := NIL; FI2 := NIL;
  for I := 0 to LFIOtmp.Count do begin



  end;



  FI1 := NIL;
  FI2 := NIL;

{
  QDone := false;
  I := 0;
  while (I < LFIOtmp.Count) and (Not QDone) do begin
    FI := TFIOut(LFIOtmp.Items[I]);
    if FI.sVar = sV1 then FI1 := FI else
    if FI.sVar = sV2 then FI2 := FI;
    if (Assigned(FI1) and Assigned(FI2)) then QDone := true;
    inc(I);
  end;

  I := 0;
  while (Not QDone) and (I < LFIO.Count) do begin
    FI := TFIOut(LFIO.Items[I]);
    if Not Assigned(FI1)
    then begin if FI.sVar = sV1
      then begin
        FI1 := FI;
        if Not FI1.CheckFill then FI1.LoadData(FI1.sFn,FI1.nbData0);
      end;
    end;
    if Not Assigned(FI2)
    then begin if FI.sVar = sV2
      then begin
        FI2 := FI;
        if Not FI2.CheckFill then FI2.LoadData(FI2.sFn,FI2.nbData0);
      end;
    end;
    if (Assigned(FI1) and Assigned(FI2)) then QDone := true;
    inc(I);
  end;

  if Not QDone then begin
    if Not Assigned(FI1) then begin
      WarnAbs('FIOut.fAny2-ERR не присвоена карта переменной '+sV1);
    end;
    if Not Assigned(FI2) then begin
      WarnAbs('FIOut.fAny2-ERR не присвоена карта переменной '+sV2);
    end;
    Exit;
  end;
}


  Case IFun of
  0 : FO := fMid(FI1,FI2);
  1 : FO := fSub(FI1,FI2);
  2 : FO := fRat(FI1,FI2);
  end;

  result := LFO;
end;


function fCircSub(FI1,FI2:TFIOut;k:real):TFIOut;
var iX,iY : integer; FO : TFIOut; r,k1,k2 : real;
begin
  result := NIL;
  if Not FI1.CheckLoad then Exit;
  if Not FI2.CheckLoad then Exit;
  if (FI1.kLoad < 2) or (FI2.kLoad < 2) then Exit; (* не все данные загружены *)
  if (FI1.nX <> FI2.nX) or (FI1.nY <> FI2.nY) then begin
    WarnAbs('В операции Sub('+FI1.Name+','+FI2.Name+
            ') карты имеют разный размер!');
    Exit;
  end;

  k1 := -k/2;
  k2 :=  k/2;

  FO := FI1.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := '('+FI1.Name+'-'+FI2.Name+')';
  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      r := FI1.aData[iX,iY]-FI2.aData[iX,iY];
      if r < k1 then r := r+k else
      if r > k2 then r := r-k;
      FO.aData[iX,iY] := r;
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)
  result := FO;
end;



function fSub(FI1,FI2:TFIOut):TFIOut;
var iX,iY : integer; FO : TFIOut;
begin
  result := NIL;
  if Not FI1.CheckLoad then Exit;
  if Not FI2.CheckLoad then Exit;
  if (FI1.kLoad < 2) or (FI2.kLoad < 2) then Exit; (* не все данные загружены *)
  if (FI1.nX <> FI2.nX) or (FI1.nY <> FI2.nY) then begin
    WarnAbs('В операции Sub('+FI1.Name+','+FI2.Name+
            ') карты имеют разный размер!');
    Exit;
  end;
  FO := FI1.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := '('+FI1.Name+'-'+FI2.Name+')';
  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      FO.aData[iX,iY] := FI1.aData[iX,iY]-FI2.aData[iX,iY];
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)
  result := FO;
end;

function fRat(FI1,FI2:TFIOut):TFIOut;  (* Ratio - отношение *)
var iX,iY : integer; FO : TFIOut; r : real;
begin
  result := NIL;
  if Not FI1.CheckLoad then Exit;
  if Not FI2.CheckLoad then Exit;
  if (FI1.kLoad < 2) or (FI2.kLoad < 2) then Exit; (* не все данные загружены *)
  if (FI1.nX <> FI2.nX) or (FI1.nY <> FI2.nY) then begin
    WarnAbs('В операции Rat('+FI1.Name+','+FI2.Name+
            ') карты имеют разный размер!');
    Exit;
  end;

  FO := FI1.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := '('+FI1.Name+'/'+FI2.Name+')/2';
  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      r := FI2.aData[iX,iY];
      if r <> 0 then FO.aData[iX,iY] := FI1.aData[iX,iY]/r
                else FO.aData[iX,iY] := 0;
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)
  result := FO;
end;

function fMul(FI1,FI2:TFIOut):TFIOut;  (* Ratio - отношение *)
var iX,iY : integer; FO : TFIOut; r : real;
begin
  result := NIL;
  if Not FI1.CheckLoad then Exit;
  if Not FI2.CheckLoad then Exit;
  if (FI1.kLoad < 2) or (FI2.kLoad < 2) then Exit; (* не все данные загружены *)
  if (FI1.nX <> FI2.nX) or (FI1.nY <> FI2.nY) then begin
    WarnAbs('В операции Mul('+FI1.Name+','+FI2.Name+
            ') карты имеют разный размер!');
    Exit;
  end;

  FO := FI1.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := '('+FI1.Name+'/'+FI2.Name+')/2';
  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      FO.aData[iX,iY] := FI1.aData[iX,iY]*FI2.aData[iX,iY];
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)
  result := FO;
end;



(* просто сумма, НЕ среднее значение *)
function fAdd(FI1,FI2:TFIOut):TFIOut;
var iX,iY : integer; FO : TFIOut;
begin
  result := NIL;
  if Not FI1.CheckLoad then Exit;
  if Not FI2.CheckLoad then Exit;
  if (FI1.kLoad < 2) or (FI2.kLoad < 2) then Exit; (* не все данные загружены *)
  if (FI1.nX <> FI2.nX) or (FI1.nY <> FI2.nY) then begin
    WarnAbs('В операции Add('+FI1.Name+','+FI2.Name+
            ') карты имеют разный размер!');
    Exit;
  end;

  FO := FI1.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := '('+FI1.Name+'+'+FI2.Name+')/2';
  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      FO.aData[iX,iY] := (FI1.aData[iX,iY]+FI2.aData[iX,iY]);
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)
  result := FO;
end;



function fMid(FI1,FI2:TFIOut):TFIOut;
var iX,iY : integer; FO : TFIOut;
begin
  result := NIL;
  if Not FI1.CheckLoad then Exit;
  if Not Assigned(FI2) then Exit;
  if Not FI2.CheckLoad then Exit;
  if (FI1.kLoad < 2) or (FI2.kLoad < 2) then Exit; (* не все данные загружены *)
  if (FI1.nX <> FI2.nX) or (FI1.nY <> FI2.nY) then begin
    WarnAbs('В операции Mid('+FI1.Name+','+FI2.Name+
            ') карты имеют разный размер!');
    Exit;
  end;

  FO := FI1.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := '('+FI1.Name+'+'+FI2.Name+')/2';
  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      FO.aData[iX,iY] := (FI1.aData[iX,iY]+FI2.aData[iX,iY])/2;
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)
  result := FO;
end;

function fMid(FI1,FI2,FI3:TFIOut):TFIOut;
var iX,iY : integer; FO : TFIOut;
begin
  result := NIL;
  if Not FI1.CheckLoad then Exit;
  if Not FI2.CheckLoad then Exit;
  if Not FI3.CheckLoad then Exit;
  if (FI1.kLoad < 2) or (FI2.kLoad < 2) or (FI3.kLoad < 2) then Exit;
  if (FI1.nX <> FI2.nX) or (FI1.nY <> FI2.nY)
  or (FI1.nX <> FI3.nX) or (FI1.nY <> FI3.nY) then begin
    WarnAbs('В операции Mid('+FI1.Name+','+FI2.Name+','+FI3.Name+
            ') карты имеют разный размер!');
    Exit;
  end;

  FO := FI1.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := '('+FI1.Name+'+'+FI2.Name+'+'+FI3.Name+')/3';
  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      FO.aData[iX,iY] := (FI1.aData[iX,iY]+FI2.aData[iX,iY]+FI3.aData[iX,iY])/3;
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)
  result := FO;
end;

function fMid(FI1,FI2,FI3,FI4:TFIOut):TFIOut;
var iX,iY : integer; FO : TFIOut;
begin
  result := NIL;
  if Not FI1.CheckLoad then Exit;
  if Not FI2.CheckLoad then Exit;
  if Not FI3.CheckLoad then Exit;
  if Not FI4.CheckLoad then Exit;
  if (FI1.kLoad < 2) or (FI2.kLoad < 2)
  or (FI3.kLoad < 2) or (FI4.kLoad < 2) then Exit;
  if (FI1.nX <> FI2.nX) or (FI1.nY <> FI2.nY)
  or (FI1.nX <> FI3.nX) or (FI1.nY <> FI3.nY)
  or (FI1.nX <> FI4.nX) or (FI1.nY <> FI4.nY)
  then begin
    WarnAbs('В операции Mid('+FI1.Name+','+FI2.Name+','+FI3.Name+','+FI3.Name+
            ') карты имеют разный размер!');
    Exit;
  end;

  FO := FI1.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := '('+FI1.Name+'+'+FI2.Name+'+'+FI3.Name+'+'+FI4.Name+')/4';
  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      FO.aData[iX,iY] := (FI1.aData[iX,iY]+FI2.aData[iX,iY]
                         +FI3.aData[iX,iY]+FI4.aData[iX,iY])/4;
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)
  result := FO;
end;



{
function fMid(FI1,FI2:TFIOut):TFIOut;  overload;
function fRat(FI1,FI2:TFIOut):TFIOut;

function fMid(FI1,FI2,FI3:TFIOut):TFIOut;  overload;
function fMid(FI1,FI2,FI3,FI4:TFIOut):TFIOut;  overload;
}











procedure TFIOut.Mul(k:real);
var iX,iY : integer; S : string;
begin
  if Not QLoad('Mul',k) then Exit;

  Self.Name  := EFSt0(k,4)+'*'+Self.Name;
  for iY := 0 to nY-1 do begin
    for iX := 0 to nX-1 do begin
      Self.aData[iX,iY] := Self.aData[iX,iY]*k;
    end;
  end;
  kLoad := 8; (* это производные данные *)

//  Pict.ReScale;
end;




function fMul(FI:TFIOut;k:real):TFIOut;
var iX,iY : integer; FO : TFIOut;
begin
  result := NIL;
  if Not FI.CheckLoad then Exit;
  if FI.kLoad < 2 then Exit; (* память выделена, но данные не загружены *)
  FO := FI.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := '('+FI.Name+')*'+EFSt0(k,5);
  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      FO.aData[iX,iY] := FI.aData[iX,iY]*k;
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)
  result := FO;
end;

function fRat(FI:TFIOut;k:real):TFIOut;
var iX,iY : integer; FO : TFIOut;
begin
  result := NIL;
  if Not FI.CheckLoad then Exit;
  if FI.kLoad < 2 then Exit; (* память выделена, но данные не загружены *)
  if k = 0 then begin
    WarnAbs('вызвана функция fRat с делителем равным нулю!'+#13#10+
            'FI: Name=<'+FI.Name+'> sVar=<'+FI.sVar+'>');
    Exit;
  end;
  FO := FI.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := '('+FI.Name+')/'+EFSt0(k,5);
  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      FO.aData[iX,iY] := FI.aData[iX,iY]/k;
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)
  result := FO;
end;




function fAdd(FI:TFIOut;k:real):TFIOut;
var iX,iY : integer; FO : TFIOut;
begin
  result := NIL;
  if Not FI.CheckLoad then Exit;
  if FI.kLoad < 2 then Exit; (* память выделена, но данные не загружены *)
  FO := FI.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := '('+FI.Name+')+'+EFSt0(k,5);
  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      FO.aData[iX,iY] := FI.aData[iX,iY]+k;
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)
  result := FO;
end;

function fSub(FI:TFIOut;k:real):TFIOut; overload;
var iX,iY : integer; FO : TFIOut;
begin
  result := NIL;
  if Not FI.CheckLoad then Exit;
  if FI.kLoad < 2 then Exit; (* память выделена, но данные не загружены *)
  FO := FI.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := '('+FI.Name+')-'+EFSt0(k,5);
  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      FO.aData[iX,iY] := FI.aData[iX,iY]-k;
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)
  result := FO;
end;





procedure TFIOut.Abs;
var iX,iY : integer;
begin
  if Not QLoad('Abs') then Exit;

  Self.Name  := 'abs('+Self.Name+')';
  for iY := 0 to nY-1 do begin
    for iX := 0 to nX-1 do begin
      Self.aData[iX,iY] := System.abs(Self.aData[iX,iY]);
    end;
  end;
  kLoad := 8; (* это производные данные *)
//  Pict.ReScale;
end;

function fAbs(FI:TFIOut):TFIOut;
var iX,iY : integer; FO : TFIOut;
begin
  result := NIL;
  if Not FI.CheckLoad then Exit;
  if FI.kLoad < 2 then Exit; (* память выделена, но данные не загружены *)
  FO := FI.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := 'abs('+FI.Name+')';
  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      FO.aData[iX,iY] := System.abs(FI.aData[iX,iY]);
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)
  result := FO;
end;

function fSig(FI:TFIOut):TFIOut;
var iX,iY : integer; FO : TFIOut; R4 : real4;
begin
  result := NIL;
  if Not FI.CheckLoad then Exit;
  if FI.kLoad < 2 then Exit; (* память выделена, но данные не загружены *)
  FO := FI.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := 'sig('+FI.Name+')';
  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      R4 := FI.aData[iX,iY];
      if R4 > 0 then FO.aData[iX,iY] := 1  else
      if R4 < 0 then FO.aData[iX,iY] := -1 else
                     FO.aData[iX,iY] := 0;
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)
  result := FO;
end;


function fCos(FI:TFIOut):TFIOut;
var iX,iY : integer; FO : TFIOut; R4 : real4;
begin
  result := NIL;
  if Not FI.CheckLoad then Exit;
  if FI.kLoad < 2 then Exit; (* память выделена, но данные не загружены *)
  FO := FI.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := 'cos('+FI.Name+')';
  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      R4 := cos(FI.aData[iX,iY]*C_PI180);
      FO.aData[iX,iY] := R4;
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)
  result := FO;
end;

function fSq (FI:TFIOut):TFIOut;
var iX,iY : integer; FO : TFIOut; R4 : real4;
begin
  result := NIL;
  if Not FI.CheckLoad then Exit;
  if FI.kLoad < 2 then Exit; (* память выделена, но данные не загружены *)
  FO := FI.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := 'sq('+FI.Name+')';
  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      R4 := FI.aData[iX,iY];
      FO.aData[iX,iY] := R4*R4;
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)
  result := FO;
end;

function fSqrt(FI:TFIOut):TFIOut;
var iX,iY : integer; FO : TFIOut; R4 : real4;
begin
  result := NIL;
  if Not FI.CheckLoad then Exit;
  if FI.kLoad < 2 then Exit; (* память выделена, но данные не загружены *)
  FO := FI.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := 'sq('+FI.Name+')';
  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      R4 := abs(FI.aData[iX,iY]);
      FO.aData[iX,iY] := SQRT(R4);
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)
  result := FO;
end;




function fSin(FI:TFIOut):TFIOut;
var iX,iY : integer; FO : TFIOut; R4 : real4;
begin
  result := NIL;
  if Not FI.CheckLoad then Exit;
  if FI.kLoad < 2 then Exit; (* память выделена, но данные не загружены *)
  FO := FI.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := 'sin('+FI.Name+')';
  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      R4 := sin(FI.aData[iX,iY]*C_PI180);
      FO.aData[iX,iY] := R4;
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)
  result := FO;
end;



procedure TFIOut.Neg;
var iX,iY : integer;
begin
  if Not QLoad('Neg') then Exit;
  Self.Name  := '-('+Self.Name+')';
  for iY := 0 to nY-1 do begin
    for iX := 0 to nX-1 do begin
      Self.aData[iX,iY] := -(Self.aData[iX,iY]);
    end;
  end;
  kLoad := 8; (* это производные данные *)
//  Pict.ReScale;
end;

function fNeg(FI:TFIOut):TFIOut;
var iX,iY : integer; FO : TFIOut;
begin
  result := NIL;
  if Not FI.CheckLoad then Exit;
  if FI.kLoad < 2 then Exit; (* память выделена, но данные не загружены *)
  FO := FI.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := '-('+FI.Name+')';
  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      FO.aData[iX,iY] := -FI.aData[iX,iY];
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)
  result := FO;
end;


{
procedure TFIOut.Exp10;
var iX,iY : integer;
begin
  if Not QLoad('Exp10') then Exit;
  Self.Name  := 'exp10('+Self.Name+')';
  for iY := 0 to nY-1 do begin
    for iX := 0 to nX-1 do begin
      Self.aData[iX,iY] := phys.Exp10(Self.aData[iX,iY]);
    end;
  end;
  kLoad := 8; (* это производные данные *)
//  Pict.ReScale;
end;
}

function fExp10(FI:TFIOut):TFIOut;
var iX,iY : integer; FO : TFIOut;
begin
  result := NIL;
  if Not FI.CheckLoad then Exit;
  if FI.kLoad < 2 then Exit; (* память выделена, но данные не загружены *)
  FO := FI.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := 'exp10('+FI.Name+')';
  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      FO.aData[iX,iY] := phys.Exp10(FI.aData[iX,iY]);
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)
  result := FO;
end;



procedure TFIOut.Inv;
var iX,iY : integer;
begin
  if Not QLoad('Inv') then Exit;
  Self.Name  := '1/('+Self.Name+')';
  for iY := 0 to nY-1 do begin
    for iX := 0 to nX-1 do begin
      if Self.aData[iX,iY] <> 0 then
        Self.aData[iX,iY] := 1/(Self.aData[iX,iY]);
    end;
  end;
  kLoad := 8; (* это производные данные *)
//  Pict.ReScale;
end;

function fInv(FI:TFIOut):TFIOut;
var iX,iY : integer; R : real; FO : TFIOut;
begin
  result := NIL;
  if Not FI.CheckLoad then Exit;
  if FI.kLoad < 2 then Exit; (* память выделена, но данные не загружены *)
  FO := FI.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := '1/('+FI.Name+')';
  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      if FI.aData[iX,iY] <> 0
        then FO.aData[iX,iY] := 1/(FI.aData[iX,iY])
        else FO.aData[iX,iY] := 0;
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)
  result := FO;
end;



procedure TFIOut.Log;
var iX,iY : integer; R : real;
begin
  if Not QLoad('Log') then Exit;
  Self.Name  := 'log('+Self.Name+')';
  for iY := 0 to nY-1 do begin
    for iX := 0 to nX-1 do begin
      R := System.abs(Self.aData[iX,iY]);
      if R = 0 then Self.aData[iX,iY] := -100.0
               else Self.aData[iX,iY] := phys.log(R);
    end;
  end;
  kLoad := 8; (* это производные данные *)
//  Pict.ReScale;
end;



function fLog(FI:TFIOut):TFIOut;
var iX,iY : integer; R : real; FO : TFIOut;
begin
  result := NIL;
  if Not FI.CheckLoad then Exit;
  if FI.kLoad < 2 then Exit; (* память выделена, но данные не загружены *)


  FO := FI.Clone;  (* скопируем основные поля из FI *)
  FO.Name  := 'log('+FI.Name+')';

  for iY := 0 to FO.nY-1 do begin
    for iX := 0 to FO.nX-1 do begin
      R := System.abs(FI.aData[iX,iY]);
      if R = 0 then FO.aData[iX,iY] := -100.0
               else FO.aData[iX,iY] := phys.log(R);
    end;
  end;
  FO.kLoad := 8; (* это производные данные *)

  result := FO;
end;




(* проверяем, что массив не содержит одни нули *)
(* возвращает kLoad = 1, если место выделено   *)
function TFIOut.CheckFill:boolean;
var iX,iY : integer; Q : boolean;
begin
  result := false;
  if Not Assigned(Self) then Exit;
  Q := false;
  if Not Assigned(Self.aData) then Q := true else
  if length(aData) = 0        then Q := true;
  if Q then begin kLoad := 0; Exit end;

  result := true;
  for iY := 0 to nY-1 do begin
    for iX := 0 to nX-1 do begin
      if aData[iX,iY] <> 0 then Exit;
    end;
  end;
  kLoad := 1; (* выделено только место *)
  result := false;
end;

function TFIOut.CheckLoad:boolean;
begin
  result := true;
  if Self.CheckFill then Exit;
  if Assigned(Self) then
    Self.LoadData(Self.sFn,Self.nbData0);
//if Self.kLoad < 2 then begin result := false; Exit end;
  result := Self.CheckFill;
end;

procedure TFIOut.MinMaxMean;
var iX,iY : integer; R4 : real;
  r4Min : real;
  r4Max : real;
begin
  if Not Assigned (Self) then Exit;
  if Self.kLoad < 2 then begin
    WarnAbs('FIOut.MinMaxMean-ERR: kLoad='+ISt(kLoad));
    Exit;
  end;
  if (Self.nX = 0) or (Self.nY = 0) then begin
    WarnAbs('FIOut.MinMaxMean-ERR: nX='+ISt(nX)+' nY='+ISt(nY));
    Exit;
  end;

  iXMi := 0; iYMi := 0; iXMa := 0; iYMa := 0;
  rMean := 0; r4Min := aData[0,0]; r4Max := r4Min;

  rMeanAv := 0; rMinAv := 0; rMaxAv := 0;
  jXMi := 0; jYMi := 0; jXMa := 0; jYMa := 0;

  for iY := 0 to nY-1 do begin
    for iX := 0 to nX-1 do begin
      R4 := aData[iX,iY];
      rMean := rMean + R4;
      if R4 < r4Min then begin
        r4Min := R4;
        iXMi := iX; iYMi := iY;
      end
      else
      if R4 > r4Max then begin
        r4Max := R4;
        iXMa := iX; iYMa := iY;
      end;

{
      if swMapFilt.kFOMask = 1 then begin
        if swMapFilt.a_Mask[iX,iY] > 0 then begin
          rMeanAv := rMeanAv + R4;
          if R4 < r4MiAv then begin
            r4MiAv := R4;
            jXMi := iX; jYMi := iY;
          end
          else
          if R4 > r4MaAv then begin
            r4MaAv := R4;
            jXMa := iX; jYMa := iY;
          end;

        end;
      end;
}
    end;
  end;

  rMean := rMean/(nX*nY);
  rMin := r4Min; rMax := r4Max;

{
  if (swMapFilt.kFOMask = 1) and (swMapFilt.n_Mask > 0) then begin
    rMeanAv := rMeanAv/n_Mask;
    rMinAv := r4MiAv; rMaxAv := r4MaAv;
  end;
}

end; (* MinMaxMean *)





(* перед вызовом надо заполнить переменную a_Mask в unit-е swMapFilt *)
procedure TFIOut.FilteredMinMax;
begin
  if Not Assigned (Self) then Exit;
  if Not (swMapFilt.kFOMask = 1) then Exit; (* 1 - маска заполнена     *)
  if Not (swMapFilt.n_Mask > 0)  then Exit; (* число элементов в маске *)
  FilteredMinMax(swMapFilt.a_Mask);
end; (* FilteredMinMax *)


(* повторяем процедуру FilteredMinMax(aMask) *)
(*    находим только Max значение!           *)
(* только делаем исключения для артефактов:  *)
(* 1. проверяем точки X-1 и X+1              *)
(*    Если в них (Val(X-1) + Val(X+1)) < Val(X)/R3 *)
(*    то такие точки отбрасываем                   *)

procedure TFIOut.MaskMax_Y3(aMask:TAMask;R3:real);
var iX,iY,_nx,_ny,ixm,iym : integer; R4,R2 : real;
  r4MaAv : real;
begin
  if Not Assigned (Self) then Exit;
  if Not Self.CheckFill then  (* если FO не заполнен *)
                              Self.LoadData(Self.sFn,Self.nbData0);

  if Self.kLoad < 2 then begin (* не удалось заполнить *)
    WarnAbs('FIOut.MaskMax_Y3-ERR: kLoad='+ISt(kLoad));
    Exit;
  end;
  if (Self.nX = 0) or (Self.nY = 0) then begin (* проверка размера карты *)
    WarnAbs('FIOut.MaskMax_Y3-ERR: nX='+ISt(nX)+' nY='+ISt(nY));
    Exit;
  end;

  _nx := length(aMask);
  _ny := length(aMask[0]);

  if (Self.nX <> _nx) or (Self.nY <> _ny) then begin(* проверка размера карты *)
    WarnAbs('FIOut.MaskMax_Y3-ERR: размеры карты и маски не совпадают!'+
    #10#13+' FO_X='+ISt(nX) +'   FO_Y='+ISt(nY) +
         ' Filt_X='+ISt(_nx)+' Filt_Y='+ISt(_ny));
    Exit;
  end;

  R3 := R3/2; (* сравниваем яркость КАЖДОЙ точки в среднем, а не их суммы *)
  r4MaAv := rMin;
  ixm := 0;
  iym := 0;
  for iY := 0 to nY-1 do begin
    for iX := 0 to nX-1 do begin
      if aMask[iX,iY] > 0 then begin
        R4 := aData[iX,iY];
        if R4 > r4MaAv then begin

          (*------------------*)
          R2 := 0;
          if iX>0 then R2 := aData[iX-1,iY] else R2 := aData[iX+1,iY];
          if iX<(nX-1)
            then R2 := R2 + aData[iX+1,iY] else R2 := R2 + aData[iX-1,iY];
          (*------------------*)
          if R4 <= R2*R3 then begin
            r4MaAv := R4; ixm := iX; iym := iY;
          end;
        end;
      end;
    end;
  end;
  rMaxAv3 := r4MaAv;

  jXMa3 := ixm; (* индексы точки с макс.значением          *)
  jYMa3 := iym; (* после того, как отфильтрованы артефакты *)

end; (* MaskMax_Y3(aMask) *)


procedure TFIOut.FilteredMinMax(aMask:TAMask);
var iX,iY,_nx,_ny : integer; R4 : real;
  r4MiAv : real;
  r4MaAv : real;
begin
  if Not Assigned (Self) then Exit;
  if Not Self.CheckFill then  (* если FO не заполнен *)
                              Self.LoadData(Self.sFn,Self.nbData0);

  if Self.kLoad < 2 then begin (* не удалось заполнить *)
    WarnAbs('FIOut.FilteredMinMax-ERR: kLoad='+ISt(kLoad));
    Exit;
  end;
  if (Self.nX = 0) or (Self.nY = 0) then begin (* проверка размера карты *)
    WarnAbs('FIOut.FilteredMinMax-ERR: nX='+ISt(nX)+' nY='+ISt(nY));
    Exit;
  end;

  _nx := length(aMask);
  _ny := length(aMask[0]);

  if (Self.nX <> _nx) or (Self.nY <> _ny) then begin(* проверка размера карты *)
    WarnAbs('FIOut.FilteredMinMax-ERR: размеры карты и маски не совпадают!'+
    #10#13+' FO_X='+ISt(nX) +'   FO_Y='+ISt(nY) +
         ' Filt_X='+ISt(_nx)+' Filt_Y='+ISt(_ny));
    Exit;
  end;


  rMeanAv := 0; r4MiAv := rMax; r4MaAv := rMin;
  jXMi := 0; jYMi := 0; jXMa := 0; jYMa := 0;
  n_Mask := 0;

  for iY := 0 to nY-1 do begin
    for iX := 0 to nX-1 do begin
      if aMask[iX,iY] > 0 then begin
        R4 := aData[iX,iY];
        inc(n_Mask);
        rMeanAv := rMeanAv + R4;
        if R4 < r4MiAv then begin
          r4MiAv := R4;
          jXMi := iX; jYMi := iY;
        end
        else
        if R4 > r4MaAv then begin
          r4MaAv := R4;
          jXMa := iX; jYMa := iY;
        end;
      end;
    end;
  end;

  if n_Mask > 0 then rMeanAv := rMeanAv/n_Mask else rMeanAv := 0;
  rMinAv := r4MiAv; rMaxAv := r4MaAv;
end; (* FilteredMinMax(aMask) *)









(* освободить память данных *)
procedure TFIOut.ClearData;
begin
  Finalize(aData);
  Self.kLoad := 0;           (* память свободна *)
  iXMi := 0; iYMi := 0; iXMa := 0; iYMa := 0;
  rMean := 0; rMin := 0; rMax := 0;
  jXMi := 0; jYMi := 0; jXMa := 0; jYMa := 0;
  rMeanAv := 0; rMinAv := 0; rMaxAv := 0;

end;

procedure TFIOut.AssignMem(nx0,ny0:integer);
begin
  if Not Assigned(Self) then begin
    WarnAbs(
      'TFIOut.AssignMem('+ISt(nx0)+','+ISt(ny0)+') ERR: Self Not Assigned');
  end;

  nX := nx0;
  nY := ny0;
  SetLength(aData,nX,nY);
  kLoad := 1;
end;


(* читать одну карту из заданного входного файла с заданного смещения *)
procedure TFIOut.LoadData(sFN:string;nb0:integer);
var nData,NN : integer;
  B4 : array[1..4] of byte; R4 : real4 absolute B4;
  aDataB : TABt; (* массив байт *)
  I,J : integer;
  iX,iY : integer;

  rSum : real;

begin
  if (kSoft < 1) or (kSoft > 3) then begin
    WarnAbs('FIOut.LoadData-ERR: Карта <'+Name+'> типа '+ISt(kSoft)+
            #13#10+'не может быть загружена из файла.'+#13#10+
            'Она должна быть рассчитана!');
    Exit;
  end;


  if nb0 = 0 then begin
    WarnAbs('TFIOut.LoadData '+#13#10+
    '<'+sFN+'> карта<'+Self.Name+'>'+#13#10+
    'nb0=$'+HexL(nb0)+#13#10+
    'nbData='+ISt(Self.nbData)+' nbData0=$'+HexL(nbData0)+#13#10+
    'ERR: Не задана привязка карты к файлу!');
     Exit;
  end;


  nData := Self.nX*Self.nY;  (* размер карты *)

  if nData = 0 then begin
    WarnAbs('TFIOut.LoadData(<'+sFN+'> nb0=$,'+HexL(nb0)+') ERR:'+#13#10+
    'Не задан nX='+ISt(nX)+' или nY='+ISt(nY) );
    Self.kLoad := 0;           (* память не выделена (незачем) *)
    Exit;
  end;


  NN := nData*4;             (* размер данных в байтах *)
  SetLength(aDataB,NN);      (* создадим временный буфер для чтения *)
  Self.kLoad := 1;           (* память выделена *)


  if Not swFile.DBRdRec1(sFN,nb0,NN,1,aDataB) then begin
    WarnAbs('TFIOut.LoadData Ошибка при чтении блока из файла '+#13#10+
    '<'+sFN+'>'+#13#10+
    'I = 1 nbH0='+ISt(nb0)+' LData='+ISt(NN)+#13#10+
    'IOResult of Reset = '+ISt(swFile.IOResultLast)+#13#10+
    'ErrLast=<'+swFile.sErrLast+'>'
    );
  end;


             (* сделаем проверку ! *)
  rSum := 0; (* Если буфер пуст rSum не изменится *)


  (* распакуем данные из буфера *)
  SetLength(aData,nX,nY);
  (*----- надо поменять местами байты в элементах aData типа Real4 --*)
  J := -1;
  for iY := 0 to nY-1 do begin
    for iX := 0 to nX-1 do begin
      inc(J); B4[4] := aDataB[J]; (* сначала второй байт *)
      inc(J); B4[3] := aDataB[J]; (* потом первый        *)
      inc(J); B4[2] := aDataB[J]; (* сначала второй байт *)
      inc(J); B4[1] := aDataB[J]; (* потом первый        *)
      aData[iX,iY] := R4;

      rSum := rSum + R4;

    end;
  end;
  Finalize(aDataB);

  if rSum = 0 then begin
    WarnAbs('Пустые данные '+Self.Name+' в файле '+sFN);
  end
  else begin
    Self.kLoad := 2; // данные загружены
    MinMaxMean; (* подготовить MaxMin значения для работы с картой *)
  end;
  Self.qTmp := false; (* эта карта - не временная переменная *)

  Self.kRun := $A5A55A5A;

end; (* TFIOut.LoadData *)





procedure TFIOut.Save;
var fNam : string;
  ib0,ib1,nb,lf : longint;
  B : array[1..80000] of byte;
  i,ii,IErr : integer;
  nb00 : longint;
  SL  : TStringList;
  S,W : string;

begin
  (* вывести карту в SW-FITS файл *)
  // Self.kSoft = 1;

//  if sDBFITSPath = '' then sDBFITSPath := 'T:\Z\ASTRO\HINODE\sot\';
//  fN := GetFITName(kSoft0,sDt0,sTi0);(* имя ME или SW fit файла *)
//fNam := TLFITS(Owner).sFN;

  fNam := Self.sFn;

  if Not Assigned (Self.aData) then begin
    WarnAbs('FO.Save Err: aData Not Assigned'+#13#10+
            'Name='+Self.Name+' Var='+Self.sVar+#13#10+
            'fNam='+fNam);
    Exit;
  end;

  if (length(Self.aData) <> NX) then begin
    WarnAbs('FO.Save Err: Length(aData)<>(nX='+ISt(nX)+'), nY='+
             ISt(nY)+#13#10+
            'Name='+Self.Name+' Var='+Self.sVar+#13#10+
            'fNam='+fNam);
    Exit;
  end;

  if Not Self.CheckFill then   (* проверяем массив на нули *)
  if Not Self.QLoad('FIOut.Save') then Exit;(* признак чтения/расчёта kLoad<2 *)

  if Not FileExists(fNam) then begin
    WarnAbs('Сперва надо создать файл'+#13#10+'<'+
             fNam+'>'+#13#10+
            'а уже потом выводить туда карту '+Self.Name);
    Exit;
  end;

  (* надо поискать карту с именем Self.Name в текущем файле  *)
  (* если она там присутствует - переписать карту поверх     *)
  (* если отсутствует - закинуть в конец                     *)

  SL := swFITS.NamList(Self.kSoft,Self.sDt,Self.sTi);

{
  if Self.nb0 > 0 then begin
    WarnAbs('Похоже, что карта <'+Name+'> уже загружена'+#13#10+
            'nb0='+ISt(nb0)+' НАДО С ЭТИМ РАЗОБРАТЬСЯ'+#13#10+
            'Пока карту сохранять отказываемся'
            );
    Exit;
  end;
}


  ii := 0;
  for i := 0 to SL.Count-1 do begin
    S := SL.Strings[i];
    W := swStr.GetWordN(S,1);
    if (Self.Name = W) then begin

      ii := i;
      W   := swStr.GetWordN(S,2);
      nb00 := swStr.ValInt(W,IErr);
      if IErr <> 0 then begin
        WarnAbs('ОШИБКА 678594!!!');
        Exit;
      end;

      if (nb00 > 0) and (nb0 = 0) then nb0 := nb00;
      if (nb00 > 0) and (nb00 <> nb0) then begin
        WarnAbs('Найдено более одной карты с именем <'+Name+
                '> в SW-FITS файле'+#13#10+Self.sFn+#13#10+
                'в строках '+ISt(ii)+' и '+ISt(i)+#13#10+
                'позиции '+ISt(nb00)+' и '+ISt(nb0)+#13#10+
                'НАДО ПОЧИСТИТЬ файл от дублей, прежде чем сохранять данные'
                );
        Exit;
      end
      else
        (* просто подтвердили число nb0 *)
      ;
    end;
  end;


  Self.SWOUTHeader;                 (* создать Хидер блока *)
  lf := swFile.File_Size(fNam);
  if (Self.nb0 = 0)     (* начальное положение карты не задано *)
  then Self.nb0 := lf;  (* значит дописываем в конец файла     *)

  ib0 := Self.nb0;

  WriteHeader(fNam,ib0,Self.HSL); (* записать строки, начиная со смещения ib0 *)
             (* HSL.Count уже должен быть дополнен до числа строк кратного 36 *)

  Self.nbHead := Self.HSL.Count*80;
  ib0 := ib0 + Self.HSL.Count*80;

  Self.nbData0 := ib0;
  Self.nbData  := nX*nY*4;
  WriteAR4R4(fNam,ib0,Self.aData);(* записать массив aData со смещения ib0 *)
  ib0 := ib0 + nX*nY*4; // =  ib0 := aOu.nbData0 + aOu.nbData;

  (* подравняем конец записи до величины NCutFO, кратной 320 *)
  (*   (раньше бралось число кратное 512 - это не правильно) *)
  ib1 := (((ib0-1) div NCutFO) + 1) * NCutFO;
  nb := ib1 - ib0;

  if nb > 0 then begin
    FillChar(B[1],nb,#0);
    if Not FileWrRec(fNam,ib0,nb,1,B) then begin
    end;
    ib0 := ib1;
  end;
end; (* TFIOut.Save *)


procedure TFIOut.Save2;
var fNam : string;
  ib0,ib1,nb,lf : longint;
  B : array[1..80000] of byte;
  i : integer;
  nb0,nb1 : longint;

  np : integer;

begin
  (* вывести карту в SW-FITS файл *)

//  if sDBFITSPath = '' then sDBFITSPath := 'T:\Z\ASTRO\HINODE\sot\';
//  fN := GetFITName(kSoft0,sDt0,sTi0);(* имя ME или SW fit файла *)
//fNam := TLFITS(Owner).sFN;

  fNam := Self.sFn;
  np := swStr.posR('.',fNam);
  fNam := swStr.left(fNam,np)+'FI2';

//Self.nb0 := 0; (* Пишем в конец файла!!! *)

  if Not Assigned (Self.aData) then begin
    WarnAbs('FO.Save Err: aData Not Assigned'+#13#10+
            'Name='+Self.Name+' Var='+Self.sVar+#13#10+
            'fNam='+fNam);
    Exit;
  end;

  if (length(Self.aData) <> NX) then begin
    WarnAbs('FO.Save Err: Length(aData)<>(nX='+ISt(nX)+'), nY='+
             ISt(nY)+#13#10+
            'Name='+Self.Name+' Var='+Self.sVar+#13#10+
            'fNam='+fNam);
    Exit;
  end;


  if Not FileExists(fNam) then begin
    WarnAbs('Сперва надо создать файл'+#13#10+'<'+
             fNam+'>'+#13#10+
            'а уже потом выводить туда карту '+Self.Name);
    Exit;
  end;

  Self.SWOUTHeader;                 (* создать Хидер блока *)
  lf := swFile.File_Size(fNam);
  if (Self.nb0 = 0)     (* начальное положение карты не задано *)
  then Self.nb0 := lf;  (* значит дописываем в конец файла     *)

  ib0 := Self.nb0;

  WriteHeader(fNam,ib0,Self.HSL); (* записать строки, начиная со смещения ib0 *)

  Self.nbHead := Self.HSL.Count*80;
  ib0 := ib0 + Self.HSL.Count*80;

  Self.nbData0 := ib0;
  Self.nbData  := nX*nY*4;
  WriteAR4R4(fNam,ib0,Self.aData);(* записать массив aData со смещения ib0 *)
  ib0 := ib0 + nX*nY*4; // =  ib0 := aOu.nbData0 + aOu.nbData;

  (* подравняем конец записи до величины, кратной 512 *)
//  ib1 := (((ib0-1) div 512) + 1) * 512;
//  nb := ib1 - ib0;

  (* подравняем конец записи до величины, кратной 320 *)
  ib1 := (((ib0-1) div 320) + 1) * 320;
  nb := ib1 - ib0;


  if nb > 0 then begin
    FillChar(B[1],nb,#0);
    if Not FileWrRec(fNam,ib0,nb,1,B) then begin
    end;
    ib0 := ib1;
  end;
end; (* TFIOut.Save2 *)






{
procedure TFIPOut.PictLinScale256(kMi0,kMa0:real);
begin
  if Not Assigned(Self.Pict) then begin
    WarnAbs('FIPOut.PictScale Pict Not Assigned yet!');
    Exit;
  end;
  Pict.LinScale256(kMi0,kMa0);
end;
}

procedure TFIOut.PictLinScale(nVal:integer;kMi0,kMa0:real);
begin
  if Not Assigned(Self.Pict) then begin
    WarnAbs('FIOut.PictScale Pict Not Assigned yet!');
    Exit;
  end;
  Pict.LinScale(nVal,kMi0,kMa0);
end;




//procedure TFITS.Link (sFN0:string;I0:integer;anOwner:TObject);

(* (пере)привязывается Owner и IXI := I0 *)
procedure TFITS.Link(I0:integer;anOwner:TObject);
const sP = 'Link';
var D,N,E : string; sFN1 : string;
begin
  if Assigned(Self) then Self.Owner := anOwner;
  if Not Check(sP) then Exit; (* проверим существование FITS и LFITS *)

  IXI   := I0; (* порядковый номер в LFITS (начиная с 0) *)
{
  if sFN0 = sFN then Exit;
  if sFN0 = DirAndName(sPath,sFN) then Exit;

  Self.Done; (* Self.KStep := 0; *)

  FSplit(sFN0,D,N,E);
  sFN   := N+E;
  sPath := D;
  Owner := anOwner; (* привязываемся к LFITS *)
}
  SetBit.BISB(Self.KStep,0);  (* = +1 *)
end;

function TFITS.fNam:string; (* имя файла (находим через LFITS) *)
const sP = 'fNam';
begin
  result := '';
  if Not CheckI(sP) then Exit;
  result := TLFITS(Owner).fNam(Self.IXI);
end;


procedure TLFITS.SetDeltaRC(d01,d02,akRC,sm:real);
begin
  if Not Assigned(Self) then Exit;
  dl6301  := d01; (* расстояние границы линии от её центра в mA *)
  dl6302  := d02; (* заданное вручную принудительно             *)
  kRC0    := akRC;(* величина (0.95-1.05) коррекция уровня континуума *)
  kRC     := 1;   (* величина (0.95-1.05) коррекция уровня континуума *)
  lsmooth := sm;  (* окно сглаживания для расчёта уровня континуума   *)
end;


procedure TLFITS.Link(sPN0:string;FOwner0,Form0:TForm);
var L,P,P0 : integer; S : string; aFITS : TFITS;
begin
  Self.FOwner := FOwner0;
  FMap := Form0;
  if sPath = sPN0 then exit;
  Self.Done;
  sPath  := sPN0;

  P := swStr.posR('\',sPath);
  Self.sDtTi := swStr.rightfrom(sPath,P+1);

//WarnAbs(sDtTi);

  (* сброс к неинициированным значениям *)
  KStep := 0;
  rLC1M := 0;
  rLC2M := 0;
  kLamChk := 0;

  rCntMH0:=0; (* средн.знач.непр.спектра в немаг.областях в ед.шкалы изм.*)
  Gc1   := 0; (* среднее полож.цетнра тяжести 6301 в пикселах *)
  Gc2   := 0; (* среднее полож.цетнра тяжести 6302 в пикселах *)

  rLa1  := 6301.5008; (* "уточнённые" длины волн *)
  rLa2  := 6302.4932;
  rLa3  := 6302.0500;

  dl6301  := 350;
  dl6302  := 350;
  kRC     := 1.0; (* величина (0.95-1.05) коррекция уровня континуума *)
  kRC0    := 1.05;

  (* найдем sPOut - имя папки выходных файлов *)
  (* по умолчанию папка FITS должна кончаться на конструкцию вида *)
  (*    20190622_164505                                           *)
  (* а папка FITS_Out - то же самое, но без секунд:               *)
  (*    20190622_1645                                             *)

  P0 := pos('_',sPath);
  P  := swStr.PosP('_',sPath,P0+1);
  while P > 0 do begin
    P0 := P;
    P  := swStr.PosP('_',sPath,P0+1);
  end;
  L := length(sPath);

  if ((L - P0) = 6) then begin
    sPOut := swStr.left(sPath,L-2);
    S     := swStr.right(sPath,8+1+6);
    sFME  := S+'.fits';
    sFM2  := S+'_L2.1.fits';
    sFSW  := swStr.left(S,-2)+'.fits';
  end
  else begin
    sPOut := '###';
    WarnAbs('TLFITS.Link(<'+sPN0+'>)'+#13#10+
    'Path должен оканчиваться конструкцией вида 20190622_164505');
  end;

  Self.KStep := 0;
  SetBit.BISB(Self.KStep,0);  (* = +1 *)


  (*=== заполняем данные о длинах волн ===*)

  (* как минимум нам надо скачать хотя бы один Хидер *)
  (* "сырого" FITS файла, чтобы загрузить данные о   *)
  (* длинах волн                                     *)

//aFITS := TFITS.Create;



  aFITS := TFITS.Create; (* экземпляр структуры FITS первого уровня *)
  aFITS.Link(0,Self);    (* 0 - порядковый номер начиная с 0 *)
  aFITS.ReadHeader;

  (*------ заполняем поля LFITS --------*)

  rLamIdx0 := aFITS.rLamIdx0;
  rdLam    := aFITS.rdLam;
  rLa00    := aFITS.rLa0;

  nY       := aFITS.nY;
  nX       := Dir.Count;

  aFITS.Done;

  Self.LoadSWHeader0; (*------ заполняем поля LFITS из SW - файла --------*)

//Self.UpDate;
end; (* TLFITS.Link *)


(* имя входного FITS файла с номером iX *)
function TLFITS.fNam(iX:integer):string;
var aDir : TDirRec;
begin
  result := '';
  if Not SetBit.IsBit(Self.KStep,0) then begin
    WarnAbs('TLFITS.fNam('+ISt(iX)+') ERROR!'+#13#10+
    'kStep='+ISt(kStep)+' => Path_Name Not Linked Yet!!!');
    Exit;
  end;

  if Not Assigned(Dir) then Dir := TDirList.Create;
  if Self.Dir.Count = 0 then begin
    Dir.CollectExt(sPath,'fits');
    Dir.SortInsideExt;
  end;

  if iX > Dir.Count then begin
    WarnAbs('TLFITS.LoadHeaders ERR Not Found File N"'+ISt(iX)+
    #13#10+'Path_Name = <'+Self.sPath+'>');
    Exit;
  end;

  aDir := Dir.Get(iX);
  result := aDir.Name;
end; (* TLFITS.fNam *)


(* загрузить в LFITS число точек на щели nY  *)
(* для работы с данными оригинальных FITS-ев *)
function TLFITS.CheckNY(nY0:integer):boolean;
var Q : boolean;
begin
  if Self.nY = 0 then begin nY := nY0; result := true; end
  else begin
    Q := (nY = nY0);
    if Not Q then nY := nY0;
    result := Q;
  end;
end;

function TLFITS.CheckNXP(nX0:integer):boolean;
var Q : boolean;
begin
  if Self.nXP = 0 then begin nXP := nX0; result := true; end
  else begin
    Q := (nXP = nX0);
    if Not Q then nXP := nX0;
    result := Q;
  end;
end;

function TLFITS.CheckExpTime(r0:real):boolean;
var Q : boolean;
begin
  if Self.rExpTime = 0 then begin rExpTime := r0; result := true; end
  else begin
    Q := (rExpTime = r0);
    if Not Q then rExpTime := r0;
    result := Q;
  end;
end;


function TLFITS.CheckNXY(nX0,nY0:integer):boolean;
var Q : boolean;
begin
  result := true;

  (* если размер LFITS.nX,nY ещё не задан, то записать его *)
  if Self.nX = 0 then nX := nX0;
  if Self.nY = 0 then nY := nY0;

  (* иначе сперва проверить и потом записать *)
  Q := true;
  if (nX <> nX0) or (nY <> nY0) then Q := false;

  if Not Q then begin
     nX := nX0;
     nY := nY0;
     result := Q;
  end;

end;



(* загрузить список длин волн LFITS.ALam *)
(* либо проверить, что он не изменился   *)
(* если пытаемся загрузить повторно      *)
function TLFITS.CheckALam(ALam0:TARe):boolean;
var Q : boolean;
begin
  if Length(ALam) = 0 then begin
    ALam := CopyARe(ALam0);
    result := true;
  end
  else begin
    Q := EqAre(ALam0,ALam);
    if Not Q then ALam := CopyARe(ALam0);
    result := Q;
  end;
end;





(* из файла с именем sFN             *)
(* начиная со смещения nbH0          *)
(* в SL добавляются строки           *)
(* последняя строка содержит "END"   *)
(* либо имеет номер 600              *)
(* никаких строк оформления в SL нет *)
(* NS = число строк в Header-е       *)
procedure GetFITSHead(sFN:string;nbH0:integer;
                      var NS:integer;var SL:TStringList);
const nStr = 80;
var
  sKey : string;
  B80  : array [1..nStr] of char;
  S : string;
  I : integer;
begin
  if Not Assigned(SL) then Exit;
  if Not FileExists(sFN) then Exit;
  sKey := ''; NS := 0;
  I := 0;     (* счётчик строк *)
  while (sKey <> 'END') and (I < 600) do begin
    inc(I);
    if Not swFile.DBRdRec(sFN,nbH0,nStr,I,B80) then begin
      WarnAbs('GetFITSHead Ошибка при чтении блока из файла '+#13#10+
      '<'+sFN+'>'+#13#10+
      'I = '+ISt(I)+' nbH0='+ISt(nbH0)+', LStr=80'+#13#10+
      'IOResult of Reset = '+ISt(swFile.IOResultLast)+#13#10+
      'ErrLast=<'+swFile.sErrLast+'>'
                );
      Exit;
    end;
    S := copy(B80,1,nStr);
    sKey := swStr.GetWordN(S,1);
    SL.Add(S);
  end;
  NS := I;
end; (* GetFITSHead *)


(* пропускаем пустые строки (сосотоящие из пробелов) длиной по 80 символов *)
procedure SkipFITSHeadEnd(sFN:string;nbH0:integer;var I:integer);
var
  nStr  : integer;
  sB80  : string;
  S     : string;
  B80   : array [1..80] of char;

begin

  (* sB80 - пустая строка длиной 80 символов *)
  nStr := 80;
  SetLength(sB80,nStr);
  FillChar(sB80[1],nStr,' ');

  (*--------------------------------------------------*)
  (* далее пропускаем место, занятое пустыми строками *)
  (* чтобы узнать, где начинаются данные              *)
  (*                                                  *)

  S := sB80;
  while (S = sB80) do begin
    inc(I);
    if Not swFile.DBRdRec(sFN,nbH0,nStr,I,B80) then begin
      WarnAbs('Ошибка при чтении блока из файла '+#13#10+
      '<'+sFN+'>'+#13#10+
      'I = '+ISt(I)+' nbH0=0, LStr=80'+#13#10+
      'IOResult of Reset = '+ISt(swFile.IOResultLast)+#13#10+
      'ErrLast=<'+swFile.sErrLast+'>'
                );
      Exit;
    end;
    S := copy(B80,1,nStr);
//  SL.Add(S);
  end;

  if S <> sB80 then dec(I);  (* последняя прочитанная строка не была пустой *)
end; (* SkipFITSHeadEnd *)


(* ОТЧЁТ *)
{
function TLFITS.H1_H2(s1,s2:string;
                      dH,               (* шаг по величине - по X    *)
                      dS,               (* параметр сглаживания по X *)
                      g1,g2,c1,c2,v1,v2,h1,h2:real;
                      qAbs:boolean;
                      ix1,ix2,iy1,iy2:integer):TStringList;
var S: string; SL : TStringList;
    AX,AY,AH,AHME,
    AVar,AVar2,
    AHr,ADr,           (* redused - отобранные *)
    AXr,AYr,
    AD,AD2,fX,fY,fY0,fW,f1,f2 : TARe;
  N,i,j : integer; r,gm : real;
  Ou1,Ou2 : TFIOut;
begin
  SL := TStringList.Create;

  Ou1 := Self.GetData(s1);
  Ou2 := Self.GetData(s2);

  swARe.CopyAR4R4toARe(ix1,ix2,iy1,iy2,Ou1.aData,AY);
  swARe.CopyAR4R4toARe(ix1,ix2,iy1,iy2,Ou2.aData,AX);


//swTy.CopyAR4R4toARe(ix1,ix2,iy1,iy2,Self.MeH.aData,AHME);

  N := length(AX)-1;
  SetLength(AH,N+1);
  SetLength(AD,N+1);
  SetLength(AD2,N+1);

  SetLength(AHr,N+1);
  SetLength(ADr,N+1);
  SetLength(AXr,N+1);
  SetLength(AYr,N+1);



  for i := 1 to N do begin
    AH[i] := (AX[i]+AY[i])/2;
    AD[i] := (AY[i]-AX[i])/2;
//  AD2[i]:= (-AHME[i]-AH[i])/2;
//  AD2[i]:= AHME[i];
  end;


  CopyARe(AH,AHr);
  CopyARe(AD,ADr);
  CopyARe(AX,AXr);
  CopyARe(AY,AYr);

  if g1 <> g2 then begin
    swARe.CopyAR4R4toARe(ix1,ix2,iy1,iy2,Self.MeGM.aData,AVar);
    j := 0;
    (* фильтр по Gamma *)
    for i := 1 to N do begin
      gm := AVar[i];
      if ((gm >= g1) and (gm <= g2))
      or ((gm >= (180-g2)) and (gm <= (180-g1)))
      then begin
        inc(j);                (* всегда j <= i *)
        AHr[j] := AHr[i];
        ADr[j] := ADr[i];
        AXr[j] := AXr[i];
        AYr[j] := AYr[i];
//      AG[j] := AG[i];
      end;
    end;
    SetLength(AHr,j+1);
    SetLength(ADr,j+1);
    SetLength(AXr,j+1);
    SetLength(AYr,j+1);
//  SetLength(AG,j+1);
    MeanFuncSmooth(AHr,ADr,dH,dS,fX,fY0,fY,fW);
  end;

  if c1 <> c2 then begin
    swARe.CopyAR4R4toARe(ix1,ix2,iy1,iy2,Self.OuCnt.aData,AVar);
    j := 0;
    (* фильтр по Cont *)
    for i := 1 to N do begin
      r := AVar[i];
      if (r >= c1) and (r <= c2)
      then begin
        inc(j);                (* всегда j <= i *)
        AHr[j] := AHr[i];
        ADr[j] := ADr[i];
        AXr[j] := AXr[i];
        AYr[j] := AYr[i];
      end;
    end;
    SetLength(AHr,j+1);
    SetLength(ADr,j+1);
    SetLength(AXr,j+1);
    SetLength(AYr,j+1);
  end;


  if v1 <> v2 then begin
    swARe.CopyAR4R4toARe(ix1,ix2,iy1,iy2,Self.OuVc1.aData,AVar);
    swARe.CopyAR4R4toARe(ix1,ix2,iy1,iy2,Self.OuVc2.aData,AVar2);
     j := 0;
    (* фильтр по Vlos *)
    for i := 1 to N do begin
      r := (AVar[i]+AVar2[i])/2;
      if (r >= v1) and (r <= v2)
      then begin
        inc(j);                (* всегда j <= i *)
        AHr[j] := AHr[i];
        ADr[j] := ADr[i];
        AXr[j] := AXr[i];
        AYr[j] := AYr[i];
      end;
    end;
    SetLength(AHr,j+1);
    SetLength(ADr,j+1);
    SetLength(AXr,j+1);
    SetLength(AYr,j+1);
  end;

  if h1 <> h2 then begin
    swARe.CopyAR4R4toARe(ix1,ix2,iy1,iy2,Self.OuH1.aData,AVar);
    swARe.CopyAR4R4toARe(ix1,ix2,iy1,iy2,Self.OuH2.aData,AVar2);
     j := 0;
    (* фильтр по Vlos *)
    for i := 1 to N do begin
      r := (AVar[i]+AVar2[i])/2;
      if qAbs then r := Abs(r);
      if (r >= h1) and (r <= h2)
      then begin
        inc(j);                (* всегда j <= i *)
        AHr[j] := AHr[i];
        ADr[j] := ADr[i];
        AXr[j] := AXr[i];
        AYr[j] := AYr[i];
      end;
    end;
    SetLength(AHr,j+1);
    SetLength(ADr,j+1);
    SetLength(AXr,j+1);
    SetLength(AYr,j+1);
  end;


  (*
    H = (H1+H2)/2
    D = (H1-H2)/2
    dH = H Step    ( 5 Гс)
    dS = H Smooth  (50 Гс)
    fX = H шагом 5 Гс
    fY0= D(H) несглаженное
    fY = D(H)   сглаженное
    fW = Weight - вес точек
   *)
  MeanFuncSmooth(AHr,ADr,dH,dS,fX,fY0,fY,fW);
//MeanFuncSmooth(AH,AHME,dH,dS,fX,fY0,fY,fW);



  S := 'HH HD0 HD Weig'; SL.Add(S);
  for i := 1 to length(fX)-1 do begin
    S:=EFSt0(fX[i],6)+' '+EFSt0(fY0[i],6)+' '+EFSt0(fY[i],6)+' '+EFSt0(fW[i],6)

//    +' '+EFSt0(f1[i],6)+' '+EFSt0(f2[i],6);
    ;
    SL.Add(S);
  end;

  swStr.LineTabStrings(SL,1);
  result := SL;
end;
}


(* вычисление производных карт (физически осмысленных) *)
procedure TLFITS.BigCalc2; (* получим OuVc1,2, нормированный OuCnt и ... *)
var iX,iY,N,kSOFT0 : integer; rSC1,rSC2 : Double; H,V,C,V1,V2 : real;
// AC : TARe; (* средние значения немагнитного континуума для *)
              (* заданных положений на щели *)
  sCnt      : real;
  rContMean : real; (* коэф-т взамен rCntH0, к-рый сделает средний CONT=1 *)
  k : integer;
begin
  Time_routine('LFITS.BigCalc2',true);


  (* Два крайних значения континуума по всему полю извлечь из списка FITS *)
  Self.MaxMinCont; (* => LFITS.rCntMi,rCntMa в отсчётах *)

  (*------------------------------------------------------------------*)
  (* рассчитываем среднее значение континуума по немагнитным областям *)
  (*   в планах:                                                      *)
  (* определяем коррекцию уровня континуума за клиновидность щели     *)
  (*------------------------------------------------------------------*)

  (*!!!!!!!!!!!!!! использует карты ouCont, ouKVI *)
//  MeanContH0; (* => rCntH0, ACnYH0, rCntA, rCntB *)
//  CalcContH0; (* => OuCnt        *)

  CalcME_HL; (* MeH,MeGM => MeHL *)
  Calc_dV;   (* MeX,MeY => Ou_dV *)(*расчёт поправок луч.скорости за вращ.С-ца*)


  Exit;

  (*!!!!!!!!!!!!!! использует карты ouGc1, ouGc2 *)
  CalcLC12;  (*   =>  rLC1M, rLC2M *)



  (*--------------------------------------------------------------*)
  (* заполняем массивы абсолютных значений скоростей OuVc1, OuVc2 *)
  (* и значение нормированной интенсивности континуума OuCnt      *)

  CalcVC12;   (* => OuVc1, OuVc2 *)


  (* если BicCalc2 получил данные от LoadRowData *)
  (* то надо перевести значения бисекторов и полжений вершин профиля *)
  (* из ангстрем в км/c                                              *)


  if QRowData then begin   (* данные только что загружены из FITS файлов *)
                           (* и рассчитаны                               *)
    NormVCore;   (* Ou35C1, Ou35C2 *)
    NormVBiseq;  (* OuBiC1, OuBiC2 *)
    QRowData := false;
  end;






  (*-------------------------------------------------------------*)
  (* находим максимальные/минимальные значения полей и скоростей *)
  (* и их положения                                              *)
  (* они будут вписаны в Хидер swFITS файла                      *)

  VRBMax; (* => VRMA, VBMA, iXVR,iXVB,iYVR,iYVB *)
  HNSMax;

  (*-------------------------------------------------------------*)

  Time_routine('LFITS.BigCalc2',false);
end; (* TLFITS.BigCalc2 *)






function TLFITS.LoadSWFITS:boolean;
var fN : string;

  (* параметры логических фрагментов файла *)

  LFile : integer; (* длина файла в байтах *)
  nbH0  : integer; (* число байт в голове файла, к-рые надо пропустить *)
  nStr  : integer; (* длина строки ( = 80 ) *)
  I     : integer; (* число строк в заголовке *)
//  sKey  : string;
  sName : string; (* наименование текущего блока данных *)
//  S     : string;
//  B80   : array [1..80] of char;


  sB80  : string;
  sB40  : string;
  nsHead0 : integer;
  nlHead0 : integer;
  nbHead0 : integer;
  nbData0 : integer; (* позиция начала данных текущего блока *)

  nsHead1 : integer;
  nlHead1 : integer;
  nbHead1 : integer;

  NAXIS   : integer;
  NAX     : integer;
  ANAX    : array [1..10] of integer;

  ls0 : integer;
  ls1 : integer;
  J,N,NN : integer;

  NBITPIX : integer;
  nB      : integer;
  Q : boolean;

  KH : integer;
  NNN : integer;
  NN1024 : integer;

  nX0,nY0 : integer;
  k       : integer;

  SLErr : TStringList;

procedure TryLoadSWAny(swAny:TFIOut);
begin
  (* не понятно, где заполняется sName *)
  if sName = swAny.Name then begin
    swAny.SetHSL(HswSL,ls0,ls1);   (* создаём Header String List *)
    swAny.LoadData(fN,nbData0);
  end;
end;


begin

  WarnAbs('Процедура LFITS.LoadSWFITS устарела!!!');
  Exit;


  fN := swFile.DirAndName(Self.sPOut,Self.sFSW); (* имя SWfit файла *)

  if Not FileExists(fN) then begin
    WarnAbs('TLFITS.LoadSWFITS ERR: файла'+#13#10+'<'+fN+'>'+#13#10+
            'не существует!');
    result := false;
    Exit;
  end;


  (*---------------------------------------------*)
  (*     загрузка главного Хидера SW файла       *)
  (*---------------------------------------------*)


  LFile := swFile.File_Size(fN);

  (* готовим место для главного заголовка SWfit файла *)
  if Not Assigned(Self.HswSL) then HswSL := TStringList.Create;
  Self.HswSL.Clear;


  nbH0  := 0;   (* число байт, которые надо пропустить *)
  nStr  := 80;  (* длина строки  *)
  ls0   := 0;   (* индекс строк HswSL указывающий начало Хидера *)

(*----------------------------*)

  SetLength(sB80,80);
  SetLength(sB40,80);
  FillChar(sB80[1] ,80,'='); (* строка для целей оформления *)
  FillChar(sB40[1] ,40,'-'); (* строка для целей оформления *)
  FillChar(sB40[41],40,' '); (* строка для целей оформления *)

(*----------------------------*)


(*------------------------------------*)
(*        главный заголовок           *)

  GetFITSHead(fN,nbH0,I,HswSL); (* первый заголовок *)
  nsHead0 := I;               (* число строк в первом заголовке    *)
  SkipFITSHeadEnd(fN,nbH0,I); (* найти конец "места под заголовок" *)

  nlHead0 := I;               (* место в "строках" под заголовок   *)
  nbHead0 := nlHead0*nStr;    (* место в байтах под заголовок      *)

  HswSL.Add(sB80);            (* строка "========================" *)

(*        главный заголовок           *)
(*------------------------------------*)
(*----------------------------------------------------------------------------*)

  NN := 0;              (* объём данных текущего (предыдущего) блока *)
  nbHead1 := nbHead0;   (* число байт в предыдущем заголовке *)
  ls1 := nsHead0;       (* индекс строк HswSL указывающий конец Хидера *)

  (* анализируем первый заголовок *)

  (* раскладывать "глобальные" значения для СЕАНСА из SW -  *)
  (* хидера в SELF=LFITS мы не будем, за исключением NAXIS  *)
  (* ls0     - номер строки начальной текущего подзаголовка *)
  (* nsHead0 - номер строки конечной текущего подзаголловка *)

  NAXIS := GetFITKeyI('NAXIS',HswSL,ls0,nsHead0);




  KH := 0;    (* номер (индекс) заголовка, первый идёт под номером 0 *)
  Q  := true;
  NN1024 := nbH0 + nbHead1 + NN;  (* "округленное" число байт *)
       (*  start + байт заголовка + байт данных *)


  (*====================================================================*)
  if NAXIS = 0 then begin (* у "правильного" заголовка SunWorld NAXIS=0 *)




    nX0 := GetFITKeyI('NAXIS1',HswSL,ls0,nsHead0);
    nY0 := GetFITKeyI('NAXIS2',HswSL,ls0,nsHead0);

    if Not Self.CheckNXY(nX0,nY0) then begin
      WarnAbs('LFITS.LoadSWFITS ERR Что-то пошло не так при установке nX,nY!');
      Exit;
    end;


    if Not Assigned(OuCont) then   (* проверяем произвольный (первый) TFIOut *)
      if Not Self.swFITSInit then begin    (* если он не задан - создаём все *)
        WarnAbs('LFITS.LoadSWFITS ERR Что-то пошло не так внутри swFITSInit');
        Exit;
      end;

    if Not Assigned(Ou35C1[3]) then(* проверяем произвольный (первый) TFIOut *)
      if Not Self.swFITSInitBi then begin  (* если он не задан - создаём все *)
        WarnAbs('LFITS.LoadSWFITS ERR Что-то пошло не так внутри swFITSInitBi');
        Exit;
      end;

//  if Not Self.swFITSInit2 then begin     (* если он не задан - создаём все *)

    (*===============================================================*)
    (* читаем следующий хидер                                        *)



    repeat

      inc(KH);

      (*======================================*)
      (* от конца предыдущего блока данных    *)
      (* до начала следующего заголовка может *)
      (* оказатся пустое место из нулей или   *)
      (* пробелов - пропускаем его -          *)
      (*   смещаем число NN1024               *)

      nbH0 := NN1024;   (* начало заголовка = объём предыдущих данных *)
      RASkipByte(fN,nbH0,0,NN1024);      (* прпускаем нулевые символы *)
      if NN1024=nbH0 then
        RASkipByte(fN,nbH0,32,NN1024);   (* пропускаем пробелы        *)

      if NN1024 <> nbH0 then begin
// DEBUG:
//        WarnAbs('Пропустили байты с $'+swStr.HexL(nbH0)+' по $'+HexL(NN1024)+
//                ' k='+ISt(KH)+' ls1='+ISt(ls1));
        nbH0 := NN1024;
      end;
      (*                                      *)
      (*======================================*)

    (*==============================================================*)
    (* читаем следующий хидер                                       *)

      GetFITSHead(fN,nbH0,I,HswSL); (* I - прочитано строк из файла *)
      nsHead1 := I;      (* место в HswSL в "строках" под заголовок *)

      SkipFITSHeadEnd(fN,nbH0,I);
      nlHead1 := I;     (* место в файле в "строках" под заголовок *)
      nbHead1 := nlHead1*nStr;  (* место в байтах под заголовок    *)
      nbData0 := nbH0 + nbHead1;(* позиция начала данных блока     *)


      ls0 :=           (* номер строки начала текущего хидера равен *)
             ls0                (* индекс начала предыдущего хидера *)
                 + nsHead0      (* + число строк предыдущего хидера *)
                           + 1;   (* + строка оформления            *)
      if KH>1 then ls0 := ls0 + 1 (* + строка со статистикой хидера *)
                              + 1;(* + ещё строка оформления        *)

      ls1 := ls0 + nsHead1 - 1    (* № послед.значащ. строки хидера *)
                           - 1;   (* счёт шёл от 0 - строка 'END'   *)

      (*============================================================*)
      (*            анализируем текущий хидер                       *)

      (*---- определяем объём блока данных NN ----*)

      NAX := GetFITKeyI('NAXIS',HswSL,ls0,ls1);
      nsHead0 := nsHead1;  (* заготовляем для след. цикла *)

      NN := 1;                    (* NN - для вычисления размера карты *)
      for J := 1 to NAX do begin  (* NAX - число осей *)
        N := GetFITKeyI('NAXIS'+ISt(J),HswSL,ls0,ls1);
        ANAX[J] := N;
        NN := NN * N;
      end;
      NBITPIX := GetFITKeyI('BITPIX',HswSL,ls0,ls1);(* битов  на элемент *)
      NB := Abs(NBITPIX) div 8;                     (* байтов на элемент *)

      NN := NN*NB;                                  (* объём данных      *)

      (*-- проверяем блок - не лежит ли в нём интересная для нас инф-а --*)

      sName := GetFITKey('EXTNAME',HswSL,ls0,ls1);  (* имя блока данных  *)
      if sName = '' then begin
        SLErr := TStringList.Create;
        SLErr.Add('не найден ключ EXTNAME в строках от '+ISt(ls0)+
                  ' до '+ISt(ls1));
        swStr.SLCopy(HswSL,SLErr,ls0,ls1);
        WarnAbs(SLErr);
        Exit;
      end;


      (* сравниваем имя sName с каждым из FIOut и грузим, если совпало    *)
      TryLoadSWAny(OuCont); (* подвязать строки хидера и загрузить данные *)
      TryLoadSWAny(OuGc1);
      TryLoadSWAny(OuGc2);
      TryLoadSWAny(OuKVI);
//    TryLoadSWAny(OuII0);
//    TryLoadSWAny(OuVV0);
      TryLoadSWAny(OuW1);
      TryLoadSWAny(OuW2);
      TryLoadSWAny(OuH1);
      TryLoadSWAny(OuH2);

      TryLoadSWAny(OuHG1);
      TryLoadSWAny(OuHG2);

      for k := 3 to 5 do begin
        TryLoadSWAny(Ou35C1[k]);
        TryLoadSWAny(Ou35C2[k]);
        TryLoadSWAny(Ou35I1[k]);
        TryLoadSWAny(Ou35I2[k]);
        TryLoadSWAny(Ou35D1[k]);
        TryLoadSWAny(Ou35D2[k]);
      end;

      for k := 1 to MBiSec do begin
        TryLoadSWAny(OuBiC1[k]);
        TryLoadSWAny(OuBiC2[k]);
        TryLoadSWAny(OuBiW1[k]);
        TryLoadSWAny(OuBiW2[k]);
      end;


      (* эти данные хранить не обязательно, можно пересчитывать *)
      (* после ввода основных массивов                          *)
//    TryLoadSWAny(OuCnt);   (* OuCnt сейчас = NIL! *)
//    TryLoadSWAny(OuVc1);
//    TryLoadSWAny(OuVc2);

//    TryLoadSWAny(MeHL);


      (*            анализируем текущий хидер                       *)
      (*============================================================*)

      HswSL.Add(sB40);

      (* выведем статистические данные по только что выведенному хидеру *)

//    HswSL.Add('NAXIS1 = '+ISt(NAX));
      NNN := nbH0 + nbHead1 + NN; (* позиция следующего блока *)

//    (* округляем NNN до числа, кратного 512 (для ME - кратного 64) *)
      NN1024 := (((NNN-1) div 512) + 1) * 512;
//    NN1024 := (((NNN-1) div  64) + 1) *  64;
//    NN1024 := NNN;


      (* добавляем строку статистики в HswSL *)
      HswSL.Add('KH='+ISt(KH)+' nbH0='+ISt(nbH0)+' nbHead='+ISt(nbHead1)
      +' NN='+ISt(NN)+
      ' NNN='+ISt(NNN)+'=$'+swStr.HexI(NNN)+' => $'+HexI(NN1024));

      if (NN1024 >= (LFile-nbHead1)) then Q := false;

      HswSL.Add(sB80);

//      if KH = 5 then Q := false;
    until Not Q
  end;













  QRowData := false; (* загрузили готовые обсчитанные данные *)
  result   := true;
end; (* TLFITS.LoadSWFITS *)



procedure TLFITS.LoadMEHeader0;  (* загрузка главного Хидера ME *)
var ls1,NAXIS,NN1024:integer;
begin LoadMEHeader0(ls1,NAXIS,NN1024) end;

procedure TLFITS.LoadSWHeader0;  (* загрузка главного Хидера SW *)
var ls1,NAXIS,NN1024:integer;
begin LoadSWHeader0(ls1,NAXIS,NN1024) end;


{
procedure TLFITS.LoadM2Header0;  (* загрузка главного Хидера M2 *)
var ls1,NAXIS,NN1024:integer;
begin LoadM2Header0(ls1,NAXIS,NN1024) end;
}

(* загрузка головного хидера ME *)
procedure TLFITS.LoadMEHeader0(var ls1,NAXIS,NN1024:integer);
var
  fn    : string;
  nbH0  : integer; (* число байт, которые надо пропустить *)
  nStr  : integer; (* длина строки  *)
  ls0   : integer; (* индекс строк HmeSL указывающий начало Хидера *)

//B80   : array [1..80] of char;
  sB80  : string;
  sB40  : string;
  I     : integer;
  NN    : integer;

  nsHead0 : integer;    (* число строк в первом заголовке    *)
  nlHead0 : integer;    (* место в "строках" под заголовок   *)
  nbHead0 : integer;    (* место в байтах под заголовок      *)

  nbHead1 : integer;   (* число байт в предыдущем заголовке *)
//ls1     : integer;   (* индекс строк HmeSL указывающий конец Хидера *)

begin

  fN := swFile.DirAndName(Self.sPOut,Self.sFME); (* имя MEfit файла *)


  (* готовим место для главного заголовка MEfit файла *)
  if Not Assigned(Self.HmeSL) then HmeSL := TStringList.Create;
  HmeSL.Clear;


  nbH0  := 0;   (* число байт, которые надо пропустить *)
  nStr  := 80;  (* длина строки  *)
  ls0   := 0;   (* индекс строк HmeSL указывающий начало Хидера *)


(*----------------------------*)

  SetLength(sB80,80);
  SetLength(sB40,80);
  FillChar(sB80[1],80,'='); (* строка для целей оформления *)
  FillChar(sB40[1] ,40,'-'); (* строка для целей оформления *)
  FillChar(sB40[41],40,' '); (* строка для целей оформления *)

(*----------------------------*)

(*------------------------------------*)
(*        главный заголовок           *)

  GetFITSHead(fN,nbH0,I,HmeSL); (* первый заголовок *)
  nsHead0 := I;               (* число строк в первом заголовке    *)
  SkipFITSHeadEnd(fN,nbH0,I); (* найти конец "места под заголовок" *)

  nlHead0 := I;               (* место в "строках" под заголовок   *)
  nbHead0 := nlHead0*nStr;    (* место в байтах под заголовок      *)

  HmeSL.Add(sB80);      (* одна строка разделитель *)

(*        главный заголовок           *)
(*------------------------------------*)



  NN := 0;              (* объём данных текущего (предыдущего) блока *)
  nbHead1 := nbHead0;   (* число байт в предыдущем заголовке *)
  ls1 := nsHead0;       (* индекс строк HmeSL указывающий конец Хидера *)

  (* анализируем первый заголовок *)

  (* разложим "глобальные" значения для СЕАНСА из ME хидера в SELF=LFITS *)
  (* ls0     - номер строки начальной текущего подзаголовка *)
  (* nsHead0 - номер строки конечной текущего подзаголловка *)

  NAXIS  := GetFITKeyI('NAXIS'   ,HmeSL,ls0,nsHead0);
  xCenME := GetFITKeyR('XCEN'    ,HmeSL,ls0,nsHead0);
  yCen   := GetFITKeyR('YCEN'    ,HmeSL,ls0,nsHead0);

  R_Sun  := GetFITKeyR('SOLAR_RA',HmeSL,ls0,nsHead0);

  xScale := GetFITKeyR('XSCALE'  ,HmeSL,ls0,nsHead0);
  yScale := GetFITKeyR('YSCALE'  ,HmeSL,ls0,nsHead0);

  sTStart:= GetFITKey('TSTART'   ,HmeSL,ls0,nsHead0);
  sTEnd  := GetFITKey('TEND'     ,HmeSL,ls0,nsHead0);

  p_Angle:= GetFITKeyR('P_ANGLE' ,HmeSL,ls0,nsHead0);
  b_Angle:= GetFITKeyR('B_ANGLE' ,HmeSL,ls0,nsHead0);

  NN1024 := nbH0 +      nbHead1   + NN;  (* "округленное" число байт *)
       (*  start + байт заголовка + байт данных *)



end;






(* загрузка головного хидера SW *)
procedure TLFITS.LoadSWHeader0(var ls1,NAXIS,NN1024:integer);
var
  fn    : string;
  nbH0  : integer; (* число байт, которые надо пропустить *)
  nStr  : integer; (* длина строки  *)
  ls0   : integer; (* индекс строк HmeSL указывающий начало Хидера *)

  sB80  : string;
  sB40  : string;
  I     : integer;
  NN    : integer;

  nsHead0 : integer;    (* число строк в первом заголовке    *)
  nlHead0 : integer;    (* место в "строках" под заголовок   *)
  nbHead0 : integer;    (* место в байтах под заголовок      *)

  nbHead1 : integer;   (* число байт в предыдущем заголовке *)

begin

  fN := swFile.DirAndName(Self.sPOut,Self.sFSW); (* имя SWfit файла *)

  if Not FileExists(fN) then begin
    Warn('Загрузка swFITS-Err:'+#13#10+
    'файла <'+fN+'> ещё нет!');
    Exit;
  end;

  (* готовим место для главного заголовка MEfit файла *)
  if Not Assigned(Self.HswSL) then HswSL := TStringList.Create;
  HswSL.Clear;


  nbH0  := 0;   (* число байт, которые надо пропустить *)
  nStr  := 80;  (* длина строки  *)
  ls0   := 0;   (* индекс строк HmeSL указывающий начало Хидера *)


(*----------------------------*)

  SetLength(sB80,80);
  SetLength(sB40,80);
  FillChar(sB80[1],80,'='); (* строка для целей оформления *)
  FillChar(sB40[1] ,40,'-'); (* строка для целей оформления *)
  FillChar(sB40[41],40,' '); (* строка для целей оформления *)

(*----------------------------*)

(*------------------------------------*)
(*        главный заголовок           *)

  GetFITSHead(fN,nbH0,I,HswSL); (* первый заголовок *)
  nsHead0 := I;               (* число строк в первом заголовке    *)
  SkipFITSHeadEnd(fN,nbH0,I); (* найти конец "места под заголовок" *)

  nlHead0 := I;               (* место в "строках" под заголовок   *)
  nbHead0 := nlHead0*nStr;    (* место в байтах под заголовок      *)

  HswSL.Add(sB80);      (* одна строка разделитель *)

(*        главный заголовок           *)
(*------------------------------------*)

  NN := 0;              (* объём данных текущего (предыдущего) блока *)
  nbHead1 := nbHead0;   (* число байт в предыдущем заголовке *)
  ls1 := nsHead0;       (* индекс строк HmeSL указывающий конец Хидера *)

  (* анализируем первый заголовок *)

  (* разложим "глобальные" значения для СЕАНСА из SW хидера в SELF=LFITS *)
  (* ls0     - номер строки начальной текущего подзаголовка *)
  (* nsHead0 - номер строки конечной текущего подзаголловка *)

  rCB0   := GetFITKeyR('CB0',HswSL,0,ls0,nsHead0);
  rVW1_0 := GetFITKeyR('VW1',HswSL,0,ls0,nsHead0);
  rVW2_0 := GetFITKeyR('VW2',HswSL,0,ls0,nsHead0);



  NN1024 := nbH0 +      nbHead1   + NN;  (* "округленное" число байт *)
       (*  start + байт заголовка + байт данных *)
end;

















{
(* загрузка головного хидера M2 *)
procedure TLFITS.LoadM2Header0(var ls1,NAXIS,NN1024:integer);
var
  fn    : string;
  nbH0  : integer; (* число байт, которые надо пропустить *)
  nStr  : integer; (* длина строки  *)
  ls0   : integer; (* индекс строк Hm2SL указывающий начало Хидера *)

//B80   : array [1..80] of char;
  sB80  : string;
  sB40  : string;
  I     : integer;
  NN    : integer;

  nsHead0 : integer;    (* число строк в первом заголовке    *)
  nlHead0 : integer;    (* место в "строках" под заголовок   *)
  nbHead0 : integer;    (* место в байтах под заголовок      *)

  nbHead1 : integer;   (* число байт в предыдущем заголовке *)
//ls1     : integer;   (* индекс строк Hm2SL указывающий конец Хидера *)

begin

  fN := swFile.DirAndName(Self.sPOut,Self.sFM2); (* имя M2fit файла *)


  (* готовим место для главного заголовка MEfit файла *)
  if Not Assigned(Self.Hm2SL) then Hm2SL := TStringList.Create;
  Hm2SL.Clear;


  nbH0  := 0;   (* число байт, которые надо пропустить *)
  nStr  := 80;  (* длина строки  *)
  ls0   := 0;   (* индекс строк Hm2SL указывающий начало Хидера *)


(*----------------------------*)

  SetLength(sB80,80);
  SetLength(sB40,80);
  FillChar(sB80[1],80,'='); (* строка для целей оформления *)
  FillChar(sB40[1] ,40,'-'); (* строка для целей оформления *)
  FillChar(sB40[41],40,' '); (* строка для целей оформления *)

(*----------------------------*)

(*------------------------------------*)
(*        главный заголовок           *)

  GetFITSHead(fN,nbH0,I,Hm2SL); (* первый заголовок *)
  nsHead0 := I;               (* число строк в первом заголовке    *)
  SkipFITSHeadEnd(fN,nbH0,I); (* найти конец "места под заголовок" *)

  nlHead0 := I;               (* место в "строках" под заголовок   *)
  nbHead0 := nlHead0*nStr;    (* место в байтах под заголовок      *)

  Hm2SL.Add(sB80);      (* одна строка разделитель *)

(*        главный заголовок           *)
(*------------------------------------*)



  NN := 0;              (* объём данных текущего (предыдущего) блока *)
  nbHead1 := nbHead0;   (* число байт в предыдущем заголовке *)
  ls1 := nsHead0;       (* индекс строк Hm2SL указывающий конец Хидера *)

  (* анализируем первый заголовок *)

  (* разложим "глобальные" значения для СЕАНСА из ME хидера в SELF=LFITS *)
  (* ls0     - номер строки начальной текущего подзаголовка *)
  (* nsHead0 - номер строки конечной текущего подзаголловка *)

(*
  NAXIS  := GetFITKeyI('NAXIS'   ,HmeSL,ls0,nsHead0);
  xCen   := GetFITKeyR('XCEN'    ,HmeSL,ls0,nsHead0);
  yCen   := GetFITKeyR('YCEN'    ,HmeSL,ls0,nsHead0);

  R_Sun  := GetFITKeyR('SOLAR_RA',HmeSL,ls0,nsHead0);

  xScale := GetFITKeyR('XSCALE'  ,HmeSL,ls0,nsHead0);
  yScale := GetFITKeyR('YSCALE'  ,HmeSL,ls0,nsHead0);

  sTStart:= GetFITKey('TSTART'   ,HmeSL,ls0,nsHead0);
  sTEnd  := GetFITKey('TEND'     ,HmeSL,ls0,nsHead0);

  p_Angle:= GetFITKeyR('P_ANGLE' ,HmeSL,ls0,nsHead0);
  b_Angle:= GetFITKeyR('B_ANGLE' ,HmeSL,ls0,nsHead0);
*)

  NN1024 := nbH0 +      nbHead1   + NN;  (* "округленное" число байт *)
       (*  start + байт заголовка + байт данных *)

end;
}




{
(* загрузка хидера и данных из FITS инверсии ME *)
function TLFITS.LoadMEfit:boolean;
var fN : string;
  LFile : integer;
  nbH0  : integer; (* число байт в голове файла, к-рые надо пропустить *)
  nStr  : integer;
  I,II  : integer;
  sKey  : string;
  sName : string; (* наименование текущего блока данных *)
  S     : string;
  B80   : array [1..80] of char;
  sB80  : string;
  sB40  : string;
  nsHead0 : integer;
  nlHead0 : integer;
  nbHead0 : integer;
  nbData0 : integer; (* позиция начала данных текущего блока *)

  nsHead1 : integer;
  nlHead1 : integer;
  nbHead1 : integer;

  NAXIS   : integer;
  NAX     : integer;
  ANAX    : array [1..10] of integer;

  ls0 : integer;
  ls1 : integer;
  J,N,NN : integer;

  NBITPIX : integer;
  nB      : integer;
  Q : boolean;

  K : integer;
  NNN : integer;
  NN1024 : integer;


procedure TryLoadMeAny(MeAny:TFIOut); (* внутри - загрузка данных *)
begin
  if sName = MeAny.Name then begin
    MeAny.SetHSL(HmeSL,ls0,ls1); (* заполнить строки Хидера MEAny *)
    MeAny.LoadData(fN,nbData0);  (* загрузить массив MeAny.aData[NX,NY] *)
  end;
end;


begin
  Time_routine('LFITS.LoadMEfit',true);

  WarnAbs('вызвали LFITS.LoadMEfit!');


  fN := swFile.DirAndName(Self.sPOut,Self.sFME); (* имя MEfit файла *)


  if Not FileExists(fN) then begin
    WarnAbs('TLFITS.LoadMEfit ERR: файла'+#13#10+'<'+fN+'>'+#13#10+
            'не существует!');
    result := false;
    Exit;
  end;

  LFile := swFile.File_Size(fN);


//nbH0  := 0;   (* число байт, которые надо пропустить *)
  nStr  := 80;  (* длина строки  *)
  SetLength(sB80,80);
  SetLength(sB40,80);
  FillChar(sB80[1],80,'='); (* строка для целей оформления *)
  FillChar(sB40[1] ,40,'-'); (* строка для целей оформления *)
  FillChar(sB40[41],40,' '); (* строка для целей оформления *)


  LoadMEHeader0(ls1,NAXIS,NN1024);

  nsHead0 := ls1;

  K := 0;     (* номер (индекс) заголовка, первый идёт под номером 0 *)
  Q := true;


  (*==================================================================*)
  if NAXIS = 0 then begin (* у "правильного" заголовка MERLIN NAXIS=0 *)


    if Not Assigned(MeCI)   (* проверяем произвольный (первый) TFIOut *)
      then Self.MeFITSInit; (* если он не задан - создаём все          *)

    repeat

      inc(K);

      (*======================================*)
      (* от конца предыдущего блока данных    *)
      (* до начала следующего заголовка может *)
      (* оказатся пустое место из нулей или   *)
      (* пробелов - пропускаем его -          *)
      (*   смещаем число NN1024               *)

      nbH0 := NN1024;   (* начало заголовка = объём предыдущих данных *)
      RASkipByte(fN,nbH0,0,NN1024);      (* прпускаем нулевые символы *)
      if NN1024=nbH0 then
        RASkipByte(fN,nbH0,32,NN1024);   (* пропускаем пробелы        *)

      if NN1024 <> nbH0 then begin
// DEBUG:
//        WarnAbs('Пропустили байты с $'+swStr.HexL(nbH0)+' по $'+HexL(NN1024)+
//                ' k='+ISt(K)+' ls1='+ISt(ls1));
        nbH0 := NN1024;
      end;
      (*                                      *)
      (*======================================*)


    (*===============================================================*)
    (* читаем следующий хидер                                        *)


      GetFITSHead(fN,nbH0,II,HmeSL);(* II - прочитано строк из файла *)
      nsHead1 := II;      (* место в HmeSL в "строках" под заголовок *)

      SkipFITSHeadEnd(fN,nbH0,II);
      nlHead1 := II;      (* место в файле в "строках" под заголовок *)
      nbHead1 := nlHead1*nStr; (* место файле в байтах под заголовок *)
      nbData0 := nbH0 + nbHead1;  (* позиция начала данных блока     *)


      (* ls0, ls1 - это номера строк (индексы) внутри HmeSL *)

      ls0 :=           (* номер строки начала текущего хидера равен *)
             ls0                (* индекс начала предыдущего хидера *)
                 + nsHead0      (* + число строк предыдущего хидера *)
                           + 1;   (* + строка оформления            *)

      if K>1 then ls0 := ls0 + 1  (* + строка со статистикой хидера *)
                             + 1; (* + ещё строка оформления        *)

      ls1 := ls0 + nsHead1 - 1    (* № послед.значащ. строки хидера *)
                           - 1;   (* счёт шёл от 0 - строка 'END'   *)
      (*============================================================*)
      (*            анализируем текущий хидер                       *)

      (*---- определяем объём блока данных NN ----*)

      NAX := GetFITKeyI('NAXIS',HmeSL,ls0,ls1);
      nsHead0 := nsHead1;  (* заготовляем для след. цикла *)

      NN := 1;                    (* NN - для вычисления размера карты *)
      for J := 1 to NAX do begin  (* NAX - число осей *)
        N := GetFITKeyI('NAXIS'+ISt(J),HmeSL,ls0,ls1);
        ANAX[J] := N;
        NN := NN * N;
      end;
      NBITPIX := GetFITKeyI('BITPIX',HmeSL,ls0,ls1);(* битов  на элемент *)
      NB := Abs(NBITPIX) div 8;                     (* байтов на элемент *)

      NN := NN*NB;                                  (* объём данных      *)

      (*-- проверяем блок - не лежит ли в нём интересная для нас инф-а --*)

      sName := GetFITKey('EXTNAME',HmeSL,ls0,ls1);  (* имя блока данных  *)



      (* сравниваем текущее sName с интересующими нас, *)
      (* при совпадении загружаем данные               *)
      TryLoadMeAny(MeCI);   (* подвязать строки хидера и загрузить данные *)
      TryLoadMeAny(MeCIO);
      TryLoadMeAny(MeQUV);
      TryLoadMeAny(MeH);
      TryLoadMeAny(MeGM);
      TryLoadMeAny(MeXI);
      TryLoadMeAny(MeVLo1);
      TryLoadMeAny(MeVLo2);
      TryLoadMeAny(MeLiSt);
      TryLoadMeAny(MeVma);
      TryLoadMeAny(MeWD);
      TryLoadMeAny(MeA);

      TryLoadMeAny(MeB0);
      TryLoadMeAny(MeBeta);


      (*            анализируем текущий хидер                       *)
      (*============================================================*)





      HmeSL.Add(sB40);

      (* выведем статистические данные по только что выведенному хидеру *)

//    HmeSL.Add('NAXIS1 = '+ISt(NAX));
      NNN := nbH0 + nbHead1 + NN; (* позиция следующего блока *)

//    (* округляем NNN до числа, кратного 512 (для ME - кратного 64) *)
      NN1024 := (((NNN-1) div 64) + 1) * 64;
//    NN1024 := NNN;


      (* добавляем строку статистики в HmeSL *)
      HmeSL.Add('K='+ISt(K)+' nbH0='+ISt(nbH0)+' nbHead='+ISt(nbHead1)
      +' NN='+ISt(NN)+
      ' NNN='+ISt(NNN)+'=$'+swStr.HexI(NNN)+' => $'+HexI(NN1024));

      if (NN1024 >= (LFile-nbHead1)) then Q := false;

      HmeSL.Add(sB80);

//      if K = 5 then Q := false;
    until Not Q
  end;
  (*==================================================================*)


  result := true;
  Time_routine('LFITS.LoadMEfit',false);
end; (* TLFITS.LoadMEfit *)
}


function TLFITS.RepMem:TStringList;
var SL : TStringList; s : string; j : integer;
begin

  SL := TStringList.Create;

  if Not Assigned(Self) then begin
    WarnAbs('LFITS Not Assigned Yet!!!');
    Result := SL;
    Exit;
  end;


  S := 'OuCont' + OuCont.RepMem; SL.Add(S);
  S := 'OuGc1'  + OuGc1.RepMem;  SL.Add(S);
  S := 'OuGc2'  + OuGc2.RepMem;  SL.Add(S);
  S := 'OuKVI'  + OuKVI.RepMem;  SL.Add(S);

  S := 'OuW1'   + OuW1.RepMem;   SL.Add(S);
  S := 'OuW2'   + OuW2.RepMem;   SL.Add(S);
  S := 'OuH1'   + OuH1.RepMem;   SL.Add(S);
  S := 'OuH2'   + OuH2.RepMem;   SL.Add(S);
  S := 'OuHG1'  + OuHG1.RepMem;  SL.Add(S);
  S := 'OuHG2'  + OuHG2.RepMem;  SL.Add(S);

  S := 'OuCnt'  + OuCnt.RepMem;  SL.Add(S);
  S := 'OuVc1'  + OuVc1.RepMem;  SL.Add(S);
  S := 'OuVc2'  + OuVc2.RepMem;  SL.Add(S);

  S := 'MeH'    + MeH.RepMem;    SL.Add(S);
  S := 'MeGM'   + MeGM.RepMem;   SL.Add(S);

  S := 'MeHL'   + MeHL.RepMem;   SL.Add(S);
  S := 'MeX'    + MeX.RepMem;    SL.Add(S);
  S := 'MeY'    + MeY.RepMem;    SL.Add(S);


(*
  S := 'MeCI'   + MeCI.RepMem;   SL.Add(S);
  S := 'MeCIO'  + MeCIO.RepMem;  SL.Add(S);
  S := 'MeQUV'  + MeQUV.RepMem;  SL.Add(S);

  S := 'MeXI'   + MeXI.RepMem;   SL.Add(S);

  S := 'MeVLo1' + MeVLo1.RepMem; SL.Add(S);
  S := 'MeVLo2' + MeVLo2.RepMem; SL.Add(S);

  S := 'MeLiSt' + MeLiSt.RepMem; SL.Add(S);
  S := 'MeA'    + MeA.RepMem;    SL.Add(S);
  S := 'MeWD'   + MeWD.RepMem;   SL.Add(S);
  S := 'MeVma'  + MeVma.RepMem;  SL.Add(S);

  S := 'MeB0'   + MeB0.RepMem;   SL.Add(S);
  S := 'MeBeta' + MeBeta.RepMem; SL.Add(S);
*)


  for j := 3 to 5 do begin
    S := 'Ou35C1['+ISt(j)+']' + Ou35C1[j].RepMem;  SL.Add(S);
    S := 'Ou35C2['+ISt(j)+']' + Ou35C2[j].RepMem;  SL.Add(S);
    S := 'Ou35I1['+ISt(j)+']' + Ou35I1[j].RepMem;  SL.Add(S);
    S := 'Ou35I2['+ISt(j)+']' + Ou35I2[j].RepMem;  SL.Add(S);
    S := 'Ou35D1['+ISt(j)+']' + Ou35D1[j].RepMem;  SL.Add(S);
    S := 'Ou35D2['+ISt(j)+']' + Ou35D2[j].RepMem;  SL.Add(S);
  end;

  for j := 1 to mBisec do begin
    S := 'OuBiC1['+ISt(j)+']' + OuBiC1[j].RepMem;  SL.Add(S);
    S := 'OuBiC2['+ISt(j)+']' + OuBiC2[j].RepMem;  SL.Add(S);
    S := 'OuBiW1['+ISt(j)+']' + OuBiW1[j].RepMem;  SL.Add(S);
    S := 'OuBiW2['+ISt(j)+']' + OuBiW2[j].RepMem;  SL.Add(S);
  end;

  result := SL;
end; (* TLFITS.RepMem *)



function TLFITS.swFITSInit:boolean;
var kSoft0 : integer;
begin
  Time_routine('LFITS.swFITSInit',true);
  result := true;
  if Assigned (OuCont) then begin
    WarnAbs('TLFITS.swFITSInit WARNING: Повторный вызов! (пропускаем Init)');
    Time_routine('LFITS.swFITSInit',false);
    Exit;
  end;

  if nX*nY = 0 then begin
    WarnAbs('TLFITS.swFITSInit ERR - до вызова процедуры надо'+
    ' завести значения nX и nY!');
    result := false;
    Time_routine('LFITS.swFITSInit',false);
    Exit;
  end;

  (*--- Для первого прохода ---*)
{
  OuCont  := TFIOut.Create; (* в единицах шкалы измерений *)
  OuGc1   := TFIOut.Create; (* в пикселах  полож.центра тяжести *)
  OuGc2   := TFIOut.Create; (* в пикселах *)
  OuKVI   := TFIOut.Create;
//  OuII0   := TFIOut.Create; (* в пикселах *)
//  OuVV0   := TFIOut.Create; (* в пикселах *)
  OuW1    := TFIOut.Create;
  OuW2    := TFIOut.Create;
  OuH1    := TFIOut.Create;
  OuH2    := TFIOut.Create;
  OuHG1   := TFIOut.Create;
  OuHG2   := TFIOut.Create;
}
  if Not Assigned (LFIO) then LFIO := TLFIOut.Create;

  kSOFT0 := 1;
  OuCont := LFIO.Link(sDtTi,'CONT'    ,'Continuum Intensity'           ,'',kSOFT0,nX,nY,Self);
  OuGc1  := LFIO.Link(sDtTi,'GRC_6301','Center of Gravity 6301, pixels','',kSOFT0,nX,nY,Self);
  OuGc2  := LFIO.Link(sDtTi,'GRC_6302','Center of Gravity 6302, pixels','',kSOFT0,nX,nY,Self);
  OuKVI  := LFIO.Link(sDtTi,'KVI'     ,'Mesure of Polarization |V|/I'  ,'',kSOFT0,nX,nY,Self);
//  OuII0  := LFIO.Link(sDtTi,'MID_I1I2','I-profiles diveder, pixels'    ,'',kSOFT0,nX,nY,Self);
//  OuVV0  := LFIO.Link(sDtTi,'MID_V1V2','V-profiles diveder, pixels'    ,'',kSOFT0,nX,nY,Self);
  OuW1   := LFIO.Link(sDtTi,'W_6301'  ,'Equivalent Width 6301, mA'     ,'',kSOFT0,nX,nY,Self);
  OuW2   := LFIO.Link(sDtTi,'W_6302'  ,'Equivalent Width 6302, mA'     ,'',kSOFT0,nX,nY,Self);
  OuH1   := LFIO.Link(sDtTi,'H_L_6301','Longitudial Field 6301, G'     ,'',kSOFT0,nX,nY,Self);
  OuH2   := LFIO.Link(sDtTi,'H_L_6302','Longitudial Field 6302, G'     ,'',kSOFT0,nX,nY,Self);
  OuHG1  := LFIO.Link(sDtTi,'H_LG6301','Long. COG Field 6301, G'       ,'',kSOFT0,nX,nY,Self);
  OuHG2  := LFIO.Link(sDtTi,'H_LG6302','Long. COG Field 6302, G'       ,'',kSOFT0,nX,nY,Self);


(*
 *  "производные" массивы OuVc1, OuVc2, OuCnt инициируем позже
 *)

  Time_routine('LFITS.swFITSInit',false);
end; (* TLFITS.swFITSInit *)



function TLFITS.meH_GM_Init:boolean;
{
var kSoft0 : integer;
       chN : char;   (* Id сессии *)
       SLN : TStringList;
   sDt,sTi : string;
        FO : TFIOut;
}        
begin
  result := false;
  if Not MeAny_Init(MeH, 'Field_Strength'   ,'') then Exit;
  if Not MeAny_Init(MeGM,'Field_Inclination','') then Exit;
  result := true;


{
  result := true;
  if Assigned (MeH) then begin
    WarnAbs('TLFITS.meH_GM_Init WARNING: Повторный вызов!');
    Exit;
  end;

  if nX*nY = 0 then begin
    WarnAbs('TLFITS.meH_GM_Init ERR - до вызова процедуры надо'+
    ' завести значения nX и nY!');
    result := false;
    Exit;
  end;

  sDt := swStr.left(sDtTi,8);
  sTi := swStr.rightfrom(sDtTi,'_');

  if Not Assigned (LFIO) then LFIO := TLFIOut.Create;
  ChN := LFIO.GetChN;

  FO := LFIO.GetFIOut(sDt,sTi,'Field_Strength','');
  if Not Assigned (FO) then begin
    SLN := TStringList.Create;
    SLN.Add('Field_Strength');
    SLN.Add('Field_Inclination');
    LFIO.LoadME(ChN,sDt,sTi,SLN,false);
  end;

  kSoft0 := 2;
  MeH   := LFIO.Link(sDtTi,'Field_Strength'   ,'','',kSOFT0,nX,nY,Self);
  MeGM  := LFIO.Link(sDtTi,'Field_Inclination','','',kSOFT0,nX,nY,Self);
  MeH.chN  := ChN;
  MeGM.chN := ChN;
}

end; (* TLFITS.meH_GM_Init *)


function TLFITS.meXY_Init:boolean;
{
var kSoft0 : integer;
       chN : char;   (* Id сессии *)
       SLN : TStringList;
   sDt,sTi : string;
        FO : TFIOut;
}
begin

  result := false;
  if Not MeAny_Init(MeX,'X_Coordinate','') then Exit;
  if Not MeAny_Init(MeY,'Y_Coordinate','') then Exit;
  result := true;


{
  result := true;
  if Assigned (MeX) then begin
    WarnAbs('TLFITS.meXY_Init WARNING: Повторный вызов!');
    Exit;
  end;

  if nX*nY = 0 then begin
    WarnAbs('TLFITS.meXY_Init ERR - до вызова процедуры надо'+
    ' завести значения nX и nY!');
    result := false;
    Exit;
  end;

  sDt := swStr.left(sDtTi,8);
  sTi := swStr.rightfrom(sDtTi,'_');

  if Not Assigned (LFIO) then LFIO := TLFIOut.Create;
  ChN := LFIO.GetChN;

  FO := LFIO.GetFIOut(sDt,sTi,'X_Coordinate','');
  if Not Assigned (FO) then begin
    SLN := TStringList.Create;
    SLN.Add('X_Coordinate');
    SLN.Add('Y_Coordinate');
    LFIO.LoadME(ChN,sDt,sTi,SLN,false);
  end;

  kSoft0 := 2;
  MeX := LFIO.Link(sDtTi,'X_Coordinate','','',kSOFT0,nX,nY,Self);
  MeY := LFIO.Link(sDtTi,'Y_Coordinate','','',kSOFT0,nX,nY,Self);
  MeX.chN := ChN;
  MeY.chN := ChN;
}
end; (* TLFITS.meXY_Init *)




function TLFITS.swGC1_GC2_Init:boolean;
var sV,s0,s1,s2 : string;
begin
  result := false;
  sV := '2022';
  s0 := 'GRC_630';
  s1 := 'Center of Gravity 630';
  s2 := ', pixels';
  if Not OuAny_Init(OuGc1,s0+'1',s1+'1'+s2,sV)then Exit;
  if Not OuAny_Init(OuGc2,s0+'2',s1+'2'+s2,sV)then Exit;
  result := true;
end; (* TLFITS.swGC1_GC2_Init *)



function TLFITS.swCont_KVI_Init:boolean;
var sV : string;
begin
  result := false;
  sV := '2022';
  if Not OuAny_Init(OuCont,'CONT','Continuum Intensity',sV)          then Exit;
  if Not OuAny_Init(OuKVI ,'KVI' ,'Mesure of Polarization |V|/I',sV) then Exit;
  result := true;
end; (* TLFITS.swFITSInit *)


function TLFITS.swCnt105_Init:boolean;
var sV : string;
begin
  result := false;
  sV := '2022';
  if Not OuAny_Init(OuCont,'CONT','Continuum Intensity',sV) then Exit;
  result := true;
end; (* TLFITS.swCnt105_Init *)


function TLFITS.swGaussCore_Init:boolean;
var kSoft0 : integer;
       chN : char;   (* Id сессии *)
     SLN : TStringList;
  sDt,sTi : string;
  FO : TFIOut;
  sV : string;
begin

  result := true;
  if Assigned (Self.OuGD16) then begin
    WarnAbs('TLFITS.swGaussCore_Init WARNING: Повторный вызов!');
    Exit;
  end;

  if nX*nY = 0 then begin
    WarnAbs('TLFITS.swGaussCore_Init ERR - до вызова процедуры надо'+
    ' завести значения nX и nY!');
    result := false;
    Exit;
  end;

  sV := '2022';

  sDt := swStr.left(sDtTi,8);
  sTi := swStr.rightfrom(sDtTi,'_');

  if Not Assigned (LFIO) then LFIO := TLFIOut.Create;
  ChN := LFIO.GetChN;

  kSOFT0 := 1;

  OuGa18  := LFIO.Link(sDtTi,'Core1_A8', 'Line Regr.A 8point 6301',sV,kSOFT0,nX,nY,Self);
  OuGa16  := LFIO.Link(sDtTi,'Core1_A6', 'Line Regr.A 6point 6301',sV,kSOFT0,nX,nY,Self);
  OuGa141 := LFIO.Link(sDtTi,'Core1_A41','Line Regr.A 4(1)point 6301',sV,kSOFT0,nX,nY,Self);
  OuGa142 := LFIO.Link(sDtTi,'Core1_A42','Line Regr.A 4(2)point 6301',sV,kSOFT0,nX,nY,Self);

  OuGa28  := LFIO.Link(sDtTi,'Core2_A8', 'Line Regr.A 8point 6302',sV,kSOFT0,nX,nY,Self);
  OuGa26  := LFIO.Link(sDtTi,'Core2_A6', 'Line Regr.A 6point 6302',sV,kSOFT0,nX,nY,Self);
  OuGa241 := LFIO.Link(sDtTi,'Core2_A41','Line Regr.A 4(1)point 6302',sV,kSOFT0,nX,nY,Self);
  OuGa242 := LFIO.Link(sDtTi,'Core2_A42','Line Regr.A 4(2)point 6302',sV,kSOFT0,nX,nY,Self);

  OuGb18  := LFIO.Link(sDtTi,'Core1_B8', 'Line Regr.B 8point 6301',sV,kSOFT0,nX,nY,Self);
  OuGb16  := LFIO.Link(sDtTi,'Core1_B6', 'Line Regr.B 6point 6301',sV,kSOFT0,nX,nY,Self);
  OuGb141 := LFIO.Link(sDtTi,'Core1_B41','Line Regr.B 4(1)point 6301',sV,kSOFT0,nX,nY,Self);
  OuGb142 := LFIO.Link(sDtTi,'Core1_B42','Line Regr.B 4(2)point 6301',sV,kSOFT0,nX,nY,Self);

  OuGb28  := LFIO.Link(sDtTi,'Core2_B8', 'Line Regr.B 8point 6302',sV,kSOFT0,nX,nY,Self);
  OuGb26  := LFIO.Link(sDtTi,'Core2_B6', 'Line Regr.B 6point 6302',sV,kSOFT0,nX,nY,Self);
  OuGb241 := LFIO.Link(sDtTi,'Core2_B41','Line Regr.B 4(1)point 6302',sV,kSOFT0,nX,nY,Self);
  OuGb242 := LFIO.Link(sDtTi,'Core2_B42','Line Regr.B 4(2)point 6302',sV,kSOFT0,nX,nY,Self);

  OuGD18  := LFIO.Link(sDtTi,'Cor1_DLD8', 'Core DLD 8point 6301',sV,kSOFT0,nX,nY,Self);
  OuGD16  := LFIO.Link(sDtTi,'Cor1_DLD6', 'Core DLD 6point 6301',sV,kSOFT0,nX,nY,Self);
  OuGD141 := LFIO.Link(sDtTi,'Cor1_DLD41','Core DLD 4(1)point 6301',sV,kSOFT0,nX,nY,Self);
  OuGD142 := LFIO.Link(sDtTi,'Cor1_DLD42','Core DLD 4(2)point 6301',sV,kSOFT0,nX,nY,Self);

  OuGD28  := LFIO.Link(sDtTi,'Cor2_DLD8', 'Core DLD 8point 6302',sV,kSOFT0,nX,nY,Self);
  OuGD26  := LFIO.Link(sDtTi,'Cor2_DLD6', 'Core DLD 6point 6302',sV,kSOFT0,nX,nY,Self);
  OuGD241 := LFIO.Link(sDtTi,'Cor2_DLD41','Core DLD 4(1)point 6302',sV,kSOFT0,nX,nY,Self);
  OuGD242 := LFIO.Link(sDtTi,'Cor2_DLD42','Core DLD 4(2)point 6302',sV,kSOFT0,nX,nY,Self);

  OuG1d0  := LFIO.Link(sDtTi,'Core1_d0',  'Core d0 6301',sV,kSOFT0,nX,nY,Self);
  OuG2d0  := LFIO.Link(sDtTi,'Core2_d0',  'Core d0 6302',sV,kSOFT0,nX,nY,Self);

  OuG1Dk  := LFIO.Link(sDtTi,'Cor1_DLDk', 'Core DLDk 6301',sV,kSOFT0,nX,nY,Self);
  OuG2Dk  := LFIO.Link(sDtTi,'Cor2_DLDk', 'Core DLDk 6302',sV,kSOFT0,nX,nY,Self);

  OuG1D   := LFIO.Link(sDtTi,'Cor1_DLD', 'Core DLD 6301',sV,kSOFT0,nX,nY,Self);
  OuG2D   := LFIO.Link(sDtTi,'Cor2_DLD', 'Core DLD 6302',sV,kSOFT0,nX,nY,Self);

  OuGL16  := LFIO.Link(sDtTi,'Cor16_L0', 'Core Lam0 6point 6301',sV,kSOFT0,nX,nY,Self);
  OuGL14  := LFIO.Link(sDtTi,'Cor14_L0', 'Core Lam0 4point 6301',sV,kSOFT0,nX,nY,Self);
  OuGL26  := LFIO.Link(sDtTi,'Cor26_L0', 'Core Lam0 6point 6302',sV,kSOFT0,nX,nY,Self);
  OuGL24  := LFIO.Link(sDtTi,'Cor24_L0', 'Core Lam0 4point 6302',sV,kSOFT0,nX,nY,Self);

  OuGL10  := LFIO.Link(sDtTi,'Core1_L0p','CorePeak Lam0 6301',sV,kSOFT0,nX,nY,Self);
  OuGL20  := LFIO.Link(sDtTi,'Core2_L0p','CorePeak Lam0 6302',sV,kSOFT0,nX,nY,Self);

  OuGL1  := LFIO.Link(sDtTi,'Core1_L0', 'Core Lam0 6301',sV,kSOFT0,nX,nY,Self);
  OuGL2  := LFIO.Link(sDtTi,'Core2_L0', 'Core Lam0 6302',sV,kSOFT0,nX,nY,Self);

  OuGa18.chN  := ChN;
  OuGa16.chN  := ChN;
  OuGa141.chN := ChN;
  OuGa142.chN := ChN;

  OuGa28.chN  := ChN;
  OuGa26.chN  := ChN;
  OuGa241.chN := ChN;
  OuGa242.chN := ChN;

  OuGb18.chN  := ChN;
  OuGb16.chN  := ChN;
  OuGb141.chN := ChN;
  OuGb142.chN := ChN;

  OuGb28.chN  := ChN;
  OuGb26.chN  := ChN;
  OuGb241.chN := ChN;
  OuGb242.chN := ChN;

  OuGD18.chN  := ChN;
  OuGD16.chN  := ChN;
  OuGD141.chN := ChN;
  OuGD142.chN := ChN;

  OuGD28.chN  := ChN;
  OuGD26.chN  := ChN;
  OuGD241.chN := ChN;
  OuGD242.chN := ChN;

  OuG1d0.chN  := ChN;
  OuG2d0.chN  := ChN;

  OuG1Dk.chN  := ChN;
  OuG2Dk.chN  := ChN;

  OuG1D.chN   := ChN;
  OuG2D.chN   := ChN;


  OuGL16.chN  := ChN;
  OuGL14.chN  := ChN;
  OuGL26.chN  := ChN;
  OuGL24.chN  := ChN;

  OuGL10.chN  := ChN;
  OuGL20.chN  := ChN;

  OuGL1.chN   := ChN;
  OuGL2.chN   := ChN;

end; (* TLFITS.swGaussCore_Init *)


function TLFITS.swErr_Init:boolean;
var sN,sCom,s9 : string; rC90 : real;
  sLN, sLCom : TStringList;
begin
  s9 := Sunworld.Get_rC90;
  sLN   := TStringList.Create;
  sLCom := TStringList.Create;

  sN  := 'WVErr'+s9;  sLN.Add(sN);
  sN  := 'WQErr'+s9;  sLN.Add(sN);
  sN  := 'WUErr'+s9;  sLN.Add(sN);
  sN  := 'WV2Err'+s9; sLN.Add(sN);
  sN  := 'WQ2Err'+s9; sLN.Add(sN);
  sN  := 'WU2Err'+s9; sLN.Add(sN);
  sN  := 'WQUErr'+s9; sLN.Add(sN);
  sN  := 'WQUVErr'+s9;sLN.Add(sN);

  sCom:= 'PerPoint V-Error (I<'+s9+')';    sLCom.Add(sCom);
  sCom:= 'PerPoint Q-Error (I<'+s9+')';    sLCom.Add(sCom);
  sCom:= 'PerPoint U-Error (I<'+s9+')';    sLCom.Add(sCom);
  sCom:= 'PerPoint sqrt(V*V) Error (I<'+s9+')';  sLCom.Add(sCom);
  sCom:= 'PerPoint sqrt(Q*Q) Error (I<'+s9+')';  sLCom.Add(sCom);
  sCom:= 'PerPoint sqrt(U*U) Error (I<'+s9+')';  sLCom.Add(sCom);
  sCom:= 'PerPoint sqrt(Q*Q+U*U) Error (I<'+s9+')';  sLCom.Add(sCom);
  sCom:= 'PerPoint sqrt(Q*Q+U*U+V*V) Error (I<'+s9+')';  sLCom.Add(sCom);

  result := swAE_Init(OuErr,sLN,sLCom,s9);

end;



function TLFITS.swFine_Init:boolean;
var sN,sCom,s9 : string; rC90 : real;
  sLN, sLCom : TStringList;
begin
  s9 := Sunworld.Get_rC90;

  sLN   := TStringList.Create;
  sLCom := TStringList.Create;

  sN   := 'wVp'+s9;  sLN.Add(sN);
  sN   := 'wVn'+s9;  sLN.Add(sN);  (*  swKVI2_Init  2 *)
//sN   := 'wVpp'+s9; sLN.Add(sN);
//sN   := 'wVnn'+s9; sLN.Add(sN);    swKVI3_Init
  sN   := 'wQp'+s9;  sLN.Add(sN);
  sN   := 'wQn'+s9;  sLN.Add(sN);  (*  swKQI2_Init  4 *)
  sN   := 'wUp'+s9;  sLN.Add(sN);
  sN   := 'wUn'+s9;  sLN.Add(sN);  (*  swKUI2_Init  6 *)
  sN   := 'wW'+s9;   sLN.Add(sN);  (*  swKWI_Init   7 *)
  sN   := 'LVMp'+s9; SLN.Add(sN);
  sN   := 'LVMn'+s9; SLN.Add(sN);
  sN   := 'LVMa'+s9; SLN.Add(sN);  (*  swMV3_Init; 10 *)
  sN   := 'LVMb'+s9; SLN.Add(sN);
  sN   := 'LVMr'+s9; SLN.Add(sN);  (* 12 *)

  sCom:='Signed p-Polarization V for 630 (I<'+s9+')';sLCom.Add(sCom);
  sCom:='Signed n-Polarization V for 630 (I<'+s9+')';sLCom.Add(sCom);
//sCom:= 'Net value of p-Polarization V for 630 (I<'+s9+')';    sLCom.Add(sCom);
//sCom:= 'Net value of n-Polarization V for 630 (I<'+s9+')';    sLCom.Add(sCom);
  sCom:='Signed p-Polarization Q for 630 (I<'+s9+')';sLCom.Add(sCom);
  sCom:='Signed n-Polarization Q for 630 (I<'+s9+')';sLCom.Add(sCom);
  sCom:='Signed p-Polarization U for 630 (I<'+s9+')';sLCom.Add(sCom);
  sCom:='Signed n-Polarization U for 630 (I<'+s9+')';sLCom.Add(sCom);
  sCom := 'Measure of EqWidth I for 630 (I<'+s9+')';            sLCom.Add(sCom);
  sCom := 'iLam of p-lobe of V for 630 (I<'+s9+')';             sLCom.Add(sCom);
  sCom := 'iLam of n-lobe of V for 630 (I<'+s9+')';             sLCom.Add(sCom);
  sCom := 'iLam of abs(V) for 630 (I<'+s9+')';                  sLCom.Add(sCom);
  sCom := 'iLam of blue-lobe of V for 630 (I<'+s9+')';          sLCom.Add(sCom);
  sCom := 'iLam of red-lobe of V for 630 (I<'+s9+')';           sLCom.Add(sCom);
//sCom := 'iLam of abs(V) for 630 (I<'+s9+')';                  sLCom.Add(sCom);

  result := swA2_Init(OuAny,sLN,sLCom,1,s9);
end; (* TLFITS.swFine_Init *)


function TLFITS.swFilt_Init:boolean;
var sN,sCom,sS,s1,s2,sL,sAbs : string;
  sLN, sLCom : TStringList;
  i1,iLi : integer;
  qAbs : boolean;
begin
  sS := SunWorld.edFilt_Stokes.Text;
  s1 := SunWorld.edFilt_1.Text;
  s2 := SunWorld.edFilt_2.Text;
  qAbs := SunWorld.cbFiltAbs.Checked;
  if qAbs then sAbs := 'a' else sAbs := '';


  i1 := swStr.ValInt(s1);
  if i1 > 60 then iLi := 2 else iLi := 1;
  sL := ISt(iLi);

  sLN   := TStringList.Create;
  sLCom := TStringList.Create;

  sN   := 'flt'+sS+sAbs+sL+'C_'+s1+'_'+s2; sLN.Add(sN);
  sN   := 'flt'+sS+sAbs+sL+'V_'+s1+'_'+s2; sLN.Add(sN);  (*    2 *)

  sCom:='Filt('+sS+') ['+s1+','+s2+'] per Cont for 630'; sLCom.Add(sCom);
  sCom:='Filt('+sS+') ['+s1+','+s2+'] per WV for 630';   sLCom.Add(sCom);

//result := swA2_Init(OuAny,sLN,sLCom,1,s9);
  result := swA2_Init1(OuAny,sLN,sLCom,1,'',iLi);
end; (* TLFITS.swFilt_Init *)


function TLFITS.swFine2_Init:boolean;
var sN,sCom,s9 : string; rC90 : real;
  sLN, sLCom : TStringList;
begin
  s9 := Sunworld.Get_rC90;

  sLN   := TStringList.Create;
  sLCom := TStringList.Create;

  sN   := 'W2QU'+s9; sLN.Add(sN);
  sN   := 'W2QUV'+s9;sLN.Add(sN);  (*    2 *)
  sN   := 'LIVp'+s9; sLN.Add(sN);
  sN   := 'LIVm'+s9; sLN.Add(sN);  (*    4 *)
  sN   := 'LQUa'+s9; sLN.Add(sN);
  sN   := 'LQUc'+s9; sLN.Add(sN);  (*    6 *)
  sN   := 'LQUb'+s9; sLN.Add(sN);
  sN   := 'LQUr'+s9; SLN.Add(sN);  (*    8 *)

  sN   := 'WQUc'+s9; SLN.Add(sN);  (*    9 *)
  sN   := 'WQUb'+s9; SLN.Add(sN);  (*   10 *)
  sN   := 'WQUr'+s9; SLN.Add(sN);  (*   11 *)

  sCom:='EqWidth sqrt(Q*Q+U*U) for 630 (I<'+s9+')';     sLCom.Add(sCom);
  sCom:='EqWidth sqrt(Q*Q+U*U+V*V) for 630 (I<'+s9+')'; sLCom.Add(sCom);
  sCom:='iLam of I+V for 630 (I<'+s9+')'; sLCom.Add(sCom);
  sCom:='iLam of I-V for 630 (I<'+s9+')'; sLCom.Add(sCom);
  sCom:='iLam of sqrt(Q*Q+U*U) for 630 (I<'+s9+')'; sLCom.Add(sCom);
  sCom:='iLam of central lobe sqrt(Q*Q+U*U) for 630 (I<'+s9+')';sLCom.Add(sCom);
  sCom:='iLam of blue lobe sqrt(Q*Q+U*U) for 630 (I<'+s9+')';sLCom.Add(sCom);
  sCom:='iLam of red lobe sqrt(Q*Q+U*U) for 630 (I<'+s9+')';sLCom.Add(sCom);

  sCom:='EqW sqrt(Q*Q+U*U) central lobe for 630 (I<'+s9+')';sLCom.Add(sCom);
  sCom:='EqW sqrt(Q*Q+U*U) blue lobe for 630 (I<'+s9+')';sLCom.Add(sCom);
  sCom:='EqW sqrt(Q*Q+U*U) red lobe for 630 (I<'+s9+')';sLCom.Add(sCom);

//result := swA2_Init(OuAny,sLN,sLCom,1,s9);
  result := swA2_Init(OuAny,sLN,sLCom,13,s9);
end; (* TLFITS.swFine2_Init *)


function TLFITS.swKVI2_Init:boolean;
var sN,sCom,s9 : string; rC90 : real;
  sLN, sLCom : TStringList;
begin
  s9 := Sunworld.Get_rC90;

  sLN   := TStringList.Create;
  sLCom := TStringList.Create;

  sN   := 'wVp'+s9; sLN.Add(sN);
  sN   := 'wVn'+s9; sLN.Add(sN);

  sCom := 'Mesure of signed p-Polarization V for 630 (I<'+s9+')';
  sLCom.Add(sCom);
  sCom := 'Mesure of signed n-Polarization V for 630 (I<'+s9+')';
  sLCom.Add(sCom);

//result := swKVQU_Init(OuAny[1,1],OuAny[1,2],OuAny[2,1],OuAny[2,2],
//                      sN1,sN2,sN3,sN4,sCom1,sCom2,sCom3,sCom4);

  result := swA2_Init(OuAny,sLN,sLCom,1,s9);
end; (* TLFITS.swKVI2_Init *)


function TLFITS.swKVI3_Init:boolean;
var sN,sCom,s9 : string; rC90 : real;
  sLN,sLCom : TStringList;
begin
  s9 := Sunworld.Get_rC90;

  sLN   := TStringList.Create;
  sLCom := TStringList.Create;

  sN    := 'wVpp'+s9;  sLN.Add(sN);
  sN    := 'wVnn'+s9;  sLN.Add(sN);
  sCom := 'Net value of p-Polarization V for 630 (I<'+s9+')'; sLCom.Add(sCom);
  sCom := 'Net value of n-Polarization V for 630 (I<'+s9+')'; sLCom.Add(sCom);

//result := swKVQU_Init(OuAnyF,OuAnyG,OuAnyH,OuAnyI,
//                      sN1,sN2,sN3,sN4,sCom1,sCom2,sCom3,sCom4);

  result := swA2_Init(OuAny,sLN,sLCom,8,s9);
end; (* TLFITS.swKVI3_Init *)


function TLFITS.swMV3_Init:boolean;
var sN,sCom,s9 : string; rC90 : real; sLN,sLCom : TStringList;
begin
  s9 := Sunworld.Get_rC90;
  sLN   := TStringList.Create;
  sLCom := TStringList.Create;

  sN   := 'wVMp'+s9; SLN.Add(sN);
  sN   := 'wVMn'+s9; SLN.Add(sN);
  sN   := 'wVMa'+s9; SLN.Add(sN);

  sCom := 'Lam of p-Polarization V for 630 (I<'+s9+')'; sLCom.Add(sCom);
  sCom := 'Lam of n-Polarization V for 630 (I<'+s9+')'; sLCom.Add(sCom);
  sCom := 'Lam of abs(V) for 630 (I<'+s9+')';           sLCom.Add(sCom);

//  result := swK6_Init(OuAnyF,OuAnyG,OuAnyH,OuAnyI,OuAnyJ,OuAnyK,
//                        sN1,sN2,sN3,sN4,sN5,sN6,
//                        sCom1,sCom2,sCom3,sCom4,sCom5,sCom6);
(* 123456789ABCDEFGHIJKLMNOPQRS *)
(* 1122334455667788990011223344 *)


  result := swA2_Init(OuAny,sLN,sLCom,8,s9);

end; (* TLFITS.swMV3_Init *)

function TLFITS.swMQ3_Init:boolean;
var sN,sCom,s9 : string; rC90 : real; sLN,sLCom : TStringList;
begin
  s9 := Sunworld.Get_rC90;
  sLN   := TStringList.Create;
  sLCom := TStringList.Create;

  sN   := 'w_VMp'+s9; SLN.Add(sN);
  sN   := 'w_VMn'+s9; SLN.Add(sN);
  sN   := 'w_VMa'+s9; SLN.Add(sN);

  sCom := 'Lam of p-Polarization V for 630 (I<'+s9+')'; sLCom.Add(sCom);
  sCom := 'Lam of n-Polarization V for 630 (I<'+s9+')'; sLCom.Add(sCom);
  sCom := 'Lam of abs(V) for 630 (I<'+s9+')';           sLCom.Add(sCom);

//  result := swK6_Init(OuAnyL,OuAnyM,OuAnyN,OuAnyO,OuAnyP,OuAnyQ,
//                        sN1,sN2,sN3,sN4,sN5,sN6,
//                        sCom1,sCom2,sCom3,sCom4,sCom5,sCom6);

  result := swA2_Init(OuAny,sLN,sLCom,11,s9);

end; (* TLFITS.swMQ3_Init *)







function TLFITS.swKQI2_Init:boolean;
var sN,sCom,s9 : string; rC90 : real;
  sLN, sLCom : TStringList;
begin
  s9 := Sunworld.Get_rC90;

  sLN   := TStringList.Create;
  sLCom := TStringList.Create;

  sN   := 'wQp'+s9; sLN.Add(sN);
  sN   := 'wQn'+s9; sLN.Add(sN);

  sCom := 'Mesure of signed p-Polarization Q for 630 (I<'+s9+')';
  sLCom.Add(sCom);
  sCom := 'Mesure of signed n-Polarization Q for 630 (I<'+s9+')';
  sLCom.Add(sCom);

//  result := swKVQU_Init(OuAny5,OuAny6,OuAny7,OuAny8,
//                        sN1,sN2,sN3,sN4,sCom1,sCom2,sCom3,sCom4);

  result := swA2_Init(OuAny,sLN,sLCom,3,s9);

{
var sN1,sN2,sN3,sN4,sCom1,sCom2,sCom3,sCom4,s9 : string; rC90 : real;
begin
  s9 := Sunworld.Get_rC90;
  sN1   := 'wQp1'+s9;
  sN2   := 'wQp2'+s9;
  sN3   := 'wQn1'+s9;
  sN4   := 'wQn2'+s9;
  sCom1 := 'Mesure of signed p-Polarization Q for 6301 (I<'+s9+')';
  sCom2 := 'Mesure of signed p-Polarization Q for 6302 (I<'+s9+')';
  sCom3 := 'Mesure of signed n-Polarization Q for 6301 (I<'+s9+')';
  sCom4 := 'Mesure of signed n-Polarization Q for 6302 (I<'+s9+')';

  result := swKVQU_Init(OuAny5,OuAny6,OuAny7,OuAny8,
                        sN1,sN2,sN3,sN4,sCom1,sCom2,sCom3,sCom4);
}
end; (* TLFITS.swKQI2_Init *)

function TLFITS.swKQI3_Init:boolean;
var sN,sCom,s9 : string; rC90 : real;
  sLN, sLCom : TStringList;
begin
  s9 := Sunworld.Get_rC90;

  sLN   := TStringList.Create;
  sLCom := TStringList.Create;

  sN   := 'wQpp'+s9; sLN.Add(sN);
  sN   := 'wQnn'+s9; sLN.Add(sN);

  sCom := 'Mesure of signed p-Polarization Q for 630 (I<'+s9+')';
  sLCom.Add(sCom);
  sCom := 'Mesure of signed n-Polarization Q for 630 (I<'+s9+')';
  sLCom.Add(sCom);

//result := swKVQU_Init(OuAnyJ,OuAnyK,OuAnyL,OuAnyM,
//                      sN1,sN2,sN3,sN4,sCom1,sCom2,sCom3,sCom4);

  result := swA2_Init(OuAny,sLN,sLCom,10,s9);

(* 123456789ABCDEFGHIJKL *)
(* 112233445566778899001 *)

{
var sN1,sN2,sN3,sN4,sCom1,sCom2,sCom3,sCom4,s9 : string; rC90 : real;
begin
  s9 := Sunworld.Get_rC90;

  sN1   := 'wQpp1'+s9;
  sN2   := 'wQpp2'+s9;
  sN3   := 'wQnn1'+s9;
  sN4   := 'wQnn2'+s9;
  sCom1 := 'Net value of p-Polarization Q for 6301 (I<'+s9+')';
  sCom2 := 'Net value of p-Polarization Q for 6302 (I<'+s9+')';
  sCom3 := 'Net value of n-Polarization Q for 6301 (I<'+s9+')';
  sCom4 := 'Net value of n-Polarization Q for 6302 (I<'+s9+')';

  result := swKVQU_Init(OuAnyJ,OuAnyK,OuAnyL,OuAnyM,
                        sN1,sN2,sN3,sN4,sCom1,sCom2,sCom3,sCom4);
}
end; (* TLFITS.swKQ3_Init *)



function TLFITS.swKUI2_Init:boolean;
var sN,sCom,s9 : string; rC90 : real;
  sLN, sLCom : TStringList;
begin
  s9 := Sunworld.Get_rC90;

  sLN   := TStringList.Create;
  sLCom := TStringList.Create;

  sN   := 'wUp'+s9; sLN.Add(sN);
  sN   := 'wUn'+s9; sLN.Add(sN);

  sCom := 'Mesure of signed p-Polarization U for 630 (I<'+s9+')';
  sLCom.Add(sCom);
  sCom := 'Mesure of signed n-Polarization U for 630 (I<'+s9+')';
  sLCom.Add(sCom);

//  result := swKVQU_Init(OuAny9,OuAnyA,OuAnyB,OuAnyC,
//                        sN1,sN2,sN3,sN4,sCom1,sCom2,sCom3,sCom4);

  result := swA2_Init(OuAny,sLN,sLCom,5,s9);


{
var sN1,sN2,sN3,sN4,sCom1,sCom2,sCom3,sCom4,s9 : string; rC90 : real;
begin
  s9 := Sunworld.Get_rC90;
  sN1   := 'wUp1'+s9;
  sN2   := 'wUp2'+s9;
  sN3   := 'wUn1'+s9;
  sN4   := 'wUn2'+s9;
  sCom1 := 'Mesure of signed p-Polarization U for 6301 (I<'+s9+')';
  sCom2 := 'Mesure of signed p-Polarization U for 6302 (I<'+s9+')';
  sCom3 := 'Mesure of signed n-Polarization U for 6301 (I<'+s9+')';
  sCom4 := 'Mesure of signed n-Polarization U for 6302 (I<'+s9+')';

  result := swKVQU_Init(OuAny9,OuAnyA,OuAnyB,OuAnyC,
                        sN1,sN2,sN3,sN4,sCom1,sCom2,sCom3,sCom4);
}
end; (* TLFITS.swKU2_Init *)

function TLFITS.swKUI3_Init:boolean;
var sN,sCom,s9 : string; rC90 : real;
  sLN, sLCom : TStringList;
begin
  s9 := Sunworld.Get_rC90;

  sLN   := TStringList.Create;
  sLCom := TStringList.Create;

  sN   := 'wUpp'+s9; sLN.Add(sN);
  sN   := 'wUnn'+s9; sLN.Add(sN);

  sCom := 'Mesure of signed p-Polarization U for 630 (I<'+s9+')';
  sLCom.Add(sCom);
  sCom := 'Mesure of signed n-Polarization U for 630 (I<'+s9+')';
  sLCom.Add(sCom);

//  result := swKVQU_Init(OuAnyN,OuAnyO,OuAnyP,OuAnyQ,
//                        sN1,sN2,sN3,sN4,sCom1,sCom2,sCom3,sCom4);

  result := swA2_Init(OuAny,sLN,sLCom,12,s9);

(* 123456789ABCDEFGHIJKLMNOPQ *)
(* 11223344556677889900112233 *)

{
var sN1,sN2,sN3,sN4,sCom1,sCom2,sCom3,sCom4,s9 : string; rC90 : real;
begin
  s9 := Sunworld.Get_rC90;

  sN1   := 'wUpp1'+s9;
  sN2   := 'wUpp2'+s9;
  sN3   := 'wUnn1'+s9;
  sN4   := 'wUnn2'+s9;
  sCom1 := 'Net value of p-Polarization U for 6301 (I<'+s9+')';
  sCom2 := 'Net value of p-Polarization U for 6302 (I<'+s9+')';
  sCom3 := 'Net value of n-Polarization U for 6301 (I<'+s9+')';
  sCom4 := 'Net value of n-Polarization U for 6302 (I<'+s9+')';

  result := swKVQU_Init(OuAnyN,OuAnyO,OuAnyP,OuAnyQ,
                        sN1,sN2,sN3,sN4,sCom1,sCom2,sCom3,sCom4);
}
end; (* TLFITS.swKU3_Init *)



function TLFITS.swKWI_Init:boolean;
var sN,sCom,s9 : string; rC90 : real;
  sLN, sLCom : TStringList;
begin
  s9 := Sunworld.Get_rC90;

  sLN   := TStringList.Create;
  sLCom := TStringList.Create;

  sN   := 'wW'+s9; sLN.Add(sN);

  sCom := 'Mesure of EqWidth I for 630 (I<'+s9+')';
  sLCom.Add(sCom);
//result := swKI_Init(OuAnyD,OuAnyE,sN1,sN2,sCom1,sCom2);
  result := swA2_Init(OuAny,sLN,sLCom,7,s9);

(* 123456789ABCDE *)
(* 11223344556677 *)

{
var sN1,sN2,sCom1,sCom2,s9 : string; rC90 : real;
begin
  s9 := Sunworld.Get_rC90;
  sN1   := 'wW1'+s9;
  sN2   := 'wW2'+s9;
  sCom1 := 'Mesure of EqWidth I for 6301 (I<'+s9+')';
  sCom2 := 'Mesure of EqWidth I for 6302 (I<'+s9+')';
  result := swKI_Init(OuAnyD,OuAnyE,sN1,sN2,sCom1,sCom2);
}
end; (* TLFITS.swKWI_Init *)



function TLFITS.swKI_Init(var Ou1,Ou2:TFIOut;
                             sN1,sN2,sCom1,sCom2:string):boolean;
var sV : string;
begin
  result := false;
  sV := '2022';
  if Not OuAny_Init(Ou1,sN1,sCom1,sV) then Exit;
  if Not OuAny_Init(Ou2,sN2,sCom2,sV) then Exit;
  result := true;
end; (* TLFITS.swKVQUI_Init *)


function TLFITS.swKVQU_Init(var Ou1,Ou2,Ou3,Ou4:TFIOut;
           sN1,sN2,sN3,sN4,sCom1,sCom2,sCom3,sCom4:string):boolean;
var sV : string;
begin
  result := false;
  sV := '2022';
  if Not OuAny_Init(Ou1,sN1,sCom1,sV) then Exit;
  if Not OuAny_Init(Ou2,sN2,sCom2,sV) then Exit;
  if Not OuAny_Init(Ou3,sN3,sCom3,sV) then Exit;
  if Not OuAny_Init(Ou4,sN4,sCom4,sV) then Exit;
  result := true;
end; (* TLFITS.swKVQU_Init *)


function TLFITS.swA2_Init(var Ou:TAFOAny;
           sLN,sLCom:TStringList;IFO0:integer;sn9:string):boolean;
var iLi : integer;
begin
  result := false;
  for iLi := 1 to 2 do begin
    if Not (swA2_Init1(Ou,sLN,sLCom,IFO0,sn9,iLi)) then Exit;
  end;
  result := true;

end; (* TLFITS.swA2_Init *)



function TLFITS.swAE_Init(var OuE:TAFOErr;
                          sLN,sLCom:TStringList;s9:string):boolean;
var i,iFO : integer; sN,sCom,sN1,sCom1 : string;
var sV : string;
begin
  result := false;
  sV := '2022';
  i  := 0;
  for iFO := 0 to sLN.Count-1 do begin
    sN   := sLN.Strings[i]+s9;    (* строка имени переменной         *)
    sCom := sLCom.Strings[i]+s9;  (* строка комментария к переменной *)
    if Not OuAny_Init(OuE[iFO],sN,sCom,sV) then Exit;
    inc(i);
  end;
  result := true;
end;




function TLFITS.swA2_Init1(var Ou:TAFOAny;
           sLN,sLCom:TStringList;IFO0:integer;sn9:string;iLi:integer):boolean;
var i,p,iFO : integer; sN,sCom,sN1,sCom1,sV : string; ch : char;
begin
  result := false;
  sV := '2022';
  i := 0;
  for iFO := IFO0 to IFO0+sLN.Count-1 do begin
    sN   := sLN.Strings[i];    (* строка имени переменной         *)
    sCom := sLCom.Strings[i];  (* строка комментария к переменной *)

    ch := chr(ord('0')+iLi); (* 1 или 2 в зависимости от линии *)

    (* вставляем номер линии в комментарий, если в шаблоне есть 630 *)
    p := pos('630',sCom);
    if p = 0 then sCom1 := sCom else
    sCom1 := swStr.left(sCom,p+2)+ch+swStr.rightfrom(sCom,p+3);

    (* вставляем номер линии в имя идентификатора *)
    (* если есть конструкция sn9 - то перед ней *)
    (* иначе - в конец имени *)
    if (sn9 = '') then sN1 := sN else begin
      p := pos(sn9,sN);
      if p = 0 then sN1 := sN+ch else
      sN1 := swStr.left(sN,p-1)+ch+swStr.rightfrom(sN,p);
    end;

    if Not OuAny_Init(Ou[iFO,iLi],sN1,sCom1,sV) then Exit;
    inc(i);
  end;
  result := true;
end; (* TLFITS.swA2_Init1 *)



function TLFITS.swK6_Init(var Ou1,Ou2,Ou3,Ou4,Ou5,Ou6:TFIOut;
           sN1,sN2,sN3,sN4,sN5,sN6,
           sCom1,sCom2,sCom3,sCom4,sCom5,sCom6:string):boolean;
var   sV : string;
begin
  result := false;
  sV := '2022';
  if Not OuAny_Init(Ou1,sN1,sCom1,sV) then Exit;
  if Not OuAny_Init(Ou2,sN2,sCom2,sV) then Exit;
  if Not OuAny_Init(Ou3,sN3,sCom3,sV) then Exit;
  if Not OuAny_Init(Ou4,sN4,sCom4,sV) then Exit;
  if Not OuAny_Init(Ou5,sN5,sCom5,sV) then Exit;
  if Not OuAny_Init(Ou6,sN6,sCom6,sV) then Exit;
  result := true;
end; (* TLFITS.swK6_Init *)



(* инициируем карты "второго прохода", т.е.после вычисл-я средних CONT и Vlos *)
function TLFITS.swFITSInit2:boolean;
var kSoft0 : integer;
begin
  result := true;
  if Assigned (OuCnt) then begin
//  WarnAbs('TLFITS.swFITSInit2 WARNING: Повторный вызов!');
    Exit;
  end;

  if nX*nY = 0 then begin
    WarnAbs('TLFITS.swFITSInit2 ERR - до вызова процедуры надо'+
    ' завести значения nX и nY!');
    result := false;
    Exit;
  end;

  kSOFT0 := 1;

  OuVc1  := LFIO.Link(sDtTi,'Vlos6301','LOS Velocity of 6301 COG','',kSOFT0,nX,nY,Self);
  OuVc2  := LFIO.Link(sDtTi,'Vlos6302','LOS Velocity of 6302 COG','',kSOFT0,nX,nY,Self);
  OuCnt  := LFIO.Link(sDtTi,'Cont_H0','Cont Normalized to NonMagnetic Regions','',kSOFT0,nX,nY,Self);
end; (* TLFITS.swFITSInit2 *)

function TLFITS.swH1_H2_Init:boolean;
var   sV : string;
begin
  result := false;
  sV     := '2002';
  if Not OuAny_Init(OuH1,'H_L_6301','Longitudial Field 6301, G',sV) then Exit;
  if Not OuAny_Init(OuH2,'H_L_6302','Longitudial Field 6302, G',sV) then Exit;
  result := true;
end; (* TLFITS.swH1_H2_Init *)



(* инициируем карты "второго прохода", т.е.после вычисл-я средних CONT и Vlos *)
function TLFITS.swVc1_Vc2_Init:boolean;
var   sV : string;
begin
  result := false;
  sV := '2022';
  if Not OuAny_Init(OuVc1,'Vlos6301','LOS Velocity of 6301 COG',sV) then Exit;
  if Not OuAny_Init(OuVc2,'Vlos6302','LOS Velocity of 6302 COG',sV) then Exit;
  result := true;
end; (* TLFITS.swVc1_Vc2_Init *)



(* инициируем карты "второго прохода", т.е.после вычисл-я средних CONT и Vlos *)
function TLFITS.swCnt_Init:boolean;
var kSoft0 : integer; ChN : char;
begin
  result := true;
  if Assigned (OuCnt) then begin
    WarnAbs('TLFITS.swCnt_Init WARNING: Повторный вызов!');
    Exit;
  end;

  if nX*nY = 0 then begin
    WarnAbs('TLFITS.swCnt_Init ERR - до вызова процедуры надо'+
    ' завести значения nX и nY!');
    result := false;
    Exit;
  end;

  ChN    := LFIO.GetChN;
  kSOFT0 := 1;
  OuCnt  := LFIO.Link(sDtTi,'Cont_H0','Cont Normalized to NonMagnetic Regions','',kSOFT0,nX,nY,Self);
  OuCnt.chN := ChN;
end; (* TLFITS.swCnt_Init *)

function TLFITS.OuAny_Init(var FO:TFIOut;sN,sC,sV:string):boolean;
var kSoft : integer;
begin kSoft := 1; result := FO_Init(kSoft,FO,sN,sC,sV); end;

function TLFITS.OuAny_Init0(var FO:TFIOut;sN,sC,sV:string):boolean;
var kSoft : integer;
begin kSoft := 1; result := FO_Init0(kSoft,FO,sN,sC,sV); end;



function TLFITS.MeAny_Init(var FO:TFIOut;sN,sC:string):boolean;
var kSoft : integer; sV : string;
begin kSoft := 2; sV := '2006'; result := FO_Init(kSoft,FO,sN,sC,sV); end;

function TLFITS.MeAny_Init0(var FO:TFIOut;sN,sC:string):boolean;
var kSoft : integer; sV : string;
begin kSoft := 2; sV := '2006'; result := FO_Init0(kSoft,FO,sN,sC,sV); end;

function TLFITS.FO_Init(kSoft:integer;var FO:TFIOut;sN,sC,sV:string):boolean;
var ChN : char; sDt,sTi : string; SLN : TStringList;
  kSoft0 : integer;
  (*-----------*)
  function sSoft(kSoft:integer):string;
  begin
    Case kSoft of
     1 : result := 'SW';
     2 : result := 'ME';
     3 : result := 'M2';
    else result := 'XX';
    end; (* case *)
  end;
  (*----------*)
begin
  result := true;

  if Not Assigned (LFIO) then LFIO := TLFIOut.Create;


{
  kSOFT0 := 1;
  OuCont := LFIO.Link(sDtTi,'CONT'    ,'Continuum Intensity'           ,'',kSOFT0,nX,nY,Self);
  OuGc1  := LFIO.Link(sDtTi,'GRC_6301','Center of Gravity 6301, pixels','',kSOFT0,nX,nY,Self);
}


  sDt := swStr.left     (Self.sDtTi,'_');
  sTi := swStr.rightfrom(Self.sDtTi,'_');
  FO := LFIO.GetFIOut(sDt,sTi,sN);

  (* повторный вызов инициации переменной карты      FO *)
  (* говорит о том, что алгоритм составлен не правильно *)
  if Assigned (FO) then begin
    WarnAbs('TLFITS.FO('+sSoft(kSoft)+')_Init('+sN+','+sC+
    ') WARNING: Повторный вызов!');
//  Exit;
  end;

  (* к моменту вызова FO_Init размерность карты должна быть уже известна *)
  (* т.е. сессия должна быть выбрана                                     *)
  if nX*nY = 0 then begin
    WarnAbs('TLFITS.FO('+sSoft(kSoft)+')_Init('+sN+','+sC+
    ') ERR - до вызова процедуры надо завести значения nX и nY!');
    result := false;
    Exit;
  end;

  (*------------------------------------------------------------------------*)
  (* если карты нет в списке LFIO, можно попытаться прочитать её из файла   *)
  (*  -------                                                               *)
  (* в некоторых случаях вызова FO_Init заранее известно, что карты ещё нет *)
  (* но чтение заголовков из одного файла swFITS не трудоёмко,              *)
  (* можно и перечитать                                                     *)
  (*------------------------------------------------------------------------*)

  FO := LFIO.GetFIOut(sDt,sTi,sN,'');
  if Not Assigned (FO) then begin
    SLN := TStringList.Create;
    SLN.Add(sN);

    if
      LFIO.Load(kSoft,ChN,sDt,sTi,SLN,false)(* попытаться занести карту  *)
                                            (* с именем sN в LFIO из     *)
                                            (* SW-FITS файла             *)
    then FO := LFIO.GetFIOut(sDt,sTi,sN,'');

  end;

//ChN    := LFIO.GetChN;

  if Not Assigned(FO) then
  FO := LFIO.Link(sDtTi,sN,sC,sV,kSOFT,nX,nY,Self);

//FO.chN := ChN;
end; (* TLFITS.FO_Init *)


function TLFITS.FO_Init0(kSoft:integer;var FO:TFIOut;sN,sC,sV:string):boolean;
var ChN : char; sDt,sTi : string; SLN : TStringList;
  (*-----------*)
  function sSoft(kSoft:integer):string;
  begin
    Case kSoft of
     1 : result := 'SW';
     2 : result := 'ME';
     3 : result := 'M2';
    else result := 'XX';
    end; (* case *)
  end;
  (*----------*)
begin
  result := true;

  if Not Assigned (LFIO) then LFIO := TLFIOut.Create;

{
  kSOFT0 := 1;
  OuCont := LFIO.Link(sDtTi,'CONT'    ,'Continuum Intensity'           ,'',kSOFT0,nX,nY,Self);
  OuGc1  := LFIO.Link(sDtTi,'GRC_6301','Center of Gravity 6301, pixels','',kSOFT0,nX,nY,Self);
}

  sDt := swStr.left     (Self.sDtTi,'_');
  sTi := swStr.rightfrom(Self.sDtTi,'_');
  FO := LFIO.GetFIOut(sDt,sTi,sN);

  (* повторный вызов инициации переменной карты      FO *)
  (* говорит о том, что алгоритм составлен не правильно *)
  if Assigned (FO) then begin
    WarnAbs('TLFITS.FO('+sSoft(kSoft)+')_Init('+sN+','+sC+
    ') WARNING: Повторный вызов!');
//    Exit;
  end;

  (* к моменту вызова FO_Init размерность карты должна быть уже известна *)
  (* т.е. сессия должна быть выбрана                                     *)
  if nX*nY = 0 then begin
    WarnAbs('TLFITS.FO('+sSoft(kSoft)+')_Init('+sN+','+sC+
    ') ERR - до вызова процедуры надо завести значения nX и nY!');
    result := false;
    Exit;
  end;

  ChN    := LFIO.GetChN;
  FO := LFIO.Link(sDtTi,sN,sC,sV,kSOFT,nX,nY,Self);
  FO.chN := ChN;
end; (* TLFITS.FO_Init *)



function TLFITS.sw_dV_Init:boolean;
var sV : string;
begin
  result := false;
  sV := '2022';
  if Not OuAny_Init(Ou_dV,'Rot_dV','Sun_surface_rotation_velocity',sV)
  then Exit;
  result := true;
end; (* TLFITS.sw_dV_Init *)




function TLFITS.swFITSInitBi:boolean;
var kSoft0 : integer; k,kk : integer; C : char; S,S1,S2,S3 : string;
begin

  result := true;

  if Assigned (Ou35C1[3]) then begin
    WarnAbs
    ('TLFITS.swFITSInitBi WARNING: Повторный вызов! (пропускаем InitBi)');
    Exit;
  end;

  if nX*nY = 0 then begin
    WarnAbs('TLFITS.swFITSInitBi ERR - до вызова процедуры надо'+
    ' завести значения nX и nY!');
    result := false;
    Exit;
  end;



  (*===========================================================*)
  (*                   положения вершин линий                  *)
  (*               а также бисекторы и абс.ширины              *)

  kSOFT0 := 1;

  S1 := 'LOS Veloc.of 630';
  S2 := 'd0 630';
  S3 := 'DLD 630';
  for k := 3 to 5 do begin
{
    Ou35C1[k] := TFIOut.Create;     (* V_los (км/с) *)
    Ou35C2[k] := TFIOut.Create;
    Ou35I1[k] := TFIOut.Create;     (* центральные глубины в % *)
    Ou35I2[k] := TFIOut.Create;
    Ou35D1[k] := TFIOut.Create;     (* DLD в mA *)
    Ou35D2[k] := TFIOut.Create;
}

    S := ISt(k); C := S[1];
{
    Ou35C1[k].Link('d0' +C+'Vlos1' ,S1+'1 d0(by '+C+'point)',kSOFT0,nX,nY,Self);
    Ou35C2[k].Link('d0' +C+'Vlos2' ,S1+'2 d0(by '+C+'point)',kSOFT0,nX,nY,Self);
    Ou35I1[k].Link('d0p'+C+'_6301' ,S2+'1 by '   +C+'point' ,kSOFT0,nX,nY,Self);
    Ou35I2[k].Link('d0p'+C+'_6302' ,S2+'2 by '   +C+'point' ,kSOFT0,nX,nY,Self);
    Ou35D1[k].Link('DLDp'+C+'_6301',S3+'1 by '   +C+'point' ,kSOFT0,nX,nY,Self);
    Ou35D2[k].Link('DLDp'+C+'_6302',S3+'1 by '   +C+'point' ,kSOFT0,nX,nY,Self);
}

    Ou35C1[k]:=LFIO.Link(sDtTi,'d0' +C+'Vlos1' ,S1+'1 d0(by '+C+'point)','',kSOFT0,nX,nY,Self);
    Ou35C2[k]:=LFIO.Link(sDtTi,'d0' +C+'Vlos2' ,S1+'2 d0(by '+C+'point)','',kSOFT0,nX,nY,Self);
    Ou35I1[k]:=LFIO.Link(sDtTi,'d0p'+C+'_6301' ,S2+'1 by '   +C+'point' ,'',kSOFT0,nX,nY,Self);
    Ou35I2[k]:=LFIO.Link(sDtTi,'d0p'+C+'_6302' ,S2+'2 by '   +C+'point' ,'',kSOFT0,nX,nY,Self);
    Ou35D1[k]:=LFIO.Link(sDtTi,'DLDp'+C+'_6301',S3+'1 by '   +C+'point' ,'',kSOFT0,nX,nY,Self);
    Ou35D2[k]:=LFIO.Link(sDtTi,'DLDp'+C+'_6302',S3+'2 by '   +C+'point' ,'',kSOFT0,nX,nY,Self);





{
    SetLength(Ou35C1[k].aData,nX,nY);
    SetLength(Ou35C2[k].aData,nX,nY);
    SetLength(Ou35I1[k].aData,nX,nY);
    SetLength(Ou35I2[k].aData,nX,nY);
    SetLength(Ou35D1[k].aData,nX,nY);
    SetLength(Ou35D2[k].aData,nX,nY);
}
  end;

  S1 := 'Bisector at ';
  S2 := 'FullWidth at ';
  for k := 1 to MBiSec do begin
{
    OuBiC1[k] := TFIOut.Create;
    OuBiC2[k] := TFIOut.Create;
    OuBiW1[k] := TFIOut.Create;
    OuBiW2[k] := TFIOut.Create;
}

    case k of
    1 : kk := 10;
    2 : kk := 30;
    3 : kk := 50;
    4 : kk := 70;
    5 : kk := 90;
    6 : kk := 20;
    7 : kk := 40;
    8 : kk := 60;
    9 : kk := 80;
    end; (* case *)

    S := ISt(kk);

{
    OuBiC1[k].Link('Bi'  +S+'_6301',S1+S+'% 6301 [km/s]',kSOFT0,nX,nY,Self);
    OuBiC2[k].Link('Bi'  +S+'_6302',S1+S+'% 6302 [km/s]',kSOFT0,nX,nY,Self);
    OuBiW1[k].Link('AbsW'+S+'_6301',S2+S+'% 6301 [mA]'  ,kSOFT0,nX,nY,Self);
    OuBiW2[k].Link('AbsW'+S+'_6302',S2+S+'% 6302 [mA]'  ,kSOFT0,nX,nY,Self);
}

    OuBiC1[k]:=LFIO.Link(sDtTi,'Bi'  +S+'_6301',S1+S+'% 6301 [km/s]','',kSOFT0,nX,nY,Self);
    OuBiC2[k]:=LFIO.Link(sDtTi,'Bi'  +S+'_6302',S1+S+'% 6302 [km/s]','',kSOFT0,nX,nY,Self);
    OuBiW1[k]:=LFIO.Link(sDtTi,'AbsW'+S+'_6301',S2+S+'% 6301 [mA]'  ,'',kSOFT0,nX,nY,Self);
    OuBiW2[k]:=LFIO.Link(sDtTi,'AbsW'+S+'_6302',S2+S+'% 6302 [mA]'  ,'',kSOFT0,nX,nY,Self);


{
    SetLength(OuBiC1[k].aData,nX,nY);
    SetLength(OuBiC2[k].aData,nX,nY);
    SetLength(OuBiW1[k].aData,nX,nY);
    SetLength(OuBiW2[k].aData,nX,nY);
}
  end;
end; (* TLFITS.swFITSInitBi *)


procedure TLFITS.meHLInit;
//var kSoft0 : integer; ChN : char;
begin
//  result := false;
  if Not MeAny_Init0(MeHL,'Longitudinal_Field','') then Exit;
//  result := true;
{
  if Assigned (MeHL) then begin
    WarnAbs('TLFITS.meHLInit WARNING: Повторный вызов!');
    Exit;
  end;
  ChN := LFIO.GetChN;
  kSoft0 := 2; (* 2 => опция софта = MERLIN *)
  MeHL  := LFIO.Link(sDtTi,'Longitudinal_Field','','',kSOFT0,nX,nY,Self);
  MeHL.chN := ChN;
}
end;

{
procedure TLFITS.MeFITSInit;
var kSoft0 : integer;
begin
  if Assigned (MeCI) then begin
    WarnAbs('TLFITS.MeFITSInit WARNING: Повторный вызов!');
    Exit;
  end;


  WarnAbs('LFITS.MeFITSInit вроде бы не должен вызываться!');


//MeCI    := TFIOut.Create; (* Continuum_Intensity *)
//MeCIO   := TFIOut.Create; (* Original_Continuum_Intensity *)
//MeQUV   := TFIOut.Create; (* Polarization *)
//MeH     := TFIOut.Create; (* Field_Strength *)
//MeGM    := TFIOut.Create; (* Field_Inclination *)
//MeXI    := TFIOut.Create; (* Field_Azimuth  *)
//MeVLo1  := TFIOut.Create; (* Doppler_Shift1 *)
//MeVLo2  := TFIOut.Create; (* Doppler_Shift2 *)

//MeLiSt  := TFIOut.Create; (* Line_Strength  *)
//MeA     := TFIOut.Create; (* Damping *)
//MeWD    := TFIOut.Create; (* Doppler_Width *)
//MeVma   := TFIOut.Create; (* Macro_Turbulence *)

//MeB0    := TFIOut.Create; (* Source_Function *)
//MeBeta  := TFIOut.Create; (* Source_Function_Gradient *)

//MeHL    := TFIOut.Create; (* Longitudinal_Field *)



  if Not Assigned (LFIO) then LFIO := TLFIOut.Create;

  kSoft0 := 2; (* 2 => опция софта = MERLIN *)

  MeCI  := LFIO.Link(sDtTi,'Continuum_Intensity'         ,'','',kSOFT0,nX,nY,Self);
  MeCIO := LFIO.Link(sDtTi,'Original_Continuum_Intensity','','',kSOFT0,nX,nY,Self);
  MeQUV := LFIO.Link(sDtTi,'Polarization'                ,'','',kSOFT0,nX,nY,Self);
  MeH   := LFIO.Link(sDtTi,'Field_Strength'              ,'','',kSOFT0,nX,nY,Self);
  MeGM  := LFIO.Link(sDtTi,'Field_Inclination'           ,'','',kSOFT0,nX,nY,Self);
  MeXI  := LFIO.Link(sDtTi,'Field_Azimuth'               ,'','',kSOFT0,nX,nY,Self);

  (*
  MeVLo1:= LFIO.Link(sDtTi,'Doppler_Shift1'              ,'','',kSOFT0,nX,nY,Self);
  MeVLo2:= LFIO.Link(sDtTi,'Doppler_Shift2'              ,'','',kSOFT0,nX,nY,Self);
  *)

  MeLiSt:= LFIO.Link(sDtTi,'Line_Strength'               ,'','',kSOFT0,nX,nY,Self);
  MeA   := LFIO.Link(sDtTi,'Damping'                     ,'','',kSOFT0,nX,nY,Self);
  MeWD  := LFIO.Link(sDtTi,'Doppler_Width'               ,'','',kSOFT0,nX,nY,Self);
  MeVma := LFIO.Link(sDtTi,'Macro_Turbulence'            ,'','',kSOFT0,nX,nY,Self);
  MeB0  := LFIO.Link(sDtTi,'Source_Function'             ,'','',kSOFT0,nX,nY,Self);
  MeBeta:= LFIO.Link(sDtTi,'Source_Function_Gradient'    ,'','',kSOFT0,nX,nY,Self);
  MeHL  := LFIO.Link(sDtTi,'Longitudinal_Field'          ,'','',kSOFT0,nX,nY,Self);

(*
  MeCI  .Link('Continuum_Intensity'         ,kSoft0,Self);
  MeCIO .Link('Original_Continuum_Intensity',kSoft0,Self);
  MeQUV .Link('Polarization'                ,kSoft0,Self);
  MeH   .Link('Field_Strength'              ,kSoft0,Self);
  MeGM  .Link('Field_Inclination'           ,kSoft0,Self);
  MeXI  .Link('Field_Azimuth'               ,kSoft0,Self);
  MeVLo1.Link('Doppler_Shift1'              ,kSoft0,Self);
  MeVLo2.Link('Doppler_Shift2'              ,kSoft0,Self);
  MeLiSt.Link('Line_Strength'               ,kSoft0,Self);
  MeA   .Link('Damping'                     ,kSoft0,Self);
  MeWD  .Link('Doppler_Width'               ,kSoft0,Self);
  MeVma .Link('Macro_Turbulence'            ,kSoft0,Self);

  MeB0  .Link('Source_Function'             ,kSoft0,Self);
  MeBeta.Link('Source_Function_Gradient'    ,kSoft0,Self);

  MeHL  .Link('Longitudinal_Field'          ,kSoft0,Self);
*)

end; (* TLFITS.MeFITSInit *)
}

procedure TLFITS.CollectPath;
begin
  if kDir = 1 then Exit;
  if Not Assigned(Dir) then Dir := TDirList.Create;
  Dir.CollectExt(sPath,'fits');
  Dir.SortInsideExt;
end;


function TLFITS.AKey(sKey:string):TARe;
var A : TARe; I : integer; aFITS : TFITS; r : real;
begin
  SetLength(A,Self.Count+1);
  for I := 1 to Self.Count do begin
    aFITS := TFITS(Items[I-1]);
    r := aFITS.GetKeyVal(sKey);
    A[I] := r;
  end;
  result := A;
end;



(* загрузить список хидеров сырых файлов FITS *)
procedure TLFITS.LoadHeaders;
var
  aDir : TDirRec;
  iX   : integer;
  aFITS: TFITS;
begin
  Time_routine('LFITS.LoadHeaders',true);

  if Not Assigned (Self) then begin
    WarnAbs('LFITS Not Assigned!');
    Exit;
  end;

  if SetBit.IsBit(Self.KStep,1) then begin
//  WarnAbs('TLFITS.LoadHeaders WARNING!'+#13#10+
//  'Headers Already Loaded!!!');
    Exit;
  end;

  if Not SetBit.IsBit(Self.KStep,0) then begin
    WarnAbs('TLFITS.LoadHeaders ERROR!'+#13#10+
    'kStep='+ISt(kStep)+' => Path_Name Not Linked Yet!!!');
    Exit;
  end;

  CollectPath;  (* загрузить имена FITS файлов в структуру Dir *)
  nX := Dir.Count;

{
  (*------ интегральные величины ---------*)
  rCntH0  : real; (* средн.знач.непр.спектра в немаг.областях в ед.шкалы изм.*)
  ACnYH0  : TARe; (* массив значений rCntYH0 вдоль щели                      *)
  ACnXH0  : TARe; (* массив значений rCntXH0 вдоль оси X                     *)

  AXP     : TAIn; (* массив SLITPOS вдоль оси X                              *)
           НУЖЕН БУДЕТ ДЛЯ РАСЧЁТА ACnXH0
//AXX     : TARe; (* массив координаты X (arcsec) вдоль оси X                *)
}

  nHead_s  := 0; (* суммарный размер строк заголовков в байтах *)

  iX := 0;
  aDir := Dir.Get(iX);
  aFITS := TFITS.Create;
  aFITS.Link(iX,Self);
  aFITS.ReadHeader;
  Self.Add(pointer(aFITS));

  Self.tMin0 := aFITS.tMin;

  nHead_s := nHead_s + aFITS.HSL.Count * 80;

//  nData_s  : longint; (* суммарный размер данных в байтах *)
//  nHead_s  : longint; (* суммарный размер строк заголовков в байтах *)



//SetLength(AXP,nX+1);
  SetLength(AXX,nX+1); (* X в секундах дуги            *)
  SetLength(AXT,nX+1); (* X в минутах от начала сеанса *)
  SetLength(AXvO,nX+1);(* $DOP_RCV в метрах в секунду  *)

  SetLength(ACnXH0,nX+1);
  SetLength(ACnYH0,nY+1);

//AXP[iX+1] := aFITS.iXP;
//AXX[iX+1] := aFITS.rXI;
  AXX[iX+1] := aFITS.rX0;
  AXT[iX+1] := 0; // = aFITS.tMin - Self.tMin0;
  AXvO[iX+1]:= aFITS.dV_los;

  for iX := 1 to nX-1 do begin
    aDir := Dir.Get(iX);
    aFITS := TFITS.Create;
    aFITS.Link(iX,Self);          // Self = LFITS
//  aFITS.Link(aDir.Name,I,Self);
    aFITS.ReadHeader;
    nHead_s := nHead_s + aFITS.HSL.Count * 80;

//  AXX[iX+1] := aFITS.rXI;
    AXX[iX+1] := aFITS.rX0;
    AXT[iX+1] := aFITS.tMin - Self.tMin0;
    AXvO[iX+1]:= aFITS.dV_los;
{
    aFITS.LoadData;
    aFITS.DefaultContArea;
    aFITS.SetLinesArea(8,54,55,100);
    aFITS.CalcSlitConts;
    aFITS.CalcCGravs;
}
    Self.Add(pointer(aFITS));

//  AXP[iX+1] := aFITS.iXP;
//  AXX[iX+1] := aFITS.rX0;

  end;


  SetBit.BISB(KStep,1); (* = +2 *)

  Self.GetDuration;
  Self.Get_dVlos; (* заполнить информацию из поля DOP_RCV - поправка скорости *)
                  (*   -- сводную информацию по сеансу                        *)
  Self.UpDate;

  Time_routine('LFITS.LoadHeaders',false);
end; (* TLFITS.LoadHeaders *)

procedure TLFITS.CalcIntegrVal;
(* рассчитать интегральные данные для всего сеанса наблюдений *)
var iX : integer; aFITS : TFITS; sLC1,sLC2 : real;
begin
  Time_routine('LFITS.CalcIntegrVal',true);
  if Self.Count = 0 then Exit;

  if SetBit.IsBit(Self.KStep,3) then begin
    WarnAbs('TLFITS.CalcIntegrVal WARNING!'+#13#10+
    'IntegralVals Already Calculated!!!');
    Exit;
  end;

  if Not SetBit.IsBit(Self.KStep,2) then begin
    WarnAbs('TLFITS.CalcIntegrVal ERROR!'+#13#10+
    'Data Not Loaded Yet!!!');
    Exit;
  end;

  sLC1 := 0;
  sLC2 := 0;

  for iX := 0 to Self.Count-1 do begin (* по каждому из FITS-ев *)
    aFITS := TFITS(Self.Items[iX]);

    aFITS.DefaultContArea;
//  aFITS.SetLinesArea(il1,il2,il3,il4,il5,il6);

    aFITS.BigCalc; (* все расчёты *)

    sLC1 := sLC1 +aFITS.rLC1;
    sLC2 := sLC2 +aFITS.rLC2;
  end;

  rLC1M := sLC1 / Self.Count;
  rLC2M := sLC2 / Self.Count;

  RawMeanContH0;

  SetBit.BISB(KStep,3); (* = +8 *)
  Time_routine('LFITS.CalcIntegrVal',false);
end; (* TLFITS.CalcIntegrVal *)


(* создать SWFITS файл и выгрузить в него нулевой хидер *)
procedure TLFITS.SWHeaderSave;
var sFNa,sFNa2 : string; ib0 : integer;
begin
  sFNa := DirAndName(sPOut,sFSW);
  Self.MakeOutHeader; (* выходной хидер нулевого уровня *)
                      (* многие поля могут быть заполнены нулями *)
  sFNa2 := swFile.BakFileName(sFNa);
  ib0 := 0;
  WriteHeader(sFNa,ib0,Self.HSL);  (* вывести в файл Header нулевого уровня *)
//ib0 := Self.HSL.Count*80;
end;






(* создать и последовательно выгрузить выходной SunWorld файл *)
procedure TLFITS.MakeSWOutFile;
var sFNa,sFNa2 : string;
  ib0,if0 : longint;
  k : integer;

(*------------------------------------------------*)
(* вложенная процедура для выгрузки одной "карты" *)
(* использует глобальную переменную == ib0 ==     *)
(* которая показывает отступ начала записи        *)
(* после записи встаёт в первую позицию след.блока*)
procedure WrFITOut(aOu:TFIOut);
var
  ib1,nb,if0 : longint;
  B : array[1..80000] of byte;
//ib00,if00 : longint;

  i : integer;
begin
//if00 := swFile.File_Size(sFNa);
  aOu.SWOUTHeader;                  (* создать Хидер блока для aOu *)
  aOu.nb0 := ib0;
  WriteHeader(sFNa,ib0,aOu.HSL); (* записать строки, начиная со смещения ib0 *)
//ib00 := ib0;  // DEBUG

  aOu.nbHead := aOu.HSL.Count*80;
  ib0 := ib0 + aOu.HSL.Count*80;

  aOu.nbData0 := ib0;
  aOu.nbData  := nX*nY*4;

  // DEBUG
//for i := 0 to aOu.HSL.Count-1 do self.SLOut.Add(aOu.HSL.Strings[i]);
//                                if0 := swFile.File_Size(sFNa);
//WarnAbs('1 ib0='+ISt(ib00)+' => '+ISt(ib0)+' fSize='+ISt(if00)+' => '+ISt(if0));

  WriteAR4R4(sFNa,ib0,aOu.aData);(* записать массив aData со смещения ib0 *)

//ib00 := ib0;

  ib0 := ib0 + nX*nY*4; // =  ib0 := aOu.nbData0 + aOu.nbData;

//if00 := if0;
//if0 := swFile.File_Size(sFNa);
//WarnAbs('2 ib0='+ISt(ib00)+' => '+ISt(ib0)+' fSize='+ISt(if00)+' => '+ISt(if0));

  (* подравняем конец записи до величины, кратной 512 *)
//if00 := if0;
//ib00 := ib0;

  ib1 := (((ib0-1) div 512) + 1) * 512;
  nb := ib1 - ib0;
  if nb > 0 then begin
    FillChar(B[1],nb,#0);
    if Not FileWrRec(sFNa,ib0,nb,1,B) then begin

    end;
    ib0 := ib1;
  end;
//if0 := swFile.File_Size(sFNa);
//WarnAbs('3 ib0='+ISt(ib00)+' => '+ISt(ib0)+' fSize='+ISt(if00)+' => '+ISt(if0));
end;
(* вложенная процедура для выгрузки одной "карты" *)
(*------------------------------------------------*)




begin
  Time_routine('LFITS.MakeSWOutFile',true);
  (* получим путь и имя файла *)
//sPOut : string; (* путь папки с выходными FITS-ами: 20190622_1645 *)
//sFN   : string; (* имя выходного файла - совпадает с именем выходной папки *)

  sFNa := DirAndName(sPOut,sFSW);
  Self.MakeOutHeader; (* выходной хидер нулевого уровня *)
                      (* многие поля могут быть заполнены нулями *)

  sFNa2 := swFile.BakFileName(sFNa);

{
  if FileExists(sFNa) then begin
    if0 := swFile.File_Size(sFNa);
    if swSayer.Query('Файл <'+sFNa+'>'+#13#10+
    'существует, его длина '+ISt(if0)+#13#10+
    'Вы действительно хотите его перезаписать?')
    then DeleteFile(sFNa)
    else Exit;
  end;
}

  ib0 := 0;
  WriteHeader(sFNa,ib0,Self.HSL);  (* вывести в файл Header нулевого уровня *)
  ib0 := Self.HSL.Count*80;



  if Not Assigned(OuCont) then begin
    WarnAbs('TLFITS.MakeSWOutFile OutFITs Not Assigned Yet!'+#13#10+
    'fNAME=<'+sFNa+'>');
    Exit;
  end;



  OuCont.Save;  //  WrFITOut(OuCont);
  WrFITOut(OuGc1);
  WrFITOut(OuGc2);
  WrFITOut(OuKVI);
//  WrFITOut(OuII0);
//  WrFITOut(OuVV0);
  WrFITOut(OuW1);
  WrFITOut(OuW2);
  WrFITOut(OuH1);
  WrFITOut(OuH2);
  WrFITOut(OuHG1);
  WrFITOut(OuHG2);     (* 12 карт *)

  (* некоторые карты в FITS файл не записываются, т.к. *)
  (* их можно пересчитать внутри LFITS.BigCalc2        *)
  (*---------------------------------------------------*)



  for k := 3 to 5 do begin  (* ещё 18 карт *)
    WrFITOut(Ou35C1[k]);
    WrFITOut(Ou35C2[k]);
    WrFITOut(Ou35I1[k]);
    WrFITOut(Ou35I2[k]);
    WrFITOut(Ou35D1[k]);
    WrFITOut(Ou35D2[k]);
  end;

  for k := 1 to MBiSec do begin  (* ещё 20 карт *)
    WrFITOut(OuBiC1[k]);
    WrFITOut(OuBiC2[k]);
    WrFITOut(OuBiW1[k]);
    WrFITOut(OuBiW2[k]);
  end;


  Time_routine('LFITS.MakeSWOutFile',false);
end; (* TLFITS.MakeSWOutFile *)




procedure TLFITS.CheckDataLength;
var k : integer;
begin
  if Length(OuCont.aData) > 0 then Exit;

  SetLength(OuCont.aData,nX,nY);
  SetLength(OuGc1 .aData,nX,nY);
  SetLength(OuGc2 .aData,nX,nY);
  SetLength(OuKVI .aData,nX,nY);
//  SetLength(OuII0 .aData,nX,nY);
//  SetLength(OuVV0 .aData,nX,nY);
  SetLength(OuW1  .aData,nX,nY);
  SetLength(OuW2  .aData,nX,nY);
  SetLength(OuH1  .aData,nX,nY);
  SetLength(OuH2  .aData,nX,nY);
  SetLength(OuHG1 .aData,nX,nY);
  SetLength(OuHG2 .aData,nX,nY);


  for k := 3 to 5 do begin
    SetLength(Ou35C1[k].aData,nX,nY);
    SetLength(Ou35C2[k].aData,nX,nY);
    SetLength(Ou35I1[k].aData,nX,nY);
    SetLength(Ou35I2[k].aData,nX,nY);
    SetLength(Ou35D1[k].aData,nX,nY);
    SetLength(Ou35D2[k].aData,nX,nY);
  end;

  for k := 1 to mBisec do begin
    SetLength(OuBiC1[k].aData,nX,nY);
    SetLength(OuBiC2[k].aData,nX,nY);
    SetLength(OuBiW1[k].aData,nX,nY);
    SetLength(OuBiW2[k].aData,nX,nY);
  end;

end; (* TLFITS.CheckDataLength *)



procedure TLFITS.RowFITSRun1; (* первый проход загрузки данных в SW-FITS файл *)
var ix : integer; aFITS : TFITS;

  AD0  : TAIn; (* значения пиковых по глубине точек *)


begin
  Time_routine('LFITS.RowFITSRun1',true);

  (* LFITS должен быть уже загружен *)
  (* берём FITS файл посередине поля *)
  ix := Self.nX div 2;

  (* загружаем данные *)
  aFITS := TFITS(Self.Items[ix]);
  aFITS.LoadData;

  (* заполняем массивы Cont *)
{
  aFITS.ACnt : TARe; (* уровень континуума. Не нормировано! *)
               (* расчёт по наиболее высокой точке    *)
               (*   после сглаживания                 *)
  (* техологические, временные массивы *)

//ASI  : TALI; (* сумма значений I      по длинам волн array of LongInt *)

  (* оценочные массивы *)
  AKVI : TARe; (* отношения W_abs(V)/W_I *)
}



  aFITS.Done;

  Time_routine('LFITS.RowFITSRun1',false);
end; (* RowFITSRun1 *)



procedure TLFITS.CalcCont;
var iX,iY,iY1 : integer;
  aFITS : TFITS;
  CONT : real4;
begin
{
  if Not Self.swFITSInit then begin
    WarnAbs('Не удалось инициализировать Ou-FITS-ы!');
    Exit;
  end;
}

  if Not Assigned(OuCONT) then Self.swCnt105_Init;(* добавляем в LFIO OuCont *)


  for iX := 0 to Self.Count-1 do begin (* по каждому из FITS-ев *)
    aFITS := TFITS(Self.Items[iX]);
    aFITS.LoadData;

    aFITS.CalcSlitConts; (* Рассчитать FITS.ACnt *)

    aFITS.CalcSums;   (* там есть и поляризации! *)
//  aFITS.BigCalc;


    if  Assigned(aFITS.ACnt) then begin  (* если определён ACnt:TARe *)
      if (length(aFITS.ACnt)-1) < nY then begin
        WarnAbs('LFITS.LoadRowData iX='+ISt(iX)+' nY='+ISt(nY)+
                 ' length(A)-1='+ISt(length(aFITS.ACnt)-1));
      end
      else begin

      //CheckDataLength;
        if Length(OuCONT.aData) = 0
        then SetLength(OuCONT.aData,nX,nY);


        for iY := 0 to nY-1 do begin
          iY1 := iY + 1;
                         CONT := aFITS.ACnt[iY1];
          OuCONT.aData[iX,iY] := CONT;
        end; (* for iY - цикл по позициям на щели iY внутри FITS файла *)
      end;
    end;

{
    if aFITS.iIMax > iIMax then iIMax := aFITS.iIMax;
    if aFITS.iIMin < iIMin then iIMin := aFITS.iIMin;
    if aFITS.iVMax > iVMax then iVMax := aFITS.iVMax;
    if aFITS.AbsVIMax > AbsVIMax then AbsVIMax := aFITS.AbsVIMax;
}

    if Self.QLight then aFITS.ClearData;
  end;
  SetBit.BISB(OuCONT.kLoad,3);  (* бит 3 - производные данные *)
  OuCONT.MinMaxMean;

//LFIO.UpDate;
end;


procedure TLFITS.CalcCont0;
var iX,iY,iY1,NN : integer;
  aFITS : TFITS;
  CONT, LCONT  : real4;
  CONT2,LCONT2 : real4;
  sV : string;
  sV2: string;
  sSes : string;
begin

  sV := '20241023';
  sV2:= '20241122';
  if Not Assigned(OuCONT) then begin
    if Not OuAny_Init(OuCont,'CONT' ,'Continuum Intensity', sV) then Exit;
    if Not OuAny_Init(OuAny2,'CONT2','Cont.Int.-Second Maximum',sV2) then Exit;
    if Not OuAny_Init(OuAny1,'LCONT','L_idx for Cont Level',sV) then Exit;
    if Not OuAny_Init(OuAny3,'LCONT2','L_idx for Cont2 Level',sV2) then Exit;
  end;


  NN := length(ISt(Self.Count));
  sSes := Self.sDtTi;
  sSes := copy(sSes,7,7);

  for iX := 0 to Self.Count-1 do begin (* по каждому из FITS-ев *)

    App.Inf.LogS('UM',sSes+'|CONT|iX='
                  +NumStr(iX+1,NN)+'/'+ISt(Self.Count));
    App.Inf.Play;(* отобразить *)

    aFITS := TFITS(Self.Items[iX]);
    aFITS.LoadData;

    aFITS.CalcSlitContsL; (* Рассчитать FITS.ACnt *)


    (* перекидываем рассчитанные в aFITS два вектора *)
    (* в два массива внутри LFITS                    *)

    if  Assigned(aFITS.ACnt) then begin  (* если определён ACnt:TARe *)
      if (length(aFITS.ACnt)-1) < nY then begin
        WarnAbs('LFITS.CalcCont0 iX='+ISt(iX)+' nY='+ISt(nY)+
                 ' length(A)-1='+ISt(length(aFITS.ACnt)-1));
      end
      else begin

        if Length(OuCONT.aData) = 0
        then SetLength(OuCONT.aData,nX,nY);
        SetLength(Self.OuAny1.aData,nX,nY);
        SetLength(Self.OuAny2.aData,nX,nY);
        SetLength(Self.OuAny3.aData,nX,nY);

        for iY := 0 to nY-1 do begin
          iY1 := iY + 1;
                         CONT := aFITS.ACnt[iY1];
                        LCONT := aFITS.AWo1[iY1];
                        CONT2 := aFITS.AWo2[iY1];
                       LCONT2 := aFITS.AWo3[iY1];
          OuCONT.aData[iX,iY] := CONT;
          OuAny1.aData[iX,iY] := LCONT;
          OuAny2.aData[iX,iY] := CONT2;
          OuAny3.aData[iX,iY] := LCONT2;
        end; (* for iY - цикл по позициям на щели iY внутри FITS файла *)
      end;
    end;

    if Self.QLight then aFITS.ClearData;
  end;

  SetBit.BISB(OuCONT.kLoad,3);  (* бит 3 - производные данные *)
  SetBit.BISB(OuAny1.kLoad,3);
  SetBit.BISB(OuAny2.kLoad,3);
  SetBit.BISB(OuAny3.kLoad,3);
  OuCONT.MinMaxMean;
  OuAny1.MinMaxMean;
  OuAny2.MinMaxMean;
  OuAny3.MinMaxMean;

//LFIO.UpDate;
end;



procedure TLFITS.Init_Ou_d0(var Q4:boolean);
var sV : string;
begin
  (* создаём или присоединяем карты *)
  sV := '2022';
  if Not Assigned(Ou_d01) then begin
    OuAny_Init(Ou_d01,'d01'  ,'Central Depth d0 for 6301',sV);
    OuAny_Init(Ou_d02,'d02'  ,'Central Depth d0 for 6302',sV);
    OuAny_Init(Ou_c01,'Ld01' ,'Wavelength (Pix) of d0 for 6301',sV);
    OuAny_Init(Ou_c02,'Ld02' ,'Wavelength (Pix) of d0 for 6302',sV);
  end;

  Q4 := (length(Ou_d01.aData) = 0);

  if Q4 then begin
    Ou_d01.AssignMem(Self.Count,nY);
    Ou_d02.AssignMem(Self.Count,nY);
    Ou_c01.AssignMem(Self.Count,nY);
    Ou_c02.AssignMem(Self.Count,nY);
  end;
end;

procedure TLFITS.Ou_d0_Fill(iX,iY:integer;aFITS : TFITS);
var   d01,d02,Ld01,Ld02 : real4; iY1 : integer;
begin
      iY1 := iY + 1;
         d01  := aFITS.AI_d01[iY1];
         d02  := aFITS.AI_d02[iY1];
        Ld01  := aFITS.AILd01[iY1];
        Ld02  := aFITS.AILd02[iY1];
        Ou_d01.aData[iX,iY] := d01;
        Ou_d02.aData[iX,iY] := d02;
        Ou_c01.aData[iX,iY] := Ld01;
        Ou_c02.aData[iX,iY] := Ld02;
end;

procedure TLFITS.Ou_d0_MaxMin;
begin
    SetBit.BISB(Ou_d01.kLoad,3);  (* бит 3 - производные данные *)
    SetBit.BISB(Ou_d02.kLoad,3);  (* бит 3 - производные данные *)
    SetBit.BISB(Ou_c01.kLoad,3);
    SetBit.BISB(Ou_c02.kLoad,3);
    Ou_d01.MinMaxMean;
    Ou_d02.MinMaxMean;
    Ou_c01.MinMaxMean;
    Ou_c02.MinMaxMean;
end;


procedure TLFITS.CalcCxx(d:real);
var iX,iY,iY1 : integer;
  aFITS : TFITS;
  rC501,rC502 : real4;
  d01,d02 : real4;
  Ld01,Ld02 : real4;
  Q4 : boolean;
  sxx : string;
  sV  : string;
begin

  sxx := swStr.NumStr(Round(d*100),2);(* целое в строку с ведущими нулями *)

{
  if Assigned (Ou_d01) then Ou_d01.Done;
  if Assigned (Ou_d02) then Ou_d02.Done;
  if Assigned (Ou_c01) then Ou_c01.Done;
  if Assigned (Ou_c02) then Ou_c02.Done;
  if Assigned (OuAny5) then OuAny5.Done;
  if Assigned (OuAny6) then OuAny6.Done;
}

  (* создаём или присоединяем карты *)
  Init_Ou_d0(Q4);

  sV := '2022';

  OuAny_Init(OuAny5,'LC'+sxx+'1','Bisector (Cont-d0)/2 for 6301',sV);
  OuAny_Init(OuAny6,'LC'+sxx+'2','Bisector (Cont-d0)/2 for 6302',sV);
  OuAny5.AssignMem(Self.Count,nY);
  OuAny6.AssignMem(Self.Count,nY);

  for iX := 0 to Self.Count-1 do begin (* по каждому из FITS-ев *)
    aFITS := TFITS(Self.Items[iX]);
    aFITS.LoadData;

    if Not aFITS.ReturnSlitConts then aFITS.CalcSlitConts;
    aFITS.CalcCxx(d);

    for iY := 0 to nY-1 do begin
      iY1 := iY + 1;

      if Q4 then Ou_d0_Fill(iX,iY,aFITS);

      rC501 := aFITS.ALC51[iY1];
      rC502 := aFITS.ALC52[iY1];
      OuAny5.aData[iX,iY] := rC501;
      OuAny6.aData[iX,iY] := rC502;

    end; (* for iY - цикл по позициям на щели iY внутри FITS файла *)
    if Self.QLight then aFITS.ClearData;
  end;

  if Q4 then Ou_d0_MaxMin;

  SetBit.BISB(OuAny5.kLoad,3);
  SetBit.BISB(OuAny6.kLoad,3);
  OuAny5.MinMaxMean;
  OuAny6.MinMaxMean;
end;

procedure TLFITS.CalcDH;
var iX,iY,iY1 : integer;
  Dt1,Dt2,ka1,ka2 : real;
  Dk1,Dk2,H1,H2 : real;

  aFITS : TFITS;
  QErr : boolean;
  sV, sSes : string;
begin


  if Assigned (OuAny1) then OuAny1.Done;
  if Assigned (OuAny2) then OuAny2.Done;
  if Assigned (OuAny3) then OuAny3.Done;
  if Assigned (OuAny4) then OuAny4.Done;
  if Assigned (OuAny5) then OuAny5.Done;
  if Assigned (OuAny6) then OuAny6.Done;
  if Assigned (OuAny7) then OuAny7.Done;
  if Assigned (OuAny8) then OuAny8.Done;

  sV := '2022';

  OuAny_Init(OuAny1,'Dtilt1', 'DLDbyTilt,B for 6301',sV);
  OuAny_Init(OuAny2,'Dtilt2', 'DLDbyTilt,B for 6302',sV);
  OuAny_Init(OuAny3,'BWdl',   'B by Width for 6301',sV);
  OuAny_Init(OuAny4,'BWd2',   'B by Width for 6302',sV);
  OuAny_Init(OuAny5,'Dktilt1','NormCoeff for DLDtilt, 6301',sV);
  OuAny_Init(OuAny6,'Dktilt2','NormCoeff for DLDtilt, 6302',sV);
  OuAny_Init(OuAny7,'kat1',   'CoreSlope by WingTilt 6301',sV); // t = tilt
  OuAny_Init(OuAny8,'kat2',   'CoreSlope by WingTilt 6302',sV);

  OuAny1.AssignMem(Self.Count,nY);
  OuAny2.AssignMem(Self.Count,nY);
  OuAny3.AssignMem(Self.Count,nY);
  OuAny4.AssignMem(Self.Count,nY);
  OuAny5.AssignMem(Self.Count,nY);
  OuAny6.AssignMem(Self.Count,nY);
  OuAny7.AssignMem(Self.Count,nY);
  OuAny8.AssignMem(Self.Count,nY);

  sSes := Self.sDtTi;
  sSes := Copy(sSes,7,7);


  for iX := 0 to Self.Count-1 do begin (* по каждому из FITS-ев *)

    App.Inf.LogS('UM',sSes+' LFITS.Calc_D,H|iX='+NumStr(iX+1,4)+
                 '/'+ISt(Self.Count));
    App.Inf.Play;(* отобразить *)

    aFITS := TFITS(Self.Items[iX]);
    aFITS.LoadData;

    aFITS.CalcDH;

    for iY := 0 to nY-1 do begin
      iY1 := iY + 1;
      Dt1 := aFITS.AWo1[iY1];
      Dt2 := aFITS.AWo3[iY1];
      H1  := aFITS.AWo2[iY1];
      H2  := aFITS.AWo4[iY1];
      Dk1 := aFITS.AWo5[iY1];
      Dk2 := aFITS.AWo7[iY1];
      ka1 := aFITS.AWo6[iY1];
      ka2 := aFITS.AWo8[iY1];

      OuAny1.aData[iX,iY] := Dt1;
      OuAny2.aData[iX,iY] := Dt2;
      OuAny3.aData[iX,iY] := H1;
      OuAny4.aData[iX,iY] := H2;
      OuAny5.aData[iX,iY] := Dk1;
      OuAny6.aData[iX,iY] := Dk2;
      OuAny7.aData[iX,iY] := ka1;
      OuAny8.aData[iX,iY] := ka2;
    end; (* for iY - цикл по позициям на щели iY внутри FITS файла *)
    if Self.QLight then aFITS.ClearData;
  end;

  SetBit.BISB(OuAny1.kLoad,3);  (* бит 3 - производные данные *)
  SetBit.BISB(OuAny2.kLoad,3);
  SetBit.BISB(OuAny3.kLoad,3);
  SetBit.BISB(OuAny4.kLoad,3);
  SetBit.BISB(OuAny5.kLoad,3);
  SetBit.BISB(OuAny6.kLoad,3);
  SetBit.BISB(OuAny7.kLoad,3);
  SetBit.BISB(OuAny8.kLoad,3);
  OuAny1.MinMaxMean;
  OuAny2.MinMaxMean;
  OuAny3.MinMaxMean;
  OuAny4.MinMaxMean;
  OuAny5.MinMaxMean;
  OuAny6.MinMaxMean;
  OuAny7.MinMaxMean;
  OuAny8.MinMaxMean;
end;



procedure TLFITS.CalcDFull;
var iX,iY,iY1 : integer;
  DF1,DF2,ka1,ka2 : real;
  Dk1,Dk2,d01,d02 : real;

  aFITS : TFITS;
  QErr : boolean;
  sV,sSes : string;
begin

//  LFITS.OuAny1 := LFIO.GetFIOut(sDt0,sTi0,'LWl1');
//  LFITS.OuAny2 := LFIO.GetFIOut(sDt0,sTi0,'LWr1');

  if Assigned (OuAny1) then OuAny1.Done;
  if Assigned (OuAny2) then OuAny2.Done;
  if Assigned (OuAny3) then OuAny3.Done;
  if Assigned (OuAny4) then OuAny4.Done;
  if Assigned (OuAny5) then OuAny5.Done;
  if Assigned (OuAny6) then OuAny6.Done;
  if Assigned (OuAny7) then OuAny7.Done;
  if Assigned (OuAny8) then OuAny8.Done;

  sV := '2022';

  OuAny_Init(OuAny1,'DFull1', 'DLD+DLH for 6301',sV);
  OuAny_Init(OuAny2,'DFull2', 'DLD+DLH for 6302',sV);
  OuAny_Init(OuAny3,'kaF1',   'CoreSlope for B=0, 6301',sV);
  OuAny_Init(OuAny4,'kaF2',   'CoreSlope for B=0, 6302',sV);
  OuAny_Init(OuAny5,'DkFull1','NormCoeff for DLDFull, 6301',sV);
  OuAny_Init(OuAny6,'DkFull2','NormCoeff for DLDFull, 6302',sV);
  OuAny_Init(OuAny7,'d0Full1','Max depth d0 for DLDFull, 6301',sV);
  OuAny_Init(OuAny8,'d0Full2','Max depth d0 for DLDFull, 6302',sV);

  OuAny1.AssignMem(Self.Count,nY);
  OuAny2.AssignMem(Self.Count,nY);
  OuAny3.AssignMem(Self.Count,nY);
  OuAny4.AssignMem(Self.Count,nY);
  OuAny5.AssignMem(Self.Count,nY);
  OuAny6.AssignMem(Self.Count,nY);
  OuAny7.AssignMem(Self.Count,nY);
  OuAny8.AssignMem(Self.Count,nY);


  sSes := Self.sDtTi;
  sSes := Copy(sSes,7,7);

  for iX := 0 to Self.Count-1 do begin (* по каждому из FITS-ев *)

    // User Massage
    App.Inf.LogS('UM',sSes+' LFITS.CalcD_Full|iX='+NumStr(iX+1,4)+
                 '/'+ISt(Self.Count));
    App.Inf.Play;(* отобразить *)

    aFITS := TFITS(Self.Items[iX]);
    aFITS.LoadData;

    aFITS.CalcDFull; //    (QErr);
          //    if QErr then begin
          //      WarnAbs('CalcLW-Err iX='+ISt(iX));
          //    end;

    for iY := 0 to nY-1 do begin
      iY1 := iY + 1;
      DF1 := aFITS.AWo1[iY1];
      DF2 := aFITS.AWo3[iY1];
      ka1 := aFITS.AWo2[iY1];
      ka2 := aFITS.AWo4[iY1];
      Dk1 := aFITS.AWo5[iY1];
      Dk2 := aFITS.AWo7[iY1];
      d01 := aFITS.AWo6[iY1];
      d02 := aFITS.AWo8[iY1];


      // 3.4 E-38  максимальное real4=single число
      // 1.18E-38  минимальное число


      if abs(d01) > 3.3E38 then begin
        WarnAbs('ix='+ISt(iX)+' iY='+ISt(iY)+' >>>> d01='+EFSt0(d01,4));
        d01 := 3.3E38;
      end;
      if abs(d02) > 3.3E38 then begin
        WarnAbs('ix='+ISt(iX)+' iY='+ISt(iY)+' >>>> d02='+EFSt0(d02,4));
        d02 := 3.3E38;
      end;
      if abs(d01) < 2.5E-38 then begin
        WarnAbs('ix='+ISt(iX)+' iY='+ISt(iY)+' <<<< d01='+EFSt0(d01,4));
        d01 := 2.5E-38;
      end;
      if abs(d02) < 2.5E-38 then begin
        WarnAbs('ix='+ISt(iX)+' iY='+ISt(iY)+' <<<< d02='+EFSt0(d02,4));
        d02 := 2.5E-38;
      end;



      if abs(DF1) > 3.3E38 then begin
        WarnAbs('ix='+ISt(iX)+' iY='+ISt(iY)+' >>>> DF1='+EFSt0(DF1,4));
        DF1 := 3.3E38;
      end;
      if abs(DF2) > 3.3E38 then begin
        WarnAbs('ix='+ISt(iX)+' iY='+ISt(iY)+' >>>> DF2='+EFSt0(DF2,4));
        DF2 := 3.3E38;
      end;
      if abs(Dk1) > 3.3E38 then begin
        WarnAbs('ix='+ISt(iX)+' iY='+ISt(iY)+' >>>> Dk1='+EFSt0(Dk1,4));
        Dk1 := 3.3E38;
      end;
      if abs(Dk2) > 3.3E38 then begin
        WarnAbs('ix='+ISt(iX)+' iY='+ISt(iY)+' >>>> Dk2='+EFSt0(Dk2,4));
        Dk2 := 3.3E38;
      end;


      if abs(DF1) < 2.5E-38 then begin
        WarnAbs('ix='+ISt(iX)+' iY='+ISt(iY)+' <<<< DF1='+EFSt0(DF1,4));
        DF1 := 2.5E-38;
      end;
      if abs(DF2) < 2.5E-38 then begin
        WarnAbs('ix='+ISt(iX)+' iY='+ISt(iY)+' <<<< DF2='+EFSt0(DF2,4));
        DF2 := 1.9E38;
      end;
      if abs(Dk1) < 2.5E-38 then begin
        WarnAbs('ix='+ISt(iX)+' iY='+ISt(iY)+' >>>> Dk1='+EFSt0(Dk1,4));
        Dk1 := 2.5E-38;
      end;
      if abs(Dk2) < 2.5E-38 then begin
        WarnAbs('ix='+ISt(iX)+' iY='+ISt(iY)+' >>>> Dk2='+EFSt0(Dk2,4));
        Dk2 := 2.5E-38;
      end;



      OuAny1.aData[iX,iY] := DF1;
      OuAny2.aData[iX,iY] := DF2;
      OuAny3.aData[iX,iY] := ka1;
      OuAny4.aData[iX,iY] := ka2;
      OuAny5.aData[iX,iY] := Dk1;
      OuAny6.aData[iX,iY] := Dk2;
      OuAny7.aData[iX,iY] := d01;
      OuAny8.aData[iX,iY] := d02;
    end; (* for iY - цикл по позициям на щели iY внутри FITS файла *)
    if Self.QLight then aFITS.ClearData;
  end;

  SetBit.BISB(OuAny1.kLoad,3);  (* бит 3 - производные данные *)
  SetBit.BISB(OuAny2.kLoad,3);
  SetBit.BISB(OuAny3.kLoad,3);
  SetBit.BISB(OuAny4.kLoad,3);
  SetBit.BISB(OuAny5.kLoad,3);
  SetBit.BISB(OuAny6.kLoad,3);
  SetBit.BISB(OuAny7.kLoad,3);
  SetBit.BISB(OuAny8.kLoad,3);
  OuAny1.MinMaxMean;
  OuAny2.MinMaxMean;
  OuAny3.MinMaxMean;
  OuAny4.MinMaxMean;
  OuAny5.MinMaxMean;
  OuAny6.MinMaxMean;
  OuAny7.MinMaxMean;
  OuAny8.MinMaxMean;

end;


procedure TLFITS.Calc_W_Mom;
var sV : string; nMap : integer;
  iA, iLi, iX, iY, iYA : integer;
  iErr : integer;
  Ch1 : char;
  aFITS : TFITS;
  R : real;
  sSes : string;

//  SL : TStringList;
//  S : string;
begin
  sV := '2025_03';
  nMap := 7;

{
  SL := LFIO.RepSL;
  SL.Insert(0,'Calc_W_Mom_1: 10 карт из swFITS + 4 производные карты');
  WarnAbs(SL);
}

  (* подготовим место под карты для расчёта *)

  (* если они ранее использовались - обнулим *)
{
  for iA := 1 to nMap do begin
    for iLi := 1 to 2 do begin
      if Assigned (OuAny[iA,iLi]) then begin
        if OuAny[iA,iLi].QRun then
(*
        S := 'iMap='+ISt(iA)+' iLi='+ISt(iLi)+' map='+
        OuAny[iA,iLi].Name+' : '+OuAny[iA,iLi].s11;
        WarnAbs('Чистим '+S);
*)
        OuAny[iA,iLi].Done;
      end;
    end;
  end;



  SL := LFIO.RepSL;
  SL.Insert(0,'Calc_W_Mom_2: 10 карт из swFITS + 4 производные карты');
  WarnAbs(SL);
}

  (* заполним заголовки этих карт *)
  (* карты автоматически добавляются в LFIO *)
  for iLi := 1 to 2 do begin
    Ch1 := chr(ord('0')+iLi);

    iA := 1; OuAny_Init(OuAny[iA,iLi],'WI'+Ch1,
               'Equivalent Width for 630'+Ch1+' Bound+12pix',sV);
    iA := 2; OuAny_Init(OuAny[iA,iLi],'BMV'+Ch1,
               'B longitudinal for 630'+Ch1+' Bound+12pix',sV);
    iA := 3; OuAny_Init(OuAny[iA,iLi],'BML'+Ch1,
               'B transversal for 630'+Ch1+' Bound+12pix',sV);
    iA := 4; OuAny_Init(OuAny[iA,iLi],'Gm'+Ch1,
               'Field Inclination for 630'+Ch1,sV);
    iA := 5; OuAny_Init(OuAny[iA,iLi],'Xi'+Ch1,
               'Field Azimuth for 630'+Ch1,sV);

    iA := 6; OuAny_Init(OuAny[iA,iLi],'BLq'+Ch1,
               'B_trans Along Xi for 630'+Ch1,sV);
    iA := 7; OuAny_Init(OuAny[iA,iLi],'BLu'+Ch1,
               'B_trans Across Xi for 630'+Ch1,sV);
{
    iA := 3; OuAny_Init(OuAny[iA,iLi],'Q2M'+Ch1,
               'Q2norm_Moment for 630'+Ch1,sV);
    iA := 4; OuAny_Init(OuAny[iA,iLi],'U2M'+Ch1,
               'U2norm_Moment for 630'+Ch1,sV);
}
  end;


  // итого сейчас в LFIO
  // 14 карт перед вызовом процедуры Calc-W-Mom
  // + 2 * 7 выходных карт после Init
  // итого 28 карт, все с разными именами
{
  SL := LFIO.RepSL;
  SL.Insert(0,'10 карт из swFITS + 4 производные карты + 14 выходных карт');
  WarnAbs(SL);
}


  (* отведём место *)
  for iA := 1 to nMap do
    for iLi := 1 to 2 do
      OuAny[iA,iLi].AssignMem(Self.Count,nY);




  (* подстрока для отчета в "информатор" *)
  sSes := Self.sDtTi;          (* '20090123_061516' *)
  sSes := copy(sSes,7,7);      (* -> '23_0615'      *)

(*
  Карты CONT и CONT2 сейчас должны лежать в LFIO
  это делается перед вызовом LFITS.Calc_W_Mom
 *)


  for iX := 0 to Self.Count-1 do begin (* по каждому из FITS-ев *)

    // User Massage
    App.Inf.LogS('UM',sSes+' LFITS.Calc_W_Mom|iX='
                  +NumStr(iX+1,4)+'/'+ISt(Self.Count));
    App.Inf.Play;(* отобразить *)

    aFITS := TFITS(Self.Items[iX]);
    aFITS.LoadData;

    if Not aFITS.ReturnMid2MapsLine('CONT','CONT2',aFITS.aCnt,IErr) then begin
      WarnAbs('LFITS.Calc_W_Mom ERR='+ISt(IErr)+' IX='+ISt(IX)+#13#10+
      'Не удаётся заполнить FITS.ACnt из CONT+CONT2!');
      Exit;
    end;
    if Not aFITS.ReturnAnyMapLine('LIV1',aFITS.ALC1) then begin
      WarnAbs('LFITS.Calc_W_Mom не загружена карта LIV1');
      Exit;
    end;
    if Not aFITS.ReturnAnyMapLine('LIV2',aFITS.ALC2) then begin
      WarnAbs('LFITS.Calc_W_Mom не загружена карта LIV2');
      Exit;
    end;
    if Not aFITS.ReturnAnyMapLine('LBob1',aFITS.AWk1) then begin
      WarnAbs('LFITS.Calc_W_Mom не загружена карта LBob1');
      Exit;
    end;
    if Not aFITS.ReturnAnyMapLine('LBor1',aFITS.AWk2) then begin
      WarnAbs('LFITS.Calc_W_Mom не загружена карта LBor1');
      Exit;
    end;
    if Not aFITS.ReturnAnyMapLine('LBob2',aFITS.AWk3) then begin
      WarnAbs('LFITS.Calc_W_Mom не загружена карта LBob2');
      Exit;
    end;
    if Not aFITS.ReturnAnyMapLine('LBor2',aFITS.AWk4) then begin
      WarnAbs('LFITS.Calc_W_Mom не загружена карта LBor2');
      Exit;
    end;

  (*====================================*)
  (*                                    *)
  (*====================================*)

    aFITS.Calc_W_Mom;

  (*====================================*)
  (*                                    *)
  (*====================================*)

    for iY := 0 to nY-1 do begin
      iYA := iY + 1;
      for iLi := 1 to 2 do begin

        for iA := 1 to nMap do begin
          R := aFITS.A2[iA,iLi,iYA];
//        if R > 1.7E38 then R := 1.7E38;
          OuAny[iA,iLi].aData[iX,iY] := R;
        end;
      end;

    end; (* for iY - цикл по позициям на щели iY внутри FITS файла *)
    if Self.QLight then aFITS.ClearData;
  end; (* for iX *)

  for iA:= 1 to nMap do
    for iLi := 1 to 2 do begin
      SetBit.BISB(OuAny[iA,iLi].kLoad,3);  (* бит 3 - производные данные *)
      OuAny[iA,iLi].MinMaxMean;
    end;



end;

procedure TLFITS.Calc_LIV;
var iA,iLi,iX,iY,iYA,iErr,nD : integer;
    sV,sSes:string; Ch1:char; aFITS : TFITS; L : real;
begin
  sV := '2025_03';

  for iA := 1 to 4 do begin
//		LIpVb
//		LIpVr
//		LImVb
//		LImVr
    for iLi := 1 to 2 do begin
      if Assigned (OuAny[iA,iLi]) then OuAny[iA,iLi].Done;
    end;
  end;

  for iLi := 1 to 2 do begin
    Ch1 := chr(ord('0')+iLi);

    iA := 1; OuAny_Init(OuAny[iA,iLi],'LIV'+Ch1,
               'L_COG by I±V for 630'+Ch1+' at d[0.4..0.6]',sV);
    iA := 2; OuAny_Init(OuAny[iA,iLi],'LBIV'+Ch1,
               'LB by I±V for 630'+Ch1+' at d[0.4..0.6]',sV);
    iA := 3; OuAny_Init(OuAny[iA,iLi],'L-Wb'+Ch1,
               'L_FWHD_I±V_blue for 630'+Ch1,sV);
    iA := 4; OuAny_Init(OuAny[iA,iLi],'L-Wr'+Ch1,
               'L_FWHD_I±V_red for 630'+Ch1,sV);
  end;

  for iA := 1 to 4 do
    for iLi := 1 to 2 do
      OuAny[iA,iLi].AssignMem(Self.Count,nY);

  nD := length(ISt(Self.Count-1));

  (* подстрока для отчета в "информатор" *)
  sSes := Self.sDtTi;          (* '20090123_061516' *)
  sSes := copy(sSes,7,7);      (* -> '23_0615'      *)


  for iX := 0 to Self.Count-1 do begin (* по каждому из FITS-ев *)

    // User Massage
    App.Inf.LogS('UM','LFITS.Calc_LIV['+sSes+']iX='
                  +NumStr(iX+1,nD)+'/'+ISt(Self.Count));
    App.Inf.Play;(* отобразить *)

    aFITS := TFITS(Self.Items[iX]);
    aFITS.LoadData;

    if Not aFITS.ReturnMid2MapsLine('CONT','CONT2',aFITS.aCnt,IErr) then begin
      WarnAbs('LFITS.Calc_LIV ERR='+ISt(IErr)+#13#10+
      'Не удаётся заполнить FITS.ACnt из CONT+CONT2!');
      Exit;
    end;

    aFITS.Calc_LIV;
//  aFITS.CalcIVcog(Self.rVW1_0,Self.rVW2_0);

    for iY := 0 to nY-1 do begin
      iYA := iY + 1;
      for iLi := 1 to 2 do begin

        for iA := 1 to 4 do begin
          L := aFITS.A2[iA,iLi,iYA];
          OuAny[iA,iLi].aData[iX,iY] := L;
        end;
      end;

    end; (* for iY - цикл по позициям на щели iY внутри FITS файла *)
    if Self.QLight then aFITS.ClearData;
  end; (* for iX *)

  for iA:= 1 to 4 do
    for iLi := 1 to 2 do begin
      SetBit.BISB(OuAny[iA,iLi].kLoad,3);  (* бит 3 - производные данные *)
      OuAny[iA,iLi].MinMaxMean;

      if Not OuAny[iA,iLi].QRun then begin

        WarnAbs('LFITS.Calc_LIV ERR Ou['+ISt(iA)+','+ISt(iLi)+'] <'+
        OuAny[iA,iLi].Name+'> kRun=$'+HexI(OuAny[iA,iLi].kRun));

      end;

    end;

end; (* TLFITS.Calc_LIV *)



procedure TLFITS.CalcIV_COG;
var iX,iY,iYA : integer;
{
  il1,ir1,il2,ir2 : real;
  LI1,LI2 : real;
  lb1,lr1,lb2,lr2 : real;
}
  B,V : real;


  aFITS : TFITS;
  QErr : boolean;
  iA,iLi,iLev : integer;
  ch1 : char;
  sLev : string;

  FOCB0 : TFIOut;
  sV : string;
begin


//for iA := 1 to 5 do begin
  for iA := 1 to 9 + 9 do begin
    for iLi := 1 to 2 do begin
      if Assigned (OuAny[iA,iLi]) then OuAny[iA,iLi].Done;
    end;
  end;

  sV := '2022';

  for iLi := 1 to 2 do begin
    Ch1 := chr(ord('0')+iLi);

    for iLev := 1 to 9 do begin
      sLev := ISt(iLev);
      OuAny_Init(OuAny[iLev,iLi],'B'+Ch1+'IV'+sLev,
                 'B(I±V) for 630'+Ch1+' for Level '+sLev,sV);
      OuAny_Init(OuAny[iLev+9,iLi],'V'+Ch1+'IV'+sLev,
                 'V(I±V) for 630'+Ch1+' for Level '+sLev,sV);
    end;
  end;

  iLi := 1;
  OuAny_Init(OuAny[19,iLi],'IV_asym',
             '(I±V) peak asymmetry %',sV);



  for iA := 1 to 18 do
    for iLi := 1 to 2 do
      OuAny[iA,iLi].AssignMem(Self.Count,nY);
  OuAny[19,1].AssignMem(Self.Count,nY);


  for iX := 0 to Self.Count-1 do begin (* по каждому из FITS-ев *)

    // User Massage
    App.Inf.LogS('UM','LFITS.CalcIV_COG|iX='
                  +NumStr(iX+1,4)+'/'+ISt(Self.Count));
    App.Inf.Play;(* отобразить *)

    aFITS := TFITS(Self.Items[iX]);
    aFITS.LoadData;

    if Not aFITS.ReturnSlitConts then (* Заполнить FITS.ACnt *)
           aFITS.CalcSlitConts;       (* Рассчитать FITS.ACnt *)


//  warnAbs('ix=>>>'+ISt(iX));

    aFITS.CalcIVcog(Self.rVW1_0,Self.rVW2_0);

//  warnAbs('ix=<<<'+ISt(iX)+#13#10+'------------------');


    for iY := 0 to nY-1 do begin
      iYA := iY + 1;
      for iLi := 1 to 2 do begin

        for iLev := 1 to 9 do begin
          B := aFITS.A2[iLev  ,iLi,iYA];
          V := aFITS.A2[iLev+9,iLi,iYA];
          OuAny[iLev  ,iLi].aData[iX,iY] := B;
          OuAny[iLev+9,iLi].aData[iX,iY] := V;
        end;
      end;

      OuAny[19,1].aData[iX,iY] := aFITS.A2[19,1,iYA];

    end; (* for iY - цикл по позициям на щели iY внутри FITS файла *)
    if Self.QLight then aFITS.ClearData;
  end;

  for iA:= 1 to 18 do
    for iLi := 1 to 2 do begin
      SetBit.BISB(OuAny[iA,iLi].kLoad,3);  (* бит 3 - производные данные *)
      OuAny[iA,iLi].MinMaxMean;
    end;
  SetBit.BISB(OuAny[19,1].kLoad,3);  (* бит 3 - производные данные *)
  OuAny[19,1].MinMaxMean;

end;


procedure TLFITS.CalcIV_COG05;
var iX,iY,iYA : integer;
  B,V : real;

  aFITS : TFITS;
  QErr : boolean;
  iA,iLi,iLev : integer;
  ch1 : char;
  sLev : string;

  FOCB0 : TFIOut;
  sV : string;
begin


  for iA := 1 to 2 + 2 do begin      // 4 *
    for iLi := 1 to 2 do begin       // 2
      if Assigned (OuAny[iA,iLi]) then OuAny[iA,iLi].Done;
    end;
  end;

  sV := '2022';

  for iLi := 1 to 2 do begin
    Ch1 := chr(ord('0')+iLi);        // '1' или '2'

    for iLev := 1 to 2 do begin
      sLev := ISt(iLev);
      case iLev of
      1 : sLev := '06';
      2 : sLev := '03';
      end; (* case *)


      (* инициируем карты (и их имена) *)
      OuAny_Init(OuAny[iLev,iLi],'B'+Ch1+'IV'+sLev,
                 'B(I±V) for 630'+Ch1+' for Level 0.'+sLev,sV);
      OuAny_Init(OuAny[iLev+2,iLi],'V'+Ch1+'IV'+sLev,
                 'V(I±V) for 630'+Ch1+' for Level 0.'+sLev,sV);
    end;
  end;


  for iA := 1 to 2 + 2 do
    for iLi := 1 to 2 do
      OuAny[iA,iLi].AssignMem(Self.Count,nY);
//OuAny[5,1].AssignMem(Self.Count,nY);


  for iX := 0 to Self.Count-1 do begin (* по каждому из сырых FITS-ев *)

    // User Massage
    App.Inf.LogS('UM','LFITS.CalcIV_COG05|iX='
                  +NumStr(iX+1,4)+'/'+ISt(Self.Count));
    App.Inf.Play;(* отобразить *)

    aFITS := TFITS(Self.Items[iX]);
    aFITS.LoadData;

    (* нужны значения CONT *)
    if Not aFITS.ReturnSlitConts then (* Заполнить FITS.ACnt *)
           aFITS.CalcSlitConts;       (* Рассчитать FITS.ACnt *)


    (* нужны $VW1 и $VW2                             *)
    (* чтобы получать в итоге нормированные скорости *)
    aFITS.CalcIVcog05(Self.rVW1_0,Self.rVW2_0);
    (* результат заносим в массивы aFITS.A2[iLev,iLi,iY] *)



//  warnAbs('ix=<<<'+ISt(iX)+#13#10+'------------------');

    for iY := 0 to nY-1 do begin
      iYA := iY + 1;
      for iLi := 1 to 2 do begin

        for iLev := 1 to 2 do begin
          B := aFITS.A2[iLev  ,iLi,iYA];
          V := aFITS.A2[iLev+2,iLi,iYA];
          OuAny[iLev  ,iLi].aData[iX,iY] := B;
          OuAny[iLev+2,iLi].aData[iX,iY] := V;
        end;
      end;

//    OuAny[19,1].aData[iX,iY] := aFITS.A2[19,1,iYA];

    end; (* for iY - цикл по позициям на щели iY внутри FITS файла *)
    if Self.QLight then aFITS.ClearData;
  end;

  for iA:= 1 to 2 + 2 do
    for iLi := 1 to 2 do begin
      SetBit.BISB(OuAny[iA,iLi].kLoad,3);  (* бит 3 - производные данные *)
      OuAny[iA,iLi].MinMaxMean;
    end;
//SetBit.BISB(OuAny[19,1].kLoad,3);  (* бит 3 - производные данные *)
//OuAny[19,1].MinMaxMean;

end;




(* расчёт WingPositions LWb,LWr,LWI для 1 и 2 (6301/6302) *)
procedure TLFITS.CalcLW;
var iX,iY,iY1 : integer;
  il1,ir1,il2,ir2 : real;
  LI1,LI2 : real;
  lb1,lr1,lb2,lr2 : real;

  aFITS : TFITS;
  QErr : boolean;
  iA,iLi : integer;
  ch1 : char;

  FOCB0 : TFIOut;
  sV : string;
begin


//for iA := 1 to 5 do begin
  for iA := 1 to 3 do begin
    for iLi := 1 to 2 do begin
      if Assigned (OuAny[iA,iLi]) then OuAny[iA,iLi].Done;
    end;
  end;

  sV := '2022';

  for iLi := 1 to 2 do begin
    Ch1 := chr(ord('0')+iLi);
    OuAny_Init(OuAny[1,iLi],'LWb'+Ch1, 'BlueWingPosition for 630'+Ch1,sV);
    OuAny_Init(OuAny[2,iLi],'LWr'+Ch1, 'Red_WingPosition for 630'+Ch1,sV);
    OuAny_Init(OuAny[3,iLi],'LWI'+Ch1, 'Level for WingPos for 630'+Ch1,sV);
//  OuAny_Init(OuAny[4,iLi],'LWbb'+Ch1,'BlueWaveLength for Wing of 630'+Ch1,sV);
//  OuAny_Init(OuAny[5,iLi],'LWrr'+Ch1,'Red_WaveLength for Wing of 630'+Ch1,sV);
  end;



//for iA := 1 to 5 do
  for iA := 1 to 3 do
    for iLi := 1 to 2 do
      OuAny[iA,iLi].AssignMem(Self.Count,nY);


  for iX := 0 to Self.Count-1 do begin (* по каждому из FITS-ев *)

    // User Massage
    App.Inf.LogS('UM','LFITS.CalcLW|iX='+NumStr(iX+1,4)+'/'+ISt(Self.Count));
    App.Inf.Play;(* отобразить *)

    aFITS := TFITS(Self.Items[iX]);
    aFITS.LoadData;

    aFITS.CalcLW(QErr,FOCB0);
    if QErr then begin
      WarnAbs('CalcLW-Err iX='+ISt(iX));
    end;

    for iY := 0 to nY-1 do begin
      iY1 := iY + 1;
      il1 := aFITS.A2[1,1,iY1];
      ir1 := aFITS.A2[2,1,iY1];
      il2 := aFITS.A2[1,2,iY1];
      ir2 := aFITS.A2[2,2,iY1];
      LI1 := aFITS.A2[3,1,iY1];
      LI2 := aFITS.A2[3,2,iY1];

{
      lb1 := aFITS.A2[4,1,iY1];
      lr1 := aFITS.A2[5,1,iY1];
      lb2 := aFITS.A2[4,2,iY1];
      lr2 := aFITS.A2[5,2,iY1];
}

      OuAny[1,1].aData[iX,iY] := il1;
      OuAny[2,1].aData[iX,iY] := ir1;
      OuAny[1,2].aData[iX,iY] := il2;
      OuAny[2,2].aData[iX,iY] := ir2;
      OuAny[3,1].aData[iX,iY] := LI1;
      OuAny[3,2].aData[iX,iY] := LI2;
{
      OuAny[4,1].aData[iX,iY] := lb1;
      OuAny[4,2].aData[iX,iY] := lb2;
      OuAny[5,1].aData[iX,iY] := lr1;
      OuAny[5,2].aData[iX,iY] := lr2;
}

    end; (* for iY - цикл по позициям на щели iY внутри FITS файла *)
    if Self.QLight then aFITS.ClearData;
  end;

//for iA:= 1 to 5 do
  for iA:= 1 to 3 do
    for iLi := 1 to 2 do begin
      SetBit.BISB(OuAny[iA,iLi].kLoad,3);  (* бит 3 - производные данные *)
      OuAny[iA,iLi].MinMaxMean;
    end;

end; (* TLFITS.CalcLW *)



(* первая пристрелка центров линий            *)
(* а также значения макс.глубин и их индексов *)
procedure TLFITS.CalcC50;
var iX,iY,iY1 : integer;
  aFITS : TFITS;
  rC501,rC502 : real4;
  d01,d02 : real4;
  Ld01,Ld02 : real4;
  sV : string;

begin

  if Assigned (OuAny1) then OuAny1.Done;
  if Assigned (OuAny2) then OuAny2.Done;
  if Assigned (OuAny3) then OuAny3.Done;
  if Assigned (OuAny4) then OuAny4.Done;
  if Assigned (OuAny5) then OuAny5.Done;
  if Assigned (OuAny6) then OuAny6.Done;

  sV := '2022';

  OuAny_Init(OuAny1,'d01'  ,'Central Depth d0 for 6301',sV);
  OuAny_Init(OuAny2,'d02'  ,'Central Depth d0 for 6302',sV);
  OuAny_Init(OuAny3,'Ld01' ,'Wavelength (Pix) of d0 for 6301',sV);
  OuAny_Init(OuAny4,'Ld02' ,'Wavelength (Pix) of d0 for 6302',sV);
  OuAny_Init(OuAny5,'LC501','Bisector (Cont-d0)/2 for 6301',sV);
  OuAny_Init(OuAny6,'LC502','Bisector (Cont-d0)/2 for 6302',sV);
  OuAny1.AssignMem(Self.Count,nY);
  OuAny2.AssignMem(Self.Count,nY);
  OuAny3.AssignMem(Self.Count,nY);
  OuAny4.AssignMem(Self.Count,nY);
  OuAny5.AssignMem(Self.Count,nY);
  OuAny6.AssignMem(Self.Count,nY);

  for iX := 0 to Self.Count-1 do begin (* по каждому из FITS-ев *)

    // User Massage
    App.Inf.LogS('UM','LFITS.CalcC50|iX='+NumStr(iX+1,4)+'/'+ISt(Self.Count));
    App.Inf.Play;(* отобразить *)



    aFITS := TFITS(Self.Items[iX]);
    aFITS.LoadData;

    if Not aFITS.ReturnSlitConts then aFITS.CalcSlitConts;
    aFITS.CalcC50;

    for iY := 0 to nY-1 do begin
      iY1 := iY + 1;
       d01  := aFITS.AI_d01[iY1];
       d02  := aFITS.AI_d02[iY1];
      Ld01  := aFITS.AILd01[iY1];
      Ld02  := aFITS.AILd02[iY1];
      rC501 := aFITS.ALC51[iY1];
      rC502 := aFITS.ALC52[iY1];

      OuAny1.aData[iX,iY] := d01;
      OuAny2.aData[iX,iY] := d02;
      OuAny3.aData[iX,iY] := Ld01;
      OuAny4.aData[iX,iY] := Ld02;
      OuAny5.aData[iX,iY] := rC501;
      OuAny6.aData[iX,iY] := rC502;

    end; (* for iY - цикл по позициям на щели iY внутри FITS файла *)
    if Self.QLight then aFITS.ClearData;
  end;

  SetBit.BISB(OuAny1.kLoad,3);  (* бит 3 - производные данные *)
  SetBit.BISB(OuAny2.kLoad,3);  (* бит 3 - производные данные *)
  SetBit.BISB(OuAny3.kLoad,3);
  SetBit.BISB(OuAny4.kLoad,3);
  SetBit.BISB(OuAny5.kLoad,3);
  SetBit.BISB(OuAny6.kLoad,3);
  OuAny1.MinMaxMean;
  OuAny2.MinMaxMean;
  OuAny3.MinMaxMean;
  OuAny4.MinMaxMean;
  OuAny5.MinMaxMean;
  OuAny6.MinMaxMean;

end;



procedure TLFITS.GaussCore_SetLength;
begin
    SetLength(OuGa18 .aData,nX,nY);
    SetLength(OuGa16 .aData,nX,nY);
    SetLength(OuGa141.aData,nX,nY);
    SetLength(OuGa142.aData,nX,nY);
    SetLength(OuGb18 .aData,nX,nY);
    SetLength(OuGb16 .aData,nX,nY);
    SetLength(OuGb141.aData,nX,nY);
    SetLength(OuGb142.aData,nX,nY);
    SetLength(OuGa28 .aData,nX,nY);
    SetLength(OuGa26 .aData,nX,nY);
    SetLength(OuGa241.aData,nX,nY);
    SetLength(OuGa242.aData,nX,nY);
    SetLength(OuGb28 .aData,nX,nY);
    SetLength(OuGb26 .aData,nX,nY);
    SetLength(OuGb241.aData,nX,nY);
    SetLength(OuGb242.aData,nX,nY);
    SetLength(OuGD18 .aData,nX,nY);
    SetLength(OuGD16 .aData,nX,nY);
    SetLength(OuGD141.aData,nX,nY);
    SetLength(OuGD142.aData,nX,nY);
    SetLength(OuGD28 .aData,nX,nY);
    SetLength(OuGD26 .aData,nX,nY);
    SetLength(OuGD241.aData,nX,nY);
    SetLength(OuGD242.aData,nX,nY);
    SetLength(OuG1d0 .aData,nX,nY);
    SetLength(OuG2d0 .aData,nX,nY);
    SetLength(OuG1Dk .aData,nX,nY);
    SetLength(OuG2Dk .aData,nX,nY);
    SetLength(OuG1D  .aData,nX,nY);
    SetLength(OuG2D  .aData,nX,nY);
    SetLength(OuGL16 .aData,nX,nY);
    SetLength(OuGL14 .aData,nX,nY);
    SetLength(OuGL26 .aData,nX,nY);
    SetLength(OuGL24 .aData,nX,nY);
    SetLength(OuGL10 .aData,nX,nY);
    SetLength(OuGL20 .aData,nX,nY);
    SetLength(OuGL1  .aData,nX,nY);
    SetLength(OuGL2  .aData,nX,nY);
end;


procedure TLFITS.CalcCore(FOH:TFIOut);  (* вычисляем параметры гауссиан при вершинах линий *)
var iX,iY,iY1 : integer;
  aFITS : TFITS;
  R4    : real4;
begin
{
  if Not Self.swFITSInit then begin
    WarnAbs('Не удалось инициализировать Ou-FITS-ы!');
    Exit;
  end;
}
{
  if Assigned(OuAny1) then OuAny1.Done;
  if Assigned(OuAny2) then OuAny2.Done;
}


  if Not OuCont.CheckLoad then begin
    WarnAbs('CalcCore ERR Данные карты '+OuCont.Name+' не найдены в файле!');
    Exit;
  end;



  if Assigned(OuGc1) then
    if Not OuGc1.CheckLoad then begin
      WarnAbs('CalcCore ERR Данные карты '+OuGc1.Name+' не найдены в файле!');
      Exit;
    end;

  if Assigned(OuGc2) then
    if Not OuGc2.CheckLoad then begin
      WarnAbs('CalcCore ERR Данные карты '+OuGc2.Name+' не найдены в файле!');
      Exit;
    end;

  Self.swGaussCore_Init; (* Инициировать список карт TFIOut для расчёта Core *)

  Self.GaussCore_SetLength;


  SunWorld.Get_gsPar1;

{
  Self.Get_gsPar1;
  CurI.sOp := 'k1'; CurI.CheckLam; CurI.reLam;
  CurI.Ajust;
  CurI_UpDate;
}


  for iX := 0 to Self.Count-1 do begin (* по каждому из FITS-ев *)


    aFITS := TFITS(Self.Items[iX]);
    aFITS.LoadData;

    (* Загрузить FITS.ACnt из OuCont *)
    if Not aFITS.ReturnSlitConts then (* Заполнить FITS.ACnt *)
           aFITS.CalcSlitConts;       (* Рассчитать FITS.ACnt *)

    (* загрузить aFITS.aLC51,aLC52 *)
//  aFITS.CalcL5_1_2;    (* ср.знач-я дл.волн bi5 *)
    aFITS.ReturnSlitLC; (* заполнить FITS.ALC1,ALC2 если OuGC1,GC2 существуют*)


    aFITS.CalcCore(FOH);




    for iY := 0 to nY-1 do begin
      iY1 := iY + 1;
      OuGa18 .aData[iX,iY] := aFITS.AGa18 [iY1];
      OuGa16 .aData[iX,iY] := aFITS.AGa16 [iY1];
      OuGa141.aData[iX,iY] := aFITS.AGa141[iY1];
      OuGa142.aData[iX,iY] := aFITS.AGa142[iY1];
      OuGb18 .aData[iX,iY] := aFITS.AGb18 [iY1];
      OuGb16 .aData[iX,iY] := aFITS.AGb16 [iY1];
      OuGb141.aData[iX,iY] := aFITS.AGb141[iY1];
      OuGb142.aData[iX,iY] := aFITS.AGb142[iY1];
      OuGa28 .aData[iX,iY] := aFITS.AGa28 [iY1];
      OuGa26 .aData[iX,iY] := aFITS.AGa26 [iY1];
      OuGa241.aData[iX,iY] := aFITS.AGa241[iY1];
      OuGa242.aData[iX,iY] := aFITS.AGa242[iY1];
      OuGb28 .aData[iX,iY] := aFITS.AGb28 [iY1];
      OuGb26 .aData[iX,iY] := aFITS.AGb26 [iY1];
      OuGb241.aData[iX,iY] := aFITS.AGb241[iY1];
      OuGb242.aData[iX,iY] := aFITS.AGb242[iY1];
      OuGD18 .aData[iX,iY] := aFITS.AGD18 [iY1];
      OuGD16 .aData[iX,iY] := aFITS.AGD16 [iY1];
      OuGD141.aData[iX,iY] := aFITS.AGD141[iY1];
      OuGD142.aData[iX,iY] := aFITS.AGD142[iY1];
      OuGD28 .aData[iX,iY] := aFITS.AGD28 [iY1];
      OuGD26 .aData[iX,iY] := aFITS.AGD26 [iY1];
      OuGD241.aData[iX,iY] := aFITS.AGD241[iY1];
      OuGD242.aData[iX,iY] := aFITS.AGD242[iY1];
      OuG1d0 .aData[iX,iY] := aFITS.AG1d0 [iY1];
      OuG2d0 .aData[iX,iY] := aFITS.AG2d0 [iY1];
      OuG1Dk .aData[iX,iY] := aFITS.AG1Dk [iY1];
      OuG2Dk .aData[iX,iY] := aFITS.AG2Dk [iY1];
      OuG1D  .aData[iX,iY] := aFITS.AG1D  [iY1];
      OuG2D  .aData[iX,iY] := aFITS.AG2D  [iY1];
      OuGL16 .aData[iX,iY] := aFITS.AGL16 [iY1];
      OuGL14 .aData[iX,iY] := aFITS.AGL14 [iY1];
      OuGL26 .aData[iX,iY] := aFITS.AGL26 [iY1];
      OuGL24 .aData[iX,iY] := aFITS.AGL24 [iY1];
      OuGL10 .aData[iX,iY] := aFITS.AGL10 [iY1];
      OuGL20 .aData[iX,iY] := aFITS.AGL20 [iY1];
      OuGL1  .aData[iX,iY] := aFITS.AGL1  [iY1];
      OuGL2  .aData[iX,iY] := aFITS.AGL2  [iY1];

    end; (* for iY - цикл по позициям на щели iY внутри FITS файла *)

    if Self.QLight then aFITS.ClearData;



  end;

  SetBit.BISB(OuGa18 .kLoad,3); (* бит 3 - производные данные *)
  SetBit.BISB(OuGa16 .kLoad,3);
  SetBit.BISB(OuGa141.kLoad,3);
  SetBit.BISB(OuGa142.kLoad,3);
  SetBit.BISB(OuGb18 .kLoad,3);
  SetBit.BISB(OuGb16 .kLoad,3);
  SetBit.BISB(OuGb141.kLoad,3);
  SetBit.BISB(OuGb142.kLoad,3);
  SetBit.BISB(OuGa28 .kLoad,3);
  SetBit.BISB(OuGa26 .kLoad,3);
  SetBit.BISB(OuGa241.kLoad,3);
  SetBit.BISB(OuGa242.kLoad,3);
  SetBit.BISB(OuGb28 .kLoad,3);
  SetBit.BISB(OuGb26 .kLoad,3);
  SetBit.BISB(OuGb241.kLoad,3);
  SetBit.BISB(OuGb242.kLoad,3);
  SetBit.BISB(OuGD18 .kLoad,3);
  SetBit.BISB(OuGD16 .kLoad,3);
  SetBit.BISB(OuGD141.kLoad,3);
  SetBit.BISB(OuGD142.kLoad,3);
  SetBit.BISB(OuGD28 .kLoad,3);
  SetBit.BISB(OuGD26 .kLoad,3);
  SetBit.BISB(OuGD241.kLoad,3);
  SetBit.BISB(OuGD242.kLoad,3);
  SetBit.BISB(OuG1d0 .kLoad,3);
  SetBit.BISB(OuG2d0 .kLoad,3);
  SetBit.BISB(OuG1D  .kLoad,3);
  SetBit.BISB(OuG2D  .kLoad,3);
  SetBit.BISB(OuG1Dk .kLoad,3);
  SetBit.BISB(OuG2Dk .kLoad,3);
  SetBit.BISB(OuG1D  .kLoad,3);
  SetBit.BISB(OuG2D  .kLoad,3);
  SetBit.BISB(OuGL16 .kLoad,3);
  SetBit.BISB(OuGL14 .kLoad,3);
  SetBit.BISB(OuGL26 .kLoad,3);
  SetBit.BISB(OuGL24 .kLoad,3);
  SetBit.BISB(OuGL10 .kLoad,3);
  SetBit.BISB(OuGL20 .kLoad,3);
  SetBit.BISB(OuGL1  .kLoad,3);
  SetBit.BISB(OuGL2  .kLoad,3);
  OuGa18 .MinMaxMean;
  OuGa16 .MinMaxMean;
  OuGa141.MinMaxMean;
  OuGa142.MinMaxMean;
  OuGb18 .MinMaxMean;
  OuGb16 .MinMaxMean;
  OuGb141.MinMaxMean;
  OuGb142.MinMaxMean;
  OuGa28 .MinMaxMean;
  OuGa26 .MinMaxMean;
  OuGa241.MinMaxMean;
  OuGa242.MinMaxMean;
  OuGb28 .MinMaxMean;
  OuGb26 .MinMaxMean;
  OuGb241.MinMaxMean;
  OuGb242.MinMaxMean;
  OuGD18 .MinMaxMean;
  OuGD16 .MinMaxMean;
  OuGD141.MinMaxMean;
  OuGD142.MinMaxMean;
  OuGD28 .MinMaxMean;
  OuGD26 .MinMaxMean;
  OuGD241.MinMaxMean;
  OuGD242.MinMaxMean;
  OuG1d0 .MinMaxMean;
  OuG2d0 .MinMaxMean;
  OuG1Dk .MinMaxMean;
  OuG2Dk .MinMaxMean;
  OuG1D  .MinMaxMean;
  OuG2D  .MinMaxMean;
  OuGL16 .MinMaxMean;
  OuGL14 .MinMaxMean;
  OuGL26 .MinMaxMean;
  OuGL24 .MinMaxMean;
  OuGL10 .MinMaxMean;
  OuGL20 .MinMaxMean;
  OuGL1  .MinMaxMean;
  OuGL2  .MinMaxMean;

  LFIO.UpDate;
end; (* CalcCore *)









procedure TLFITS.CalcFilt(var iLi:integer);
var
  iFO : integer;
  iX,iY,iY1 : integer;
  aFITS : TFITS;


  sS,s1,s2,sL,sAbs : string;
  qAbs : boolean;
  la1,la2 : integer;


begin
  sS := SunWorld.edFilt_Stokes.Text;
  s1 := SunWorld.edFilt_1.Text;
  s2 := SunWorld.edFilt_2.Text;
  qAbs := SunWorld.cbFiltAbs.Checked;
  if qAbs then sAbs := 'a' else sAbs := '';

  la1 := swStr.ValInt(s1);
  la2 := swStr.ValInt(s2);

  if la1 > 60 then iLi := 2 else iLi := 1;

  for iFO := 1 to 2 do // to mFine do
//  for iLi := 1 to 2 do
    if Assigned(OuAny[iFO,iLi]) then OuAny[iFO,iLi].Done;

  Self.swFilt_Init;


  (* выделение памяти для массивов карт *)
{
  for iFO := 1 to 2 do // to mFine do
    for iLi := 1 to 2 do begin
      if Assigned(OuAny[iFO,iLi])
      then OuAny[iFO,iLi].AssignMem(Self.Count,nY)
      else ; // WarnAbs('iFO='+ISt(iFO)+' Lin='+ISt(iLi)+' OuAny Not Assigned!');
    end;
}


  WarnAbs('nX,nY='+ISt(nX)+','+ISt(nY));


  for iFO := 1 to 2 do // to mFine do
//  for iLi := 1 to 2 do begin
      if Assigned(OuAny[iFO,iLi])
      then SetLength(OuAny[iFO,iLi].aData,nX,nY)
      else ;
//  end;

  for iX := 0 to Self.Count-1 do begin (* по каждому из FITS-ев *)
    aFITS := TFITS(Self.Items[iX]); (* заголовок находим в списке *)
    aFITS.LoadData;          (* профили Стокса загружаем из файла *)

    (* Загрузить FITS.ACnt из OuCont *)
    if Not aFITS.ReturnSlitConts then begin (* Заполнить FITS.ACnt *)
      WarnAbs('LFITS.CalcFilt-Err (iX='+ISt(iX)+') не найден CONT');
      Exit;
    end;

//  if iLi = 2 then
    if Not aFITS.ReturnAnyMapLine('WV2',aFITS.AWI2) then begin
      WarnAbs('LFITS.CalcFilt-Err (iX='+ISt(iX)+') не найдены поляризации 2');
      Exit;
    end;
//  if iLi = 1 then
    if Not aFITS.ReturnAnyMapLine('WV1',aFITS.AWI1) then begin
      WarnAbs('LFITS.CalcFilt-Err (iX='+ISt(iX)+') не найдены поляризации 1');
      Exit;
    end;

   {
    WarnAbs('length AWI1='+ISt(length(aFITS.AWI1))+#13#10+
            'length AWI2='+ISt(length(aFITS.AWI2))
    );
   }

//    WV2 := AWI2[iY];
//    WV1 := AWI1[iY];


    aFITS.CalcFilt(la1,la2,sS,qAbs);



    for iFO := 1 to 2 do // mFine do
//    for iLi := 1 to 2 do begin
        if assigned(OuAny[iFO,iLi]) then begin
          for iY := 0 to nY-1 do begin
            iY1 := iY + 1;
            OuAny[iFO,iLi].aData[iX,iY] := RtoR4(aFITS.A2[iFO,iLi,iY1])
          end; (* for iY - цикл по позициям на щели iY внутри FITS файла *)
        end
        else begin
          WarnAbs('OuAny['+ISt(iFO)+','+ISt(iLi)+'] Not Assigned!');
        end;
//    end;

    if Self.QLight then aFITS.ClearData;
  end;






end;



(* сейчас по умолчанию kCalcStep = 0 *)
procedure TLFITS.CalcKVI(kCalcStep:integer);
var iX,iY,iY1 : integer;
  aFITS : TFITS;
  R4    : real4;
  R     : real;
  S, sSes : string;
  rC90 : real;

  iFO,iLi : integer;
begin

  (* уровень интенсивности, на котором заканчиваем  *)
  (* интегрирование, следуя из центра линии к краям *)
  rc90 := ValReal(SunWorld.ed_rC90.Text);
  if rc90 = 0 then rc90 := 0.9;

  for iFO := 1 to mFOE do                            (* mFOE  =  8 *)
    if Assigned(OuErr[iFO]) then OuErr[iFO].Done;

  for iFO := 1 to mFine do                           (* mFine = 23 *)
    for iLi := 1 to 2 do if Assigned(OuAny[iFO,iLi]) then OuAny[iFO,iLi].Done;

//  if KCalcStep = 0 then Self.swFine_Init;
//  if KCalcStep = 1 then Self.swFine2_Init;

  Self.swFine_Init;  (* wVp,wVn,wQp,wQn,wUp,wUn,wW,LVMp,LVMn,LVMa,LVMb,LVMr *)
  Self.swFine2_Init;(* W2QU,W2QUV,LIVp,LIVm,LQUa,LQUc,LQUb,LQUr,WQUc,WQUb,WQUr*)


{
  Self.swKVI2_Init;   (* 1,2 <- 1,2,3,4 *)
  Self.swKQI2_Init;   (* 3,4 <- 5,6,7,8 *)
  Self.swKUI2_Init;   (* 5,6 <- 9,A,B,C *)
  Self.swKWI_Init;    (* 7   <- D,E     *)
  Self.swMV3_Init;    (*  8, 9,10 <- F,G,H,I,J,K *)
  Self.swMQ3_Init;    (* 11,12,13 <- L,M,N,O,P,Q *)
  Self.swKVI3_Init;
  Self.swKQI3_Init;
  Self.swKUI3_Init;
}

  for iFO := 1 to mFine do
    for iLi := 1 to 2 do begin
      if Assigned(OuAny[iFO,iLi])
      then OuAny[iFO,iLi].AssignMem(Self.Count,nY)
      else ; // WarnAbs('iFO='+ISt(iFO)+' Lin='+ISt(iLi)+' OuAny Not Assigned!');
    end;

(*
  Self.swErr_Init; // 8 карт -Err: WV,WQ,VU,VW2,WQ2,WU2,WQU,WQUV
  for iFO := 1 to mFOE do begin
    if Assigned(OuErr[iFO])
      then OuErr[iFO].AssignMem(Self.Count,nY)
      else ;// WarnAbs('iFO='+ISt(iFO)+' OuErr Not Assigned!');
  end;
*)

  sSes := Self.sDtTi;
  sSes := Copy(sSes,7,7);

(*----------------------------------------------------------------------------*)
  for iX := 0 to Self.Count-1 do begin (* по каждому из FITS-ев *)

    // User Massage
    App.Inf.LogS('UM',sSes+' LFITS.CalcKVI|iX='+NumStr(iX+1,4)+
                 '/'+ISt(Self.Count));
    App.Inf.Play;(* отобразить *)


    aFITS := TFITS(Self.Items[iX]); (* заголовок находим в списке *)
    aFITS.LoadData;          (* профили Стокса загружаем из файла *)

    (* Загрузить FITS.ACnt из OuCont *)
    if Not aFITS.ReturnSlitConts then (* Заполнить FITS.ACnt *)
           aFITS.CalcSlitConts;       (* Рассчитать FITS.ACnt *)

    if Not aFITS.ReturnSlitLC50 then (* Заполнить FITS.ALC51,52 *)
           aFITS.CalcC50;            (* Рассчитать FITS.ALC51,52 *)

    (*===========================================*)
    (*        ОСНОВНАЯ ПРОЦЕДУРА РАСЧЁТА         *)
    (*===========================================*)

    aFITS.CalcSumsFine(rC90,kCalcStep);  (* AKVI *)

    (*===========================================*)
    (*                                           *)
    (*===========================================*)



(*----------------------------------------------------------------------------*)
    for iY := 0 to nY-1 do begin
      iY1 := iY + 1;

(*
      for iFO := 1 to mFOE do begin
        if assigned(OuErr[iFO])
        then OuErr[iFO].aData[iX,iY] := RtoR4(aFITS.AE[iFO,iY1])
        else ;
      end;
*)

      for iFO := 1 to mFine do
        for iLi := 1 to 2 do begin
          if assigned(OuAny[iFO,iLi])
          then OuAny[iFO,iLi].aData[iX,iY] := RtoR4(aFITS.A2[iFO,iLi,iY1])
          else ;
        end;

    end; (* for iY - цикл по позициям на щели iY внутри FITS файла *)
(*----------------------------------------------------------------------------*)

    if Self.QLight then aFITS.ClearData;
  end;
(*----------------------------------------------------------------------------*)

(*
  for iFO := 1 to mFOE do begin
    if assigned(OuErr[iFO]) then begin
      SetBit.BISB(OuErr[iFO].kLoad,3); // бит 3 - производные данные
      OuErr[iFO].MinMaxMean;
    end
    else ;
  end;
*)

  for iFO := 1 to mFine do
    for iLi := 1 to 2 do begin
      if assigned(OuAny[iFO,iLi]) then begin
        SetBit.BISB(OuAny[iFO,iLi].kLoad,3); // бит 3 - производные данные
        OuAny[iFO,iLi].MinMaxMean;
      end
      else ;
    end;

  LFIO.UpDate;
end; (* TLFITS.CalcKVI *)






(* процедура предназначена для работы с большими массивами данных *)
(* она последовательно подгружает FITS-ы, считывает из них данные *)
(* и выгружает, чтобы не переполнить память                       *)

procedure TLFITS.LoadRowData;
var iX,iY,iY1,kSOFT0,k : integer; aFITS:TFITS; CONT : real;
begin
  Time_routine('LFITS.LoadRowData',true);


  if Not Self.swFITSInit then begin
    WarnAbs('Не удалось инициализировать Ou-FITS-ы!');
    Exit;
  end;

  if Not Self.swFITSInitBi then begin
    WarnAbs('Не удалось инициализировать Ou-FITS-ы для Бисекторов!');
    Exit;
  end;



  iIMax := 0;
  iIMin := 32768;
  iVMax := 0;
  AbsVIMax := 0.0;

  (* для каждого FITS        *)
  (* загружаем "сырой" FITS, *)
  (* расчитываем для него интегральные величины *)
  (* эти интегральные величины раскладываем по интегральным массивам *)
  (* освобождаем память сырого FITS-а *)

  for iX := 0 to Self.Count-1 do begin (* по каждому из FITS-ев *)
    aFITS := TFITS(Self.Items[iX]);
    aFITS.LoadData;

    aFITS.DefaultContArea;
    aFITS.BigCalc;

    if  Assigned(aFITS.ACnt) then begin  (* если определён ACnt:TARe *)
      if (length(aFITS.ACnt)-1) < nY then begin
        WarnAbs('LFITS.LoadRowData iX='+ISt(iX)+' nY='+ISt(nY)+
                 ' length(A)-1='+ISt(length(aFITS.ACnt)-1));
      end
      else begin

        CheckDataLength;


        for iY := 0 to nY-1 do begin
          iY1 := iY + 1;
                         CONT := aFITS.ACnt[iY1];
          OuCont.aData[iX,iY] := CONT;
          OuGc1 .aData[iX,iY] := aFITS.ALC1[iY1];
          OuGc2 .aData[iX,iY] := aFITS.ALC2[iY1];
          OuKVI .aData[iX,iY] := aFITS.AKVI[iY1];
 //         OuII0 .aData[iX,iY] := aFITS.AIC [iY1];
 //         OuVV0 .aData[iX,iY] := aFITS.AVC [iY1];
          OuW1  .aData[iX,iY] := aFITS.AWI1[iY1];
          OuW2  .aData[iX,iY] := aFITS.AWI2[iY1];
          OuH1  .aData[iX,iY] := aFITS.AHM1[iY1];
          OuH2  .aData[iX,iY] := aFITS.AHM2[iY1];
          OuHG1 .aData[iX,iY] := aFITS.AHG1[iY1];
          OuHG2 .aData[iX,iY] := aFITS.AHG2[iY1];


          (*-----------------------------------*)
          (* вычисление положения центра линии *)
          (* подбором гауссианы                *)
          (*-----------------------------------*)
          for k := 3 to 5 do begin
            (* размер элемента aData это Real4 - максимум 7 цифр! *)
            (* поэтому от длины волны нужно отнять 6300           *)

{
          (* полож-е центра переводим в дл.волны-6300, ПОТОМ переведём в км/с *)
          Self.Ou35C1[k].aData[iX,iY] :=ItoLam(aFITS.A35C1[k,iY1])-6300;(*Lam0*)
          Self.Ou35C2[k].aData[iX,iY] := ItoLam(aFITS.A35C2[k,iY1])-6300;
}

          (* полож-е центра никуда не переводим, в BigCalc2 переведём в км/с *)
            Self.Ou35C1[k].aData[iX,iY] := aFITS.A35C1[k,iY1]; (*Lam0*)
            Self.Ou35C2[k].aData[iX,iY] := aFITS.A35C2[k,iY1];

          (* d0 получаем в процентах *)
            Self.Ou35I1[k].aData[iX,iY] := aFITS.A35I1[k,iY1]/CONT*100;(* D0 *)
            Self.Ou35I2[k].aData[iX,iY] := aFITS.A35I2[k,iY1]/CONT*100;

          (* DLD переводим в миллиангстремы *)
            Self.Ou35D1[k].aData[iX,iY] := aFITS.A35D1[k,iY1]*rdLam*1000;(* DLD *)
            Self.Ou35D2[k].aData[iX,iY] := aFITS.A35D2[k,iY1]*rdLam*1000;(* DLD *)
          end;
          (*                                   *)
          (* вычисление положения центра линии *)
          (* подбором гауссианы                *)
          (*-----------------------------------*)



          (*-----------------------------------*)
          (* вычисление бисектора и ширины     *)
          (*-----------------------------------*)
          for k := 1 to MBiSec do begin
{
          (* полож-е бисектора переводим в дл.волны, ПОТОМ переведём в км/с *)
          Self.OuBiC1[k].aData[iX,iY] := ItoLam(aFITS.ABiC1[k,iY1]) - 6300;
          Self.OuBiC2[k].aData[iX,iY] := ItoLam(aFITS.ABiC2[k,iY1]) - 6300;
}
            (* полож-е бисектора переведём в км/с внутри BigCalc2 *)
            Self.OuBiC1[k].aData[iX,iY] := aFITS.ABiC1[k,iY1];
            Self.OuBiC2[k].aData[iX,iY] := aFITS.ABiC2[k,iY1];



            (* FullWidth переводим в миллиангстремы *)
            Self.OuBiW1[k].aData[iX,iY] := aFITS.ABiW1[k,iY1]*rdLam*1000;
            Self.OuBiW2[k].aData[iX,iY] := aFITS.ABiW2[k,iY1]*rdLam*1000;
          end;
          (*                                   *)
          (* вычисление бисектора и ширины     *)
          (*-----------------------------------*)


        end; (* for iY - цикл по позициям на щели iY внутри FITS файла *)


      end;
    end;

    if aFITS.iIMax > iIMax then iIMax := aFITS.iIMax;
    if aFITS.iIMin < iIMin then iIMin := aFITS.iIMin;
    if aFITS.iVMax > iVMax then iVMax := aFITS.iVMax;
    if aFITS.AbsVIMax > AbsVIMax then AbsVIMax := aFITS.AbsVIMax;

    if Self.QLight then aFITS.ClearData;
  end;

  QRowData := true;  (* сообщение для BigCalc2 *)

{
  OuCont.Save(1);
  OuGc1 .Save(2);
  OuGc2 .Save(3);
  OuKVI .Save(4);
//  OuII0 .Save(5);
//  OuVV0 .Save(6);
  OuW1  .Save(7);
  OuW2  .Save(8);
  OuH1  .Save(9);
  OuH2  .Save(10);
}
  Time_routine('LFITS.LoadRowData',false);
end; (* TLFITS.LoadRowData *)



(* заполнить все aData для всех FITS *)
procedure TLFITS.LoadData;
(* загрузить данные всего сеанса наблюдений *)
var iX : integer; aFITS : TFITS;
begin
  Time_routine('LFITS.LoadData',true);
  if Self.Count = 0 then Exit;


  WarnAbs('LFITS.LoadData WARN! Загружаем все aData для всех FITS'+#13#10+
          'Count='+ISt(Self.Count)+' NX='+ISt(Self.nX)+' NY='+
          ISt(Self.nY)+#13#10+'Могут быть проблемы с памятью!');

  if SetBit.IsBit(Self.KStep,2) then begin
    WarnAbs('TLFITS.LoadData WARNING!'+#13#10+
    'Data Already Loaded!!!');
    Exit;
  end;

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TLFITS.LoadData ERROR!'+#13#10+
    'Headers Not Loaded Yet!!!');
    Exit;
  end;

  for iX := 0 to Self.Count-1 do begin (* по каждому из FITS-ев *)
    aFITS := TFITS(Self.Items[iX]);
    aFITS.LoadData; (* заполнить буфер aData *)
  end;
  SetBit.BISB(Self.KStep,2); (* = +4 *)
  Time_routine('LFITS.LoadData',false);
end; (* TLFITS.LoadData *)


(* расчёт H продольное для одной точки           *)
(* задаём расстояние от центров линий dl1 и dl2  *)
(* и для этих расстояни считаем W и M, а затем H *)
procedure TLFITS.CalcH0(iX,iY:integer;dl1,dl2,kV,akRC:real;
                        var W1,W2,M1,M2,H1,H2,HG1,HG2,l1,l2,
                        l11,l12,l21,l22,ln1,ln2,
                        lIV1,lVI1,lIV2,lVI2:real);
var aFITS : TFITS; N : integer;
begin
  N := Self.Count;
  if N = 0 then begin Self.LoadHeaders; N := Self.Count; end;

  if (iX < 0) or (iX >= N) then begin
    WarnAbs('LFITS.CalcH0 ERR: iX='+ISt(iX)+' LFITS.Count='+ISt(N));
    Exit;
  end;

  aFITS := TFITS(Self.Items[iX]);

//aFITS.BigCalc;

  aFITS.CalcH0(iY,dl1,dl2,kV,akRC,W1,W2,M1,M2,H1,H2,HG1,HG2,l1,l2,
                                       l11,l12,l21,l22,ln1,ln2,
                                       lIV1,lVI1,lIV2,lVI2);
end; (* TLFITS.CalcH0 *)

(* KV - поправка (делитель), которая определяет континуум для V-параметра, *)
(* относительно верхней точки профиля I                                    *)
procedure TFITS.CalcH0(iY:integer;dl1,dl2,kV,akRC:real;
                       var W1,W2,M1,M2,H1,H2,HG1,HG2,l1,l2,
                       l11,l12,l21,l22,ln1,ln2,
                       lIV1,lVI1,lIV2,lVI2:real);
var AI,AV : TAIn;
  AD,AE,AF,AG : TARe;
  dl : real;
  dl21,ddl,rC,rCV,lC,ddl1,ddl2 : real;
  ww1,ww2,wm1,wm2,w : real;
  ri,rv : real;

//  lIV1,lVI1,lIV2,lVI2 : real;
  dlam1,dlam2 : real;

  iYA,iL,i11,i12,i21,i22 : integer;


  MV1,MV2 : real;

  AIE : TAIn; AEE : TARe;
begin
  dl21 := Abs(0.9985/Self.rdLam); (* среднее расстояние между линиями *)
  dl1 := dl1/1000/rdLam;  (* из миллиангстремов в шаги *)
  dl2 := dl2/1000/rdLam;

  if Not SetBit.IsBit(Self.KStep,2) then LoadData;

  iYA := iY + 1;

  Self.GetCol3(iYA,1,AI); (* профиль интенсивности в "отсчётах" *)
  Self.GetCol3(iYA,4,AV); (* профиль круговой поляризации       *)

  GetICont_01(iY,rC,lC); (* уровень континуума = Max после сглаживания *)
                 (* внутри GetICont_01 есть kRC0 !!! *)


  (* корректируем rC *)
//rC := rC * TLFITS(Owner).kRC;
  rC := rC * akRC;(* akRC - входной параметр процедуры CalcH0 *)

//ANE - число экстремумов профиля интенсивности
  if length(ANE) <> nY+1 then SetLength(ANE,nY+1);

  CalcCGrav5(iY,l1,l2,AIE,AEE);
  if Self.ANE[iY] <> 5 then begin
    CalcCGrav(iY,l1,l2); (* положение центров тяжести (без континуума) *)
  end;

  (* корректируем значения l1 и l2 зная расстояние l2-l1 *)
  ddl := ((l2-l1) - dl21) / 2;
  ln2 := l2 - ddl; ln1 := l1 + ddl;

  (* найдем границы *)
  l11 := ln1 - dl1; l12 := ln1 + dl1;
  l21 := ln2 - dl2; l22 := ln2 + dl2;

  (*--- формируем массивы d, I+V, I-V, V ---*)
  SetLength(AD,NLam+1);
  SetLength(AE,NLam+1);
  SetLength(AF,NLam+1);
  SetLength(AG,NLam+1);

  rCV := rC/kV;
  for iL := 1 to Self.nLam do begin
    ri := AI[iL]/rC;
    rv := AV[iL]/rCV;        (* = /rC*kV *)
    AD[iL] := 1 - ri;
    AE[iL] := rv;
    AF[iL] := 1 - (ri + rv);
    AG[iL] := 1 - (ri - rv);
  end;
  (*---------------------------------------*)


  (* повторяем поиск центров по суженой области *)
  (* из нормированных профилей глубины линии    *)
  ln1 := swARe.LineCenter_d(l11,l12,AD);
  ln2 := swARe.LineCenter_d(l21,l22,AD);

//  ALC1[iY] := ln1;
//  ALC2[iY] := ln2;

  (* заново опредилим границы *)
  l11 := ln1 - dl1; l12 := ln1 + dl1;
  l21 := ln2 - dl2; l22 := ln2 + dl2;


  (* найдём центры тяжести профилей CONT-(I+V) = AF и CONT-(I-V) = AG *)


  lIV1 := swARe.LineCenter_d(l11,l12,AF);
  lVI1 := swARe.LineCenter_d(l11,l12,AG);
  lIV2 := swARe.LineCenter_d(l21,l22,AF);
  lVI2 := swARe.LineCenter_d(l21,l22,AG);

  dlam1 := (lVI1-lIV1) * Abs(Self.rdLam) * 1000;
  dlam2 := (lVI2-lIV2) * Abs(Self.rdLam) * 1000;

  HG1 := PHYS.LamToH(dlam1/2,6301.5,1.669);  //1.503);
  HG2 := PHYS.LamToH(dlam2/2,6302.5,2.487);






  (*------------ считаем эквивалентные ширины --------------*)

  (* найдём внутренние участки *)
  i11 := trunc(l11); if (l11 - i11) > 0 then inc(i11);
  i12 := trunc(l12);
  i21 := trunc(l21); if (l21 - i21) > 0 then inc(i21);
  i22 := trunc(l22);

  (* суммируем в пределах внутренних участков *)
  ww1 := 0;
  for iL := i11+1 to i12-1 do begin
    ww1 := ww1 + AD[iL];
  end;
  ww1 := ww1 + (AD[i11] + AD[i12])/2;

    wm1 := 0;
  for iL := i11+1 to i12 do begin
    dl  := (iL-0.5) - l1;
    wm1 := wm1 + dl * (AE[iL-1] + AE[iL])/2;  (* AE содержит rV = AV[iL]/rCV *)
  end;



  ww2 := 0; wm2 := 0;
  for iL := i21+1 to i22-1 do begin
    ww2 := ww2 + AD[iL];
  end;
  ww2 := ww2 + (AD[i21] + AD[i22])/2;

  wm2 := 0;
  for iL := i21+1 to i22 do begin
    dl  := (iL-0.5) - l2;
    wm2 := wm2 + dl * (AE[iL-1] + AE[iL])/2;
  end;


  (* добавляем "хвостики" *)
  ddl1 := i11-l11;
  ddl2 := l12-i12;

  w := (AD[i11] - AD[i11-1])* ddl1 + AD[i11-1];
  ww1 := ww1 + (w+AD[i11])/2* ddl1;
  w := (AD[i12+1] - AD[i12])* ddl2 + AD[i12];
  ww1 := ww1 + (w+AD[i12])/2* ddl2;

  w := (AE[i11] - AE[i11-1])* ddl1 + AE[i11-1];
  wm1 := wm1 + (w+AE[i11])/2* ddl1 * ( (i11+l11)/2 - l1 );
  w := (AE[i12+1] - AE[i12])* ddl2 + AE[i12];
  wm1 := wm1 + (w+AE[i12])/2* ddl1 *( (i12+l12)/2 - l1 );

  (*-----------------------------------------------*)


  ddl1 := i21-l21;
  ddl2 := l22-i22;

  w := (AD[i21] - AD[i21-1])* ddl1 + AD[i21-1];
  ww2 := ww2 + (w+AD[i21])/2* ddl1;
  w := (AD[i22+1] - AD[i22])* ddl2 + AD[i22];
  ww2 := ww2 + (w+AD[i22])/2* ddl2;

  w := (AE[i21] - AE[i21-1])* ddl1 + AE[i21-1];
  wm2 := wm2 + (w+AE[i21])/2* ddl1 * ( (i21+l21)/2 - l2 );
  w := (AE[i22+1] - AE[i22])* ddl2 + AE[i22];
  wm2 := wm2 + (w+AE[i22])/2* ddl2 *( (i22+l22)/2 - l2 );


  (*===============================================================*)

  (* переводим в миллиангстремы *)
  W1 := ww1 * Abs(Self.rdLam) * 1000;
  W2 := ww2 * Abs(Self.rdLam) * 1000;

  M1 := wm1 * Self.rdLam * 1000 * Self.rdLam * 1000;
  M2 := wm2 * Self.rdLam * 1000 * Self.rdLam * 1000;

  H1 := PHYS.LamToH(M1/W1,6301.5,1.669);  //1.503);
  H2 := PHYS.LamToH(M2/W2,6302.5,2.487);




  (* надо сравнить
     M1 и M2 с

     AMV1[iY]
     AMV2[iY]

  MV1 := AMV1[iY];
  MV2 := AMV2[iY];
  if H1 > 10000 then WarnAbs(FSt(MV1,5)+FSt(MV2,5));

   *)











//  l1 := Self.ItoLam(l1);
//  l2 := Self.ItoLam(l2);
  Finalize(AI); Finalize(AV);

end; (* TFITS.CalcH0 *)


function TLFITS.GetFIT_SL(iX,iY:integer;sStokes:string):TStringList;
var aFITS : TFITS;
begin
  result := NIL;

  if Not Assigned(Self) then begin
    WarnAbs('TLFITS.GetFIT_SL ERROR!'+#13#10+
    'LFITS Not Assigned Yet!!!');
    Exit;
  end;

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TLFITS.GetFIT_SL ERROR!'+#13#10+
    'Headers Not Loaded Yet!!!');
    Exit;
  end;

  aFITS := TFITS(Self.Items[iX]);
  result := aFITS.GetFIT_SL(iY,sStokes);

end; (* TLFITS.GetFIT_SL *)


function TLFITS.GetFIT_SL(iX,iY:integer;sStokes:string;chI,chL:char):TStringList;
var aFITS : TFITS;
begin
  result := NIL;

  if Not Assigned(Self) then begin
    WarnAbs('TLFITS.GetFIT_SL ERROR!'+#13#10+
    'LFITS Not Assigned Yet!!!');
    Exit;
  end;

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TLFITS.GetFIT_SL ERROR!'+#13#10+
    'Headers Not Loaded Yet!!!');
    Exit;
  end;

  aFITS := TFITS(Self.Items[iX]);
  result := aFITS.GetFIT_SL(iY,sStokes,chI,chL);

end; (* TLFITS.GetFIT_SL *)





procedure TLFITS.GetFITARe(iX,iY:integer;sStokes:string;var AX,AI,AQ,AU,AV:TARe;
                           var Cont:real);
var aFITS : TFITS; L : integer; rC,lC : real;
begin
  if Not Assigned(Self) then begin
    WarnAbs('TLFITS.GetFIT_SL ERROR!'+#13#10+
    'LFITS Not Assigned Yet!!!');
    Exit;
  end;

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TLFITS.GetFIT_SL ERROR!'+#13#10+
    'Headers Not Loaded Yet!!!');
    Exit;
  end;

  aFITS := TFITS(Self.Items[iX]);
  aFITS.GetFITARe(iY,sStokes,AX,AI,AQ,AU,AV);
  L := length(aFITS.aCnt);
  if L = 0 then begin
    aFITS.GetICont_01(iY,rC,lC);
    Cont := rC;
  end
  else Cont := aFITS.aCnt[iY+1];

end; (* TLFITS.GetFITARe *)

procedure TLFITS.GetFITARe2(iX,iY:integer;sStokes:string;
                            var AX,AXb,AI,AQ,AU,AV,AP,AD:TARe;
                            var Cont:real);
var aFITS : TFITS; L : integer; rC,lC : real;
begin
  if Not Assigned(Self) then begin
    WarnAbs('TLFITS.GetFIT_SL ERROR!'+#13#10+
    'LFITS Not Assigned Yet!!!');
    Exit;
  end;

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TLFITS.GetFIT_SL ERROR!'+#13#10+
    'Headers Not Loaded Yet!!!');
    Exit;
  end;

  aFITS := TFITS(Self.Items[iX]);
  aFITS.GetFITARe2(iY,sStokes,AX,AXb,AI,AQ,AU,AV,AP,AD);

  Cont := aFITS.ContiY(iY);

end; (* TLFITS.GetFITARe2 *)


procedure TLFITS.GetFITARe2(iX,iY:integer;sStokes:string;chI,chL:char;
                            rL0 : real; (* сдвиг нуля длин волн *)
                            var AX,AXb,AI,AQ,AU,AV,AP,AD:TARe;
                            var Cont:real);
var aFITS : TFITS; L : integer; rC,lC : real;
begin
  if Not Assigned(Self) then begin
    WarnAbs('TLFITS.GetFIT_SL ERROR!'+#13#10+
    'LFITS Not Assigned Yet!!!');
    Exit;
  end;

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TLFITS.GetFIT_SL ERROR!'+#13#10+
    'Headers Not Loaded Yet!!!');
    Exit;
  end;

  aFITS := TFITS(Self.Items[iX]);
  aFITS.GetFITARe2(iY,sStokes,chI,chL,rL0,AX,AXb,AI,AQ,AU,AV,AP,AD);

  Cont := aFITS.ContiY(iY);

end; (* TLFITS.GetFITARe2 *)







function TLFITS.GetFITNorm_SL(iX,iY:integer;sStokes:string):TStringList;
var aFITS : TFITS;
begin
  result := NIL;

  if Not Assigned(Self) then begin
    WarnAbs('TLFITS.GetFITNorm_SL ERROR!'+#13#10+
    'LFITS Not Assigned Yet!!!');
    Exit;
  end;

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TLFITS.GetFITNorm_SL ERROR!'+#13#10+
    'Headers Not Loaded Yet!!!');
    Exit;
  end;

  aFITS := TFITS(Self.Items[iX]);
  result := aFITS.GetFITNorm_SL(iY,sStokes);

end; (* TLFITS.GetFITNorm_SL *)

procedure TLFITS.GetFITNormARe(iX,iY:integer;sStokes:string;
                               rL0:real;
                               var AX,AI,AQ,AU,AV:TARe);
var aFITS : TFITS;
begin
  if Not Assigned(Self) then begin
    WarnAbs('TLFITS.GetFITNorm_SL ERROR!'+#13#10+
    'LFITS Not Assigned Yet!!!');
    Exit;
  end;
  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TLFITS.GetFITNorm_SL ERROR!'+#13#10+
    'Headers Not Loaded Yet!!!');
    Exit;
  end;
  aFITS := TFITS(Self.Items[iX]);
  aFITS.GetFITNormARe(iY,sStokes,rL0,AX,AI,AQ,AU,AV);
end; (* TLFITS.GetFITNormARe *)

procedure TLFITS.GetFITNormARe2(iX,iY:integer;sStokes:string;
                        rL0:real;
                        var AX,AXd,AI,AQ,AU,AV,AP,AD:TARe);
var aFITS : TFITS;
begin
  if Not Assigned(Self) then begin
    WarnAbs('TLFITS.GetFITNorm_SL ERROR!'+#13#10+
    'LFITS Not Assigned Yet!!!');
    Exit;
  end;
  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TLFITS.GetFITNorm_SL ERROR!'+#13#10+
    'Headers Not Loaded Yet!!!');
    Exit;
  end;
  aFITS := TFITS(Self.Items[iX]);
  aFITS.GetFITNormARe2(iY,sStokes,rL0,AX,AXd,AI,AQ,AU,AV,AP,AD);
end; (* TLFITS.GetFITNormARe *)




procedure TLFITS.GetFIT9ARe(iX,iY:integer;sStokes:string;
                            var AX,AI,AQ,AU,AV:TARe;var Cont:real);
var aFITS1,aFITS2,aFITS3 : TFITS; A41,A42,A43,A4S : TA4In;
  SL : TStringList; S : string; iL,I4 : integer;
  Q4 : array[1..4] of boolean;
//  AI1,AQ1,AU1,AV1:TARe;
  sC : real;
  nC : integer;

begin
  if Not Assigned(Self) then begin
    WarnAbs('TLFITS.GetFIT9_SL ERROR!'+#13#10+
    'LFITS Not Assigned Yet!!!');
    Exit;
  end;

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TLFITS.GetFIT9_SL ERROR!'+#13#10+
    'Headers Not Loaded Yet!!!');
    Exit;
  end;

  Q4[1] := (pos('I',sStokes) > 0);
  Q4[2] := (pos('Q',sStokes) > 0);
  Q4[3] := (pos('U',sStokes) > 0);
  Q4[4] := (pos('V',sStokes) > 0);


  aFITS1 := TFITS(Self.Items[iX-1]);
  aFITS2 := TFITS(Self.Items[iX  ]);
  aFITS3 := TFITS(Self.Items[iX+1]);

  A41 := aFITS1.GetFIT3(iY,sStokes); (* три смежных просуммированных профиля *)
  A42 := aFITS2.GetFIT3(iY,sStokes);
  A43 := aFITS3.GetFIT3(iY,sStokes);

  nC := length(aFITS1.aCnt);
  if nC = 0 then aFITS1.CalcSlitConts; (* заполнить aCnt *)
  nC := length(aFITS2.aCnt);
  if nC = 0 then aFITS2.CalcSlitConts; (* заполнить aCnt *)
  nC := length(aFITS3.aCnt);
  if nC = 0 then aFITS3.CalcSlitConts; (* заполнить aCnt *)


  sC := 0;
  sC := aFITS1.aCnt[iY-1] + aFITS1.aCnt[iY] + aFITS1.aCnt[iY+1] +
        aFITS2.aCnt[iY-1] + aFITS2.aCnt[iY] + aFITS2.aCnt[iY+1] +
        aFITS3.aCnt[iY-1] + aFITS3.aCnt[iY] + aFITS3.aCnt[iY+1];
  Cont := sC / 9;

                SetLength(AX,aFITS1.nLam+1);
  if Q4[1] then SetLength(AI,aFITS1.nLam+1);
  if Q4[2] then SetLength(AQ,aFITS1.nLam+1);
  if Q4[3] then SetLength(AU,aFITS1.nLam+1);
  if Q4[4] then SetLength(AV,aFITS1.nLam+1);

{
  SL := TStringList.Create;
  S := 'L ';
  if Q4[1] then S := S + 'I ';
  if Q4[2] then S := S + 'Q ';
  if Q4[3] then S := S + 'U ';
  if Q4[4] then S := S + 'V ';
  SL.Add(S);
}

  for iL := 1 to aFITS1.nLam do begin
    AX[iL] := iL;
    if Q4[1] then AI[iL] := (A41[1,iL] + A42[1,iL] + A43[1,iL])/9;
    if Q4[2] then AQ[iL] := (A41[2,iL] + A42[2,iL] + A43[2,iL])/9;
    if Q4[3] then AU[iL] := (A41[3,iL] + A42[3,iL] + A43[3,iL])/9;
    if Q4[4] then AV[iL] := (A41[4,iL] + A42[4,iL] + A43[4,iL])/9;
  end;

end; (* TLFITS.GetFIT9ARe *)

procedure TLFITS.GetFIT9ARe2(iX,iY:integer;sStokes:string;
                      var AX,AXd,AI,AQ,AU,AV,AP,AD:TARe;var Cont:real);
var aFITS1,aFITS2,aFITS3 : TFITS; A41,A42,A43,A4S : TA4In;
  SL : TStringList; S : string;
  iL,I4 : integer;
  Q4 : array[1..6] of boolean; Q,Q1 : boolean;
  rI,rQ,rU,rV : real;
  rL1,rI0 : real;
  nC : integer;
  sC : real;

begin
  if Not Assigned(Self) then begin
    WarnAbs('TLFITS.GetFIT9_SL ERROR!'+#13#10+
    'LFITS Not Assigned Yet!!!');
    Exit;
  end;

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TLFITS.GetFIT9_SL ERROR!'+#13#10+
    'Headers Not Loaded Yet!!!');
    Exit;
  end;


  Q4[1] := (pos('I',sStokes) > 0);
  Q4[2] := (pos('Q',sStokes) > 0);
  Q4[3] := (pos('U',sStokes) > 0);
  Q4[4] := (pos('V',sStokes) > 0);
  Q4[5] := (pos('P',sStokes) > 0);
  Q4[6] := (pos('D',sStokes) > 0);
  Q1 := false;

  if pos('D',sStokes) > 0 then begin Q4[1] := true; Q1 := true; end;
  if pos('P',sStokes) > 0 then begin Q4[2] := true; Q4[3] := true end;

  Q := false;     (* для заполнения AX *)
  for I4 := 1 to 4 do if Q4[I4] then begin
//  SetLength(A4[I4],nLam+1); GetCol3(iY+1,I4,A4[I4]);
    Q := true;
  end;

  aFITS1 := TFITS(Self.Items[iX-1]);
  aFITS2 := TFITS(Self.Items[iX  ]);
  aFITS3 := TFITS(Self.Items[iX+1]);

  A41 := aFITS1.GetFIT3(iY,sStokes); (* три смежных просуммированных профиля *)
  A42 := aFITS2.GetFIT3(iY,sStokes);
  A43 := aFITS3.GetFIT3(iY,sStokes);

  nC := length(aFITS1.aCnt);
  if nC = 0 then aFITS1.CalcSlitConts; (* заполнить aCnt *)
  nC := length(aFITS2.aCnt);
  if nC = 0 then aFITS2.CalcSlitConts; (* заполнить aCnt *)
  nC := length(aFITS3.aCnt);
  if nC = 0 then aFITS3.CalcSlitConts; (* заполнить aCnt *)

  sC := 0;
  sC := aFITS1.aCnt[iY-1] + aFITS1.aCnt[iY] + aFITS1.aCnt[iY+1] +
        aFITS2.aCnt[iY-1] + aFITS2.aCnt[iY] + aFITS2.aCnt[iY+1] +
        aFITS3.aCnt[iY-1] + aFITS3.aCnt[iY] + aFITS3.aCnt[iY+1];
  Cont := sC / 9;


  if Q     then SetLength(AX,aFITS1.nLam+1);
  if Q4[1] then SetLength(AI,aFITS1.nLam+1);
  if Q4[2] then SetLength(AQ,aFITS1.nLam+1);
  if Q4[3] then SetLength(AU,aFITS1.nLam+1);
  if Q4[4] then SetLength(AV,aFITS1.nLam+1);
  if Q4[5] then SetLength(AP,aFITS1.nLam+1);
  if Q4[6] then SetLength(AD ,aFITS1.nLam);
  if Q1    then SetLength(AXd,aFITS1.nLam);


  iL := 1;
  if Q1    then rL1 := 1;
  if Q4[6] then rI0 := (A41[1,iL] + A42[1,iL] + A43[1,iL])/9;  // A4[1,1];

  for iL := 1 to aFITS1.nLam-1 do begin
    if Q     then AX[iL] := iL;
    if Q1    then AXd[iL] := iL+0.5;

    if Q4[1] then begin rI := (A41[1,iL] + A42[1,iL] + A43[1,iL])/9;
                        AI[iL] := rI;
                  end;
    if Q4[2] then begin rQ := (A41[2,iL] + A42[2,iL] + A43[2,iL])/9;;
                        AQ[iL] := rQ;
                  end;
    if Q4[3] then begin rU := (A41[3,iL] + A42[3,iL] + A43[3,iL])/9;
                        AU[iL] := rU;
                  end;
    if Q4[4] then begin rV := (A41[4,iL] + A42[4,iL] + A43[4,iL])/9;
                        AV[iL] := rV;
                  end;
    if Q4[5] then begin AP[iL] := SQRT(rQ*rQ+rU*rU);  end;
    if Q4[6] then begin AD[iL] := (rI-rI0); rI0 := rI end;
  end;

  iL := aFITS1.nLam;
  begin
    if Q     then AX[iL] := iL;

    if Q4[1] then begin rI := (A41[1,iL] + A42[1,iL] + A43[1,iL])/9;
                        AI[iL] := rI;
                  end;
    if Q4[2] then begin rQ := (A41[2,iL] + A42[2,iL] + A43[2,iL])/9;;
                        AQ[iL] := rQ;
                  end;
    if Q4[3] then begin rU := (A41[3,iL] + A42[3,iL] + A43[3,iL])/9;
                        AU[iL] := rU;
                  end;
    if Q4[4] then begin rV := (A41[4,iL] + A42[4,iL] + A43[4,iL])/9;
                        AV[iL] := rV;
                  end;
    if Q4[5] then begin AP[iL] := SQRT(rQ*rQ+rU*rU);  end;
  end;

end; (* TLFITS.GetFIT9ARe2 *)




function TLFITS.GetFIT9_SL(iX,iY:integer;sStokes:string):TStringList;
var aFITS1,aFITS2,aFITS3 : TFITS; A41,A42,A43,A4S : TA4In;
  SL : TStringList; S : string; iL,I4 : integer;
  Q4 : array[1..4] of boolean;
begin
  result := NIL;

  if Not Assigned(Self) then begin
    WarnAbs('TLFITS.GetFIT9_SL ERROR!'+#13#10+
    'LFITS Not Assigned Yet!!!');
    Exit;
  end;

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TLFITS.GetFIT9_SL ERROR!'+#13#10+
    'Headers Not Loaded Yet!!!');
    Exit;
  end;

  Q4[1] := (pos('I',sStokes) > 0);
  Q4[2] := (pos('Q',sStokes) > 0);
  Q4[3] := (pos('U',sStokes) > 0);
  Q4[4] := (pos('V',sStokes) > 0);


  aFITS1 := TFITS(Self.Items[iX-1]);
  aFITS2 := TFITS(Self.Items[iX  ]);
  aFITS3 := TFITS(Self.Items[iX+1]);

  A41 := aFITS1.GetFIT3(iY,sStokes);
  A42 := aFITS2.GetFIT3(iY,sStokes);
  A43 := aFITS3.GetFIT3(iY,sStokes);

  SL := TStringList.Create;

  S := 'L ';
  if Q4[1] then S := S + 'I ';
  if Q4[2] then S := S + 'Q ';
  if Q4[3] then S := S + 'U ';
  if Q4[4] then S := S + 'V ';
  SL.Add(S);

  for iL := 1 to aFITS1.nLam do begin
    S := ISt(iL) + ' ';
    for I4 := 1 to 4 do if Q4[I4] then
      S := S + FSt0(
      (A41[I4,iL] + A42[I4,iL] + A43[I4,iL])/9
      ,1) +' ';
    SL.Add(S);
  end;

  swStr.LineTabStrings(SL,1);
  result := SL;
end; (* TLFITS.GetFIT9_SL *)


procedure TLFITS.GetFITNorm9ARe(iX,iY:integer;sStokes:string;
                                var AX,AI,AQ,AU,AV:TARe);
var aFITS1,aFITS2,aFITS3 : TFITS; A41,A42,A43,A4S : TA4In;
//SL : TStringList; S : string;
  iL,I4 : integer;
  Q4 : array[1..4] of boolean;
  rCONT,rCONT1,rCONT2,rCONT3 : real;
begin

  if Not Assigned(Self) then begin
    WarnAbs('TLFITS.GetFIT9Norm_SL ERROR!'+#13#10+
    'LFITS Not Assigned Yet!!!');
    Exit;
  end;

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TLFITS.GetFIT9Norm_SL ERROR!'+#13#10+
    'Headers Not Loaded Yet!!!');
    Exit;
  end;

  Q4[1] := (pos('I',sStokes) > 0);
  Q4[2] := (pos('Q',sStokes) > 0);
  Q4[3] := (pos('U',sStokes) > 0);
  Q4[4] := (pos('V',sStokes) > 0);


  aFITS1 := TFITS(Self.Items[iX-1]);
  aFITS2 := TFITS(Self.Items[iX  ]);
  aFITS3 := TFITS(Self.Items[iX+1]);

  A41 := aFITS1.GetFIT3(iY,sStokes); (* выборка всех точек одного профиля *)
  A42 := aFITS2.GetFIT3(iY,sStokes);
  A43 := aFITS3.GetFIT3(iY,sStokes);


//aFITS1.ALam := aFITS1.GetALam;

  aFITS1.CalcSlitConts;
  rCONT1 := aFITS1.ACnt[iY] * Self.kRC;

  aFITS2.CalcSlitConts;
  rCONT2 := aFITS2.ACnt[iY] * Self.kRC;

  aFITS3.CalcSlitConts;
  rCONT3 := aFITS3.ACnt[iY] * Self.kRC;

  rCONT := (rCONT1 + rCONT2 + rCONT3) * 3;
  if rCONT = 0 then rCONT := 1; (* для областей за краем диска *)

                SetLength(AX,aFITS1.nLam+1);
  if Q4[1] then SetLength(AI,aFITS1.nLam+1);
  if Q4[2] then SetLength(AQ,aFITS1.nLam+1);
  if Q4[3] then SetLength(AU,aFITS1.nLam+1);
  if Q4[4] then SetLength(AV,aFITS1.nLam+1);

  for iL := 1 to aFITS1.nLam do begin
    AX[iL] := ALam[iL];
    if Q4[1] then AI[iL] := (A41[1,iL] + A42[1,iL] + A43[1,iL])/rCONT;
    if Q4[2] then AQ[iL] := (A41[2,iL] + A42[2,iL] + A43[2,iL])/rCONT;
    if Q4[3] then AU[iL] := (A41[3,iL] + A42[3,iL] + A43[3,iL])/rCONT;
    if Q4[4] then AV[iL] := (A41[4,iL] + A42[4,iL] + A43[4,iL])/rCONT;
  end;
end; (* TLFITS.GetFIT9NormARe *)


procedure TLFITS.GetFITNorm9ARe2(iX,iY:integer;sStokes:string;
                                 rL0:real;
                                 var AX,AXd,AI,AQ,AU,AV,AP,AD:TARe);
var aFITS1,aFITS2,aFITS3 : TFITS; A41,A42,A43,A4S : TA4In;
  iL,I4 : integer;
  nC : integer; (* размерность FITS.ACnt массивов *)

  Q4 : array[1..6] of boolean; Q,Q1 : boolean;
  rI,rQ,rU,rV : real;
  rL1,rL2,rI0 : real;

  rCONT,rCONT1,rCONT2,rCONT3 : real;
begin

  if Not Assigned(Self) then begin
    WarnAbs('TLFITS.GetFIT9Norm_SL ERROR!'+#13#10+
    'LFITS Not Assigned Yet!!!');
    Exit;
  end;

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TLFITS.GetFIT9Norm_SL ERROR!'+#13#10+
    'Headers Not Loaded Yet!!!');
    Exit;
  end;


{
##############################################################

procedure TLFITS.GetFIT9ARe2(iX,iY:integer;sStokes:string;
                      var AX,AXd,AI,AQ,AU,AV,AP,AD:TARe;var Cont:real);
var aFITS1,aFITS2,aFITS3 : TFITS; A41,A42,A43,A4S : TA4In;
  SL : TStringList; S : string;
  iL,I4 : integer;
  Q4 : array[1..6] of boolean; Q,Q1 : boolean;
  rI,rQ,rU,rV : real;
  rL1,rI0 : real;
  nC : integer;
  sC : real;

begin




  iL := 1;
  if Q1    then rL1 := 1;
  if Q4[6] then rI0 := (A41[1,iL] + A42[1,iL] + A43[1,iL])/9;  // A4[1,1];

  for iL := 1 to aFITS1.nLam-1 do begin
    if Q     then AX[iL] := iL;
    if Q1    then AXd[iL] := iL+0.5;

    if Q4[1] then begin rI := (A41[1,iL] + A42[1,iL] + A43[1,iL])/9;
                        AI[iL] := rI;
                  end;
    if Q4[2] then begin rQ := (A41[2,iL] + A42[2,iL] + A43[2,iL])/9;;
                        AQ[iL] := rQ;
                  end;
    if Q4[3] then begin rU := (A41[3,iL] + A42[3,iL] + A43[3,iL])/9;
                        AU[iL] := rU;
                  end;
    if Q4[4] then begin rV := (A41[4,iL] + A42[4,iL] + A43[4,iL])/9;
                        AV[iL] := rV;
                  end;
    if Q4[5] then begin AP[iL] := SQRT(rQ*rQ+rU*rU);  end;
    if Q4[6] then begin AD[iL] := (rI-rI0); rI0 := rI end;
  end;

  iL := aFITS1.nLam;
  begin
    if Q     then AX[iL] := iL;

    if Q4[1] then begin rI := (A41[1,iL] + A42[1,iL] + A43[1,iL])/9;
                        AI[iL] := rI;
                  end;
    if Q4[2] then begin rQ := (A41[2,iL] + A42[2,iL] + A43[2,iL])/9;;
                        AQ[iL] := rQ;
                  end;
    if Q4[3] then begin rU := (A41[3,iL] + A42[3,iL] + A43[3,iL])/9;
                        AU[iL] := rU;
                  end;
    if Q4[4] then begin rV := (A41[4,iL] + A42[4,iL] + A43[4,iL])/9;
                        AV[iL] := rV;
                  end;
    if Q4[5] then begin AP[iL] := SQRT(rQ*rQ+rU*rU);  end;
  end;

end; (* TLFITS.GetFIT9ARe2 *)

######################################################
}












  Q4[1] := (pos('I',sStokes) > 0);
  Q4[2] := (pos('Q',sStokes) > 0);
  Q4[3] := (pos('U',sStokes) > 0);
  Q4[4] := (pos('V',sStokes) > 0);
  Q4[5] := (pos('P',sStokes) > 0);
  Q4[6] := (pos('D',sStokes) > 0);
  Q1 := false;

  if pos('D',sStokes) > 0 then begin Q4[1] := true; Q1 := true; end;
  if pos('P',sStokes) > 0 then begin Q4[2] := true; Q4[3] := true end;

  Q := false;     (* для заполнения AX *)
  for I4 := 1 to 4 do if Q4[I4] then begin
//  SetLength(A4[I4],nLam+1); GetCol3(iY+1,I4,A4[I4]);
    Q := true;
  end;


  aFITS1 := TFITS(Self.Items[iX-1]);
  aFITS2 := TFITS(Self.Items[iX  ]);
  aFITS3 := TFITS(Self.Items[iX+1]);

  A41 := aFITS1.GetFIT3(iY,sStokes); (* три смежных просуммированных профиля *)
  A42 := aFITS2.GetFIT3(iY,sStokes);
  A43 := aFITS3.GetFIT3(iY,sStokes);

  nC := length(aFITS1.aCnt);
  if nC = 0 then aFITS1.CalcSlitConts; (* заполнить aCnt *)
  nC := length(aFITS2.aCnt);
  if nC = 0 then aFITS2.CalcSlitConts; (* заполнить aCnt *)
  nC := length(aFITS3.aCnt);
  if nC = 0 then aFITS3.CalcSlitConts; (* заполнить aCnt *)

//aFITS1.ALam := aFITS1.GetALam;

(*
  rCONT1 := aFITS1.ACnt[iY] * Self.kRC;
  rCONT2 := aFITS2.ACnt[iY] * Self.kRC;
  rCONT3 := aFITS3.ACnt[iY] * Self.kRC;
  rCONT := (rCONT1 + rCONT2 + rCONT3) * 3;
*)

  rCONT :=
        aFITS1.aCnt[iY-1] + aFITS1.aCnt[iY] + aFITS1.aCnt[iY+1] +
        aFITS2.aCnt[iY-1] + aFITS2.aCnt[iY] + aFITS2.aCnt[iY+1] +
        aFITS3.aCnt[iY-1] + aFITS3.aCnt[iY] + aFITS3.aCnt[iY+1];

  if rCONT = 0 then rCONT := 1; (* для областей за краем диска *)

//rCONT := rCONT / 9;


  if Q     then SetLength(AX,aFITS1.nLam+1);
  if Q4[1] then SetLength(AI,aFITS1.nLam+1);
  if Q4[2] then SetLength(AQ,aFITS1.nLam+1);
  if Q4[3] then SetLength(AU,aFITS1.nLam+1);
  if Q4[4] then SetLength(AV,aFITS1.nLam+1);
  if Q4[5] then SetLength(AP,aFITS1.nLam+1);
  if Q4[6] then SetLength(AD ,aFITS1.nLam);
  if Q1    then SetLength(AXd,aFITS1.nLam);


//--------------------------------------



{
  if Q1    then rL1 := TLFITS(Owner).ALam[1];
  if Q4[6] then rI0 := A4[1,1]/rCONT;

  for iL := 1 to Self.nLam-1 do begin
    if Q     then AX[iL] := TLFITS(Owner).ALam[iL] - rL0; // 6301.5;
    if Q1    then begin
               rL2 := TLFITS(Owner).ALam[iL+1];
               AXd[iL] := (rL2 + rL1)/2 - rL0;
               rL1 := rL2;
             end;
    if Q4[1] then begin rI := A4[1,iL]/rCONT; AI[iL] := rI; end;
    if Q4[2] then begin rQ := A4[2,iL]/rCONT; AQ[iL] := rQ; end;
    if Q4[3] then begin rU := A4[3,iL]/rCONT; AU[iL] := rU; end;
    if Q4[4] then begin rV := A4[4,iL]/rCONT; AV[iL] := rV; end;
    if Q4[5] then begin AP[iL] := SQRT(rQ*rQ+rU*rU);        end;
    if Q4[6] then begin AD[iL] := (rI-rI0)/(rL2-rL1); rI0 := rI end;
  end;

  iL := nLam;
  begin
    if Q     then AX[iL] := TLFITS(Owner).ALam[iL] - rL0;
    if Q4[1] then begin rI := A4[1,iL]/rCONT; AI[iL] := rI; end;
    if Q4[2] then begin rQ := A4[2,iL]/rCONT; AQ[iL] := rQ; end;
    if Q4[3] then begin rU := A4[3,iL]/rCONT; AU[iL] := rU; end;
    if Q4[4] then begin rV := A4[4,iL]/rCONT; AV[iL] := rV; end;
    if Q4[5] then begin AP[iL] := SQRT(rQ*rQ+rU*rU);        end;
  end;




#####################################
}

  iL := 1;
  if Q1    then rL1 := ALam[1] - rL0;
  if Q4[6] then rI0 := (A41[1,iL] + A42[1,iL] + A43[1,iL])/rCONT;


  for iL := 1 to aFITS1.nLam-1 do begin
    if Q     then AX[iL] := ALam[iL] - rL0; // 6301.5;
    if Q1    then begin
               rL2 := ALam[iL+1] - rL0;
               AXd[iL] := (rL2 + rL1)/2;
//             rL1 := rL2;
             end;
    if Q4[1] then begin rI := (A41[1,iL] + A42[1,iL] + A43[1,iL])/rCONT;
                  AI[iL] := rI;
             end;
    if Q4[2] then begin rQ := (A41[2,iL] + A42[2,iL] + A43[2,iL])/rCONT;
                  AQ[iL] := rQ;
             end;
    if Q4[3] then begin rU := (A41[3,iL] + A42[3,iL] + A43[3,iL])/rCONT;
                  AU[iL] := rU;
             end;
    if Q4[4] then begin rV := (A41[4,iL] + A42[4,iL] + A43[4,iL])/rCONT;
                  AV[iL] := rV;
             end;
    if Q4[5] then begin AP[iL] := SQRT(rQ*rQ+rU*rU);        end;
    if Q4[6] then begin AD[iL] := (rI-rI0)/(rL2-rL1);
                  rI0 := rI; rL1 := rL2;
             end;
  end;

  iL := aFITS1.nLam;
  begin
    if Q     then AX[iL] := ALam[iL] - rL0; // 6301.5;
    if Q4[1] then begin rI := (A41[1,iL] + A42[1,iL] + A43[1,iL])/rCONT;
                  AI[iL] := rI;
             end;
    if Q4[2] then begin rQ := (A41[2,iL] + A42[2,iL] + A43[2,iL])/rCONT;
                  AQ[iL] := rQ;
             end;
    if Q4[3] then begin rU := (A41[3,iL] + A42[3,iL] + A43[3,iL])/rCONT;
                  AU[iL] := rU;
             end;
    if Q4[4] then begin rV := (A41[4,iL] + A42[4,iL] + A43[4,iL])/rCONT;
                  AV[iL] := rV;
             end;
    if Q4[5] then begin AP[iL] := SQRT(rQ*rQ+rU*rU);        end;
  end;
end; (* TLFITS.GetFIT9NormARe *)




function TLFITS.GetFIT9Norm_SL(iX,iY:integer;sStokes:string):TStringList;
var aFITS1,aFITS2,aFITS3 : TFITS; A41,A42,A43,A4S : TA4In;
  SL : TStringList; S : string; iL,I4 : integer;
  Q4 : array[1..4] of boolean;
  rCONT,rCONT1,rCONT2,rCONT3 : real;
begin
  result := NIL;

  if Not Assigned(Self) then begin
    WarnAbs('TLFITS.GetFIT9Norm_SL ERROR!'+#13#10+
    'LFITS Not Assigned Yet!!!');
    Exit;
  end;

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TLFITS.GetFIT9Norm_SL ERROR!'+#13#10+
    'Headers Not Loaded Yet!!!');
    Exit;
  end;

  Q4[1] := (pos('I',sStokes) > 0);
  Q4[2] := (pos('Q',sStokes) > 0);
  Q4[3] := (pos('U',sStokes) > 0);
  Q4[4] := (pos('V',sStokes) > 0);


  aFITS1 := TFITS(Self.Items[iX-1]);
  aFITS2 := TFITS(Self.Items[iX  ]);
  aFITS3 := TFITS(Self.Items[iX+1]);

  A41 := aFITS1.GetFIT3(iY,sStokes);
  A42 := aFITS2.GetFIT3(iY,sStokes);
  A43 := aFITS3.GetFIT3(iY,sStokes);


//aFITS1.ALam := aFITS1.GetALam;

  aFITS1.DefaultContArea;
  aFITS1.CalcSlitConts;
  rCONT1 := aFITS1.ACnt[iY] * Self.kRC;

  aFITS2.DefaultContArea;
  aFITS2.CalcSlitConts;
  rCONT2 := aFITS2.ACnt[iY] * Self.kRC;

  aFITS3.DefaultContArea;
  aFITS3.CalcSlitConts;
  rCONT3 := aFITS3.ACnt[iY] * Self.kRC;

  rCONT := (rCONT1 + rCONT2 + rCONT3) * 3;
  if rCONT = 0 then rCONT := 1; (* для областей за краем диска *)


  SL := TStringList.Create;

  S := 'L ';
  if Q4[1] then S := S + 'I ';
  if Q4[2] then S := S + 'Q ';
  if Q4[3] then S := S + 'U ';
  if Q4[4] then S := S + 'V ';
  SL.Add(S);

  for iL := 1 to aFITS1.nLam do begin
    S := EFSt0(ALam[iL],9) + ' ';
    for I4 := 1 to 4 do if Q4[I4] then
      S := S + EFSt0(
      (A41[I4,iL] + A42[I4,iL] + A43[I4,iL])/rCONT
      ,6) +' ';
    SL.Add(S);
  end;

  swStr.LineTabStrings(SL,1);
  result := SL;
end; (* TLFITS.GetFIT9Norm_SL *)



constructor TLFITS.Create;
begin
  inherited Create;

  QDebug    := false;
  QLight    := false; (* По умолчанию данные FITS  хранить        *)
  QRowData  := false; (* "взводим" после загрузки из "сырых" FITS *)
  QSW       := false; (* существование SWFITS файла не проверено  *)
  QCalcCont := false; (* включим при расчёте                      *)

  Self.nData_s := 0;
  Self.nHead_s := 0;

  kRun := $A55AA55A;
end;

{
procedure TLFITS.ShowData(sName,sName2,sOP:string);
var Ou1,Ou2,Ou : TFIOut;
  //Ou1,Ou2,Ou : TFIPOut;
    O1,O2,O : TFIOut; Ch : char;
begin
  O1 := GetData(sName);
  Ou1 := TFIOut.Create; Ou1.CloneFrom(O1); (* карта "картинки" *)

  if Not Ou1.CheckFill then begin
    WarnAbs('LFITS.ShowData('+sName+') WARNING: массив данных не заполнен!');
    Exit;
  end;
  Ch := sOP[1];
  if Ch <> '0' then begin
    O2  := GetData(sName2);
    Ou2 := TFIOut.Create; Ou2.CloneFrom(O2);



//  if Not Assigned (Ou2) then Exit;
    if Not Ou2.CheckFill then begin
      WarnAbs('LFITS.ShowData('+sName2+') WARNING: массив данных не заполнен!');
      Exit;
    end;

    Ou  := TFIOut.Create;
  end;

  if Ch = '0' then begin
                Ou1.Pict.Init(Ou1.aData);
                Ou1.ShowData
              end
              else begin
                Ou.Fuse(Ou1,Ou2,Ch);
                Ou.ShowData;
              end;

end; (* TLFITS.ShowData *)
}


{
(* загрузка специального FITOut, который рисует картинку *)
(* на входе 4 имени карт и 3 + 2 действия над картами *)
procedure TLFITS.OuPictLoad(sN1,sN2,sN3,sN4:string;chOp,chOp3,chOp13:char;
  s1Op1,s1Op3:string);

var Ou1,Ou2,Ou3,Ou4,Ou01,Ou02,Ou : TFIOut; ch1Op1,ch1Op3 : char;

procedure FITFunc1(var OO : TFIOut; ch : char);
begin
(*--
  case ch of
  'i' : OO.Inv;
  'n' : OO.Neg;
  'e' : OO.Exp10;
  'l' : OO.Log;
  'a' : OO.Abs;
  end; // case
--*)
end;

begin

  (*------------------------------------------------------*)
  (*          операции neg,abs,log,inv,exp                *)
  (*  над парами операндов                                *)
  if s1Op1 <> '' then ch1Op1 := s1Op1[1] else ch1Op1 := ' ';
  if s1Op3 <> '' then ch1Op3 := s1Op3[1] else ch1Op3 := ' ';

  (*======== верхние два поля (верхняя строка) ==========*)
  (*                                                     *)

  Ou1 := GetData(sN1);
//if Not Assigned (Ou1) then Exit;
  if Not Ou1.CheckFill then begin
    WarnAbs('LFITS.ShowData('+sN1+') WARNING: массив данных не заполнен!');
    Exit;
  end;

  if chOp <> '0' then begin
    Ou2 := GetData(sN2);

//  if Not Assigned (Ou2) then Exit;
    if Not Ou2.CheckFill then begin
      WarnAbs('LFITS.ShowData('+sN2+') WARNING: массив данных не заполнен!');
      Exit;
    end;

//  Ou  := TFIOut.Create;
  end;

  (*                                                     *)
  (*================== верхние два поля =================*)





  if chOp13 <> '0' then begin

  (*==================== поля 3 и 4 =====================*)
  (*                                                     *)

    Ou3 := GetData(sN3);
//    if Not Assigned (Ou3) then Exit;
//    if (Not Assigned(Ou3.aData)) or (length(Ou3.aData)=0) then begin
    if Not Ou3.CheckFill then begin
      WarnAbs('LFITS.ShowData('+sN3+') WARNING: массив данных не заполнен!');
      Exit;
    end;

    if chOp3 <> '0' then begin
      Ou4 := GetData(sN4);
//    if Not Assigned (Ou4) then Exit;
//    if (Not Assigned(Ou4.aData)) or (length(Ou4.aData)=0) then begin
      if Ou3.CheckFill then begin
        WarnAbs('LFITS.ShowData('+sN4+') WARNING: массив данных не заполнен!');
        Exit;
      end;
    end;
  (*                                                     *)
  (*==================== поля 3 и 4 =====================*)
  end;




  (*======== итоговый Ou для первой пары ==============*)
  if chOp = '0' then begin
                  Ou01 := Ou1;
                end
                else begin
                  Ou01 := TFIOut.Create;
                  Ou01.Fuse(Ou1,Ou2,chOp);
                end;
  (*========= если задана операция типа neg и т.д. ====*)
  FITFunc1(Ou01,ch1Op1);


  (*=========== если задана комбинация двух пар =========*)
  if chOp13 in ['+','-','/'] then begin


  (*======== итоговый Ou для второй пары ==============*)
    if chOp3 = '0' then begin
                    Ou02 := Ou3;
                  end
                  else begin
                    Ou02 := TFIOut.Create;
                    Ou02.Fuse(Ou3,Ou4,chOp3);
                  end;

  (*========= если задана операция типа neg и т.д. ====*)
    FITFunc1(Ou02,ch1Op3);


    if chOp13 = '+' then begin

      (*--------------------------------------*)
      (* если в итоге складываем три величины *)

      if (chOp <> '+') and (chOp3 = '+') then begin
        Ou02.Mul(2);
        Ou := TFIOut.Create;
        Ou.Fuse(Ou01,Ou02,chOp13);
        Ou.Mul(2/3);
      end
      else begin
        if (chOp = '+') and (chOp3 <>'+') then begin
          Ou01.Mul(2);
          Ou := TFIOut.Create;
          Ou.Fuse(Ou01,Ou02,chOp13);
          Ou.Mul(2/3);
        end

      (* если в итоге складываем три величины *)
      (*--------------------------------------*)

        else begin
          Ou := TFIOut.Create;
          Ou.Fuse(Ou01,Ou02,chOp13);
        end;
      end;
    end
    else begin
      Ou := TFIOut.Create;
      Ou.Fuse(Ou01,Ou02,chOp13);
    end;
  end
  else
    Ou := Ou01;

//Self.OuPict := Ou;
  Self.OuPict := TFIOut.Create;
  OuPict.CloneFrom(Ou);

end; (* TLFITS.OuPictLoad *)
}






(* >>>>>-- процедура TLFITS.ShowData4 устарела, её надо удалить --<<<<< *)
{
procedure TLFITS.ShowData4(sN1,sN2,sN3,sN4:string;chOp,chOp3,chOp13:char;
  s1Op1,s1Op3:string;
  rMi,rMa:real;qHist0:boolean;var sMi,sMa:string);
var nVal : integer;
begin

  OuPictLoad(sN1,sN2,sN3,sN4,chOp,chOp3,chOp13,s1Op1,s1Op3);

  if Not Assigned(OuPict) then Exit;
//Self.OuPict := Ou;

  nVal := 256;

  OuPict.Pict.Init(OuPict.aData);
  OuPict.Pict.LinScaleR(nVal,rMi,rMa);

  sMi := EFSt0(OuPict.Pict.dMi,4);
  sMa := EFSt0(OuPict.Pict.dMa,4);

  OuPict.ShowData;

//  Ed.EdLoadSL('Histogramm',Ou.Pict.SL);
end;  (* TLFITS.ShowData4 *)
}



(* получить объект FIOut по его имени *)
{
function TLFITS.GetData(sName:string):TFIOut;
var k : integer;
begin
  Result := NIL;
  if Not Assigned(Self) then begin
    WarnAbs('LFITS.GetData("'+sName+'") LFITS не инициирован!');
    Exit;
  end;
  if Not Assigned(OuCont)  then if Not Self.swFITSInit then Exit;
  if Not Assigned(OuCnt)   then if Not Self.swFITSInit2 then Exit;
  if Not Assigned(MeCI)   then MeFITSInit;

  if OuCnt .Name = sName then result := OuCnt  else
  if OuVc1 .Name = sName then result := OuVc1  else
  if OuVc2 .Name = sName then result := OuVc2  else
  if OuH1  .Name = sName then result := OuH1   else
  if OuH2  .Name = sName then result := OuH2   else
  if OuHG1 .Name = sName then result := OuHG1  else
  if OuHG2 .Name = sName then result := OuHG2  else
  if OuW1  .Name = sName then result := OuW1   else
  if OuW2  .Name = sName then result := OuW2   else
  if OuKVI .Name = sName then result := OuKVI  else
//  if OuII0 .Name = sName then result := OuII0  else
//  if OuVV0 .Name = sName then result := OuVV0  else
  if OuCont.Name = sName then result := OuCont else
  if OuGc1 .Name = sName then result := OuGc1  else
  if OuGc2 .Name = sName then result := OuGc2  else
  if MeCI  .Name = sName then result := MeCI   else
  if MeCIO .Name = sName then result := MeCIO  else
  if MeQUV .Name = sName then result := MeQUV  else
  if MeH   .Name = sName then result := MeH    else
  if MeGM  .Name = sName then result := MeGM   else
  if MeXI  .Name = sName then result := MeXI   else
  if MeVLo1.Name = sName then result := MeVLo1 else
  if MeVLo2.Name = sName then result := MeVLo2 else

  if MeLiSt.Name = sName then result := MeLiSt else
  if MeA.Name    = sName then result := MeA else
  if MeWD.Name   = sName then result := MeWD else
  if MeVma.Name  = sName then result := MeVma else

  if MeB0.Name   = sName then result := MeB0 else
  if MeBeta.Name = sName then result := MeBeta else


  if MeHL  .Name = sName then result := MeHL  else
  begin
    for k := 3 to 5 do begin
      if Ou35C1[k].Name = sName then begin result := Ou35C1[k]; Exit end;
      if Ou35C2[k].Name = sName then begin result := Ou35C2[k]; Exit end;
      if Ou35I1[k].Name = sName then begin result := Ou35I1[k]; Exit end;
      if Ou35I2[k].Name = sName then begin result := Ou35I2[k]; Exit end;
      if Ou35D1[k].Name = sName then begin result := Ou35D1[k]; Exit end;
      if Ou35D2[k].Name = sName then begin result := Ou35D2[k]; Exit end;
    end;

    for k := 1 to MBiSec do begin
      if OuBiC1[k].Name = sName then begin result := OuBiC1[k]; Exit end;
      if OuBiC2[k].Name = sName then begin result := OuBiC2[k]; Exit end;
      if OuBiW1[k].Name = sName then begin result := OuBiW1[k]; Exit end;
      if OuBiW2[k].Name = sName then begin result := OuBiW2[k]; Exit end;
    end;

    result := NIL;
    WarnAbs('LFITS.GetData WARN: FIOut с именем "'+sName+'" не найден!');
  end;
end; (* TLFITS.GetData *)
}

(* избранный список имён карт для комбо-боксов для разных операций *)
{
function TLFITS.OuMeSL:TStringList;
var SL : TStringList; k : integer;
begin
  result := NIL;

  if Not Assigned(OuCont)    then if Not swFITSInit   then Exit;
  if Not Assigned(OuCnt)     then if Not swFITSInit2  then Exit;
  if Not Assigned(Ou35C1[3]) then if Not swFITSInitBi then Exit;
  if Not Assigned(MeCI)      then Self.MeFITSInit;

  SL := TStringList.Create;


  (* избранные карты рассчитанного или загруженного swFIT *)

  (*---- карты, полученные после расчёта интегральных величин ---------*)
  SL.Add(OuCnt.Name); (* нормированный на средн.знач.в немагн.областях *)
  SL.Add(OuVc1.Name); (* положение центра, относительное в км/с *)
  SL.Add(OuVc2.Name);

  (* эквивалентная ширина *)
  SL.Add(OuW1.Name);
  SL.Add(OuW2.Name);

  (* ---- продольное поле --------*)
  SL.Add(OuH1.Name);   (* по "нормированному моменту" *)
  SL.Add(OuH2.Name);
  SL.Add(OuHG1.Name);  (* методом COG *)
  SL.Add(OuHG2.Name);

  (* индекс "магнитности" по V-параметру Стокса *)
  SL.Add(OuKVI.Name);




  for k := 3 to 5 do begin
    SL.Add(Self.Ou35C1[k].Name);
    SL.Add(Self.Ou35C2[k].Name);
    SL.Add(Self.Ou35I1[k].Name);
    SL.Add(Self.Ou35I2[k].Name);
    SL.Add(Self.Ou35D1[k].Name);
    SL.Add(Self.Ou35D2[k].Name);
  end;


  for k := 1 to MBiSec do begin
    SL.Add(Self.OuBiC1[k].Name);
    SL.Add(Self.OuBiC2[k].Name);
    SL.Add(Self.OuBiW1[k].Name);
    SL.Add(Self.OuBiW2[k].Name);
  end;





  (* "разделители" профилей двух линий *)
//  SL.Add(OuII0.Name);
//  SL.Add(OuVV0.Name);


  SL.Add(OuCont.Name); (* "Первопроходной" CONT в единицах шкалы измерений *)
  SL.Add(OuGc1.Name);  (* в пикселах  полож.центра тяжести *)
  SL.Add(OuGc2.Name);




  (* добавим избранные карты MEfit *)

  SL.Add(MeCI.Name);
  SL.Add(MeCIO.Name);
  SL.Add(MeQUV.Name);
  SL.Add(MeH.Name);
  SL.Add(MeHL.Name);
  SL.Add(MeGM.Name);
  SL.Add(MeXI.Name);

(*
  SL.Add(MeVLo1.Name);
  SL.Add(MeVLo2.Name);
*)

  SL.Add(MeLiSt.Name);
  SL.Add(MeA.Name);
  SL.Add(MeWD.Name);
  SL.Add(MeVma.Name);

  SL.Add(MeB0.Name);
  SL.Add(MeBeta.Name);


  (*-----------------------*)

  result := SL;
end; (* TLFITS.OuMeSL *)
}

{
procedure TLFITS.MEDone;
begin
  MeCI.Done;
  MeCIO.Done;
  MeQUV.Done;
  MeH.Done;
  MeGM.Done;
  MeXI.Done;


  MeVLo1.Done;
  MeVLo2.Done;


  MeLiSt.Done;
  MeA.Done;
  MeWD.Done;
  MeVma.Done;

  MeB0.Done;
  MeBeta.Done;

  MeHL.Done;
end;
}

procedure TLFITS.OuDone;
begin





  (*--- Для первого прохода ---*)
  OuCont.Done;
  OuAny1.Done;

  OuGc1.Done;
  OuGc2.Done;
//  OuSI.Done;
//  OuSVA.Done;
  OuKVI.Done;
//  OuII0.Done;
//  OuVV0.Done;
  OuW1.Done;
  OuW2.Done;
//OuW3.Done;
//  OumV1.Done;
//  OumV2.Done;
  OuH1.Done;
  OuH2.Done;
  OuHG1.Done;
  OuHG2.Done;

  (*--- после расчёта интегральных величин ---*)
  OuCnt.Done;
//OuCnm.Done;
  OuVc1.Done;
  OuVc2.Done;

{
  OuCI.Done;
  OuCQ.Done;
  OuCU.Done;
  OuCV.Done;
  OuDI.Done;
  OuDQ.Done;
  OuDU.Done;
  OuDV.Done;
}

  (*--- Для данных MERLIN-инверсии ---*)
  MeH.Done;
  MeGM.Done;
  MeHL.Done;

  {
  MeCI.Done;
  MeCIO.Done;
  MeQUV.Done;
  MeXI.Done;


  MeVLo1.Done;
  MeVLo2.Done;


  MeLiSt.Done;
  MeA.Done;
  MeWD.Done;
  MeVma.Done;

  MeB0.Done;
  MeBeta.Done;
}
end;



procedure TLFITS.Done;
var iX : integer; aFITS : TFITS;
begin
  if Not Assigned(Self) then Exit;

  for iX := Self.Count-1 downto 0 do begin
    aFITS := TFITS(Items[iX]);
    aFITS.Done; aFITS.Free;
  end;
  Self.Clear;


  Self.KStep := 0;
  Self.sPath := '';
  Self.Dir.Done;
  Self.kDir := 0;

  //FMap  := NIL;
  sPath := '';
  sPOut := '';
  sFSW  := '';
  sFME  := '';
  sFM2  := '';

  if Assigned (HSL) then begin
    HSL.Clear;
//  HSL.Free;
    FreeAndNil(HSL);
  end;
  if Assigned (HmeSL) then begin
//  WarnAbs('HmeSL.Count = '+ISt(HmeSL.Count));
    HmeSL.Clear;
//  HmeSL.Free;
  end;
  if Assigned (Hm2SL) then begin
    Hm2SL.Clear;
  end;
  if Assigned (HswSL) then begin
    HswSL.Clear;
//  HswSL.Free; (* входной Хидер файлов SunWorld *)
  end;

  nsHead   := 0;
  nlHead   := 0;
  nbHead   := 0;
  nData    := 0;
  nbData   := 0;



  (* для задания положений границ линий
  il1,il2 : integer;
  il3,il4 : integer;
  il5,il6 : integer;
  -----------------------------------*)

  rLamIdx0 := 0;
  rdLam    := 0;
  rLa00    := 0;
  kLamChk  := 0;
  rExpTime := 0;

  Finalize(ALam);   (* LFITS.ALam *)

  xCenME := 0;
  yCen   := 0;
  R_Sun  := 0;
  xScale := 0;
  yScale := 0;
  sTStart:= '';
  sTEnd  := '';
  p_Angle:= 0;
  b_Angle:= 0;

  Self.tDura   := 0;
  Self.tMin0   := 0;
  Self.tDay    := 0;
  Self.dVlosMi := 0;
  Self.dVlosMa := 0;
  Self.tdVMi   := 0;
  Self.tdVMa   := 0;
  Self.Ts_1    := 0;
  Self.Ts_2    := 0;
  Self.Ts_3    := 0;
  Self.Ts_4    := 0;
  Self.Ts_5    := 0;
  Self.Ts_6    := 0;

  (*------ интегральные величины ---------*)

  (* для контроля за возможным различием единиц измерения I и QUV *)
  iIMax := 0;
  iIMin := 0;
  iVMax := 0;
  AbsVIMax := 0;



  rCntMH0 := 0;
  Finalize(ACnYH0);
  Finalize(ACnXH0);
//Finalize(AXP);
//Finalize(AXX);

  rCntYA  := 0;
  rCntYB  := 0;
  rCntXA  := 0;
  rCntXB  := 0;



  Gc1     := 0;
  Gc2     := 0;
  rLC1M   := 0;
  rLC2M   := 0;
  HNMa    := 0;
  HSMa    := 0;
  VRMa    := 0;
  VBMa    := 0;
  rCntMa  := 0;
  rCntMi  := 0;
  iXHN    := 0;
  iYHN    := 0;
  iXHS    := 0;
  iYHS    := 0;
  iXVR    := 0;
  iYVR    := 0;
  iXVB    := 0;
  iYVB    := 0;
  iXCA    := 0;
  iYCA    := 0;
  iXCI    := 0;
  iYCI    := 0;
  rLa1    := 0;
  rLa2    := 0;
  rLa3    := 0;
//  FillChar(boundL,SizeOf(TrBounds3),#0);
//  FillChar(boundC,SizeOf(TrBounds3),#0);
  dl6301  := 0;
  dl6302  := 0;
  kRC     := 0;
  kRC0    := 0;
  lsmooth := 0;
  nX      := 0;
  nY      := 0;
  nXP     := 0;

//OuDone;

  Self.nData_s := 0;
  Self.nHead_s := 0;

(*******************************************************)

end; (* TLFITS.Done *)


type
  TKeyRec = Class(TObject)  //  record
    sKey : string;
    sVal : string;
    Q1   : boolean;
    QSkip: boolean; (* 'не интересный' ключ *)
  end;

function TLFITS.ReportIntegrVals:TStringList;
var J : integer; SL : TStringList; S : string; aFITS : TFITS;
begin
  Time_routine('LFITS.ReportIntegrVals',true);
  result := NIL;
  if Self.Count = 0 then Exit;
  SL := TStringList.Create;
  J := 0; aFITS := TFITS(Self.Items[J]); S := aFITS.ValRepHd; SL.Add(S);
  for J := 0 to Self.Count-1 do begin (* по каждому из FITS-ев *)
    aFITS := TFITS(Self.Items[J]); S := aFITS.ValReport; SL.Add(S);
  end;
  swStr.LineTabStrings(SL,1);
  result := SL;
  Time_routine('LFITS.ReportIntegrVals',false);
end; (* TLFITS.ReportIntegrVals *)


(* занести рассчитанные данные в массивы     *)
(* которые можно будет вывести в наши FITS-ы *)
(* инф-у получаем из исходных FITS-ев        *)
procedure TLFITS.FillData;
var iX,iY,N : integer; aFITS : TFITS; S : string;
    H1,H2,HG1,HG2,Cnt,Dsp,Vc1,Vc2,W1,W2,kVI(*,II0,VV0*) : real;
begin
  Time_routine('LFITS.FillData',true);
  nX := Self.Count;
  if (nX = 0) then Exit;
  iX := 0; aFITS := TFITS(Self.Items[iX]); nY := aFITS.nY;


  for iX := 0 to nX-1 do begin (* по каждому из FITS-ев *)
    aFITS := TFITS(Self.Items[iX]);
    for iY := 0 to nY-1 do begin
      aFITS.GetIYData(iY,H1,H2,HG1,HG2,Cnt,Dsp,Vc1,Vc2,W1,W2,kVI(*,II0,VV0*));

      OuH1.aData [iX,iY] := H1;
      OuH2.aData [iX,iY] := H2;
      OuHG1.aData[iX,iY] := HG1;
      OuHG2.aData[iX,iY] := HG2;
      OuCnt.aData[iX,iY] := Cnt;
      OuVc1.aData[iX,iY] := Vc1;
      OuVc2.aData[iX,iY] := Vc2;
      OuW1.aData [iX,iY] := W1;
      OuW2.aData [iX,iY] := W2;
      OukVI.aData[iX,iY] := kVI;
    end;
  end;

  SetBit.BISB(Self.KStep,3); (* = +8 *)
  Time_routine('LFITS.FillData',false);
end; (* TLFITS.FillData *)


(* получить вектор значений вдоль оси Y для карты FO *)
(* которая должна входить в данный LFITS             *)
(* индексы A:TARe от 1 !                             *)
procedure TLFITS.GetXFOARe(FO:TFIOut;iX:integer;var A:TARe);
var iY,n : integer; R : real;
begin
  if Not Assigned(FO) then begin
    WarnAbs('LFITS.GetXFOARe FO not Assigned!');
    SetLength(A,0);
    Exit;
  end;
  n := FO.nY;
  SetLength(A,n+1);
  A[0] := 0;
  for iY := 0 to n-1 do begin
    R := FO.aData[iX,iY];
    A[iY+1] := R;
  end;
end;




procedure TLFITS.AverageH1onH2(dH:real;var AHM2,AHM1:TARe);
var h,dH2,Hmin,Hmax,H0,H1 : real; iX, iY, nX, nY : integer;
begin
  if Not SetBit.IsBit(Self.KStep,3) then begin
    WarnAbs('TLFITS.AverageH1onH2 ERR: Fill Arrays First!');
    Exit;
  end;


  (* найдем Hmin, Hmax *)
  Hmin := OuH2.aData[0,0]; Hmax := Hmin;

  for iX := 0 to nX-1 do begin
    for iY := 0 to nY-1 do begin
      h := OuH2.aData[iX,iY];
      if h < Hmin then Hmin := h else
      if h > Hmax then Hmax := h;
    end;
  end;

  (* найдем H0,H1 - точки ЗА границами Hmin,Hmax кратные dH *)

    //##



end; (* TLFITS.AverageH1onH2 *)




function TLFITS.Report:TStringList;
var IX,IY,N : integer; SL : TStringList; S : string; aFITS : TFITS;
begin
  result := NIL;
  if Self.Count = 0 then Exit;
  SL := TStringList.Create;
  (* сформируем заголовок *)
  IX := 0; aFITS := TFITS(Self.Items[IX]);
  S := aFITS.ReportHead; S := 'N IX ' + S; SL.Add(S);
  N := 0;
  for IX := 0 to Self.Count-1 do begin (* по каждому из FITS-ев *)
    aFITS := TFITS(Self.Items[IX]);
    for IY := 0 to aFITS.nY-1 do begin
      inc(N);
      S := ISt(N)+' '+ISt(IX)+' '+aFITS.ReportIY(IY);
      SL.Add(S);
    end;
  end;
  swStr.LineTabStrings(SL,1);
  result := SL;
end; (* TLFITS.Report *)


procedure HeaderReField(var hSL:TStringList;sKey,S:string);
var QWr : boolean;
begin HeaderReField(hSL,sKey,S,QWr); end;


(* замена строки в хидере по ключу *)
(* S - новая строка целиком, т.е. строка 80 символов Key+Val+Comment *)
procedure HeaderReField(var hSL:TStringList;sKey,S:string;var QWr:boolean);
var n,i,ii : integer; SS,S0,sKey0 : string;
begin
  QWr := false;
  if length(S) <> 80 then begin
    WarnAbs('HeaderReField - ERR: вставляемая строка должна быть длиной '+
            '80 символов:'+#13#10+'<'+S+'>');
    Exit;
  end;

{
function SLFindStringHeadL(S:string;L:integer;SL:TStrings):integer;
function SLCutStringHeadL(S:string;J0,L:integer;var SL:TStrings):integer;
}
  if Not Assigned(hSL) then Exit;
  sKey0 := Trim(swStr.left(S,'=')); (* ОСНОВНОЙ  ключ *)

  n := swStr.SLFindStringHead(sKey0,'=',hSL);
  if n >= 0 then begin
    SS := hSL.Strings[n];
    if (Not (SS = S)) then QWr := true;
    hSL.Strings[n] := S;
    for ii := hSL.Count - 1 downto n+1 do begin
      S0 := Trim(left(hSL.Strings[ii],'='));
      if (sKey0 = S0) then begin
        hSL.Delete(ii); (* повторное вхождение Main-ключа *)
        QWr := true;
      end;
    end;
  end
  else begin                        (* Ключ строки под замену *)
    n := swStr.SLFindStringHead(sKey,'=',hSL);
    if n >= 0 then begin
      QWr := true;
      hSL.Strings[n] := S;
      for ii := hSL.Count - 1 downto n+1 do begin
        S0 := Trim(left(hSL.Strings[ii],'='));
        if (sKey = S0) then hSL.Delete(ii); (* повторное вхождение Alt-ключа *)
      end;
    end
    else begin
      QWr := true;
      i := swStr.SLFindStringHead('END',hSL);
      if i > 0 then hSL.Insert(i,S)
               else begin
                 hSL.Add(S);
                 WarnAbs('HeaderReField: в Header-е не найден "END", вставляем'+
                   #13#10+S);
               end;
    end;
  end;
end; (* HeaderReField *)

procedure HeaderEraseField(hSL:TStringList;sKey:string);
var ii : integer; S0 : string;
begin
  for ii := hSL.Count - 1 downto 0 do begin
    S0 := Trim(left(hSL.Strings[ii],'='));
    if (sKey = S0) then hSL.Delete(ii);
  end;
end;




(* сформировать строку для Header-а из ключа, значения и коммента *)
function MakeHdStr(sKey,sVal,sCom:string):string;
var S : string;
begin
  S := swStr.SSt(sKey,8)+'='+' '+swStr.JustStr(sVal,20,JRight)+' / '+sCom;
  result := SSt(S,80);
end;

function MakeHdIS(sKey:string;iVal:integer;sCom:string):string;
begin
  result := MakeHdStr(sKey,ISt(iVal),sCom);
end;

function MakeHdES(sKey:string;rVal:real;NDig:integer;sCom:string):string;
begin
  result := MakeHdStr(sKey,EFSt(rVal,NDig),sCom);
end;

function MakeHdFS(sKey:string;rVal:real;NDig:integer;sCom:string):string;
begin
  result := MakeHdStr(sKey,FSt(rVal,NDig),sCom);
end;


function MakeHdQS(sKey,sVal,sCom:string):string;
var S,sq : string;
begin
  if length(sVal)< 8 then sq := SSt(sVal,8) else sq := sVal;
  sq := ''''+sVal+'''';
  if length(sq) < 20 then sq := SSt(sq,20);

  S := swStr.SSt(sKey,8)+'='+' '+sq+' / '+sCom;
  result := SSt(S,80);
end;

(* извлечь комментарий из строки Header-а *)
function GetHdCom(S80:string):string;
begin
  result := '';
end;





procedure TLFITS.UpDate; (* выгрузить данные в контролы *)
var N,I : integer; aFITS : TFITS;
  rdLam21 : real;

  Status: TMemoryStatus;
  nDif : integer;

  S,SH,sPSWFn : string;
  QWr,Q0 : boolean;
  QHd    : boolean; (* обновление SW-хидера *)

(*------------------*)
  procedure ClearDate;
  begin
    with SunWorld do begin
      gbLFITS.Caption := 'LFITS NONE';
      lbLFITS_kStep.Caption  := '0';
      lbLFITS_nsHead.Caption := '0';

      lbLFITS_nX.Caption   := '0';
      lbLFITS_nY.Caption   := '0';
      lbLFITS_nXP.Caption  := '0';
      lbLFITS_nbData.Caption := '0';

      lbLFITS_xCen.Caption := '0';
      lbLFITS_yCen.Caption := '0';
      lbLFITS_TStart.Caption := '';

      lb_rdLam.Caption := '1.0';
      lb_rLam0.Caption := '6302';
      lb_CLam0.Caption := '56.5';
      lb_kSign.Caption := '0';


      (* обновление элементов в рамке LFITS *)

      lbFITS1n.Caption := '000'; (*число эл-тов по оси X = число aFITS *)
      lbFITS2n.Caption := '000'; (* nY *)

      udFITSiX.Max := 1;
      udFITSiY.Max := 1;

      lbLC51.Caption := '0';
      lbLC52.Caption := '0';
      lbdLam.Caption := '0';

      lb_kRC.Caption := '0';


//      btLFITS_HSL.Enabled := false;
//      btLFITS_HmeSL.Enabled := false;
//      btLFITS_HswSL.Enabled := false;

      ngFITS.ClearRows;
    end;
  end;
begin
  if Not Assigned(Self)        then begin ClearDate; Exit; end;
  if Not Assigned(Self.FOwner) then begin ClearDate; Exit; end;


  if Assigned (Self.HSL) then N := Self.HSL.Count else N := 0;

  with TSunWorld(FOwner) do begin

    gbLFITS.Caption:='LFITS  '+swStr.left(sDtTi,13)+' n='+ISt(Self.Count)+' ';
    lbLFITS_kStep.Caption  := ISt(Self.KStep);
    lbLFITS_nsHead.Caption := ISt(N);

    lbLFITS_nX.Caption   := ISt(Self.nX);
    lbLFITS_nY.Caption   := ISt(Self.nY);
    udFITSiX.Max         := Self.nX-1;
    udFITSiY.Max         := Self.nY-1;

    lbLFITS_nXP.Caption  := ISt(Self.nXP);
    lbLFITS_nbData.Caption := ISt(Self.nbData);

    lbLFITS_xCen.Caption := EFSt0(Self.xCenME,8);
    lbLFITS_yCen.Caption := EFSt0(Self.yCen,8);
    lbLFITS_TStart.Caption :=
      swStr.StripChars(swStr.left(sTStart,10),'-')+' '+
      swStr.StripChars(swStr.copyfromto(sTStart,12,19),':');

    lb_rdLam.Caption := FSt(Self.rdLam*1000,7,3); // '1.0';
    lb_rLam0.Caption := FSt(Self.rLa00,8,3);      //'6302.080';
    lb_CLam0.Caption := FSt(Self.rLamIdx0,5,1);
    lb_kSign.Caption := ISt(Self.kLamChk);

    lb_RSun.Caption  := EFSt0(Self.R_Sun,8);
    lb_PAngle.Caption:= EFSt0(Self.p_Angle,8);
    lb_BAngle.Caption:= EFSt0(Self.b_Angle,8);

    lbLC51.Caption   := EFSt0(Self.rLC51,7);
    lbLC52.Caption   := EFSt0(Self.rLC52,7);

    rdLam21 := (rLC52-rLC51)*Self.rdLam;
    lbdLam.Caption := EFSt0(rdLam21,6);

    lb_kRC.Caption := EFSt0(Self.kRC,6);



    QHd := true;
    if (Self.dVlosMi = Self.dVlosMa) then QHd := false else
    if Not Assigned (Self.HswSL)     then QHd := false else
    if Self.HswSL.Count < 3          then QHd := false else begin
      sPSWFn := swFile.DirAndName(sPOut,sFSW);
      if Not FileExists(sPSWFn) then QHd := false;
    end;


    QWr := false;

    S := ISt(Round(Self.dVlosMi));
    if (Self.tdVMi = 0) or (Self.tdVMi = Self.tDura) then S := '['+S+']';
    lbdVlosMi.Caption := S;

    if QHd then begin
      SH := MakeHdStr('dVCmi',S,'Delta Velocity Compensation min value');
      HeaderReField(HswSL,'CNT_H0',SH,Q0); if Q0 then QWr := true;
    end;

    S := ISt(Round(Self.dVlosMa));
    if (Self.tdVMa = 0) or (Self.tdVMa = Self.tDura) then S := '['+S+']';
    lbdVlosMa.Caption := S;

    if QHd then begin
      SH := MakeHdStr('dVCma',S,'Delta Velocity Compensation max value');
      HeaderReField(HswSL,'HL_S_MA',SH,Q0); if Q0 then QWr := true;
    end;

    S := FSt(tdVMi,1);
    lbtdVmi.Caption := S;

    if QHd then begin
      SH := MakeHdStr('tVCmi',S,'Time for Velocity Compensation min value');
      HeaderReField(HswSL,'VL_R_MA',SH,Q0); if Q0 then QWr := true;
    end;

    S := FSt(tdVMa,1);
    lbtdVma.Caption := S;

    if QHd then begin
      SH := MakeHdStr('tVCma',S,'Time for Velocity Compensation max value');
      HeaderReField(HswSL,'VL_B_MA',SH,Q0); if Q0 then QWr := true;
    end;

    lbtDura.Caption := FSt(tDura,2);

    (* надо вернуть значения в sw-Хидер (все проверки сделаны раньше) *)
    if QWr then WriteHeader(sPSWFn,0,HswSL);

//  btLFITS_HSL.Enabled   := Assigned (Self.HSL);
//  btLFITS_HmeSL.Enabled := Assigned (Self.HmeSL);
//  btLFITS_Hm2SL.Enabled := Assigned (Self.Hm2SL);
//  btLFITS_HswSL.Enabled := Assigned (Self.HswSL);

    ngFITS.ClearRows;
    for I := 0 to Self.Count-1 do begin
      aFITS := TFITS(Self.Items[I]);
      ngFITS.AddRow;
      ngFITS.CellByName['NxFITS_ix',I].AsInteger  := aFITS.IXI;
      ngFITS.CellByName['NxFITS_ixp',I].AsInteger := aFITS.IXP;
    end;

    (* обновление элементов в рамке LFITS *)

    lbFITS1n.Caption := ISt(Self.Count);(*число эл-тов по оси X = число aFITS *)

    if Self.Count > 0 then begin
      lbFITS2n.Caption := ISt(TFITS(Self.Items[0]).nY); (* nY *)
      udFITSiX.Max := Self.Count-1;
      udFITSiY.Max := TFITS(Self.Items[0]).nY - 1;
    end
    else begin
      lbFITS2n.Caption := '0'; (* nY *)
      udFITSiX.Max := 1;
      udFITSiY.Max := 1;
    end;

    lb_nHeads.Caption := ISt(Self.nHead_s);
    lb_nData.Caption  := ISt(Self.nData_s);

    lb_GrossCount.Caption := ISt(nGrossCount);
    lb_GrossN.Caption     := ISt(nGrossData);

    Status.dwLength := sizeof(TMemoryStatus);
    GlobalMemoryStatus(Status);
{
    Status.dwMemoryLoad: Количество используемой памяти в процентах (%).
    Status.dwTotalPhys: Общее количество физической памяти в байтах.
    Status.dwAvailPhys: Количество оставшейся физической памяти в байтах.
    Status.dwTotalPageFile: Объём страничного файла в байтах.
    Status.dwAvailPageFile: Свободного места в страничном файле.
    Status.dwTotalVirtual: Общий объём виртуальной памяти в байтах.
    Status.dwAvailVirtual: Количество свободной виртуальной памяти в байтах.
  lbMem.Caption     := ISt(Status.dwTotalPhys);
  lbMemFree.Caption := ISt(Status.dwAvailPhys);
  lbMemVirt.Caption := ISt(Status.dwTotalVirtual);
  lbMemVirF.Caption := ISt(Status.dwAvailVirtual);
 }

   nDif := (Status.dwTotalVirtual - Status.dwAvailVirtual) // занято
           - nGrossData;              // чем-то кроме nGrossData
   lb_GrossDif.Caption     := ISt(nDif);

// WarnAbs('1');


  end;

end; (* TLFITS.UpDate; *)




(* собрать выходной хидер для SunWorld расчёта *)
procedure TLFITS.MakeOutHeader;
var S,W : string;
begin

  if Not Assigned(Self.HSL) then Self.HSL := TStringList.Create;
  Self.HSL.Clear;

  (* проверка *)
  if sTStart = '' then begin
    Self.LoadMEHeader0;
//  WarnAbs('WARN:При формировании sw-Header-a данные ME были не заполнены!!!');
  end;


  (* определим текущую дату/время *)
  W := swTimer.NowStr15;

  S := MakeHdStr('SIMPLE','T','Written By SunWorld '+W);             HSL.Add(S);
  S := MakeHdStr('CRE_TIME',W,'The SW_FITS Creation Time');          HSL.Add(S);
  S := MakeHdStr('HD_VER','20241023','Main Header Version');         HSL.Add(S);
  S := MakeHdIS('BITPIX',8,'');                                      HSL.Add(S);
  S := MakeHdIS('NAXIS' ,0,'');                                      HSL.Add(S);
  S := MakeHdIS('NAXIS1',nX,'');                                     HSL.Add(S);
  S := MakeHdIS('NAXIS2',nY,'');                                     HSL.Add(S);
  S := MakeHdIS('NSLITPOS',nXP,'');                                  HSL.Add(S);
  S := MakeHdStr('EXTEND','T','File contains extensions');           HSL.Add(S);
                                                                 (* 09=09    *)
  (* должны быть взяты из файла ME *)
  S := MakeHdES('XCEN',xCenME,6,'');                                 HSL.Add(S);
  S := MakeHdES('YCEN',yCen,6,'');                                   HSL.Add(S);
  S := MakeHdES('XSCALE',xScale,6,'');                               HSL.Add(S);
  S := MakeHdES('YSCALE',yScale,6,'');                               HSL.Add(S);
  S := MakeHdQS('TSTART',sTStart,'');                                HSL.Add(S);
  S := MakeHdQS('TEND',sTEnd,'');                                    HSL.Add(S);
  S := MakeHdES('P_ANGLE',p_Angle,12,'');                            HSL.Add(S);
  S := MakeHdES('B_ANGLE',b_Angle,12,'');                            HSL.Add(S);
  S := MakeHdES('SOLAR_RA',R_Sun,12,'');                             HSL.Add(S);
                                                                 (* 18=09+09 *)

  S := MakeHdES('EXPTIME',rExpTime,4,'');                            HSL.Add(S);
  S := MakeHdES('CNT_H0',rCntMH0,12,'CONT Level for regions without Field');
                                                                     HSL.Add(S);
  S := MakeHdES('CNT_MI',rCntMi,6,'Minimal normolized CONT level');  HSL.Add(S);
  S := MakeHdES('CNT_MA',rCntMa,6,'Maximal normolized CONT level');  HSL.Add(S);

  S := MakeHdES('HL_N_MA',HNMa,6,'Longitud.Field Max Value N');      HSL.Add(S);
  S := MakeHdES('HL_S_MA',HSMa,6,'Longitud.Field Max Value S');      HSL.Add(S);

  S := MakeHdES('VL_R_MA',VRMa,6,'V_los_red  Max Value');            HSL.Add(S);
  S := MakeHdES('VL_B_MA',VBMa,6,'V_los_blue Max Value');            HSL.Add(S);

  S := MakeHdES('GC_1',Gc1,12,'6301 Center of Gravity');             HSL.Add(S);
  S := MakeHdES('GC_2',Gc2,12,'6302 Center of Gravity');             HSL.Add(S);

  S := MakeHdES('LC_1',rLC1M,12,'6301 Central WaveLength');          HSL.Add(S);
  S := MakeHdES('LC_2',rLC2M,12,'6302 Central WaveLength');          HSL.Add(S);
                                                                 (* 30=12+18 *)

{
  S := MakeHdIS('HLNMA_IX',iXHN,'Long.Field Max N X_Position');    HSL.Add(S);
  S := MakeHdIS('HLNMA_IY',iYHN,'Long.Field Max N Y_Position');    HSL.Add(S);
  S := MakeHdIS('HLSMA_IX',iXHS,'Long.Field Max S X_Position');    HSL.Add(S);
  S := MakeHdIS('HLSMA_IY',iYHS,'Long.Field Max S Y_Position');    HSL.Add(S);

  S := MakeHdIS('VLRMA_IX',iXVR,'V_los_red  Max X_Position');      HSL.Add(S);
  S := MakeHdIS('VLRMA_IY',iYVR,'V_los_red  Max Y_Position');      HSL.Add(S);
  S := MakeHdIS('VLBMA_IX',iXVB,'V_los_blue Max Y_Position');      HSL.Add(S);
  S := MakeHdIS('VLBMA_IY',iYVB,'V_los_blue Max Y_Position');      HSL.Add(S);

  S := MakeHdIS('CMTMA_IX',iXCA,'CONT MAX X_Position');            HSL.Add(S);
  S := MakeHdIS('CMTMA_IY',iYCA,'CONT MAX Y_Position');            HSL.Add(S);
  S := MakeHdIS('CMTMI_IX',iXCI,'CONT MIN X_Position');            HSL.Add(S);
  S := MakeHdIS('CMTMI_IY',iYCI,'CONT MIN Y_Position');            HSL.Add(S);
}

{
  S := MakeHdES('CNTH0_AX',rCntXA,12,'A for CONT =CONTY*AX+B');    HSL.Add(S);
  S := MakeHdES('CNTH0_AY',rCntYA,12,'A for CONTY=CONT0*AY+B');    HSL.Add(S);
  S := MakeHdES('CNTH0_BX',rCntXB,12,'B for CONT =CONTY*AX+B');    HSL.Add(S);
  S := MakeHdES('CNTH0_BY',rCntYB,12,'B for CONTY=CONT0*AY+B');    HSL.Add(S);
}

  S := MakeHdIS('ICNT_MA',Self.iIMax,'I CONT MAX');                HSL.Add(S);
  S := MakeHdIS('ICNT_MI',Self.iIMin,'I CONT MIN');                HSL.Add(S);
  S := MakeHdIS('IVABS_MA',Self.iVMax,'V MAX');                    HSL.Add(S);
  S := MakeHdES('VIABS_MA',Self.AbsVIMax,6,'V/CONT MAX');          HSL.Add(S);

  S := MakeHdES('K_CONT',kRC,4,'CONT Corrector');                  HSL.Add(S);
  S := MakeHdES('DL6301',dl6301,4,'6301 DELTA WaveLength, mA');    HSL.Add(S);
  S := MakeHdES('DL6302',dl6302,4,'6302 DELTA WaveLength, mA');    HSL.Add(S);


  S := SSt('END',80);                                             HSL.Add(S);
                                                               (* 38=8+30 *)


  S := SSt('',80);
  while (HSL.Count mod 36) <> 0 do HSL.Add(S);

  Self.UpDate;
end; (* TLFITS.MakeOutHeader *)


function TLFIOut.GetFIOut(sNam:string;I0:integer;var I1:integer):pointer;
var I : integer;  P,P1 : TFIOut; S : string; SL : TStringList;
begin
  result := NIL; I1 := I0;
  if Not Assigned(Self) then begin
    WarnAbs('LFIO.GetFIOut-ERR : LFIO не инициирован!');
    Exit;
  end;
  for I := I0 to Self.Count-1 do begin
    P := TFIOut(Get(I));
    if Not Assigned(P) then Exit;


{
    if Not Assigned(P.Owner) then begin
      S := 'LFIO.GetFIOut-ERR у карты с именем <'+sNam+
              '> Owner=LFITS не присвоен!';
      WarnAbs(S);
      Exit;
    end;
}


    if P.Name = sNam then
    begin  I1 := I; result := P;

      if Not P.QRun then begin
        SL := Self.RepSL;  // список карт в LFIO (или пустой SL)
        S := 'LFIO.GetFIOut-ERR у карты <'+sNam+
                '> kRun не задан!, '+
                'I='+ISt(I1)+' Count='+ISt(Self.Count);
        if Not Assigned(P.Owner) then begin
          S := S + ', Owner=LFITS не присвоен!';
        end
        else begin
          S := S + ', sDtTi='+TLFITS(P.Owner).sDtTi;
        end;
        SL.Insert(0,S);
        WarnAbs(SL);
      end;

      Exit;
    end;
  end;


end;



(* процедура позволяет привязать карту из списка LFIO    *)
(* к TFIOut переменной, приписанной, например, к LFITS   *)
(* если карта не найдена, создаётся новый пустой         *)
(* экземпляр и этому экземляру даются необходимые данные *)
function TLFIOut.Link(sDtTi0,sNam,sCom,sVer:string;
                      k0,nX,nY:integer;anOwner:TObject):TFIOut;
var FO : TFIOut; sDt0,sTi0 : string;
begin
  sDt0 := swStr.left     (sDtTi0,'_');
  sTi0 := swStr.rightfrom(sDtTi0,'_');

  if sVer = '' then FO := GetFIOut(sDt0,sTi0,sNam)
               else FO := GetFIOut(sDt0,sTi0,sNam,sVer);
  if FO = NIL then begin
    FO := TFIOut.Create;
    FO.Name    := sNam;
    FO.Comment := sCom;
    FO.Alg_Ver := sVer;
    FO.kSoft   := k0;
    FO.nX      := nX;
    FO.nY      := nY;
    FO.Owner   := anOwner;
    FO.sDt     := sDt0;
    FO.sTi     := sTi0;
    FO.kLoad   := 0;   (* память не распределена *)
    FO.nb0     := 0;   (* нет привязки к файлу   *)
    FO.qTmp    := false;
    FO.kRun    := $A5A55A5A; (* "настоящий" FO *)

//  FO.Link(sNam,sCom,k0,nX,nY,anOwner); (* заносим значения, k0=kSoft *)

//    FO.chN  := '0';
//    FO.sVar := 'A0';

    Self.Add(FO);
  end;

{
  FO.Name  := sNam;
  FO.kSoft := k0;
  FO.kLoad := 0;   (* память не распределена *)
  FO.Owner := anOwner;
}
  result := FO;
end;


function TLFIOut.GetChN:char;
var FO : TFIOut; I : integer; S : string;
begin
  result := ' ';
  FO := SunWorld.ngFIO_GetFO;
  if Assigned(FO) then result := FO.chN
                  else
  begin                   (* ищем Id в списке ngFITS_DT *)
    with Sunworld do begin
      if ngFITS_DT.RowCount > 0 then begin
        S := ngFITS_DT.CellByName[ngFITS_DTRow,'NxFITS_DTNum'].AsString;
        if length(S) > 0 then result := S[1];
      end;
    end;
  end;
end;



function TLFIOut.GetFIOut(sDt0,sTi0,sNam,sVer:string):pointer;
var I0,I1,II : integer; P : TFIOut; FOVer : string; QVer : boolean;
begin
  result := NIL; I0 := 0; II := I0;

  (* пробегаем по всему LFIO *)
  (*  для каждой строчки в списке LFIO *)
  While (GetFIOut(sNam,I0,I1) <> Nil) do begin
    P := TFIOut(Get(I1));
    if Not Assigned(P) then Exit;
    if Not P.QRun then
    begin

     (* ПРОВЕРКА! *)

      WarnAbs('LFIO.GetFIOut '+sDt0+' '+sTi0+' <'+sNam+'> ver=<'+sVer+
      '> ERR: kRun = $'+HexI(P.kRun));
 //   FreeAndNil(P);
      Exit;
    end;

    QVer := false;
    if P.Alg_Ver = sVer then QVer := true;
    if (P.Alg_Ver = '220101') and (sVer = '') then QVer := true;
    if (P.Alg_Ver = '') and (sVer = '220101') then QVer := true;

    if (P.sDt = sDt0) and (P.sTi = sTi0) and (QVer)
          then begin result := P; Exit; end;

    if I1 = II then begin inc(I1); I0 := I1 end;
    II := I1;
  end; (* while *)
end;

procedure TLFIOut.ReFineList; (* очистить список LFIO от уже выгруженных карт *)
var i : integer; FF : TFIOut;

  S,s1,s2 : string;


begin
  for i := Self.Count-1 downto 0 do begin
    FF := TFIOut(Self.Get(i));
{
    s1 := swStr.HexA(FF);
    s2 := swStr.HexP(FF);

    S := s1+' == '+s2;
    if (s2 < '$1000:0000') or (s2 > '$1FFF:FFFF') then
      WarnAbs('>'+S);
}

    if Not Assigned(FF) then begin
      WarnAbs('LFIO.ReFineList NotAssigned '+ISt(i)+'/'+ISt(Self.Count));
      Self.Delete(i)
    end  
    else
//  if Not Assigned(FF) then Self.Delete(i) else
    if Not FF.QRun then begin
      // при очистке некоторых карт во время расчёта
      // они не удаляются из LFIO
      // поэтому статус QRun = false - не есть предмет сообщений пользователю
 (*
      WarnAbs('LFIO.ReFineList Not(QRun) +'+ISt(i)+'/'+ISt(Self.Count)+
      ' Name=<'+FF.Name+'>');
  *)
      if FF.Name = '' then begin (* а вот это странно *)
        WarnAbs('LFIO.ReFineList Not(QRun) +'+ISt(i)+'/'+ISt(Self.Count)+
        ' Name не задан!');
      end;

      FreeAndNil(FF);
      Self.Delete(i);
    end;
  end;
end;




(* получить индекс в списке LFIO карты FO *)
function TLFIOut.GetFOIdx(FO:TFIOut):integer;
var i : integer; FF : TFIOut;
begin
  result := -1;
  if Not Assigned(FO) then Exit;
  if Not FO.QRun then
  begin
    FreeAndNil(FO);
    Exit;
  end;
//Self.ReFineList; (* очистить LFIO от карт, которые "забыты", стёрты *)
  for i := 0 to Self.Count-1 do begin
    FF := TFIOut(Self.Get(i));
    if Assigned(FF) then
    if FO.Name = FF.Name then
      if FO.sDt = FF.sDt then
        if FO.sTi = FF.sTi then
          if FO.Alg_Ver = FF.Alg_Ver then begin
            result := i;
            Exit;
          end;
  end;
end;

procedure TLFIOut.DeleteFO(FO:TFIOut);
var i : integer;
begin
  i := GetFOIdx(FO);
  if i >= 0 then begin
    FO.Done;
    FreeAndNil(FO);
    Self.Delete(i);
  end;
end;


function TLFIOut.GetFIOut(sDaTi,sNam:string):pointer;
var sDt0,sTi0 : string;
begin
  sDt0 := swStr.left     (sDaTi,'_');
  sTi0 := swStr.rightfrom(sDaTi,'_');
  result := GetFIOut(sDt0,sTi0,sNam);
end;

function TLFIOut.GetFIOut(sId:string):pointer;
var sDTi,sNa,sT:string; FO : TFIOut; i,ip : integer;
begin
  result := NIL;
  if Not Assigned(Self) then Self := TLFIOut.Create;
  sNa := swStr.left(sId,'[');   (* отбросить масштаб    *)
  sNa := swStr.left(sNa,'|');   (* отбросить дату/время *)
  for i := 0 to Self.Count - 1 do begin
    FO := TFIOut(Get(i));
    if FO.QRun then
    if (FO.Name = sNa) then begin
      (* дата_время заданное в sId *)
      sDTi := swstr.rightfrom(sId,'|');

      if sDTi = '' then       (* имя сессии в запросе (в sId) не запрошено *)
        begin result := FO; Exit end;
//    WarnAbs(sDTi);

      (* год может быть задан без столетия - тогда корректируем *)
      if length(left(sDTi,'_')) = 6 then sDTi := '20'+sDTi;

      if (pos(FO.sDt,sDTi) = 1) then begin
        sT := swStr.left(FO.sTi,4);    (* отбросим секунды *)
        if (pos(sT,swstr.rightfrom(sDTi,'_')) = 1) then begin
          result := FO; Exit;
        end;
      end;
    end;
  end;
end;



function TLFIOut.GetFIOut(sDt0,sTi0,sNam:string):pointer;
var I0,I1,II : integer; P : TFIOut;
  S : string;
  SL : TStringList;
  I : integer;
begin
  result := NIL; I0 := 0; II := I0;

  if sNam = '' then begin
    (* взять первую попавшуюся карту с любым именем *)
    for I0 := 0 to Self.Count - 1 do begin
      P := TFIOut(Get(I0));
      if P.QRun then
      if ((P.sDt = sDt0) and
          (pos(sTi0,P.sTi) = 1))    (* sTi0 может быть и 4 и 6 симвоолов *)
        then begin result := P; Exit; end;
    end;
    Exit;
  end;

  While (GetFIOut(sNam,I0,I1) <> Nil) do begin
    P := TFIOut(Get(I1));
    if P.QRun then begin
    if ((P.sDt = sDt0) and
        (pos(sTi0,P.sTi) = 1))    (* sTi0 может быть и 4 и 6 симвоолов *)
          then begin result := P; Exit; end;
    end
    else begin
      if Not Assigned(SL) then SL := TStringList.Create else SL.Clear;

      S := 'LFIO['+ISt(Self.Count)+'].GetFIOut('+sDt0+','+sTi0+', <'+sNam+
      '> ERR kRun=$'+HexI(P.kRun);

      SL.Add(S);

      for I := 0 to Self.Count-1 do begin
        S := SunWorld.ngFIO_sGetFO(I);(* взять строку карты из позиции I *)
        SL.Add(S);
      end;
      WarnAbs(SL);

    end;

    if I1 = II then begin inc(I1); I0 := I1 end;
    II := I1;
  end; (* while *)
end;



function TLFIOut.swHdVar(sN:string):real;
begin

  result := 0;
end;

function TLFIOut.RepSL:TStringList;
var i : integer; SL : TStringList; P : TFIOut;
begin
  SL := TStringList.Create;
  if assigned (Self) then
  for i := 0 to Self.Count-1 do begin
    P := TFIOut(Get(i));
    if Assigned(P) then SL.Add(ISt(i)+' '+P.Name+' '+P.sTi+' '+BoolStr(P.QRun));
  end;
  result := SL;
end;



(* получить индекс в списке FIOut LFIO с заданными параметрами *)
function TLFIOut.GetFIOutI(sDt0,sTi0,sNam,sVer:string):integer;
var I0,I1 : integer; P : TFIOut;
begin
  result := -1; I0 := 0;
  While (GetFIOut(sNam,I0,I1) <> Nil) do begin
    P := TFIOut(Get(I1));
    if P.QRun then
    if (P.sDt = sDt0) and (P.sTi = sTi0) and (P.Alg_Ver = sVer)
      then begin result := I1; Exit; end;
    I0 := I1;
  end; (* while *)
end;


procedure TFIShed.Link(Na0,Co0,Ve0:string;FI0:TPFIShed);
begin
  if Not Assigned (Self) then begin
    WarnAbs('FIShed Link('+Na0+','+Co0+','+Ve0+') Self Not Assigned!');
    Exit;
  end;
  Self.Nam := Na0;
  Self.Com := Co0;
  Self.Ver := Ve0;
  Self.Up  := FI0;
end;



procedure TLFIShed.FillSWOrder_1;
var FIS : TFIShed;
begin
  FIS := TFIShed.Create;
  FIS.Link('CONT'    ,'Continuum Intensity'           ,'220101',NIL);
  Self.Add(FIS); FIS := TFIShed.Create;
  FIS.Link('GRC_6301','Center of Gravity 6301, pixels','220101',NIL);
  Self.Add(FIS); FIS := TFIShed.Create;
  FIS.Link('GRC_6302','Center of Gravity 6302, pixels','220101',NIL);
  Self.Add(FIS); FIS := TFIShed.Create;
  FIS.Link('KVI'     ,'Mesure of Polarization |V|/I'  ,'220101',NIL);
  Self.Add(FIS); FIS := TFIShed.Create;
  FIS.Link('MID_I1I2','I-profiles diveder, pixels'    ,'220101',NIL);
  Self.Add(FIS); FIS := TFIShed.Create;
  FIS.Link('MID_V1V2','V-profiles diveder, pixels'    ,'220101',NIL);
  Self.Add(FIS); FIS := TFIShed.Create;
  FIS.Link('W_6301'  ,'Equivaelent Width 6301, mA'    ,'220101',NIL);
  Self.Add(FIS); FIS := TFIShed.Create;
  FIS.Link('W_6302'  ,'Equivaelent Width 6302, mA'    ,'220101',NIL);
  Self.Add(FIS); FIS := TFIShed.Create;
  FIS.Link('H_L_6301','Longitudial Field 6301, G'     ,'220101',NIL);
  Self.Add(FIS); FIS := TFIShed.Create;
  FIS.Link('H_L_6302','Longitudial Field 6302, G'     ,'220101',NIL);
  Self.Add(FIS); FIS := TFIShed.Create;
  FIS.Link('H_LG6301','Long. COG Field 6301, G'       ,'220101',NIL);
  Self.Add(FIS); FIS := TFIShed.Create;
  FIS.Link('H_LG6302','Long. COG Field 6302, G'       ,'220101',NIL);
  Self.Add(FIS);
end;


procedure TLFIShed.FillSWOrder_2;
var FIS : TFIShed;
begin
  FIS := TFIShed.Create;
  FIS.Link('Vlos6301','LOS Velocity of 6301 COG'             ,'220101',NIL);
  Self.Add(FIS); FIS := TFIShed.Create;
  FIS.Link('Vlos6302','LOS Velocity of 6302 COG'             ,'220101',NIL);
  Self.Add(FIS); FIS := TFIShed.Create;
  FIS.Link('Cont_H0','Cont Normalized to NonMagnetic Regions','220101',NIL);
  Self.Add(FIS);
end;


procedure TLFIShed.FillSWOrder_bi;
var FIS : TFIShed;
  S,S1,S2,S3 : string;
  C : char; k,kk : integer;
begin

  S1 := 'LOS Veloc.of 630';
  S2 := 'd0 630';
  S3 := 'DLD 630';
  for k := 3 to 5 do begin

    S := ISt(k); C := S[1];
{
    Ou35C1[k].Link('d0' +C+'Vlos1' ,S1+'1 d0(by '+C+'point)',kSOFT0,nX,nY,Self);
    Ou35C2[k].Link('d0' +C+'Vlos2' ,S1+'2 d0(by '+C+'point)',kSOFT0,nX,nY,Self);
    Ou35I1[k].Link('d0p'+C+'_6301' ,S2+'1 by '   +C+'point' ,kSOFT0,nX,nY,Self);
    Ou35I2[k].Link('d0p'+C+'_6302' ,S2+'2 by '   +C+'point' ,kSOFT0,nX,nY,Self);
    Ou35D1[k].Link('DLDp'+C+'_6301',S3+'1 by '   +C+'point' ,kSOFT0,nX,nY,Self);
    Ou35D2[k].Link('DLDp'+C+'_6302',S3+'1 by '   +C+'point' ,kSOFT0,nX,nY,Self);

    OuBiC1[k].Link('Bi'  +S+'_6301',S1+S+'% 6301 [km/s]',kSOFT0,nX,nY,Self);
    OuBiC2[k].Link('Bi'  +S+'_6302',S1+S+'% 6302 [km/s]',kSOFT0,nX,nY,Self);
    OuBiW1[k].Link('AbsW'+S+'_6301',S2+S+'% 6301 [mA]'  ,kSOFT0,nX,nY,Self);
    OuBiW2[k].Link('AbsW'+S+'_6302',S2+S+'% 6302 [mA]'  ,kSOFT0,nX,nY,Self);
}
    FIS := TFIShed.Create;
    FIS.Link('d0' +C+'Vlos1' ,S1+'1 d0(by '+C+'point)','220101',NIL);
    Self.Add(FIS); FIS := TFIShed.Create;
    FIS.Link('d0' +C+'Vlos2' ,S1+'2 d0(by '+C+'point)','220101',NIL);
    Self.Add(FIS); FIS := TFIShed.Create;
    FIS.Link('d0p'+C+'_6301' ,S2+'1 by '   +C+'point' ,'220101',NIL);
    Self.Add(FIS); FIS := TFIShed.Create;
    FIS.Link('d0p'+C+'_6302' ,S2+'2 by '   +C+'point' ,'220101',NIL);
    Self.Add(FIS); FIS := TFIShed.Create;
    FIS.Link('DLDp'+C+'_6301',S3+'1 by '   +C+'point' ,'220101',NIL);
    Self.Add(FIS); FIS := TFIShed.Create;
    FIS.Link('DLDp'+C+'_6302',S3+'1 by '   +C+'point' ,'220101',NIL);
    Self.Add(FIS);
  end; (* for k *)

  S1 := 'Bisector at ';
  S2 := 'FullWidth at ';
  for k := 1 to MBiSec do begin

    case k of
    1 : kk := 10;
    2 : kk := 30;
    3 : kk := 50;
    4 : kk := 70;
    5 : kk := 90;
    6 : kk := 20;
    7 : kk := 40;
    8 : kk := 60;
    9 : kk := 80;
    end; (* case *)

    S := ISt(kk);
    FIS := TFIShed.Create;
    FIS.Link('Bi'  +S+'_6301',S1+S+'% 6301 [km/s]'    ,'220101',NIL);
    Self.Add(FIS); FIS := TFIShed.Create;
    FIS.Link('Bi'  +S+'_6302',S1+S+'% 6302 [km/s]'    ,'220101',NIL);
    Self.Add(FIS); FIS := TFIShed.Create;
    FIS.Link('AbsW'+S+'_6301',S2+S+'% 6301 [mA]'      ,'220101',NIL);
    Self.Add(FIS); FIS := TFIShed.Create;
    FIS.Link('AbsW'+S+'_6302',S2+S+'% 6302 [mA]'      ,'220101',NIL);
    Self.Add(FIS);

{
    OuBiC1[k].Link('Bi'  +S+'_6301',S1+S+'% 6301 [km/s]',kSOFT0,nX,nY,Self);
    OuBiC2[k].Link('Bi'  +S+'_6302',S1+S+'% 6302 [km/s]',kSOFT0,nX,nY,Self);
    OuBiW1[k].Link('AbsW'+S+'_6301',S2+S+'% 6301 [mA]'  ,kSOFT0,nX,nY,Self);
    OuBiW2[k].Link('AbsW'+S+'_6302',S2+S+'% 6302 [mA]'  ,kSOFT0,nX,nY,Self);
}
  end; (* for k *)




end; (* TLFIShed.FillSWOrder_bi *)













(* получить имя swFITS файла включая путь БД *)
function GetSWFITName(sDt,sTi:string):string;
var s7,s13,ss : string;
begin
  result := '';
  (* шаблон имени swFITS файла *)
  (* 'YYYY_MM\YYYYMMDD_hhmm\YYYYMMDD_hhmm.fits' *)
  if (length(sDt) <> 8) or (length(sTi)<4) then begin
    WarnAbs('GetSWFITName('+sDt+','+sTi+')-Err in length of sDt or sTi!');
    Exit
  end;
  s7  := swStr.left(sDt,4)+'_'+swStr.CopyFromTo(sDt,5,6);
  s13 := sDt+'_'+swStr.left(sTi,4);
  ss  := s7+'\'+s13+'\'+s13+'.fits';
  result := swFile.DirAndName(sDBFITSPath,ss);
end;


(* получить имя meFITS файла включая путь БД *)
function GetMEFITName(sDt,sTi:string):string;
var s7,s13,s15,ss : string;
begin
  result := '';
  (* шаблон имени meFITS файла *)
  (* 'YYYY_MM\YYYYMMDD_hhmm\YYYYMMDD_hhmmss.fits' *)
  if (length(sDt) <> 8) or (length(sTi)<6) then begin
    WarnAbs('GetMEFITName('+sDt+','+sTi+')-Err in length of sDt or sTi!');
    Exit
  end;
  s7  := swStr.left(sDt,4)+'_'+swStr.CopyFromTo(sDt,5,6);
  s15 := sDt+'_'+swStr.left(sTi,6);
  s13 := swStr.left(s15,13);
  ss  := s7+'\'+s13+'\'+s15+'.fits';
  result := swFile.DirAndName(sDBFITSPath,ss);
end;

(* получить имя meFITS файла включая путь БД *)
function GetM2FITName(sDt,sTi:string):string;
var s7,s13,s15,ss : string;
begin
  result := '';
  (* шаблон имени meFITS файла *)
  (* 'YYYY_MM\YYYYMMDD_hhmm\YYYYMMDD_hhmmss_L2.1.fits' *)
  if (length(sDt) <> 8) or (length(sTi)<6) then begin
    WarnAbs('GetMEFITName('+sDt+','+sTi+')-Err in length of sDt or sTi!');
    Exit
  end;
  s7  := swStr.left(sDt,4)+'_'+swStr.CopyFromTo(sDt,5,6);
  s15 := sDt+'_'+swStr.left(sTi,6);
  s13 := swStr.left(s15,13);
  ss  := s7+'\'+s13+'\'+s15+'_L2.1.fits';
  result := swFile.DirAndName(sDBFITSPath,ss);
end;


function GetFITName(kSoft:integer;sDt,sTi:string):string;
begin
  result := '';
  case kSoft of
  1 : result := GetSWFITName(sDt,sTi);(* имя SWfit файла *)
  2 : result := GetMEFITName(sDt,sTi);(* имя MEfit файла *)
  3 : result := GetM2FITName(sDt,sTi);(* имя MEfit файла *)
  end; (* case *)
end;


(* получить путь к "сырым" FITS файлам (включая путь БД) *)
function GetFITSPath(sDt,sTi:string):string;
var s7,s15,ss : string;
begin
  result := '';
  (* шаблон пути "сырых" FITS файлов *)
  (* 'YYYY_MM\YYYYMMDD_hhmmss' *)
  if (length(sDt) <> 8) or (length(sTi)<6) then begin
    WarnAbs('GetFITSPath('+sDt+','+sTi+')-Err in length of sDt or sTi!');
    Exit
  end;
  s7  := swStr.left(sDt,4)+'_'+swStr.CopyFromTo(sDt,5,6);
  s15 := sDt+'_'+swStr.left(sTi,6);
  ss  := s7+'\'+s15;
  result := swFile.DirAndName(sDBFITSPath,ss);
end;




function TFIOut.sFn:string;
begin
  result := '';                        (* виртуальные и временные карты *)
  if Not Assigned(Self) then Exit;
  if length(sDt) < 8 then Exit;
  case Self.kSoft of
  1 : result := GetSWFITName(sDt,sTi); (* файл типа SW *)
  2 : result := GetMEFITName(sDt,sTi); (* файл типа ME *)
  3 : result := GetM2FITName(sDt,sTi); (* файл типа M2 *)
  end; (* case *)
end;

function TFIOut.sFOId:string;
begin
  result := '';
  if Not Assigned(Self) then Exit;
  sFOId := Self.Name+'|'+Self.s11;   (* s13 ??? *)
end;

function TFIOut.s15:string;
begin
  result := '';
  if Not Assigned(Self) then Exit;
  s15 := Self.sDt+'_'+Self.sTi;
end;

function TFIOut.s13:string;
begin
  result := '';
  if Not Assigned(Self) then Exit;
  s13 := Self.sDt+'_'+swStr.left(Self.sTi,4);
end;

function TFIOut.s11:string;
begin
  result := '';
  if Not Assigned(Self) then Exit;
  s11 := rightfrom(Self.sDt,3)+'_'+swStr.left(Self.sTi,4);
end;




function TFIOut.sY_M:string;
begin
  result := '';
  if Not Assigned(Self) then Exit;
  sY_M := swStr.left(sDt,4)+'_'+copy(sDt,5,2);
end;



(* прочитать очередную карту - её заголовок *)
(* получить StringList заголовка *)
(* сформировать объект FIOut     *)
(* обозначить место в файле, откуда мы будем подгружать карту *)
procedure TFIOut.LoadHeader(var NN1024:integer);
const nStr = 80;
var nbH0 : integer;
    nsH : integer;
    fn  : string;

    nlHead1 : integer;   (* место в файле в "строках" под заголовок *)
//  nbHead1 : integer;   (* место в байтах под заголовок    *)
//  nbData0 : integer;   (* позиция начала данных блока     *)
    nsHead1 : integer;   (* место в HSL в "строках" под заголовок *)

//  ls0     : integer;   (* номер строки начала текущего хидера *)

    NAX : integer;
    NN,J,N : integer;
    ANAX    : array [1..10] of integer;
    NBITPIX,NB : integer;
    NNN : integer;
    s80   : string; (* копия строки хидера *)
    sName : string;
    iName : integer; (* номер строки, в к-рой лежит имя карты *)

    SLErr : TStringList;
begin
  if Not Assigned(Self) then begin
    WarnAbs('FIOut.LoadHeader('+ISt(NN1024)+')-Err: FIOut Not Assigned!');
    Exit;
  end;

  if (length(Self.sDt) <> 8) or (length(Self.sTi) < 4) then begin
    WarnAbs('FIOut.LoadHeader('+ISt(NN1024)+')-Err: in Da=<'+
             sDt+'> or Ti=<'+sTi+'> strings!');
    Exit;
  end;

  fn := Self.sFn;


  (*===================*)
  (*===================*)
  (*===================*)
  (* временная вставка *)
//  fn := swFile.ReplaceExt(fn,'FI0');
  (*===================*)
  (*===================*)


      (*======================================*)
      (* от конца предыдущего блока данных    *)
      (* до начала следующего заголовка может *)
      (* оказатся пустое место из нулей или   *)
      (* пробелов - пропускаем его -          *)
      (*   смещаем число NN1024               *)

      Self.nb0 := NN1024;

      nbH0 := NN1024;   (* начало заголовка = объём предыдущих данных *)

      (*--------------------------------------------------------------*)
      RASkipByte(fN,nbH0,0,NN1024);      (* прпускаем нулевые символы *)
      if NN1024=nbH0 then
        RASkipByte(fN,nbH0,32,NN1024);   (* пропускаем пробелы        *)
      (*--------------------------------------------------------------*)

      if (NN1024 - nbH0) > 4 then begin
        (* если в данных случайно оказалось число 32 сдвигать nbH0 не нужно! *)
// DEBUG:
//        WarnAbs('Пропустили байты с $'+swStr.HexL(nbH0)+' по $'+HexL(NN1024)+
//                ' k='+ISt(KH)+' ls1='+ISt(ls1));
        nbH0 := NN1024;
        Self.nb0 := NN1024;
      end;
      (*                                      *)
      (*======================================*)

    (*==============================================================*)
    (* читаем текущий (очередной) хидер                             *)

      if Not Assigned (Self.HSL) then HSL := TStringList.Create
                                 else HSL.Clear;

      GetFITSHead(fN,nbH0,nsH,HSL); (* nsH - прочитано строк из файла *)
//      nsHead1 := nsH;        (* место в HswSL в "строках" под заголовок *)

      SkipFITSHeadEnd(fN,nbH0,nsH); (* пропускаем пустые строки *)
                                 (* общее число строк кратно 36 *)


 //     nlHead1 := nsH;     (* место в файле в "строках" под заголовок *)
      nbHead  := nsH*nStr;       (* место в байтах под заголовок    *)
      nbData0 := nbH0 + nbHead;  (* позиция начала данных блока     *)

{
      ls0 :=           (* номер строки начала текущего хидера равен *)
             ls0                (* индекс начала предыдущего хидера *)
                 + nsHead0      (* + число строк предыдущего хидера *)
                           + 1;   (* + строка оформления            *)
      if KH>1 then ls0 := ls0 + 1 (* + строка со статистикой хидера *)
                              + 1;(* + ещё строка оформления        *)

      ls1 := ls0 + nsHead1 - 1    (* № послед.значащ. строки хидера *)
                           - 1;   (* счёт шёл от 0 - строка 'END'   *)
}
      (*============================================================*)
      (*            анализируем текущий хидер                       *)

      (*---- определяем объём блока данных NN ----*)

      NAX := GetFITKeyI('NAXIS',HSL);
//    nsHead0 := nsHead1;  (* заготовляем для след. цикла *)

      NN := 1;                    (* NN - для вычисления размера карты *)
      for J := 1 to NAX do begin  (* NAX - число осей *)
        N := GetFITKeyI('NAXIS'+ISt(J),HSL);
        ANAX[J] := N;
        NN := NN * N;
      end;

      Self.nX := ANAX[1];
      Self.nY := ANAX[2];

      NBITPIX := GetFITKeyI('BITPIX',HSL);(* битов  на элемент *)

      NB := System.Abs(NBITPIX) div 8;           (* байтов на элемент *)

      NN := NN*NB;                                  (* объём данных      *)
      self.nbData := NN;


      (*-- проверяем блок - не лежит ли в нём интересная для нас инф-а --*)



      s80   := GetFITKeyS80('EXTNAME',HSL);
//    sName := GetFITKey('EXTNAME',HSL);  (* имя блока данных  *)
      sName := GetFITVal(s80);            (* имя блока данных  *)

      if sName = '' then begin
        SLErr := TStringList.Create;
        SLErr.Add('не найден ключ EXTNAME в строках от хидера -->');
        swStr.SLCopy(HSL,SLErr,0,nsH-1);
        WarnAbs(SLErr);
        Exit;
      end;
      Self.Name    := sName;
      Self.Comment := GetFITCom(s80);
      if Self.kSoft = 1 then begin
        Self.Alg_Ver := GetFITKey('ALG_VER',HSL);
        if Alg_Ver = '' then Alg_Ver := '220101';
      end
      else Self.Alg_Ver := '';


      (* сравниваем имя sName с каждым из FIOut и грузим, если совпало    *)
//    TryLoadSWAny(OuCont); (* подвязать строки хидера и загрузить данные *)


      (*            анализируем текущий хидер                       *)
      (*============================================================*)

//    HswSL.Add(sB40);

      (* выведем статистические данные по только что выведенному хидеру *)

//    HswSL.Add('NAXIS1 = '+ISt(NAX));
      NNN := nbData0 + NN;       (* позиция следующей карты FIOut *)





      if swFITS.QFITS320 then
      (* округляем NNN до числа NCutFO, кратного 320 (или 512) *)
      (* но только если FITS-файл стандартный!!!               *)
      case Self.KSoft of
      1   : NN1024 := (((NNN-1) div swFITS.NCutFO) + 1) * swFITS.NCutFO;
//    2,3 : NN1024 := (((NNN-1) div  64) + 1) *  64;
      2,3 : NN1024 := (((NNN-1) div 320) + 1) * 320;
      end (* case *)
      else
        NN1024 := NNN;

{
      (* добавляем строку статистики в HswSL *)
      HswSL.Add('KH='+ISt(KH)+' nbH0='+ISt(nbH0)+' nbHead='+ISt(nbHead1)
      +' NN='+ISt(NN)+
      ' NNN='+ISt(NNN)+'=$'+swStr.HexI(NNN)+' => $'+HexI(NN1024));
}







//      if (NN1024 >= (LFile-nbHead1)) then Q := false;

//      HswSL.Add(sB80);

//      if KH = 5 then Q := false;


//    until Not Q


  (* результаты загрузки блока *)
  (* N1024 - позиция начала следующего блока *)
  (* В TFIOuy(Self) оказываются загружены поля *)
  (* Self.Name : имя блолка данных *)
  (* Self.HSL : строки Хидера      *)
  (* Self.Comment *)
  (* Self.Alg_Ver *)
  (* Self.nbData0 - индекс байта в файле, с которого начинается карта *)
  (* Self.nX,nY   - размер карты *)
//  Self.

  (* поля Self.(sDt,sTi) загружены до вызова процедуры Load *)
  (* поле Self.kSoft, которое выбирает (1 SW, 2 ME) загружено до вызова *)



end; (* TFIOut.LoadHeader *)





procedure TFIOut.UpDate;
var S,sK: string; SL : TStringList;
  QN : boolean;
begin
  QN :=
    NotAssigned(Self);

  SunWorld.lbFIOVe.Caption := '<>';

  if Not QN then
    QN :=
      (Self.kRun <> $A5A55A5A);

  if QN then begin               (* FO не определён/не загружен *)
    with SunWorld do begin
      lbFIODt.Caption := '20000000';
      lbFIOTi.Caption := '000000';
      lbFIONa.Caption := '<>';
      lbFIOCom.Caption:= '<>';
      lbFIOVe.Caption := '<>';

      lbFIOmi.Caption    := '0';
      lbFIOmiAv.Caption  := '0';
      lbFIOma.Caption    := '0';
      lbFIOmaAv.Caption  := '0';
      lbFIOmean.Caption  := '0';
      lbFIOmeanAv.Caption:= '0';

      lbFIOnxy.Caption     := '(0,0)';
      lbFIOnxyAv.Caption   := '0';
      lbFIOmiIdx.Caption   := '(0,0)';
      lbFIOmiAvIdx.Caption := '(0,0)';
      lbFIOmaIdx.Caption   := '(0,0)';
      lbFIOmaAvIdx.Caption := '(0,0)';
      lbFIOfocusIdx.Caption:= '(0,0)';

      lbDaNum.Caption := '-';
      lbFIOVal.Caption := '0';
      lbFIOkload.Caption := '0';

    end;
    Exit;
  end; (* if FO не определён/не загружен *)

  if swMapFilt.kFOMask = 1 then begin
    Self.FilteredMinMax;
    if (Self.Name = 'BML1') or (Self.Name = 'BML2')
    then begin

      Self.MaskMax_Y3(swMapFilt.a_Mask,2);
    end;
  end;


  with SunWorld do begin

    Self.iXFocus := ValInt(edFITSiX.Text);
    Self.iYFocus := ValInt(edFITSiY.Text);

    lbFIODt.Caption := sDt;
    lbFIOTi.Caption := sTi;
    gbFIOut.Caption := 'FO  '+Self.Name;
    lbFIONa.Caption := '<'+Self.Name+'>';
    lbFIOCom.Caption:= '<'+Comment+'>';
    lbFIOVe.Caption := Alg_Ver;

    lbFIOmi.Caption    := EFSt0(Self.rMin,5);
    lbFIOma.Caption    := EFSt0(Self.rMax,5);
    lbFIOmean.Caption  := EFSt0(Self.rMean,5);

    lbFIOmiAv.Caption  := EFSt0(Self.rMinAv,5);
    if Self.rMaxAv3 <> 0
    then begin
      lbFIOmaAv.Caption  := EFSt0(Self.rMaxAv3,5);
      lbFIOmaAvIdx.Caption := '('+ISt(Self.jXMa3)+','+ISt(Self.jYMa3)+')';
    end
    else begin
      lbFIOmeanAv.Caption:= EFSt0(Self.rMeanAv,5);
      lbFIOmaAvIdx.Caption := '('+ISt(Self.jXMa)+','+ISt(Self.jYMa)+')';
    end;

    lbFIOnxy.Caption     := '('+ISt(Self.nX)  +','+ISt(Self.nY)+')';
    lbFIOnxyAv.Caption   := '('+ISt(swMapFilt.n_Mask)+')';
    lbFIOmiIdx.Caption   := '('+ISt(Self.iXMi)+','+ISt(Self.iYMi)+')';
    lbFIOmiAvIdx.Caption := '('+ISt(Self.jXMi)+','+ISt(Self.jYMi)+')';
    lbFIOmaIdx.Caption   := '('+ISt(Self.iXMa)+','+ISt(Self.iYMa)+')';
    lbFIOfocusIdx.Caption := '('+ISt(Self.iXFocus)+','+ISt(Self.iYFocus)+')';

    lbDaNum.Caption := Self.chN;

    if kLoad > 0 then
    if Length(aData) >= nX then
    if ((iXFocus >=0) and (iXFocus < nX)) and
       ((iYFocus >=0) and (iYFocus < nY))
    then lbFIOVal.Caption := EFSt0(Self.aData[iXFocus,iYFocus],5)
    else lbFIOVal.Caption := '0';

    case Self.kLoad of
    0 : sK := 'FREE';
    1 : sK := 'EMPTY';
    2 : sK := 'LOADED';
    3 : sK := 'EMPTY + LOADED';
    4 : sK := 'CALCULATED';
    5 : sK := 'EMPTY + CALCULATED';
    6 : sK := 'LOADED + CALCULATED';
    7 : sK := 'EMPTY+LOADED+CALCULATED';
    8 : sK := 'INHERATED';
    else (* case *)
        sK := '';
    end; (* case *)
    sK := ISt(Self.kLoad)+' '+sK;
    lbFIOkload.Caption := sK;

  end;

(*
  SL := TStringList.Create;
  S := 'Da='+sDt; SL.Add(S);
  S := 'Ti='+sTi; SL.Add(S);
  S := 'Na='+Name; SL.Add(S);
  S := 'Co='+Self.Comment; SL.Add(S);
  S := 'Ve='+Self.Alg_Ver; SL.Add(S);
  S := '---------------';  SL.Add(S);
  SL := swStr.sListAdd(SL,Self.HSL);

  swStr.SLCopy(SL,SunWorld.memoFIOut.Lines);
*)

end;


(* назначить точку карты, профили Стокса для которой мы будем анализировать *)
procedure TFIOut.SetFocusPoint;
var  s : string; iX,iY,iErr : integer;
begin
  if Not Assigned (Self) then Exit;
  with SunWorld do begin
    s := UnBlanks(edFITSiX.Text); val(s,iX,iErr); if IErr<>0 then Exit;
    s := UnBlanks(edFITSiY.Text); val(s,iY,iErr); if IErr<>0 then Exit;
  end;
  Self.iXFocus := iX;
  Self.iYFocus := iY;
end;


procedure TLFIOut.ClearAll;
var I : integer; FO : TFIOut;
begin
  if Not Assigned(Self) then Exit;
  for I := Self.Count-1 downto 0  do begin
    FO := TFIOut(Self.Items[I]);
    if FO.QRun then begin
      FO.Done;
      FreeAndNil(FO);
    end;
    Self.Delete(I);
  end;
  Self.UpDate;
end;



procedure TLFIOut.ClearOneSession(ChN0:char);
var I : integer; FO : TFIOut;
begin
  for I := Self.Count-1 downto 0  do begin
    FO := TFIOut(Self.Items[I]);
    if Not FO.QRun then Continue;
    if FO.chN = ChN0 then if (FO.kSoft = 1) (* только SW карты *)
    then begin
      FO.Done;
      FreeAndNil(FO);
      Self.Delete(I);
    end;
  end;

  Self.UpDate;
end;

function TLFIOut.QOneSession:boolean;
var ChN0:char; I : integer;
begin
  if Self.Count < 2 then begin
    result := true;
    Exit;
  end;
//FO := TFIOut(Self.Items[0]);
  ChN0 := TFIOut(Self.Items[0]).chN;
  result := false;
  for I := 1 to Self.Count-1 do
    if TFIOut(Self.Items[I]).chN <> ChN0 then Exit;
  result := true;
end;




procedure TLFIOut.UpDate;
var N,I,II,J,ICur,Idx : integer; FO,FOCur : TFIOut; Q,QQ : boolean; S : string;
(*------------------*)
  procedure ClearData;
  begin
    with SunWorld do begin
      gbLFIO.Caption := 'LFITS NONE';
      ngFIO.ClearRows;
{
      lbLFITS_kStep.Caption  := '0';
      lbLFITS_nsHead.Caption := '0';

      lbLFITS_nX.Caption   := '0';
      lbLFITS_nY.Caption   := '0';
      lbLFITS_nXP.Caption  := '0';
      lbLFITS_nbData.Caption := '0';

      lbLFITS_xCen.Caption := '0';
      lbLFITS_yCen.Caption := '0';
      lbLFITS_TStart.Caption := '';

      btLFITS_HSL.Enabled := false;
      btLFITS_HmeSL.Enabled := false;
      btLFITS_HswSL.Enabled := false;
}
    end;
  end;
begin
  if Not Assigned(Self)        then begin ClearData; Exit; end;
//if Not Assigned(Self.FOwner) then begin ClearData; Exit; end;


  N := Self.Count;

  with SunWorld do begin
    (* запомним карту, на которой стоит активная строка *)


//  FOCur := ngFIO_GetFO;
    FOCur := LFIO.GetFIOut(ngFIO_sDaTi,ngFIO_sNam);
    if Not Assigned(FOCur) then Idx := -1
                           else Idx := LFIO.GetFOIdx(FOCur);

    (* в заголовке номер текущей карты и количество карт *)
    gbLFIO.Caption := 'LFIO '+ISt(Idx)+' ('+ISt(Self.Count)+')';

    ngFIO.ClearRows;

    I := -1;
    ICur := -1;


//    WarnAbs('1');


    for II := 0 to LFIO.Count-1 do begin
      FO := TFIOut(LFIO.Items[II]);
      if Not FO.QRun
        then Continue; (* пропускаем карты LFIO, у к-рых испорчены данные *)

      S := FO.sDt+'_'+FO.sTi;
      QQ := true;

      (* выясним из таблицы сеансов, надо ли показывать карту *)
      (* для данного сеанса                                   *)
      for J := 0 to ngFITS_DT.RowCount-1 do
        if ngFITS_DT.CellByName['NxFITS_DT',J].AsString = S then
          QQ := ngFITS_DT.CellByName['NxFITS_DTon',J].AsBoolean;

      if QQ then begin (* для этого сеанса FO показываем *)
        ngFIO.AddRow(1);  inc(I);   (* создаём новую строку *)

        (*------------------ заполняем все поля ------------------*)
        ngFIO.CellByName['NxFIO_Name'  ,I].AsString := FO.Name;
//      ngFIO.CellByName['NxFIO_Com'   ,I].AsString := FO.Comment;
        ngFIO.CellByName['NxFIO_Ver'   ,I].AsString := FO.Alg_Ver;
        ngFIO.CellByName['NxFIO_Var'   ,I].AsString := FO.sVar;
        ngFIO.CellByName['NxFIO_DaNum' ,I].AsString := FO.chN;
        ngFIO.CellByName['NxFIO_Da'    ,I].AsString := FO.sDt;
        ngFIO.CellByName['NxFIO_Ti'    ,I].AsString := FO.sTi;
        ngFIO.CellByName['NxFIO_DaTi'  ,I].AsString :=
                                               swStr.left(FO.sDt+'_'+FO.sTi,13);
        ngFIO.CellByName['NxFIO_kSoft' ,I].AsString := ISt(FO.kSoft);
        ngFIO.CellByName['NxFIO_Writed',I].AsString := BSt(FO.nb0=0,'0','1');
        ngFIO.CellByName['NxFIO_KH'    ,I].AsString := ISt(FO.IH);

        Q := Assigned (FO.aData);
        ngFIO.CellByName['NxFIO_Map'  ,I].AsBoolean := Q;



        (* проверяем, совпадает ли данный FO с картой, которая считается *)
        (* текущей. Если да, эту строку надо будет сделать активной      *)
        if Assigned (FOCur) then
          if FO.Name = FOCur.Name then
            if FO.sTi = FOCur.sTi then ICur := I;
        (*-------------------------------------------------*)

      end;


{
    lbLFITS_kStep.Caption  := ISt(Self.KStep);
    lbLFITS_nsHead.Caption := ISt(N);

    lbLFITS_nX.Caption   := ISt(Self.nX);
    lbLFITS_nY.Caption   := ISt(Self.nY);
    lbLFITS_nXP.Caption  := ISt(Self.nXP);
    lbLFITS_nbData.Caption := ISt(Self.nbData);

    lbLFITS_xCen.Caption := EFSt0(Self.xCen,8);
    lbLFITS_yCen.Caption := EFSt0(Self.yCen,8);
    lbLFITS_TStart.Caption := Self.sTStart;

    btLFITS_HSL.Enabled   := Assigned (Self.HSL);
    btLFITS_HmeSL.Enabled := Assigned (Self.HmeSL);
    btLFITS_HswSL.Enabled := Assigned (Self.HswSL);
}
    end; (* for II *)






//    WarnAbs('2');



    (* вернуться на строку, к-рая была активной до команды *)
    if ICur >= 0 then ngFIO_Row := ICur;
    if (ngFIO_Row >=0) and (ngFIO_Row < ngFIO.RowCount) (* №строки допустимый *)
    then
    if (ngFIO_Col >=0) and (ngFIO_Row < ngFIO.Columns.Count)
    then begin
      ngFIO.SelectCell(ngFIO_Col,ngFIO_Row);
      if ngFIO.Enabled then
        if ngFIO.Visible then
          ngFIO.SetFocus;
      ngFIO.ScrollToRow(ngFIO_Row);
      ngFIOVerticalScroll(NIL,ngFIO_Row);
    end;

//    WarnAbs('3');


    if (sLastFocus = 'ngFIO') then begin
      ngFIO.SetFocus;
      ngFIO_ScrollTo(ngFIO_Row);
    end;


  end; (* with SunWorld *)
end; (* LFIO UpDate *)


function TLFIOut.LoadSW(sDt0,sTi0:string):boolean;
begin
  result := Load(1,sDt0,sTi0);
end;


function TLFIOut.LoadSW(ChN0:char;sDt0,sTi0:string):boolean;
begin
  result := Load(1,ChN0,sDt0,sTi0);
end;

function TLFIOut.LoadSW(ChN0:char;sDt0,sTi0:string;
                         SLN:TStringList;QAll:boolean):boolean;
begin
  result := Load(1,ChN0,sDt0,sTi0,SLN,QAll);
end;

function TLFIOut.LoadSW(sDt0,sTi0:string;
                        SLN:TStringList;QAll:boolean):boolean;
begin
  result := Load(1,sDt0,sTi0,SLN,QAll);
end;



function TLFIOut.LoadME(ChN0:char;sDt0,sTi0:string):boolean;
begin result := Load(2,ChN0,sDt0,sTi0); end;

function TLFIOut.LoadM2(ChN0:char;sDt0,sTi0:string):boolean;
begin result := Load(3,ChN0,sDt0,sTi0); end;

function TLFIOut.LoadME(ChN0:char;sDt0,sTi0:string;
                         SLN:TStringList;QAll:boolean):boolean;
begin result := Load(2,ChN0,sDt0,sTi0,SLN,QAll); end;

function TLFIOut.LoadME(sDt0,sTi0:string;
                        SLN:TStringList;QAll:boolean):boolean;
begin result := Load(2,sDt0,sTi0,SLN,QAll); end;


function TLFIOut.LoadM2(ChN0:char;sDt0,sTi0:string;
                         SLN:TStringList;QAll:boolean):boolean;
begin result := Load(3,ChN0,sDt0,sTi0,SLN,QAll); end;

function TLFIOut.LoadM2(sDt0,sTi0:string;
                         SLN:TStringList;QAll:boolean):boolean;
begin result := Load(3,sDt0,sTi0,SLN,QAll); end;



function TLFIOut.HmapSLDefine(kSoft:integer):TStringList;
var SL : TStringList;
begin
  result := NIL;

  if Not Assigned(Self) then begin
    WarnAbs('LFIO.HmapSLDefine(kSoft='+ISt(kSoft)+') LFIO Not Defined');
    Exit;
  end;

  case kSoft of
  1 : SL := Self.HswSL;
  2 : SL := Self.HmeSL;
  3 : SL := Self.Hm2SL;
  end; (* case *)

  (* готовим место для главного заголовка SWfit файла *)
  if Not Assigned(SL) then begin
    case kSoft of
    1 : begin Self.HswSL := TStringList.Create; SL := HswSL; end;
    2 : begin Self.HmeSL := TStringList.Create; SL := HmeSL; end;
    3 : begin Self.Hm2SL := TStringList.Create; SL := Hm2SL; end;
    end; (* case *)
  end;
  SL.Clear;
  result := SL; (* SL это ссылка на SW / ME или M2 SL-хидер в LFIO, он пустой *)
end;


procedure sB80_40(var sB80,sB40:string);
begin
  SetLength(sB80,80);
  SetLength(sB40,80);
  FillChar(sB80[1] ,80,'='); (* строка для целей оформления *)
  FillChar(sB40[1] ,40,'-'); (* строка для целей оформления *)
  FillChar(sB40[41],40,' '); (* строка для целей оформления *)
end;


procedure TLFIOut.FITS2FO(var KH:integer;var FO:TFIOut;
                         var HmapSL:TStringList;
                         kSoft0:integer;
                         sDt0,sTi0,sB40,sB80:string;
                         var NN1024:integer);
begin

    (* читаем следующий хидер                                        *)
    inc(KH);

    (*----------------------------------------------------------*)
    (* FO - карта, прочитанная только что из SW/ME - FITS файла *)
    (*----------------------------------------------------------*)

    FO := TFIOut.Create; // FO.kRun := $A5A55A5A - есть внутри Create;
    FO.kSoft := kSoft0;    (* 1 SW, 2 ME *)
    FO.chN := 'a'; // chN0;
    FO.sDt := sDt0;
    FO.sTi := sTi0;
    FO.LoadHeader(NN1024);   (* стартовая позиция следующего заголовка *)
    (* там внутри читается также sName *)
    FO.IH := KH;
{

  ВЫНЕСЕНО В ВЫЗЫВАЮЩЮЮ ПРОЦЕДУРУ:


    (* закинуть прочитанный хидер карты в сводный хидер FITS файла *)
    swStr.SListAdd(HmapSL,FO.HSL); HmapSL.Add(sB40);

    if (NN1024 >= (LFile-FO.nbHead)) then QNext := false; (* конец файла *)
    HmapSL.Add(sB80);
}
end;






function TLFIOut.ListedFO(FO:TFIOut;SLN:TStringList):integer;
var iv : integer; QDone : boolean; w : string;
begin
  (* ищем, есть ли имя FO.Name в списке НУЖНЫХ нам карт SLN *)
  if SLN.Count = 0 then begin result := -1; Exit end;

  iv := 0; (* индекс, пробегающий по списку SLN *)
  QDone := false;

  while (Not QDone) do begin
{
    if (iv < SLVar.Count) then begin
      w := SLVar.Strings[iv];
      w := swStr.GetWordN(w,1);
      if (w = FO.Name) then QDone := true
                       else inc(iv);
    end
    else QDone := true;
}
    if (iv < SLN.Count) then begin
      w := swStr.GetWordN(SLN.Strings[iv],1);
      if (w = FO.Name) then QDone := true (* нашли - выходим из цикла *)
                       else inc(iv);
    end
    else begin QDone := true; iv := -1; end;
  end;

  result := iv;
end;


function TLFIOut.Load(kSoft0:integer;
               sDt0,sTi0:string;SLN:TStringList;QAll:boolean):boolean;
var chN0:char;
begin
  chN0 := '0';
  result := Load(kSoft0,chN0,sDt0,sTi0,SLN,QAll);
end;



(* загрузка Me или Sw файла *)
                        (* УСТАРЕЛО:   процедура использует псевдонимы карт - *)
                        (*   двухсимвольные идентификаторы, первый символ     *)
                        (*   привязан к имени карты, второй привязан к сессии *)
function TLFIOut.Load(kSoft0:integer;chN0:char;
                       sDt0,sTi0:string;SLN:TStringList;QAll:boolean):boolean;
const nStr = 80;  (* длина строки Хидера *)
var LFile,iv : integer; ch : char;
  fN,sB80,sB40,w : string;
  HmapSL : TStringList;
  nbH0,nb0Head : integer;
  ls0,ls1      : integer;
  nsH,nsHead0  : integer;
  NN1024       : integer;
  KH,NAXIS     : integer;
  Q,QDone  : boolean;  nQ : integer;
  FO,FO1 : TFIOut;

begin
  result := false;

  (* для начала надо найти файл *)
  if sDBFITSPath = '' then sDBFITSPath := 'S:\Z\ASTRO\HINODE\sot\';
  fN := GetFITName(kSoft0,sDt0,sTi0);(* имя ME или SW fit файла *)

  (*---------------------------------*)
  (* проверки для файла:             *)
  (*---------------------------------*)
  if Not FileExists(fN) then begin
    Warn('TLFIOut.Load-SW/ME-FITS ERR: файла'+#13#10+
         '<'+fN+'>'+#13#10+'не существует!');
    Exit;
  end;
  LFile  := swFile.File_Size(fN);
  if (LFile <= 80*36*2) then begin
    WarnAbs('TLFIOut.Load-SW-FITS ERR: файл'+#13#10+'<'+fN+'>'+#13#10+
            'имеет размер '+ISt(LFile)+' От него есть только заголовок!');
    Exit;
  end;
  (*                                 *)
  (*---------------------------------*)



  HmapSL := HmapSLDefine(kSoft0);(* связывание HmapSL (ещё не заполнение) *)
  sB80_40(sB80,sB40); (* заполняем строчки для оформления *)



(*------------------------------------*)
(*        главный заголовок           *)
(*------------------------------------*)

(*
 nsHead0 только в этом блоке
*)

  nbH0  := 0;   (* число байт, которые надо пропустить           *)
  ls0   := 0;   (* индекс строк HmapSL указывающий начало Хидера *)

(*------------------------------------*)
(*    главный заголовок - чтение      *)

  GetFITSHead(fN,nbH0,nsH,HmapSL);(* считываем главный(0-вой)заголовок *)
  nsHead0 := nsH;                 (* число строк в первом заголовке    *)
  SkipFITSHeadEnd(fN,nbH0,nsH);   (* найти конец "места под заголовок" *)
                                  (* (пропускаем пустые строки в файле)*)
//nlHead0 := nsH;         (* место в "строках" под заголовок   *)
  nb0Head := nsH*nStr;    (* место в байтах под заголовок      *)

  HmapSL.Add(sB80); (* отделим от следующих заголовков *)


(*        главный заголовок           *)
(*------------------------------------*)
(*----------------------------------------------------------------------------*)

  (* дополним nsH до величины, кратной 36 *)
  if (nsH mod 36) <> 0 then nsH := ((nsH div 36)+1)*36;
  nb0Head := nsH*nStr;    (* место в байтах под заголовок      *)

//  NN := 0;              (* объём данных текущего (предыдущего) блока *)
//  nbHead1 := nb0Head;   (* число байт в предыдущем заголовке *)
  ls1 := nsHead0;       (* индекс строк HmapSL указывающий конец Хидера *)
  (* nsH > nsHead0 так как включает пустые строки *)

  (*========================================*)
  (*                                        *)
  (*      анализируем нулевой заголовок     *)
  (*                                        *)
  (*========================================*)

  (* раскладывать "глобальные" значения для СЕАНСА из SW -  *)
  (* хидера в SELF=LFITS мы не будем, за исключением NAXIS  *)
  (* ls0     - номер строки начальной текущего подзаголовка *)
  (* nsHead0 - номер строки конечной  текущего подзаголовка *)

  NAXIS := GetFITKeyI('NAXIS',HmapSL,ls0,ls1);
  if NAXIS <> 0 then begin (* у "правильного" заголовка SunWorld NAXIS=0 *)
    WarnAbs('FIOut.Load-ERR: У "правильного" заголовка SunWorld и ME NAXIS=0!');
    Exit;
  end;

//NN1024 := nbH0 + nbHead1        + NN;           (* "округленное" число байт *)
        (* start + байт заголовка + байт данных *)
  (* для нулевого хидера *)
  NN1024 := nb0Head; (* число байт в нулевом заголовке с учётом пустых строк *)


  (*========================================*)
  (*                                        *)
  (*    КОНЕЦ работы с главным заголовком   *)
  (*                                        *)
  (*========================================*)










  (*====================================================================*)
  (* начинаем цикл по оставшимся хидерам *)
  (*====================================================================*)


  KH := 0;    (* номер (индекс) заголовка, первый идёт под номером 0  *)
              (* (главный заголовок не учитываем)                     *)
  Q  := true; (* Not Q - условие окончания repeat цикла по заголовкам *)

  if (NN1024 >= LFile) then Q := false; (* конец файла *)

  nQ := 0;
  while Q do begin            (* until Not Q *)
    inc(nQ);

    (*===============================================================*)
    (* читаем следующий хидер                                        *)
    (*----------------------------------------------------------*)
    (* FO - карта, прочитанная только что из SW/ME - FITS файла *)
    (*----------------------------------------------------------*)


    FITS2FO(KH,FO,HmapSL,kSoft0,sDt0,sTi0,sB40,sB80,NN1024); // inc(KH);

    (* закинуть прочитанный хидер карты в сводный хидер FITS файла *)
    swStr.SListAdd(HmapSL,FO.HSL); HmapSL.Add(sB40);

    if (NN1024 >= (LFile-FO.nbHead)) then Q := false; (* конец файла *)
    HmapSL.Add(sB80);



    (* в этой процедуре мы загружаем только такие карты *)
    (* которые уже загружены в составе других сеансов   *)
    (* и при этом им назначены имена                    *)


    (* ищем, есть ли имя FO.Name в списке НУЖНЫХ нам карт SLN *)
    iv := Self.ListedFO(FO,SLN);     (* если не нашли iv = -1 *)

    if (iv >=0 ) then begin (* FO.Name нашли в списке SLN *)

      (* теперь его надо загрузить в LFIO           *)
      (* если его там нет                           *)
      (* или проигнорировать загрузку и очистить FO *)
      (* если он там уже есть                       *)

      if Not Assigned(LFIO) then LFIO := TLFIOut.Create;



      (* теперь надо проверить, не лежит ли уже такая карта в LFIO *)
      FO1 := LFIO.GetFIOut(sDt0,sTi0,FO.Name,FO.Alg_Ver);


      if Not Assigned(FO1) then begin (* карты нет в LFIO - добавляем *)
                             w := swStr.GetWordN(SLN.Strings[iv],2);
                             if w <> '' then FO.sVar := w + ChN0;
                             LFIO.Add(FO);
                           end
                           else
                           begin
                             (* FO - такая же карта, как и FO1, *)
                             (*   к-рая лежит в LFIO            *)

                             (* её бы надо удалить *)

                             (* ========= ОТЛАДКА ========== *
                             WarnAbs('162738 FO.Adr='+swStr.HexA(FO)+
                                        ' FO1.Adr='+swStr.HexA(FO));
                              * ========= ОТЛАДКА ========== *)
//                           FO.Done; FreeAndNil(FO)
                             (* но только если она не одно и то же, что и FO1 *)

                           end;
      result := true;
    end
    else begin

{
      if QAll = false then begin
        WarnAbs('LFIO.Load-QAll='+BoolStr(QAll)+
                ' FO.Name='+FO.Name+' '+sDt0+sTi0);
        WarnAbs(SLN);
      end;
}

      (* для карты с именем FO.Name не задано имя переменной Var *)
      if QAll then begin (* всё равно загружаем! *)
        (* надо проверить, не лежит ли уже такая карта в LFIO *)

{
        FO1 := LFIO.GetFIOut(sDt0,sTi0,FO.Name,FO.Alg_Ver);
        if Not Assigned(FO1) then LFIO.Add(FO)
                             else begin FO.Done; FreeAndNil(FO) end;
}
        LFIO.Add(FO);
        result := true;
      end;
    end;

    if nQ > 1000 then begin
      WarnAbs('LFIO.Load-ERR: '+sDt0+sTi0+' QAll='+BoolStr(QAll));
      WarnAbs(SLN);
      Exit;
    end;

  end; // until Not Q;

//result := true;
end; (* TLFIOut.Load *)


function TLFIOut.Load(kSoft0:integer;sDt0,sTi0,sN0:string):boolean;
var SLN : TStringList;
begin
  SLN := TStringList.Create;
  SLN.Add(sN0);
  result := Self.Load(kSoft0,sDt0,sTi0,SLN,false);
  SLN.Clear;
end;

function TLFIOut.Load(sDt0,sTi0,sN0:string):boolean;
var kSoft0 : integer; Q : boolean;
begin
  kSoft0 := 1;
  Q := Load(kSoft0,sDt0,sTi0,sN0);
  if Q then begin result := true; Exit end;
  kSoft0 := 2;
  result := Load(kSoft0,sDt0,sTi0,sN0);
end;



function TLFIOut.Load(kSoft0:integer;
                       sDt0,sTi0:string;SLN:TStringList):boolean;
const nStr = 80;  (* длина строки Хидера *)
var LFile,iv : integer; ch : char;
  fN,sB80,sB40,w : string;
  HmapSL : TStringList;
  nbH0,nb0Head : integer;
  ls0,ls1      : integer;
  nsH,nsHead0  : integer;
  NN1024       : integer;
  KH,NAXIS     : integer;
  Q,QDone  : boolean;
  FO,FO1 : TFIOut;
  nLFIO : integer;

begin
  result := false;

  nLFIO := LFIO.Count;

  (* для начала надо найти файл *)
  if sDBFITSPath = '' then sDBFITSPath := 'S:\Z\ASTRO\HINODE\sot\';
  fN := GetFITName(kSoft0,sDt0,sTi0);(* имя ME или SW fit файла *)

  if Not FileExists(fN) then begin
    Warn('TLFIOut.Load-SW/ME-FITS ERR: файла'+#13#10+'<'+fN+'>'+#13#10+
            'не существует!');
    Exit;
  end;


  LFile  := swFile.File_Size(fN);
  HmapSL := HmapSLDefine(kSoft0);(* связывание HmapSL (ещё не заполнение) *)
  sB80_40(sB80,sB40); (* заполняем строчки для оформления *)

(*------------------------------------*)
(*        главный заголовок           *)
(*------------------------------------*)

(*
 nsHead0 только в этом блоке
*)

  nbH0  := 0;   (* число байт, которые надо пропустить           *)
  ls0   := 0;   (* индекс строк HmapSL указывающий начало Хидера *)

(*------------------------------------*)
(*        главный заголовок           *)

  GetFITSHead(fN,nbH0,nsH,HmapSL);(* считываем главный заголовок       *)
  nsHead0 := nsH;                 (* число строк в первом заголовке    *)
  SkipFITSHeadEnd(fN,nbH0,nsH);   (* найти конец "места под заголовок" *)
                                  (* (пропускаем пустые строки в файле)*)
//nlHead0 := nsH;         (* место в "строках" под заголовок   *)
  nb0Head := nsH*nStr;    (* место в байтах под заголовок      *)

  HmapSL.Add(sB80); (* отделим от следующих заголовков *)

(*        главный заголовок           *)
(*------------------------------------*)
(*----------------------------------------------------------------------------*)

//  NN := 0;              (* объём данных текущего (предыдущего) блока *)
//  nbHead1 := nb0Head;   (* число байт в предыдущем заголовке *)
  ls1 := nsHead0;       (* индекс строк HmapSL указывающий конец Хидера *)
  (* nsH > nsHead0 так как включает пустые строки *)

  (*========================================*)
  (*                                        *)
  (*      анализируем нулевой заголовок     *)
  (*                                        *)
  (*========================================*)

  (* раскладывать "глобальные" значения для СЕАНСА из SW -  *)
  (* хидера в SELF=LFITS мы не будем, за исключением NAXIS  *)
  (* ls0     - номер строки начальной текущего подзаголовка *)
  (* nsHead0 - номер строки конечной  текущего подзаголовка *)

  NAXIS := GetFITKeyI('NAXIS',HmapSL,ls0,ls1);
  if NAXIS <> 0 then begin (* у "правильного" заголовка SunWorld NAXIS=0 *)
    WarnAbs('FIOut.Load-ERR: У "правильного" заголовка SunWorld и ME NAXIS=0!');
    Exit;
  end;

//NN1024 := nbH0 + nbHead1        + NN;           (* "округленное" число байт *)
        (* start + байт заголовка + байт данных *)
  (* для нулевого хидера *)
  NN1024 := nb0Head; (* число байт в нулевом заголовке с учётом пустых строк *)

  (*====================================================================*)
  (* начинаем цикл по оставшимся хидерам *)
  (*====================================================================*)

  KH := 0;    (* номер (индекс) заголовка, первый идёт под номером 0  *)
  Q  := true; (* Not Q - условие окончания repeat цикла по заголовкам *)
  repeat             (* until Not Q *)
    (*===============================================================*)
    (* читаем следующий хидер                                        *)
    inc(KH);

    FO := TFIOut.Create;
    FO.kSoft := kSoft0;    (* 1 SW, 2 ME *)
//  FO.chN := chN0;
    FO.sDt := sDt0;
    FO.sTi := sTi0;
    FO.LoadHeader(NN1024);   (* стартовая позиция следующего заголовка *)
    (* там внутри читается также sName *)
    FO.IH := KH;

    swStr.SListAdd(HmapSL,FO.HSL);
    HmapSL.Add(sB40);

    if (NN1024 >= (LFile-FO.nbHead)) then Q := false; (* конец файла *)
    HmapSL.Add(sB80);


    (* в этой процедуре мы загружаем только такие карты *)
    (* которые уже загружены в составе других сеансов   *)
    (* и при этом им назначены имена                    *)

    (* ищем, есть ли имя FO.Name в списке SLN *)
    iv := 0; QDone := false;
    while (Not QDone) do begin
      if (iv < SLN.Count) then begin
        w := swStr.GetWordN(SLN.Strings[iv],1);
        if (w = FO.Name) then QDone := true (* нашли - выходим из цикла *)
                         else inc(iv);
      end
      else QDone := true;
    end;


    if (iv < SLN.Count) then begin (* нашли *)
      if Not Assigned(LFIO) then LFIO := TLFIOut.Create;
      (* теперь надо проверить, не лежит ли уже такая карта в LFIO *)
//    FO1 := LFIO.GetFIOut(sDt0,sTi0,FO.Name,FO.Alg_Ver);
      FO1 := LFIO.GetFIOut(sDt0,sTi0,FO.Name);
      if Not Assigned(FO1) then begin
                             LFIO.Add(FO);
                           end
                           else begin FO.Done; FreeAndNil(FO) end;
    end
  until Not Q;

  result := (LFIO.Count > nLFIO);
end; (* TLFIOut.Load *)






















(* просто получить список имён карт *)
(* для заданной опции SW/ME/M2      *)
(* и для заданной сессии            *)
(* Id сеанса (ChN0 = '0'..'z') нам не нужен *)
(* объект LFIO можно и не создавать *)
function NamList(kSoft0:integer;sDt0,sTi0:string):TStringList;
var fN : string;
    HmapSL : TStringList;
    SL : TStringList;      (* для результата - списка имён карт *)
    nStr  : integer;       (* длина строки Хидера = 80 *)
    LFile : integer;
    nsH : integer;         (* число строк в [первом] заголовке    *)
    nbH0  : integer;       (* число байт, которые надо пропустить           *)
    nb0Head : integer;     (* место в байтах под заголовок      *)
    NN1024: integer; (* число байт в нулевом заголовке с учётом пустых строк *)
    NN0   : integer; (* число байт в очередном заголовке с учётом пустых строк*)
    KH    : integer; (* номер (индекс) заголовка, первый идёт под номером 0  *)
    Q     : boolean; (* Not Q - условие окончания repeat цикла по заголовкам *)

    FO    : TFIOut;  (* очередная карта *)
    chN0  : char;
    S : string;
begin
  result := NIL;

  (* для начала надо найти файл *)
  if sDBFITSPath = '' then sDBFITSPath := 'S:\Z\ASTRO\HINODE\sot\';
  fN := GetFITName(kSoft0,sDt0,sTi0);(* имя ME или SW fit файла *)
  if Not FileExists(fN) then begin
    Warn('TLFIOut.Load-SW/ME-FITS ERR: файла'+#13#10+'<'+fN+'>'+#13#10+
            'не существует!');
    Exit;
  end;

  SL     := TStringList.Create;
  HmapSL := TStringList.Create;

  nStr  := 80;                    (* длина строки Хидера *)
  LFile  := swFile.File_Size(fN); (* длина SW/ME файла   *)

(*------------------------------------*)
(*        главный заголовок           *)

  nbH0  := 0;                   (* число байт, которые надо пропустить *)
  GetFITSHead(fN,nbH0,nsH,HmapSL);(* первый заголовок                  *)

//  WarnAbs(HmapSL);
//  ed.edLoadSL('-',HmapSL);
//  Exit;

  SkipFITSHeadEnd(fN,nbH0,nsH);   (* найти конец "места под заголовок" *)

  (* корректируем, выравнивая в блоках по 36 строк *)
  if (nsH mod 36) > 0 then nsH := ((nsH div 36) + 1)*36;

  nb0Head := nsH*nStr;            (* место в байтах под заголовок      *)

  (* для нулевого хидера *)
  NN1024 := nb0Head; (* число байт в нулевом заголовке с учётом пустых строк *)

(*        главный заголовок           *)
(*------------------------------------*)

  (*====================================================================*)
  (* начинаем цикл по оставшимся хидерам *)
  (*====================================================================*)

  KH := 0;    (* номер (индекс) заголовка, первый идёт под номером 0  *)
  Q  := true; (* Not Q - условие окончания repeat цикла по заголовкам *)
  chN0 := '-';(* пустой номер *)

  S := 'Name b0_hd b0_data L_hd L_data';          (* Заглавная строка *)
  SL.Add(S);

  NN0 := NN1024;

  if (NN0 >= LFile) then Q := false; (* конец файла *)

  while Q do begin // repeat             (* until Not Q *)
    (*===============================================================*)
    (* читаем следующий хидер                                        *)
    inc(KH); (* индекс заголовка *)

    FO := TFIOut.Create;
    FO.kSoft := kSoft0;    (* 1 SW, 2 ME *)
    FO.chN := chN0;        (* временный chId сеанса *)
    FO.sDt := sDt0;
    FO.sTi := sTi0;
    FO.LoadHeader(NN0);(* прочитать очередную карту (с именем FO.Name)    *)
                       (* NN0 - стартовая позиция следующего заголовка *)
                       (* процедура меняет значение NN0 !!! *)
(*
    S := FO.Name+' '+HexL(FO.nb0)+   ' '+HexL(FO.nbData0)+' '
                    +HexL(FO.nbHead)+' '+HexL(FO.nbData);
*)
    S := FO.Name+' '+ISt (FO.nb0)+   ' '+ISt (FO.nbData0)+' '
                    +ISt (FO.nbHead)+' '+ISt (FO.nbData);


    SL.Add(S);
    if (NN0 >= (LFile-FO.nbHead)) then Q := false; (* конец файла *)
    FO.Done; FreeAndNil(FO);
  end; // until Not Q;

  HmapSL.Clear;
  result := SL;
end; (* TLFIOut.NamList *)




procedure TLFIOut.HSLAddStat(var HswSL:TStringList;
                             var NNN,nbH0,nbHead1,NN,NN1024;
                             KH:integer;
                             FO:TFIOut);
begin
    (* выведем статистические данные по только что выведенному хидеру *)
{
//    HswSL.Add('NAXIS1 = '+ISt(NAX));
      NNN := nbH0 + nbHead1 + NN; (* позиция следующего блока *)

//    (* округляем NNN до числа, кратного 512 (для ME - кратного 64) *)
      NN1024 := (((NNN-1) div 512) + 1) * 512;
//    NN1024 := (((NNN-1) div  64) + 1) *  64;
//    NN1024 := NNN;
}

      (* добавляем строку статистики в HswSL *)
//      HswSL.Add('KH='+ISt(KH)+' nbH0='+ISt(nbH0)+' nbHead='+ISt(nbHead1)
//      +' NN='+ISt(NN)+
//      ' NNN='+ISt(NNN)+'=$'+swStr.HexI(NNN)+' => $'+HexI(NN1024));

{
      HswSL.Add('KH='+ISt(KH)+' nbH0='+ISt(NN1024)+' nbHead='+
      ISt(FO.HSL.Count*80)
      +' NN='+ISt(FO.nbData)+
      ' NNN='+ISt(NNN)+'=$'+swStr.HexI(NNN)+' => $'+HexI(NN1024));
}

end;


function TLFIOut.Load(kSoft0:integer;sDt0,sTi0:string):boolean;
var ch : char;
begin
  ch := '0';
  result := Load(kSoft0,ch,sDt0,sTi0);
end;



(* попытаться загрузить карты FIOut из предварительно расчитанных SW *)
(*  - только описания карт, без данных!                              *)
function TLFIOut.Load(kSoft0:integer;chN0:char;sDt0,sTi0:string):boolean;

var //I : integer;
//  sYM : string;
//  s4  : string;
  fN  : string;


  LFile : integer; (* размер входного файла *)

  nbH0  : integer;   (* число байт, которые надо пропустить *)
  nStr  : integer;   (* = 80  длина строки  *)
  ls0   : integer;   (* индекс строк HswSL указывающий начало Хидера *)
  ls1   : integer;   (* индекс строк HswSL указывающий конец  Хидера *)


  sB40,sB80 : string; (* строки-разделители для целей оформления *)

  nsH : integer; (* число строк в заголовке *)

  KH : integer;  (* номер (индекс) заголовка, первый идёт под номером 0 *)
  Q  : boolean;  (* *)
  NN1024 : integer;(* "округленное" число байт: start+байт загол.+байт данных *)

  nsHead0 : integer;          (* место в "строках" под заголовок   *)
  nlHead0 : integer;          (* место в строках под заголовок      *)
  nb0Head : integer;          (* место в байтах под заголовок      *)

  NAXIS : integer; (* число осей в карте нужно здесь локально *)

  FO,FO1 : TFIOut;

  NN : integer; (* объём данных карты (для 0-ого заголовка = 0) *)

  HmapSL : TStringList;
begin
  result := false;

  if Not Assigned(Self) then begin
    WarnAbs('LFIO.Load k='+ISt(kSoft0)+sDt0+'_'+sTi0+
    ' когда LFIO Not Assigned!');
    Exit;
 // LFIO := TLFIOut.Create;
  end;


  (* для начала надо найти файл *)
  if sDBFITSPath = '' then sDBFITSPath := 'S:\Z\ASTRO\HINODE\sot\';
  fN := GetFITName(kSoft0,sDt0,sTi0);(* имя ME или SW fit файла *)


  (*===================*)
  (*===================*)
  (*===================*)
  (*===================*)
  (* временная вставка *)
  (*                   *)

//    SysUtils.DeleteFile(fN);
//    fN := swFile.ReplaceExt(fN,'FIO');

  (*===================*)
  (*===================*)
  (*===================*)


  if Not FileExists(fN) then begin
    Warn('TLFIOut.Load-SW/ME-FITS ERR: файла'+#13#10+'<'+fN+'>'+#13#10+
            'не существует!');
    Exit;
  end;


  nStr  := 80;  (* длина строки Хидера *)

  LFile  := swFile.File_Size(fN);
  HmapSL := HmapSLDefine(kSoft0);(*связываем HmapSL с LFIO.(HswSL/HmeSL/Hm2SL)*)
  sB80_40(sB80,sB40); (* заполняем строчки для оформления *)



(*---------------------------------------------*)
(*        главный (первый) заголовок           *)
(*          SW/ME/M2 - FITS файла              *)
(*---------------------------------------------*)

(*

 nsHead0 только в этом блоке


*)

  nbH0  := 0;   (* число байт, которые надо пропустить           *)
  ls0   := 0;   (* индекс строк HmapSL указывающий начало Хидера *)

(*------------------------------------*)
(*        главный заголовок           *)

  GetFITSHead(fN,nbH0,nsH,HmapSL);(* считываем главный заголовок       *)
  nsHead0 := nsH;                 (* число строк в первом заголовке    *)
  SkipFITSHeadEnd(fN,nbH0,nsH);   (* найти конец "места под заголовок" *)

//nlHead0 := nsH;         (* место в "строках" под заголовок   *)
  nb0Head := nsH*nStr;    (* место в байтах под заголовок      *)

  HmapSL.Add(sB80); (* отделим от следующих заголовков *)

(*        главный заголовок           *)
(*------------------------------------*)
(*----------------------------------------------------------------------------*)

//  NN := 0;              (* объём данных текущего (предыдущего) блока *)
//  nbHead1 := nb0Head;   (* число байт в предыдущем заголовке *)
  ls1 := nsHead0;       (* индекс строк HmapSL указывающий конец Хидера *)
  (* nsH > nsHead0 так как включает пустые строки *)

  (*========================================*)
  (*                                        *)
  (*      анализируем нулевой заголовок     *)
  (*                                        *)
  (*========================================*)

  (* раскладывать "глобальные" значения для СЕАНСА из SW -  *)
  (* хидера в SELF=LFITS мы не будем, за исключением NAXIS  *)
  (* ls0     - номер строки начальной текущего подзаголовка *)
  (* nsHead0 - номер строки конечной  текущего подзаголовка *)

  NAXIS := GetFITKeyI('NAXIS',HmapSL,ls0,ls1);
  if NAXIS <> 0 then begin (* у "правильного" заголовка SunWorld NAXIS=0 *)
    WarnAbs('FIOut.Load-ERR: У "правильного" заголовка SunWorld и ME NAXIS=0!');
    Exit;
  end;

//NN1024 := nbH0 + nbHead1        + NN;           (* "округленное" число байт *)
        (* start + байт заголовка + байт данных *)
  (* для нулевого хидера *)
  NN1024 := nb0Head; (* число байт в нулевом заголовке с учётом пустых строк *)

  (*====================================================================*)
  (* начинаем цикл по оставшимся хидерам *)
  (*====================================================================*)


  KH := 0;    (* номер (индекс) заголовка, первый идёт под номером 0  *)
  Q  := true; (* Not Q - условие окончания repeat цикла по заголовкам *)

  if Not Assigned(LFIO) then LFIO := TLFIOut.Create;



  (* идём по заголовкам sw/me - FITS файла *)
  (*---------------------------------------*)
  repeat             (* until Not Q *)
    (*===============================================================*)
    (* читаем следующий хидер,                                       *)
    (*    загружаем из хидера FO                                     *)
    (*    FO.kRun взводится внутри FO.Create                         *)
    FITS2FO(KH,FO,HmapSL,kSoft0,sDt0,sTi0,sB40,sB80,NN1024); // inc(KH);

{
    inc(KH); (* индекс заголовка *)

    FO := TFIOut.Create;  // FO.kRun := $A5A55A5A;
    FO.kSoft := kSoft0;    (* 1 SW, 2 ME *)
//  FO.chN := chN0;        (* временный chId сеанса // любой символ *)
    FO.chN := 'a';         (* временный chId сеанса // любой символ *)
    FO.sDt := sDt0;
    FO.sTi := sTi0;
    FO.IH  := KH;
    FO.LoadHeader(NN1024);(* прочитать очередную карту из файла FO.sFn       *)
                          (*     + выясняем и заполняем FO.Name              *)
                          (* NN1024 - стартовая позиция следующего заголовка *)
}


    (* здесь надо проверить - нет ли такой карты FO уже в LFIO *)
//  FO1 := LFIO.GetFIOut(sDt0,sTi0,FO.Name,FO.Alg_Ver);
    FO1 := LFIO.GetFIOut(sDt0,sTi0,FO.Name);

    (* на всякий случай *)
    if Assigned (FO1) then
      FO1.kRun := $A5A55A5A;


    (* если карты в LFOI не было, то её хидер добавляем к HmapSL *)
    if Not Assigned (FO1) then begin
      swStr.SListAdd(HmapSL,FO.HSL); HmapSL.Add(sB40);
    end;

    (* выведем статистические данные по только что выведенному хидеру *)
//  HSLAddStat(HswSL,NNN,nbH0,nbHead1,NN,NN1024,KH,FO);


    if (NN1024 >= (LFile-FO.nbHead)) then Q := false; (* конец файла *)
    HmapSL.Add(sB80);

//  LFIO.Add(FO); (* загружаем ВСЕ карты *)
                  (* т.е. дважды,трижды записанные в swFITS-файл *)


    if Not Assigned(FO1) then begin

                           // проверка
                           if Not FO.QRun then begin
                             WarnAbs(
      'WARN: взяли карту '+FO.Name+' из sw/me FITS-файла и у неё kRun=$'+
                             HexI(FO.kRun)+'!!!');
                           end;

                           LFIO.Add(FO);
                         end
                         else begin

                           // проверка
                           if Not FO1.QRun then begin
                             WarnAbs(
      'WARN карту '+FO1.Name+' нашли в LFIO, а у неё там kRun=$'+
                             HexI(FO1.kRun)+'!!!');
                           end;

                           (* загруженную из sw/me FITS карту (дубль) обнуляем*)
                           FO.Done; FreeAndNil(FO)
                         end;

  until Not Q;
  result := true;


//QRowData := false; (* загрузили готовые обсчитанные данные *)
end; (* TLFIOut.Load *)



{
(* рисовать *)
procedure TFIPOut.ShowData;
var hBMP : hBITMAP; W,H : integer; FMap : TFMap;
begin

  (*============= ПРОВЕРКИ =======================*)
  if Not Assigned(Self) then begin
    WarnAbs('FIOut.ShowData ERR: FIOut не создан!');
    Exit;
  end;

  if Self.kLoad < 2 then begin
    WarnAbs('FIPOut.ShowData '+Self.Name+' kLoad='+ISt(Self.kLoad)+'!!!');
    Exit;
  end;
  (*============= ПРОВЕРКИ =======================*)


  if Not MakeBitMap then begin (* создаём пустую BMP *)
    WarnAbs('FIOut.ShowData ERR: не удалось создать BMP');
    Exit;(* создать Shad = TBitMap размерами как GRAF.ShadeBMP *)
  end;
//hBMP := Shad.Handle;
//hBMP := TLFITS(Owner).Shad.Handle;
  hBMP := Shad.Handle;   (* Shad:TBitMap - глобальная переменная swFITS *)


  (*==============================================*)
  (*                рисуем на BMP                 *)
  (*        (чтобы разобраться заходите глубже)   *)

  Pict.FillBMP(hBMP);     (* FIOut.Pict : TR4Pict *)

  (*                                              *)
  (*                                              *)
  (*==============================================*)



  (* подцепляем форму рисования *)
//FMap := TLFITS(Owner).FMap;
  FMap := UFMap.FMap;
  if Not FMap.Visible then FMap.Show;
  if Not (FMap.WindowState = wsNormal) then FMap.WindowState := wsNormal;

(*
  Этот код почему-то ничего не рисует:
  ------------------------------------
  W := TLFITS(Owner).Shad.Width;
  H := TLFITS(Owner).Shad.Height;
  BitBlt(FMap.Canvas.Handle,0,0,W,H,hBMP,0,0,SRCCOPY);
*)

  FMap.mapNx  := Self.nx;
  FMap.mapNy  := Self.ny;
  FMap.pictNx := Shad.Width;
  FMap.pictNy := Shad.Height;

  FMap.kx := FMap.pictNx div FMap.mapNx;
  FMap.ky := FMap.pictNy div FMap.mapNy;


  FMap.Canvas.Draw(0,0,Shad);  (* Shad - глобальная переменная swFITS *)



end; (* TFIPOut.ShowData *)
}


function TFIOut.CheckForShow:boolean;
begin
  result := false;
  (*============= ПРОВЕРКИ =======================*)
  if Not Assigned(Self) then begin
    WarnAbs('FIOut.ShowData ERR: FIOut не создан!');
    Exit;
  end;

  if Self.kLoad < 2 then begin
    WarnAbs('FIOut.ShowData '+Self.Name+' kLoad='+ISt(Self.kLoad)+'!!!');
    Exit;
  end;
  (*============= ПРОВЕРКИ =======================*)


  if Not MakeBitMap then begin (* создаём пустую BMP *)
    WarnAbs('FIOut.ShowData ERR: не удалось создать BMP');
    Exit;(* создать Shad = TBitMap размерами как GRAF.ShadeBMP *)
  end;
  result := true;
end;



procedure TFIOut.ShowMask(aMask:TAMask);
var hBMP : hBITMAP;
begin
  (*============= ПРОВЕРКИ =======================*)
  if Not CheckForShow then Exit; (* проверка Self, kLoad и создания BMP *)

  Pict.aMsk := CopyAByBy(aMask);
  hBMP := Shad.Handle;   (* Shad:TBitMap - глобальная переменная swFITS *)

  Pict.MaskBMP(hBMP);     (* FIOut.Pict : TR4Pict *)



  (*---------- покажем форму FMap --------*)
  FMap := UFMap.FMap;
  if Not FMap.Visible then FMap.Show;
  if Not (FMap.WindowState = wsNormal) then FMap.WindowState := wsNormal;

  (* заполним поля, управляющие масштабированием *)
  FMap.InitNN(Self.nx,Self.ny,Shad.Width,Shad.Height);


{
  FMap.mapNx  := Self.nx;
  FMap.mapNy  := Self.ny;
  FMap.pictNx := Shad.Width;
  FMap.pictNy := Shad.Height;

  FMap.kx := FMap.pictNx div FMap.mapNx;
  FMap.ky := FMap.pictNy div FMap.mapNy;
}

  FMap.Canvas.Draw(0,0,Shad);  (* Shad - глобальная переменная swFITS *)
end;


(* рисовать *)
procedure TFIOut.ShowData;
var hBMP : hBITMAP; W,H : integer; FMap : TFMap;
begin


  (*============= ПРОВЕРКИ =======================*)
  if Not CheckForShow then Exit;

//hBMP := Shad.Handle;
//hBMP := TLFITS(Owner).Shad.Handle;
  hBMP := Shad.Handle;   (* Shad:TBitMap - глобальная переменная swFITS *)


  (*==============================================*)
  (*                рисуем на BMP                 *)
  (*        (чтобы разобраться заходите глубже)   *)

  Pict.FillBMP(hBMP);     (* FIOut.Pict : TR4Pict *)

  (*                                              *)
  (*                                              *)
  (*==============================================*)



  (* подцепляем форму рисования *)
//FMap := TLFITS(Owner).FMap;
  FMap := UFMap.FMap;
  if Not FMap.Visible then FMap.Show;
  if Not (FMap.WindowState = wsNormal) then FMap.WindowState := wsNormal;


{
  Этот код почему-то ничего не рисует:
  ------------------------------------
  W := TLFITS(Owner).Shad.Width;
  H := TLFITS(Owner).Shad.Height;
  BitBlt(FMap.Canvas.Handle,0,0,W,H,hBMP,0,0,SRCCOPY);
}

  FMap.mapNx  := Self.nx;
  FMap.mapNy  := Self.ny;
  FMap.pictNx := Shad.Width;
  FMap.pictNy := Shad.Height;

  FMap.kx := FMap.pictNx div FMap.mapNx;
  FMap.ky := FMap.pictNy div FMap.mapNy;


  FMap.Canvas.Draw(0,0,Shad);  (* Shad - глобальная переменная swFITS *)



end; (* TFIOut.ShowData *)



function TFIOut.MakeBitMap:boolean;
begin
  result := false;

//if Not Assigned(TLFITS(Owner).Shad) then begin
  if Not Assigned(Shad) then begin (* Shad - глобальная переменная swFITS *)
    Shad := TBitMap.Create;
    Shad.PixelFormat := pf24bit;
  end;

(*--- Shad - глобальная переменная swFits ---*)

  Shad.Width  := Round(Self.nX*rMapScale); // GRAF.ShadeBMP.Width;
  Shad.Height := Round(Self.nY*rMapScale); // .ShadeBMP.Width;
  BMPClear(Shad,clblue);

  result := true;
end; (* TFIOut.MakeBitMap *)



(*                 создать Хидер блока           *)
(* от других хидеров он отличается полем EXTNAME *)
procedure TFIOut.SWOUTHeader;
var S,W : string;
begin
  if Not Assigned(Self) then begin
    WarnAbs('TFIOut.SWOUTHeader ERR FIOut Not Assigned!');
    Exit;
  end;

  if Self.Alg_Ver = '' then begin
    WarnAbs('Для карты FITS_Out с именем '+Name+' не задана версия алгоритма');
    Exit;
  end;

  if Not Assigned(Self.HSL) then Self.HSL := TStringList.Create;
  Self.HSL.Clear;

  W := swTimer.NowStr15;

  S := MakeHdQS('XTENSION','IMAGE','IMAGE extension');               HSL.Add(S);
  S := MakeHdIS('BITPIX',-32,'IEEE single precision floating point');HSL.Add(S);
  S := MakeHdIS('NAXIS' ,2,'Number of data axes');                   HSL.Add(S);
  S := MakeHdIS('NAXIS1',nX,'Number of positions along axis 1');     HSL.Add(S);
  S := MakeHdIS('NAXIS2',nY,'Number of positions along axis 2');     HSL.Add(S);
  S := MakeHdIS('PCOUNT',0,'No Group Parameters');                   HSL.Add(S);
  S := MakeHdIS('GCOUNT',1,'One Data Group');                        HSL.Add(S);
  S := MakeHdStr('EXTNAME',Self.Name,'SW: '+Self.Comment);           HSL.Add(S);
  S := MakeHdStr('ALG_VER',Self.Alg_Ver,'Version of algorithm');     HSL.Add(S);
  S := MakeHdStr('CALCTIME',W,'Date_Time of Calculations');          HSL.Add(S);
  S := MakeHdES('VAL_MIN',rMin,7,'Minimal Value on the Map');        HSL.Add(S);
  S := MakeHdES('VAL_MAX',rMax,7,'Maximum Value on the Map');        HSL.Add(S);
  S := MakeHdES('VAL_MEAN',rMean,7,'Averaged Value on the Map');     HSL.Add(S);

  S := SSt('END',80);                                                HSL.Add(S);

  S := SSt('',80);  (* строка из 80-ти пробелов *)
  while (HSL.Count mod 36) <> 0 do HSL.Add(S); (* дополняем до 2880*x байт *)

end; (* TFIOut.SWOUTHeader *)





function TLFITS.sME_HEAD:string;
begin
  result := 'iX iY Cnt OriC kQUV H|| H GM HI VD1 VD2';
end;

function TLFITS.sSW_HEAD:string;
begin
  result := 'iX iY Cnt LC1 LC2 KVI W1 W2 H1 H2 HG1 HG2'; //II0 VV0
end;


{
procedure TLFITS.MEiXSL0(var SL:TStringList;iX:integer); (* без заголовка *)
var iY : integer; H,GM,HL : real; S : string;
begin
  for iY := 0 to nY-1 do begin
    H  := MeH   .aData[iX,iY];
    GM := MeGM  .aData[iX,iY];
    HL := H * cos(GM*C_PI180);

    S := '';
    S := S + ISt(iX) + ' ';
    S := S + ISt(iY) + ' ';
    S := S + EFSt0(MeCI  .aData[iX,iY],6) + ' ';
    S := S + EFSt0(MeCIO .aData[iX,iY],6) + ' ';
    S := S + EFSt0(MeQUV .aData[iX,iY],6) + ' ';
    S := S + EFSt0(HL                 ,6) + ' ';
    S := S + EFSt0(MeH   .aData[iX,iY],6) + ' ';
    S := S + EFSt0(MeGM  .aData[iX,iY],6) + ' ';
    S := S + EFSt0(MeXI  .aData[iX,iY],6) + ' ';
    S := S + EFSt0(MeVLo1.aData[iX,iY],6) + ' ';
    S := S + EFSt0(MeVLo2.aData[iX,iY],6) + ' ';
    S := S + EFSt0(MeLiSt.aData[iX,iY],6) + ' ';
    S := S + EFSt0(MeA   .aData[iX,iY],6) + ' ';
    S := S + EFSt0(MeWD  .aData[iX,iY],6) + ' ';
    S := S + EFSt0(MeVma .aData[iX,iY],6) + ' ';

    S := S + EFSt0(MeB0  .aData[iX,iY],6) + ' ';
    S := S + EFSt0(MeBeta.aData[iX,iY],6) + ' ';

    SL.Add(S);
  end;
end; (* TLFITS.MEiXSL0 *)
}

function TLFITS.sAny_HEAD:string;
begin
//result := 'iX iY CIO Cnt HL HH HD L1 L2 V1 V2';
//result := 'VV Cont';
  result := 'H2 H1';
end;

{
procedure TLFITS.AnyiXSL0(var SL:TStringList;iX:integer); (* без заголовка *)
var iY : integer; S : string; C,D,H,GM,HL,KVI,HH,HD : real;
begin
  for iY := 0 to nY-1 do begin
(*
    KVI := OuKVI.aData[iY,iX];
    if KVI < 0.1 then continue;
*)
//    C :=  OuCnt.aData[iY,iX];
//    if C > 0.8 then Continue;


    H  := MeH   .aData[iX,iY];
    GM := MeGM  .aData[iX,iY];
    HL := -H * cos(GM*C_PI180);
    D := (MeCI.aData[iX,iY]-MeCIO.aData[iX,iY])/MeCIO.aData[iX,iY];

    HH := (OuHG1.aData[iX,iY] + OuHG2.aData[iX,iY])/2;
    HD := (OuHG1.aData[iX,iY] - OuHG2.aData[iX,iY])/2;


    S := '';
(*
    S := S + ISt(iX) + ' ';
    S := S + ISt(iY) + ' ';
//  S := S + EFSt0(D,6)  + ' ';


    S := S + EFSt0(MeCIO.aData[iX,iY] ,6) + ' ';

    S := S + EFSt0(OuCnt.aData[iX,iY] ,6) + ' ';

    S := S + EFSt0(HL                 ,6) + ' ';
*)
    S := S + EFSt0(HH  ,6) + ' ';
    S := S + EFSt0(HD  ,6) + ' ';
(*

    S := S + EFSt0(OuVc1.aData[iX,iY] ,6) + ' ';
    S := S + EFSt0(OuVc2.aData[iX,iY] ,6) + ' ';
    S := S + EFSt0(MeVLo1.aData[iX,iY],6) + ' ';
    S := S + EFSt0(MeVLo2.aData[iX,iY],6) + ' ';
*)
    SL.Add(S);
  end;
end; (* TLFITS.AnyiXSL0 *)
}

{
procedure TLFITS.AnyiFilteredSL(var SL:TStringList;s1,s2,s3,s4:string;
iX:integer; iy1,iy2 : integer;
g1,g2,c1,c2,v1,v2,h1,h2:real; (* значения фильтров по gm,cont,vlos,Blos *)
qAbs:boolean;
chOp,chOp2:char
); (* без заголовка *)


var iY : integer; S : string;
C,D,H,GM,HL,KVI,P01,P02,H01,H02,H12,HH,HD,V01,V02,VV,W1,W2,R1,R2 : real;
r : real;
Ou1,Ou2,Ou3,Ou4,Ou01,Ou02 : TFIOut;
nd1,nd2 : integer; (* значащих цифр в выводимых значениях *)
begin
  nd1 := 6;
  nd2 := 6;

  if (c2<c1) then swTy.SWAP(c1,c2);

  (*

Получить гистограмму для величины W2/W1 от 64 до 71% с шагом 0.1%

   *)

  Ou1 := Self.GetData(s1);      (* строка параметра 1 *)
  if Not Assigned (Ou1) then Exit;
  if ChOp <> '0' then begin
    Ou2 := Self.GetData(s2);      (* строка параметра 2 *)
    if Not Assigned (Ou2) then Exit;
  end;


  Ou3 := Self.GetData(s3);      (* строка параметра 3 *)
  if Not Assigned (Ou3) then Exit;
  if ChOp2 <> '0' then begin
    Ou4 := Self.GetData(s4);      (* строка параметра 4 *)
    if Not Assigned (Ou4) then Exit;
  end;


  (*======== Ou1,Ou2,Ou3,Ou4 -> Ou01,Ou2 ==========*)

  if chOp = '0' then begin
                  Ou01 := Ou1;
                end
                else begin
                  Ou01 := TFIOut.Create;
                  Ou01.Fuse(Ou1,Ou2,chOp);
                end;

  if chOp2= '0' then begin
                  Ou02 := Ou3;
                end
                else begin
                  Ou02 := TFIOut.Create;
                  Ou02.Fuse(Ou3,Ou4,chOp2);
                end;

  (*-----------------------------------------------*)


(*
  S := Ou01.Name + ' ' + Ou02.Name;
  SL.Add(S);
*)

  nd1 := 8;
  nd2 := 8;


  for iY := iy1 to iy2 do begin
(*
    KVI := OuKVI.aData[iY,iX];
    if KVI < 0.1 then continue;
*)

    if g1 <> g2 then begin         (* задан фильтр по GM *)
      r := Self.MeGM.aData[iX,iY];
      if Not (((r >= g1) and (r <= g2))
              or ((r >= (180-g2)) and (r <= (180-g1))))
      then Continue;
    end;

    C :=  OuCnt.aData[iX,iY];
    if c1 <> c2 then begin         (* задан фильтр по CONT *)
      r := C;
//    if Not ((r >= c1) and (r <= c2))
//    then Continue;
      if (r < c1) or (r > c2) then Continue;
    end;



    V01 := OuVc1.aData[iX,iY];
    V02 := OuVc2.aData[iX,iY];
    if v1 <> v2 then begin         (* задан фильтр по V_los *)
      r := (V01 + V02)/2; (* V средн *)
      if Not ((r >= v1) and (r <= v2))
      then Continue;
    end;


    H  := MeH .aData[iX,iY];
    GM := MeGM.aData[iX,iY];
    HL := H * cos(GM*C_PI180);    (* продольное поле из данных ME *)




//  H01 := -OuH1.aData[iX,iY];   (* поле из данных V-момента *)
//  H02 := -OuH2.aData[iX,iY];
    H01 := -OuHG1.aData[iX,iY];  (* поле методом COG         *)
    H02 := -OuHG2.aData[iX,iY];



    if h1 <> h2 then begin        (* задан фильтр по полю *)
      r := (H01 + H02)/2;
      if qAbs then r := abs(r);
      if Not ((r >= h1) and (r <= h2))
      then Continue;
    end;




//    P01 := Ou1.aData[iX,iY];      (* значение параметра 1 *)
//    P02 := Ou2.aData[iX,iY];      (* значение параметра 2 *)




//  VV := (V01+V02)/2;            (* средняя скорость *)
    VV := (V01-V02);    (* разность скоростей = градиент скорости с высотой *)

    H12 := H01/H02;               (* отношение параметров 1/2 *)

    HH := (H01 + H02)/2;          (* среднее значение параметров 1 и 2 *)
    HD := (H01 - H02)/2;          (* полуазность параметров 1 и 2      *)







(*
    H  := MeH   .aData[iX,iY];
    GM := MeGM  .aData[iX,iY];
    HL := -H * cos(GM*C_PI180);
    D := (MeCI.aData[iX,iY]-MeCIO.aData[iX,iY])/MeCIO.aData[iX,iY];
*)

    W1 := OuW1.aData[iX,iY];
    W2 := OuW2.aData[iX,iY];


    R1 := Ou01.aData[iX,iY];
    R2 := Ou02.aData[iX,iY];


    S := '';
(*
    S := S + ISt(iX) + ' ';
    S := S + ISt(iY) + ' ';
//  S := S + EFSt0(D,6)  + ' ';


    S := S + EFSt0(MeCIO.aData[iX,iY] ,6) + ' ';

    S := S + EFSt0(OuCnt.aData[iX,iY] ,6) + ' ';

    S := S + EFSt0(HL                 ,6) + ' ';
*)
//    S := S + EFSt0(VV,6) + ' ';
//    S := S + EFSt0(C,6) + ' ';

//             S := S + EFSt0(P01 ,6) + ' ';
//             S := S + EFSt0(P02 ,6) + ' ';
(*
    S := S + EFSt0(C     ,6) + ' ';  // VV
    S := S + EFSt0(W2/W1 ,6) + ' ';
*)
    S := S + EFSt0(R1,nd1) + ' ';  // VV
    S := S + EFSt0(R2,nd2) + ' ';


(*
    S := S + EFSt0(OuVc1.aData[iX,iY] ,6) + ' ';
    S := S + EFSt0(OuVc2.aData[iX,iY] ,6) + ' ';
    S := S + EFSt0(MeVLo1.aData[iX,iY],6) + ' ';
    S := S + EFSt0(MeVLo2.aData[iX,iY],6) + ' ';
*)
    SL.Add(S);
  end;

(*   это копии других FIOut-ов!
  Ou1.Done;
  Ou2.Done;
  Ou3.Done;
  Ou4.Done;
 *)
  if chOp  <> '0' then Ou01.Done;
  if chOp2 <> '0' then Ou02.Done;

end; (* TLFITS.AnyiFilteredSL *)
*)


{
procedure TLFITS.AnyiFilteredSL8(var SL:TStringList;
s1,s2,s3,s4,s5,s6,s7,s8:string;
sf1,sf2,sf3,sf4,sf5,sf6:string;
rf1,rf2,rf3,rf4,rf5,rf6:real;      (* граничные значения фильтров *)
iX:integer; iy1,iy2 : integer;
nDig:integer;
g1,g2,c1,c2,v1,v2,h1,h2:real; (* значения фильтров по gm,cont,vlos,Blos *)
qHAbs:boolean;
//qCoord:boolean;
qX,qY:boolean;
qAbsf1,qAbsf3,qAbsf5:boolean;            (*        Abs для фильтров *)
chOp,chOp2,chOp3,chOp4,chOp13,chOp24:char;
chOpf1,chOpf3,chOpf5:char;     (* операторы связи фильтров *)
sOp1,sOp2,sOp3,sOp4:string
); (* без заголовка *)


var iY : integer; S : string;
C,D,H,GM,HL,KVI,P01,P02,H01,H02,H12,HH,HD,V01,V02,VV,W1,W2: real;
R1,R2,R3,R4 : real;
r : real;
Ou1,Ou2,Ou3,Ou4,Ou01,Ou02     : TFIOut;
Ou5,Ou6,Ou7,Ou8,Ou21,Ou22     : TFIOut;
Ouf1,Ouf2,Ouf3,Ouf4,Ouf5,Ouf6 : TFIOut;
Ouf11,Ouf33,Ouf55             : TFIOut;
(*======================================*)
//                  Ou31,Ou32 : TFIOut;
nd1,nd2,nd3,nd4 : integer; (* значащих цифр в выводимых значениях *)
qf1,qf3,qf5 : boolean;

//qAbs1,qAbs2,qAbs3,qAbs4:boolean;
ch1Op1,ch1Op2,ch1Op3,ch1Op4 : char;

(*---------------------------*)
(* унарная вложенная функция *)
function Func1(R:real;ch:char):real;
begin
  case ch of
    'a' : R := abs(R);
    'i' : if R <> 0 then R := 1/R;
    'n' : R := - R;
    'l' : begin R := abs(R);
            if R = 0 then R := -100 else R := log(R);
          end;
    'e' : R := exp10(R);
  end; (* case *)
  result := R;
end;
(*---------------------------*)

begin
  Time_routine('LFITS.AnyiFilteredSL8',true);
  nd1 := nDig;
  nd2 := nDig;
  nd3 := nDig;
  nd4 := nDig;

                           //  abs/neg/inv/lg/exp10

  ch1Op1 := ' '; if sOp1 <> '' then ch1Op1 := sOp1[1];
  ch1Op2 := ' '; if sOp2 <> '' then ch1Op2 := sOp2[1];
  ch1Op3 := ' '; if sOp3 <> '' then ch1Op3 := sOp3[1];
  ch1Op4 := ' '; if sOp4 <> '' then ch1Op4 := sOp4[1];


(*
  qAbs1 := sOp1 = 'abs';
  qAbs2 := sOp2 = 'abs';
  qAbs3 := sOp3 = 'abs';
  qAbs4 := sOp4 = 'abs';
*)

(*======================================*)
(* ДО циклов уточняем значения фильтров *)

  (*---- старый фильтр CONT -----*)
  if (c2<c1) then swTy.SWAP(c1,c2);

  if qAbsf1 then begin rf1 := Abs(rf1); rf2 := Abs(rf2); end;
  if qAbsf3 then begin rf3 := Abs(rf3); rf4 := Abs(rf4); end;
  if qAbsf5 then begin rf5 := Abs(rf5); rf6 := Abs(rf6); end;

  if rf2 < rf1 then swTy.SWAP(rf1,rf2);
  if rf4 < rf3 then swTy.SWAP(rf3,rf4);
  if rf6 < rf5 then swTy.SWAP(rf5,rf6);

  qf1 := Not (rf1 = rf2);
  qf3 := Not (rf3 = rf4);
  qf5 := Not (rf5 = rf6);

  if qf1 then begin
    if (chOpf1 = '0') then begin
      Ouf11 := Self.GetData(sf1);
    end
    else begin
      Ouf1 := Self.GetData(sf1);
      Ouf2 := Self.GetData(sf2);
      Ouf11 := TFIOut.Create;
      Ouf11.Fuse(Ouf1,Ouf2,chOpf1);
    end;
  end;

  if qf3 then begin
    if (chOpf3 = '0') then begin
      Ouf33 := Self.GetData(sf3);
    end
    else begin
      Ouf3 := Self.GetData(sf3);
      Ouf4 := Self.GetData(sf4);
      Ouf33 := TFIOut.Create;
      Ouf33.Fuse(Ouf3,Ouf4,chOpf3);
    end;
  end;

  if qf5 then begin
    if (chOpf5 = '0') then begin
      Ouf55 := Self.GetData(sf5);
    end
    else begin
      Ouf5 := Self.GetData(sf5);
      Ouf6 := Self.GetData(sf6);
      Ouf55 := TFIOut.Create;
      Ouf55.Fuse(Ouf5,Ouf6,chOpf5);
    end;
  end;

(*======================================*)



  (*

Получить гистограмму для величины W2/W1 от 64 до 71% с шагом 0.1%

   *)

  Ou1 := Self.GetData(s1);      (* строка параметра 1 *)
  if Not Assigned (Ou1) then Exit;
  if Not (ChOp  in ['0','i']) then begin
    Ou2 := Self.GetData(s2);      (* строка параметра 2 *)
    if Not Assigned (Ou2) then Exit;
  end;

  if Not (ChOp13 in ['0','i']) then begin
    Ou5 := Self.GetData(s5);      (* строка параметра 5 *)
    if Not Assigned (Ou5) then Exit;
    if ChOp3 <> '0' then begin
      Ou6 := Self.GetData(s6);      (* строка параметра 6 *)
      if Not Assigned (Ou6) then Exit;
    end;
  end;



  Ou3 := Self.GetData(s3);      (* строка параметра 3 *)
  if Not Assigned (Ou3) then Exit;
  if Not (ChOp2 in ['0','i']) then begin
    Ou4 := Self.GetData(s4);      (* строка параметра 4 *)
    if Not Assigned (Ou4) then Exit;
  end;

  if ChOp24 <> '0' then begin
    Ou7 := Self.GetData(s7);      (* строка параметра 7 *)
    if Not Assigned (Ou7) then Exit;
    if Not (ChOp4 in ['0','i']) then begin
      Ou8 := Self.GetData(s8);      (* строка параметра 8 *)
      if Not Assigned (Ou8) then Exit;
    end;
  end;




  (*======== Ou1,Ou2,Ou3,Ou4 -> Ou01,Ou2 ==========*)

  if chOp in ['0','i'] then begin
                  Ou01 := Ou1;
                end
                else begin
                  Ou01 := TFIOut.Create;
                  Ou01.Fuse(Ou1,Ou2,chOp);
                end;

  if ChOp13 <> '0' then begin
    if chOp3 in ['0','i'] then begin
                    Ou21 := Ou5;
                  end
                  else begin
                    Ou21 := TFIOut.Create;
                    Ou21.Fuse(Ou5,Ou6,chOp3);
                  end;
(*
    if ChOp13 in ['+','-','/'] then begin
      Ou31 := TFIOut.Create;
      Ou31.Fuse(Ou01,Ou21,ChOp13);
    end
    else Ou31 := Ou21;
*)
  end;


  if chOp2 in ['0','i'] then begin
                  Ou02 := Ou3;
                end
                else begin
                  Ou02 := TFIOut.Create;
                  Ou02.Fuse(Ou3,Ou4,chOp2);
                end;

  if ChOp24 <> '0' then begin
    if chOp4 in ['0','i'] then begin
                    Ou22 := Ou7;
                  end
                  else begin
                    Ou22 := TFIOut.Create;
                    Ou22.Fuse(Ou7,Ou8,chOp4);
                  end;
(*
    if ChOp24 in ['+','-','/'] then begin
      Ou32 := TFIOut.Create;
      Ou32.Fuse(Ou02,Ou22,ChOp24);
    end
    else Ou32 := Ou22;
*)
  end;





  (*-----------------------------------------------*)


(*
  S := Ou01.Name + ' ' + Ou02.Name;
  SL.Add(S);
*)


  for iY := iy1 to iy2 do begin

    (* применение фильтров из серии 3-х штук *)
    if qf1 then begin
      r := Ouf11.aData[iX,iY]; if qAbsf1 then r := Abs(r);
      if ((r < rf1) or (r > rf2)) then Continue;
    end;
    if qf3 then begin
      r := Ouf33.aData[iX,iY]; if qAbsf3 then r := Abs(r);
      if ((r < rf3) or (r > rf4)) then Continue;
    end;
    if qf5 then begin
      r := Ouf55.aData[iX,iY]; if qAbsf5 then r := Abs(r);
      if ((r < rf5) or (r > rf6)) then Continue;
    end;

    (* фильтр старого типа *)

    if g1 <> g2 then begin         (* задан фильтр по GM *)
      r := Self.MeGM.aData[iX,iY];
      if Not (((r >= g1) and (r <= g2))
              or ((r >= (180-g2)) and (r <= (180-g1))))
      then Continue;
    end;





    R1 := Ou01.aData[iX,iY];
    R2 := Ou02.aData[iX,iY];

                           //  abs/neg/inv/lg/exp10
    if ch1Op1 <> ' ' then R1 := Func1(R1,ch1Op1);
    if ch1Op2 <> ' ' then R2 := Func1(R2,ch1Op1);


    if chOp13 <> '0' then begin
      R3 := Ou21.aData[iX,iY];
      if ch1Op3 <> ' ' then R3 := Func1(R3,ch1Op3);
      case chOp13 of
      '+' : R1 := R1 + R3;
      '-' : R1 := R1 - R3;
      '/' : if (R3 <> 0) then R1 := R1/R3;
      end; (* case *)
    end;

    if chOp24 <> '0' then begin
      R4 := Ou22.aData[iX,iY];
      if ch1Op4 <> ' ' then R4 := Func1(R4,ch1Op4);
      case chOp24 of
      '+' : R2 := R2 + R4;
      '-' : R2 := R2 - R4;
      '/' : if (R4 <> 0) then R2 := R2/R4;
      end; (* case *)
    end;


    if QExport then begin

      S :=     RSt(R1,nd1+6) + ' ';  // VV
      if (chOp13 = '&') then S := S + RSt(R3,nd3+6) + ' ';

      S := S + RSt(R2,nd2+6) + ' ';
      if (chOp24 = '&') then S := S + RSt(R4,nd4+6) + ' ';

    end
    else begin
      S :=     EFSt0(R1,nd1) + ' ';  // VV
      if (chOp13 = '&') then S := S + EFSt0(R3,nd3) + ' ';

      S := S + EFSt0(R2,nd2) + ' ';
      if (chOp24 = '&') then S := S + EFSt0(R4,nd4) + ' ';


    end;






//  if qCoord then S := S + ISt(iX) + ' ' + ISt(iY) + ' ';
    if qX then S := S + ISt(iX) + ' ';
    if qY then S := S + ISt(iY) + ' ';


    SL.Add(S);
  end;

(*   это копии других FIOut-ов!
  Ou1.Done;
  Ou2.Done;
  Ou3.Done;
  Ou4.Done;
 *)
  if chOp  <> '0' then Ou01.Done;
  if chOp2 <> '0' then Ou02.Done;

  if chOp13 <> '0' then begin
    if chOp3 <> '0' then Ou21.Done;
  end;
  if chOp24 <> '0' then begin
    if chOp4 <> '0' then Ou22.Done;
  end;

  if qf5 then if (chOpf5 <> '0') then Ouf55.Done;
  if qf3 then if (chOpf3 <> '0') then Ouf33.Done;
  if qf1 then if (chOpf1 <> '0') then Ouf11.Done;

  Time_routine('LFITS.AnyiFilteredSL8',false);
end; (* TLFITS.AnyiFilteredSL8 *)
*)






procedure TLFITS.SWiXSL0(var SL:TStringList;iX:integer); (* без заголовка *)
var iY : integer; S : string;
begin
  for iY := 0 to nY-1 do begin
    S := '';
    S := S + ISt(iX) + ' ';
    S := S + ISt(iY) + ' ';
    S := S + EFSt0(OuCont.aData[iX,iY],6) + ' ';
    S := S + EFSt0(OuGc1.aData[iX,iY] ,6) + ' ';
    S := S + EFSt0(OuGc2.aData[iX,iY] ,6) + ' ';
    S := S + EFSt0(OuKVI.aData[iX,iY] ,6) + ' ';
 //   S := S + EFSt0(OuII0.aData[iX,iY] ,6) + ' ';
 //   S := S + EFSt0(OuVV0.aData[iX,iY] ,6) + ' ';
    S := S + EFSt0(OuW1.aData[iX,iY]  ,6) + ' ';
    S := S + EFSt0(OuW2.aData[iX,iY]  ,6) + ' ';
    S := S + EFSt0(OuH1.aData[iX,iY]  ,12) + ' ';
    S := S + EFSt0(OuH2.aData[iX,iY]  ,12) + ' ';
    S := S + EFSt0(OuHG1.aData[iX,iY]  ,12) + ' ';
    S := S + EFSt0(OuHG2.aData[iX,iY]  ,12) + ' ';
    SL.Add(S);
  end;
end; (* TLFITS.SWiXSL0 *)


function TLFITS.AnyiXSL(iX:integer):TStringList;
var S : string; SL : TStringList; iY : integer;  H,GM,HL : real;
begin
  result := NIL;
  if Not Assigned(Self.OuCont)
  then begin
    WarnAbs('TLFITS.SWiXSL('+ISt(iX)+') ERR: SW DATA NOT Loaded or Calculated!');
    Exit;
  end;

  SL := TStringList.Create;
  S := sAny_HEAD;
  SL.Add(S);
  AnyiXSL0(SL,iX);

  swStr.LineTabStrings(SL,1);
  result := SL;
end; (* TLFITS.AnyiXSL *)




function TLFITS.SWiXSL(iX:integer):TStringList;
var S : string; SL : TStringList; iY : integer;  H,GM,HL : real;
begin
  result := NIL;
  if Not Assigned(Self.OuCont) then begin
    WarnAbs('TLFITS.SWiXSL('+ISt(iX)+') ERR: SW DATA NOT Loaded or Calculated!');
    Exit;
  end;

  SL := TStringList.Create;
  S := sSW_HEAD;
  SL.Add(S);
  SWiXSL0(SL,iX);

  swStr.LineTabStrings(SL,1);
  result := SL;
end;




function TLFITS.MEiXSL(iX:integer):TStringList;
var S : string; SL : TStringList; iY : integer;  H,GM,HL : real;
begin
  result := NIL;
  if Not Assigned(Self.MeCI) then begin
    WarnAbs('TLFITS.MEiXSL('+ISt(iX)+') ERR: MERLIN DATA NOT Loaded Yet!');
    Exit;
  end;

  SL := TStringList.Create;
  S := sME_HEAD;
  SL.Add(S);
  MEiXSL0(SL,iX);

  swStr.LineTabStrings(SL,1);
  result := SL;
end;






{
function TLFITS.Any_SL(s1,s2,s3,s4:string;
ix1,ix2,
iy1,iy2 : integer;
g1,g2,c1,c2,v1,v2,h1,h2:real;
qAbs:boolean;
chOp,chOp2:char
):TStringList; (* без заголовка *)



var SL : TStringList; iX:integer; ss1,ss2 : string;
begin
  result := NIL;
  if Not Assigned(Self.OuCont) then begin
    WarnAbs('TLFITS.AnyiXSL('+ISt(iX)+
    ') ERR: SunWorld DATA NOT Loaded or Calculated!');
    Exit;
  end;

  if Not Assigned(Self.MeCI) then begin
    WarnAbs('TLFITS.AnyiXSL('+ISt(iX)+') ERR: MERLIN DATA NOT Loaded Yet!');
    Exit;
  end;

  SL := TStringList.Create;
//SL.Add(sAny_HEAD);

  ss1 := s1; if chOp  <> '0' then ss1 := ss1+chOp +s2;
  ss2 := s3; if chOp2 <> '0' then ss2 := ss2+chOp2+s4;
  SL.Add(ss1+' '+ss2);

//for iX := 0 to nX-1 do AnyiXSL0(SL,iX);

  for iX := ix1 to ix2 do
   AnyiFilteredSL(SL,s1,s2,s3,s4,iX,iy1,iy2,
g1,g2,c1,c2,v1,v2,h1,h2,
qAbs,chOp,chOp2);

  swStr.LineTabStrings(SL,1);
  result := SL;
end; (* TLFITS.Any_SL *)
}






{
function TLFITS.Any_SL8(s1,s2,s3,s4,s5,s6,s7,s8:string;
sf1,sf2,sf3,sf4,sf5,sf6:string;
r1,r2,r3,r4,r5,r6:real;        (* граничные значения фильтров *)
ix1,ix2,
iy1,iy2 : integer;
nDig:integer;
g1,g2,c1,c2,v1,v2,h1,h2:real;
qHAbs:boolean;
//qCoord:boolean;
qX,qY:boolean;
qAbs1,qAbs3,qAbs5:boolean;            (*        Abs для фильтров *)
chOp,chOp2,chOp3,chOp4,chOp13,chOp24:char;
chOpf1,chOpf3,chOpf5:char;     (* операторы связи фильтров *)
sOp1,sOp2,sOp3,sOp4:string
):TStringList; (* без заголовка *)



var SL : TStringList; iX:integer; ss1,ss2,ss3,ss4,ssXY : string;
begin
  Time_routine('LFITS.Any_SL8',true);
  result := NIL;
  if Not Assigned(Self.OuCont) then begin
    WarnAbs('TLFITS.AnyiXSL('+ISt(iX)+
    ') ERR: SunWorld DATA NOT Loaded or Calculated!');
    Time_routine('LFITS.Any_SL8',false);
    Exit;
  end;

  if Not Assigned(Self.MeCI) then begin
    WarnAbs('TLFITS.AnyiXSL('+ISt(iX)+') ERR: MERLIN DATA NOT Loaded Yet!');
    Time_routine('LFITS.Any_SL8',false);
    Exit;
  end;

  SL := TStringList.Create;
//SL.Add(sAny_HEAD);


  (* формируем заголовок строки *)
  ss1 := s1; if (Not (chOp  in ['0','i'])) then ss1 := ss1+chOp +s2;
  ss2 := s3; if (Not (chOp2 in ['0','i'])) then ss2 := ss2+chOp2+s4;
  if sOp1 <> '' then ss1 := sOp1+'('+ss1+')';
  if sOp2 <> '' then ss2 := sOp2+'('+ss2+')';

  ss3 := s5; if (Not (chOp3 in ['0','i'])) then ss3 := ss3+chOp3+s6;
  ss4 := s7; if (Not (chOp4 in ['0','i'])) then ss4 := ss4+chOp4+s8;
  if sOp3 <> '' then ss3 := sOp3+'('+ss3+')';
  if sOp4 <> '' then ss4 := sOp4+'('+ss4+')';



  if (chOp13 in ['-','+','/']) then ss1 := '('+ss1+')'+chOp13+'('+ss3+')' else
  if (chOp13 = '&')            then ss1 :=     ss1    + ' '  +    ss3;
  if (chOp24 in ['-','+','/']) then ss2 := '('+ss2+')'+chOp24+'('+ss4+')' else
  if (chOp24 = '&')            then ss2 :=     ss2    + ' '  +    ss4;

  ssXY := ''; if qX then ssXY := ssXY +'X '; if qY then ssXY := ssXY +'Y ';

  SL.Add(ss1+' '+ss2+' '+ssXY);

//for iX := 0 to nX-1 do AnyiXSL0(SL,iX);

  for iX := ix1 to ix2 do
    AnyiFilteredSL8(SL,s1,s2,s3,s4,s5,s6,s7,s8,
    sf1,sf2,sf3,sf4,sf5,sf6,
    r1,r2,r3,r4,r5,r6,
    iX,iy1,iy2,nDig,
    g1,g2,c1,c2,v1,v2,h1,h2,
    qHAbs,
//  qCoord,
    qX,qY,
    qAbs1,qAbs3,qAbs5,           (*        Abs для фильтров *)
    chOp,chOp2,chOp3,chOp4,chOp13,chOp24,
    chOpf1,chOpf3,chOpf5,     (* операторы связи фильтров *)
    sOp1,sOp2,sOp3,sOp4);

  swStr.LineTabStrings(SL,1);
  result := SL;
  Time_routine('LFITS.Any_SL8',false);
end; (* TLFITS.Any_SL8 *)
}


function TLFITS.FITSbyIX(ix0:integer):TFITS;
var i : integer;
begin
  result := NIL;
  if Not Assigned(Self) then Exit;
  if Self.Count = 0 then Exit;
  for i := 0 to Count-1 do
    if TFITS(Self.Items[i]).IXI = ix0 then begin
      result := TFITS(Self.Items[i]);
    end;
end;






{
function TLFITS.SW_SL:TStringList;
var SL : TStringList; iX:integer;
begin
  result := NIL;
  if Not Assigned(Self.OuCont) then begin
    WarnAbs('TLFITS.SWiXSL('+ISt(iX)+
    ') ERR: SunWorld DATA NOT Loaded or Calculated!');
    Exit;
  end;

  SL := TStringList.Create;
  SL.Add(sSW_HEAD);
  for iX := 0 to nX-1 do SWiXSL0(SL,iX);

  swStr.LineTabStrings(SL,1);
  result := SL;
end; (* TLFITS.SW_SL *)
}

{
function TLFITS.ME_SL:TStringList;
var SL : TStringList; iX:integer;
begin
  result := NIL;
  if Not Assigned(Self.MeCI) then begin
    WarnAbs('TLFITS.MEiXSL('+ISt(iX)+') ERR: MERLIN DATA NOT Loaded Yet!');
    Exit;
  end;

  SL := TStringList.Create;
  SL.Add(sME_HEAD);
  for iX := 0 to nX-1 do MEiXSL0(SL,iX);

  swStr.LineTabStrings(SL,1);
  result := SL;
end; (* TLFITS.ME_SL *)
}


function TLFITS.HeaderGross:TStringList;
(* вывести главную информацию *)
var J : integer; SL : TStringList; S : string; aFITS : TFITS;
begin
  if Self.Count = 0 then Exit;
  SL := TStringList.Create;

  J := 0; aFITS := TFITS(Self.Items[J]); S := aFITS.HeadHd; SL.Add(S);
  for J := 0 to Self.Count-1 do begin (* по каждому из FITS-ев *)
    aFITS := TFITS(Self.Items[J]); S := aFITS.HeadReport; SL.Add(S);
  end;
  swStr.LineTabStrings(SL,1);

  S := 'Основные поля Header-а для набора FITS-ев'; SL.Insert(0,S);
  S := '-----------------------------------------'; SL.Insert(1,S);

  result := SL;
end; (* TLFITS.HeaderGross *)


procedure TLFITS.CalcParts(sDaTi:string;p07_1,p07_2:real;
                           var pLimb,pU,ppu,minC,pB077,pB007:real);
var J : integer; aFITS : TFITS;
    FOCB0 : TFIOut;
  FL : TLIST; (* список фильтров *)
  qa,qh : boolean;
  sn,S : string;
  Q : boolean;
  pp,ppp : real;
  aMask : TAMask;
  N_85 : integer;
  N, _nx,_ny, ix, iy : integer;
  CB,CBmin : real;
(*-----------------------------*)
procedure CalcMaskFilling;    // SetMask;
var ix,iy : integer;
begin
  Q := SunWorld.FITS_CurMask(FL,aMask);
  _nx := length(aMask);
  _ny := length(aMask[0]);

  (* N - число точек в маске *)
  N := 0;
  for ix := 0 to _nx-1 do
    for iy := 0 to _ny-1 do
      N := N + aMask[ix,iy];



  pp := 100*N/(_nx*_ny);
  if N_85 > 0 then ppp := 100*N/N_85 else ppp := 0;

  Finalize(aMask);
end;
(*- ---------------------- -*)

begin
  FOCB0 := TFIOut(LFIO.GetFIOut(sDaTi,'CB0'));
  if Not Assigned(FOCB0) then begin
    WarnAbs('В сеансе '+sDaTi+' не рассчитана карта CB0');
    Exit;
  end;

  FL := TList.Create;
  qa := false;
  qh := false;

  N_85 := 0;

  (* сначала определяем - есть ли области за краем диска Солнца *)

  sn := 'CB0';
  S  := '0 0.03';
  AddFiltr(FL,sn,S,qa,qh);  (* первый фильтр *)
  CalcMaskFilling;  pLimb := pp;


  (* определяем площадь тени *)
  FL.Clear;

  if pLimb = 0 then begin
    sn := 'CB0';
    S  := '0.03 0.4';         (* достаточно отфильтровать по яркости *)
    AddFiltr(FL,sn,S,qa,qh);  (* снова первый фильтр *)
  end
  else begin
    sn := 'CB0';
    S  := '0.1 0.5';         (* надо отфильтровать по яркости *)
    AddFiltr(FL,sn,S,qa,qh); (* первый фильтр *)

    sn := 'W2QUV';           (* и по поляризации *)
    S  := '50 500';
    AddFiltr(FL,sn,S,qa,qh); (* второй фильтр *)
  end;

  CalcMaskFilling; pU := pp;


  (* определяем площадь полутени *)
  FL.Clear;
  sn := 'CB0';
  S  := '0.5 0.85';
  AddFiltr(FL,sn,S,qa,qh);   (* первый фильтр *)

  if pLimb > 0 then begin    (* если есть области "за краем" *)
    sn := 'W2QUV';           (* фильтруем по поляризации     *)
    S  := '40 500'; // '15 500';
    AddFiltr(FL,sn,S,qa,qh);
  end;

  CalcMaskFilling;  ppu := pp;

  (* определяем минимальную яркость на диске (кроме лимба) *)
  FL.Clear;

  CBMin := 2;

  if pLimb = 0 then begin
    for ix := 0 to _nx-1 do
      for iy := 0 to _ny-1 do begin
        CB := FOCB0.aData[ix,iy];
        if CB >= 0.03          (* если CB - не артефакт, то *)
          then if (CB < CBMin) then CBMin := CB;
      end;
  end
  else begin
    if (pU > 0) or (ppu > 0) then begin
      sn := 'W2QUV';           (* фильтр по поляризации *)
      S  := '15 500';
      AddFiltr(FL,sn,S,qa,qh); (* первый фильтр *)

      Q := SunWorld.FITS_CurMask(FL,aMask);  (* заполняем aMask *)
      _nx := length(aMask);
      _ny := length(aMask[0]);

      for ix := 0 to _nx-1 do
        for iy := 0 to _ny-1 do begin
          if aMask[ix,iy] > 0 then begin
            CB := FOCB0.aData[ix,iy];
            if CB >= 0.03 then if (CB < CBMin) then CBMin := CB;
          end;
        end;
      Finalize(aMask);
    end
    else CBMin := 0.03;
  end;
  minC := CBMin;


  FL.Clear;
  sn := 'CB0';
  S := '0.85 2';
  AddFiltr(FL,sn,S,qa,qh);  (* фильтр по CB0 *)
  CalcMaskFilling; N_85 := N;

  FL.Clear;
  sn := 'W2QUV';
  S := EFSt0(p07_1,5)+' '+EFSt0(p07_2,5);
  AddFiltr(FL,sn,S,qa,qh);  (* фильтр по гистограмме поляризации на ур-не 0.7 *)

  sn := 'CB0';
  S := '0.5 2';
  AddFiltr(FL,sn,S,qa,qh);  (* плюс фильтр по CB0 *)

  CalcMaskFilling; pB077 := ppp; (* доля "точек без поля" *)

  FL.Clear;
  sn := 'W2QUV';
  S := '0 '+EFSt0(p07_1,5);
  AddFiltr(FL,sn,S,qa,qh);
  sn := 'CB0';
  S := '0.5 2';
  AddFiltr(FL,sn,S,qa,qh);

  CalcMaskFilling; pB007 := ppp; (* доля "ГОРЯЧИХ точек без поля" *)


(*
  WarnAbs(swStr.boolStr(Q)+' nx='+ISt(_nx)+' ny='+ISt(_ny)+
  ' pU='+FSt(pU,2)+
  ' ppu=' + FSt(ppu,2)+
  ' pLimb='+FSt(pLimb,2)+
  ' minCB0='+FSt(minC,3));
*)

{
  for J := 0 to Self.Count-1 do begin (* по каждому из FITS-ев *)
    aFITS := TFITS(Self.Items[J]);
    aFITS.ReturnSlitMeanV;
//  S := aFITS.ListReport; SL.Add(S);
  end;
}
end;




(*------------------------------------------------*)
(* расширяем маску, отбрасывая точки вблизи лимба *)
(* Если значение CB0=FO.aData[x,y] < C20 = 0.20   *)
(* тогда                                          *)
(* Если значение в любой из точек x,y ± R10 = 10  *)
(*      меньше, чем C03 = 0.03                    *)
(* тогда элемент маски сбрасываем                 *)

procedure EscapeLimb(var aMsk:TAMask;aDt:TAR4R4;C20,C03,R10:real);
var _nX, _nY, iX, iY, ix1, iy1, ii : integer; R4 : real;
begin
  ii := round(R10);

  _nX := length(aMsk);
  _nY := length(aMsk[0]);

  (* предполагаем, что текущие значения nX,nY *)
  (* соответствуют текущей карте FO           *)
  (* соторая содержит 'CB0'                   *)

  for iY := 0 to _nY-1 do begin
    for iX := 0 to _nX-1 do begin
      if aMsk[iX,iY] > 0 then begin
        R4 := aDt[iX,iY];
        if R4 < C20 then begin
          iX1 := iX - ii;
          if iX1 >= 0 then begin
            if (aDt[iX1,iY] < C03) then aMsk[iX,iY] := 0;
          end;
          iX1 := iX + ii;
          if iX1 < _nX then begin
            if (aDt[iX1,iY] < C03) then aMsk[iX,iY] := 0;
          end;
          iY1 := iY - ii;
          if iY1 >= 0 then begin
            if (aDt[iX,iY1] < C03) then aMsk[iX,iY] := 0;
          end;
          iY1 := iY + ii;
          if iY1 < _nY then begin
            if (aDt[iX,iY1] < C03) then aMsk[iX,iY] := 0;
          end;
        end; (* aDt[] < C20 *)
      end;  (* aMsk[] > 0  *)
    end;   (* for X *)
  end;    (* for Y *)

end;
(*------------------------------------------------*)





procedure TLFITS.CalcBML(sDaTi:string;
                           var maxBML1,maxBML2,maxBIV,minBIV:real);
var
  FO    : TFIOut;
  FOCB0 : TFIOut;
  FL    : TLIST; (* список фильтров *)
  qa,qh : boolean;
  sn,S : string;

  (* для маски *)
  aMask : TAMask;
  Q : boolean;
  _nx,_ny : integer;


// для отладки
  S1,S2 : string;

(*=====================*)

function WorkWith(sMap:string):boolean;
begin
  result := false;
  FO := TFIOut(LFIO.GetFIOut(sDaTi,sMap));
  if Not Assigned (FO) then begin
    WarnAbs('LFITS.CalcBML-ERR: Карта <'+sMap+'> не загружена в LFIO!');
    Exit;
  end;
  FO.FilteredMinMax(aMask);

  if (sMap = 'BML1') or (sMap = 'BML2') then
  FO.MaskMax_Y3(aMask,2);

  result := true;
end;

(*=====================*)

begin
  maxBML1 := 0; maxBML2 := 0; maxBIV := 0; minBIV := 0;

  FOCB0 := TFIOut(LFIO.GetFIOut(sDaTi,'CB0'));
  if Not Assigned(FOCB0) then begin
    WarnAbs('В сеансе '+sDaTi+' не рассчитана карта CB0');
    Exit;
  end;

  FL := TList.Create;

  qa := false;  (* фильтруем НЕ по абс.значениям *)
  qh := false;  (* фильтруем НЕ по гистограмме   *)

  (* задаём области, к-рые не попадают за край диска Солнца *)

  sn := 'CB0';
//S  := '0.05 2';
  S  := '0.3 2';     (* а также исключим области тени *)
  AddFiltr(FL,sn,S,qa,qh);

  (* заполняем маску *)
  Q := SunWorld.FITS_CurMask(FL,aMask);
  _nx := length(aMask);
  _ny := length(aMask[0]);


  if Not WorkWith('BIV') then Exit;
  maxBIV := FO.rMaxAv;
  minBIV := FO.rMinAv;

  (* дополнительно надо отсечь точки вблизи края по условию *)
  (* если точка имеет яркость меньше 0.25    *)
  (* а также на расстоянии в 10 точек от неё *)
  (* есть точка с яркостью меньше 0.05       *)
  (* то такую точку отбраcываем              *)

//EscapeLimb(aMask,FOCB0.aData,0.2,0.05,10);

  if Not WorkWith('BML1') then Exit;
  maxBML1 := FO.rMaxAv3;

//  S1 := 'MaxBML1='+EFSt0(maxBML1,5)+'['+ISt(FO.jXMa3)+','+ISt(FO.jYMa3)+']';

  if Not WorkWith('BML2') then Exit;
  maxBML2 := FO.rMaxAv3;

//  S2 := 'MaxBML2='+EFSt0(maxBML2,5)+'['+ISt(FO.jXMa3)+','+ISt(FO.jYMa3)+']';



{
  WarnAbs(S1+#10#13+S2);

  UFMap.FMap.UpSize(FO.nX,FO.nY,1);
  FO.PictOn; (* содержит FO.Pict.Init(FO.aData); *)
  FO.Pict.MaxMin; (* иначе будет ругаться на границы *)
  FO.ShowMask(aMask);
}

end;












procedure TLFITS.GetDuration;
var J : integer;
  aFITS : TFITS;
//Self.tMin0 : real;
  tMin1 : real;
//  S : string;
begin

  J := 0; aFITS := TFITS(Self.Items[J]); // S := aFITS.ListRepHd; SL.Add(S);
  Self.tMin0 := aFITS.tMin;
  J := Self.Count-1; aFITS := TFITS(Self.Items[J]);
  tMin1 := aFITS.tMin;
  Self.tDura := tMin1 - tMin0; if tDura < 0 then tDura := tDura + 60*24;
  Self.tDay  := ((tMin1 + tMin0)/2)/(60*24);

end;



(* определяем поправку скорости - поле DOP_RCV *)
procedure TLFITS.Get_dVlos;
var   J : integer;
  dV,tM : real;
  aFITS : TFITS;
begin
  J := 0; aFITS := TFITS(Self.Items[J]);
  dV := aFITS.dV_los;
  tM := aFITS.tMin - Self.tMin0;
  Self.dVlosMi := dV; Self.tdVMi := tM;
  Self.dVlosMa := dV; Self.tdVMa := tM;

  for J := 1 to Self.Count-1 do begin
    aFITS := TFITS(Self.Items[J]);
    dV := aFITS.dV_los;
    tM := aFITS.tMin - Self.tMin0;
    if dV < dVlosMi then begin
      dVlosMi := dV; tdVMi := tM;
    end else
    if dV > dVlosMa then begin
      dVlosMa := dV; tdVMa := tM;
    end;
  end;
end;



function TLFITS.HeaderList:TStringList;
(* вывести главную информацию *)
var J : integer; SL : TStringList; S : string; aFITS : TFITS;
  tMin0,tMin1,t1,t2,t3,t4,t5,t6 : real;
begin

  (* первая задача процедуры - расчёт сводных и суммарных характеристик скана *)


  if Self.Count = 0 then Exit;
  SL := TStringList.Create;
  J := 0; aFITS := TFITS(Self.Items[J]); S := aFITS.ListRepHd; SL.Add(S);

  Self.GetDuration;   (* найти tDura и tDay *)

  t1 := 0; t2 := 0; t3 := 0; t4 := 0; t5 := 0; t6 := 0;

  for J := 0 to Self.Count-1 do begin (* по каждому из FITS-ев *)

//  if J = 349 then WarnAbs('J=349');

    aFITS := TFITS(Self.Items[J]);
    aFITS.ReturnMeanV;
    S := aFITS.ListReport; SL.Add(S);
    t1 := t1 + aFITS.T_1;
    t2 := t2 + aFITS.T_2;
    t3 := t3 + aFITS.T_3;
    t4 := t4 + aFITS.T_4;
    t5 := t5 + aFITS.T_5;
    t6 := t6 + aFITS.T_6;
  end;
  Self.Ts_1 := t1 / Self.Count;
  Self.Ts_2 := t2 / Self.Count;
  Self.Ts_3 := t3 / Self.Count;
  Self.Ts_4 := t4 / Self.Count;
  Self.Ts_5 := t5 / Self.Count;
  Self.Ts_6 := t6 / Self.Count;

  swStr.LineTabStrings(SL,1);

//  S := 'Основные поля Header-а для набора FITS-ев'; SL.Insert(0,S);
//  S := '-----------------------------------------'; SL.Insert(1,S);

  result := SL;
end; (* TLFITS.HeaderList *)



function TLFITS.GetXHeader(iX:integer):TStringList;
var aFITS : TFITS; SL : TStringList;
begin
  result := NIL;
  if Not Assigned(Self) then begin
    WarnAbs('LFITS Not Assigned Yet,'+#13#10+
    'Make Load Headers First!');
    Exit;
  end;

  if Not SetBit.IsBit(KStep,1) then begin
    WarnAbs('TLFITS.GetXHeader('+ISt(iX)+' Headers Not Loaded Yet!');
    Exit;
  end;

  aFITS := TFITS(Self.Items[iX]);
  SL := TStringList.Create;
  swStr.SLCopy(aFITS.HSL,SL);
  result := SL;
end; (* TLFITS.GetXHeader *)



{
function TLFITS.GetXIntegrVal(iX:integer):TStringList;
var aFITS : TFITS; SL : TStringList;
begin
  if Not SetBit.IsBit(KStep,1) then begin
    WarnAbs('TLFITS.GetXIntegrVal('+ISt(iX)+' Headers Not Loaded Yet!');
    Exit;
  end;

  if il2 = 0 then begin
    WarnAbs('TLFITS.GetXIntegrVal Err значения границ линий ещё не заданы!');
    Exit;
  end;

  aFITS := TFITS(Self.Items[iX]); (* iX не совпадает с поз-ей щели iXP *)

  SetBit.BICB(aFITS.KStep,3);(*сообщим FITS, что надо заново выполнить BigCalc*)
  SL := aFITS.ReportIntegrVal(il1,il2,il3,il4,il5,il6);
  result := SL;
end; (* TLFITS.GetXIntegrVal *)
}




{
function TLFITS.GetXIntegrVal2(iX:integer):TStringList;
var aFITS : TFITS; SL : TStringList;
begin
  if Not SetBit.IsBit(KStep,1) then begin
    WarnAbs('TLFITS.GetXIntegrVal('+ISt(iX)+' Headers Not Loaded Yet!');
    Exit;
  end;

  if il2 = 0 then begin
    WarnAbs('TLFITS.GetXIntegrVal Err значения границ линий ещё не заданы!');
    Exit;
  end;

  aFITS := TFITS(Self.Items[iX]); (* iX не совпадает с поз-ей щели iXP *)
  SL := aFITS.ReportIntegrVal2;
  result := SL;
end;
}



function TLFITS.HeadersDiff:TStringList;
(* составить список ключей     *)
(* пробежаться по всем хидерам *)
var LKey : TList; aFITS : TFITS; I,J : integer; S,W,sK,sV : string;
 aKey : TKeyRec; SL : TStringList;
 LSkip : TStringList;
begin
  if Self.Count = 0 then Exit;

  LSkip := TStringList.Create;
  LSkip.Add('DATE_RF0');
  LSkip.Add('TIME-OBS');
  LSkip.Add('CTIME');
  LSkip.Add('DATE_END');
  LSkip.Add('CROTA2');

  LKey := TList.Create;
  aFITS := TFITS(Self.Items[0]);
  for I := 0 to aFITS.HSL.Count-1 do begin (* число колонок в Хидере *)
    S := aFITS.HSL.Strings[I];
    aFITS.SplitHeaderStr(S,sK,sV);
    aKey := TKeyRec.Create;
    aKey.sKey := sK;
    aKey.sVal := sV;
    aKey.Q1   := true;
    aKey.QSkip:= false;
    if swStr.FindStrings(sK,LSkip) > -1 then aKey.QSkip := true;
    LKey.Add(aKey);
  end;

  for J := 1 to Self.Count-1 do begin (* по каждому из FITS-ев *)
    aFITS := TFITS(Self.Items[J]);
    if aFITS.HSL.Count <> LKey.Count then begin
      WarnAbs('Число полей в Хидере изменилось!!!');
      Exit;
    end;

    for I := 0 to aFITS.HSL.Count-1 do begin (* пребираем колонки хидера *)
      S := aFITS.HSL.Strings[I];
      aFITS.SplitHeaderStr(S,sK,sV);
      if sK <> TKeyRec(LKey.Items[I]).sKey then begin
        WarnAbs('Порядок полей в Хидере изменился!'+#13#10+
        'строка N='+ISt(I+1)+' OldKey=<'+TKeyRec(LKey.Items[I]).sKey+
        '> NewKey=<'+sK+'>');
        Exit;
      end;
      if sV <> TKeyRec(LKey.Items[I]).sVal then begin
        TKeyRec(LKey.Items[I]).Q1 := false; (* множественное значение *)
      end;
    end;
  end;

  SL := TStringList.Create;


  S := '';
  for I := 0 to LKey.Count-1 do begin
    if (Not TKeyRec(LKey.Items[I]).Q1) and
       (Not TKeyRec(LKey.Items[I]).QSkip)
    then begin
      W := TKeyRec(LKey.Items[I]).sKey;
      while pos(' ',W) > 0 do W := swStr.SubstStr(W,' ','_');
      S := S + W+' ';
    end;
  end;
  SL.Add(S);


  for J := 0 to Self.Count-1 do begin
    aFITS := TFITS(Self.Items[J]);

    S := '';
    for I := 0 to aFITS.HSL.Count-1 do begin
      if (Not TKeyRec(LKey.Items[I]).Q1) and
         (Not TKeyRec(LKey.Items[I]).QSkip)
      then begin
        W := aFITS.HSL.Strings[I];
        aFITS.SplitHeaderStr(W,sK,sV);
        while pos(' ',sV) > 0 do sV := swStr.SubstStr(sV,' ','_');
        S := S + sV + ' ';
      end;
    end;
    SL.Add(S);
  end;

  swStr.LineTabStrings(SL,1);

  S := 'Различающиеся поля Header-а для набора FITS-ев'+#13#10+
       '----------------------------------------------'; SL.Insert(0,S);
  S := '----------------------------------------------'; SL.Insert(1,S);

  result := SL;
end; (* TLFITS.HeadersDiff *)

function TLFITS.HeadersEqw:TStringList;
(* составить список ключей     *)
(* пробежаться по всем хидерам *)
var LKey : TList; aFITS : TFITS; I,J,JS,I1 : integer; S,W,sK,sV : string;
 aKey : TKeyRec; SL,SLH,SL2 : TStringList;
begin
  if Self.Count = 0 then Exit;

  LKey := TList.Create;
  aFITS := TFITS(Self.Items[0]);
  for I := 0 to aFITS.HSL.Count-1 do begin
    S := aFITS.HSL.Strings[I];
    aFITS.SplitHeaderStr(S,sK,sV);
    aKey := TKeyRec.Create;
    aKey.sKey := sK;
    aKey.sVal := sV;
    aKey.Q1   := true;
    aKey.QSkip:= false;
    LKey.Add(aKey);
  end;

  for J := 1 to Self.Count-1 do begin
    aFITS := TFITS(Self.Items[J]);
    if aFITS.HSL.Count <> LKey.Count then begin
      WarnAbs('Число полей в Хидере изменилось!!!');
      Exit;
    end;

    for I := 0 to aFITS.HSL.Count-1 do begin
      S := aFITS.HSL.Strings[I];
      aFITS.SplitHeaderStr(S,sK,sV);
      if sK <> TKeyRec(LKey.Items[I]).sKey then begin
        WarnAbs('Порядок полей в Хидере изменился!'+#13#10+
        'строка N='+ISt(I+1)+' OldKey=<'+TKeyRec(LKey.Items[I]).sKey+
        '> NewKey=<'+sK+'>');
        Exit;
      end;
      if sV <> TKeyRec(LKey.Items[I]).sVal then begin
        TKeyRec(LKey.Items[I]).Q1 := false;
      end;
    end;
  end;


  SLH := TStringList.Create;

  S := '';
  I1 := 0;
  for I := 0 to LKey.Count-1 do begin
    if TKeyRec(LKey.Items[I]).Q1 then begin
      W := TKeyRec(LKey.Items[I]).sKey;

      if W = 'END' then Continue;

      while pos(' ',W) > 0 do W := swStr.SubstStr(W,' ','_');
      S := S + W+' ';

      inc(I1);
      if ((I1) mod 10) = 0 then begin
        SLH.Add(S);
        S := '';
      end;
    end;
  end;
  SLH.Add(S);


  SL2 := TStringList.Create;
  SL  := TStringList.Create;
  J := 1; JS := 0;
  aFITS := TFITS(Self.Items[J]);

  S := '';
  I1 := 0;
  for I := 0 to aFITS.HSL.Count-1 do begin
    if TKeyRec(LKey.Items[I]).Q1 then begin
      W := aFITS.HSL.Strings[I];
      aFITS.SplitHeaderStr(W,sK,sV);

      if sK = 'END' then Continue;
      if sV = '' then sV := '<>';

      while pos(' ',sV) > 0 do sV := swStr.SubstStr(sV,' ','_');
      S := S + sV + ' ';

      inc(I1);

      if ((I1) mod 10) = 0 then begin
        SL.Clear;
        SL.Add(SLH.Strings[JS]); inc(JS);
        SL.Add(S);
        swStr.LineTabStrings(SL,1);
        SL2 := swStr.SListAdd(SL2,SL);
        SL2.Add('');
        S := '';
      end;
    end;
  end;

  SL.Clear;
  SL.Add(SLH.Strings[JS]); inc(JS);
  SL.Add(S);

  swStr.LineTabStrings(SL,1);

  SL2 := swStr.SListAdd(SL2,SL);
  SL2.Add('');

  S := 'Повторяющиеся поля Header-а для набора FITS-ев'; SL2.Insert(0,S);
  S := '----------------------------------------------'; SL2.Insert(1,S);

  result := SL2;
end; (* TLFITS.HeadersEqw *)

constructor TFITS.Create;
begin
  Inherited Create;

  Owner := NIL;
  IXI   := -1;   (* номер в DirList не задан *)
  KStep := 0;    (* стадии обработки *)
  k_VI1 := 0.01;     //  0.25; (* примерно 0.1 *)
  k_VI2 := 1;        //  0.9;  (* примерно 0.4 *)

//lsmooth := 90;
end;




procedure TFITS.Done;
var I : integer;
begin
//if K = 0 then Exit;

  Finalize(aData);

  for I := 1 to nAXIS do begin
    ACTYPE[I] := '';  (* типы *)
    ACUNIT[I] := '';  (* единицы измерения осей *)
  end;
  FillChar(AnAX,SizeOf(AnAx),#0); (* размерности осей данных NAXIS[1..10] *)

  sFN      := '';
  if Assigned(HSL) then HSL.Clear;

//  Finalize(AC4);
//  Finalize(AD4);

  Finalize(ACnt);

  Finalize(ALC1);
  Finalize(ALC2);

  Finalize(ANE);

  Finalize(AWI1);
  Finalize(AWI2);

  Finalize(AMV1);
  Finalize(AMV2);

  Finalize(AHM1);
  Finalize(AHM2);

//Finalize(ALam);

  nsHead   := 0;(* число строк в хидере *)
  nlHead   := 0;(* размер места под хидер в строках *)
  nbHead   := 0;(* размер хидера в байтах *)
  nData    := 0;(* размер данных (одной записи) в nBITPIX-битных числах *)
  nbData   := 0;(* размер данных (одной записи) в байтах *)

  nBITPIX  := 0; (* число бит в единице данных *)
  nAXIS    := 0; (* число осей данных *)
  DATA_LEV := 0; (* уровень данных 0 = исходные *)

  KStep    := 0;
end; (* TFITS.Done *)

(* проверка, что у FITS назначен номер по порядку *)
(* sP указывает, из какой процедуры запущена проверка *)
function TFITS.CheckI(sP:string):boolean;
begin
  result := false;
  if Not Check(sP) then Exit; (* все ключевые эл-ты заполнены? *)
  if IXI < 0 then begin
    WarnAbs(sP+'ERR IXI<0 => Self Not Linked!');
    Exit;
  end;
  result := true;
end;

(* проверка, что у FITS все ключевые эл-ты заполнены *)
function TFITS.Check(sP:string):boolean;
begin
  sP := 'TFITS.'+sP;
  result := false;
  if Not Assigned(Self) then begin
    WarnAbs(sP+'ERR Self Not Assigned'); Exit;
  end;
  if Not Assigned(Owner) then begin
    WarnAbs(sP+'ERR Owner Not Assigned'); Exit;
  end;
//  if Self.sFN = '' then begin
//    WarnAbs(sP+'ERR FileName sFN is Empty!'); Exit;
//  end;
  result := true;
end;

function TFITS.CheckFN(sP:string):boolean;
begin
  sP := 'TFITS.'+sP;
  result := false;
  if Self.sFN = '' then begin
    WarnAbs(sP+'ERR FileName sFN is Empty!'); Exit;
  end;
  result := true;
end;




procedure TFITS.ClearData;
begin
//if Not SetBit.IsBit(KStep,2) then Exit; (* данные не загружены *)
  ClearAData;
  ClearMData;

  TLFITS(Owner).nHead_s := TLFITS(Owner).nHead_s - HSL.Count*80;
  HSL.Clear;
end;

function TFITS.nWorkData:longint;
var L : longint; i,iFO,iLi : integer;
begin
  L := 0;
  if Assigned(ACnt) then L := L + length(ACnt);
  if Assigned(AKVI) then L := L + length(AKVI);

  for iFO := 1 to mFine do
    for iLi:=1 to 2 do if Assigned(A2[iFO,iLi]) then L:=L+length(A2[iFO,iLi]);
 {
  if Assigned(Aa1)  then L := L + length(Aa1);
  if Assigned(Aa2)  then L := L + length(Aa2);
  if Assigned(Ab1)  then L := L + length(Ab1);
  if Assigned(Ab2)  then L := L + length(Ab2);
  if Assigned(Ac1)  then L := L + length(Ae1);
  if Assigned(Ac2)  then L := L + length(Ae2);
  if Assigned(Ad1)  then L := L + length(Ad1);
  if Assigned(Ad2)  then L := L + length(Ad2);
  if Assigned(Ae1)  then L := L + length(Ae1);
  if Assigned(Ae2)  then L := L + length(Ae2);
  if Assigned(Af1)  then L := L + length(Af1);
  if Assigned(Af2)  then L := L + length(Af2);
  if Assigned(Ag1)  then L := L + length(Ag1);
  if Assigned(Ag2)  then L := L + length(Ag2);

  if Assigned(Ah1)  then L := L + length(Ah1);
  if Assigned(Ai1)  then L := L + length(Ai1);
  if Assigned(Aj1)  then L := L + length(Aj1);
  if Assigned(Ak1)  then L := L + length(Ak1);
  if Assigned(Al1)  then L := L + length(Al1);
  if Assigned(Am1)  then L := L + length(Am1);
  if Assigned(Ah2)  then L := L + length(Ah2);
  if Assigned(Ai2)  then L := L + length(Ai2);
  if Assigned(Aj2)  then L := L + length(Aj2);
  if Assigned(Ak2)  then L := L + length(Ak2);
  if Assigned(Al2)  then L := L + length(Al2);
  if Assigned(Am2)  then L := L + length(Am2);
}




  if Assigned(ALC1) then L := L + length(ALC1);
  if Assigned(ALC2) then L := L + length(ALC2);

  if Assigned(AI_d01) then L := L + length(AI_d01);
  if Assigned(AI_d02) then L := L + length(AI_d02);
  if Assigned(AILd01) then L := L + length(AILd01);
  if Assigned(AILd02) then L := L + length(AILd02);

  if Assigned(ALC51) then L := L + length(ALC51);
  if Assigned(ALC52) then L := L + length(ALC52);

  for i := 1 to mBisec do begin
    if Assigned(AbiC1[i]) then L := L + length(AbiC1[i]);
    if Assigned(AbiW1[i]) then L := L + length(AbiW1[i]);
    if Assigned(AbiC2[i]) then L := L + length(AbiC2[i]);
    if Assigned(AbiW2[i]) then L := L + length(AbiW2[i]);
  end;

  for i := 3 to 5 do begin
    if Assigned(A35C1[i]) then L := L + length(A35C1[i]);
    if Assigned(A35I1[i]) then L := L + length(A35I1[i]);
    if Assigned(A35D1[i]) then L := L + length(A35D1[i]);
    if Assigned(A35C2[i]) then L := L + length(A35C2[i]);
    if Assigned(A35I2[i]) then L := L + length(A35I2[i]);
    if Assigned(A35D2[i]) then L := L + length(A35D2[i]);
  end;

  if Assigned(AGa18 ) then L := L + length(AGa18 );
  if Assigned(AGa16 ) then L := L + length(AGa16 );
  if Assigned(AGa141) then L := L + length(AGa141);
  if Assigned(AGa142) then L := L + length(AGa142);
  if Assigned(AGb18 ) then L := L + length(AGb18 );
  if Assigned(AGb16 ) then L := L + length(AGb16 );
  if Assigned(AGb141) then L := L + length(AGb141);
  if Assigned(AGb142) then L := L + length(AGb142);

  if Assigned(AGa28 ) then L := L + length(AGa28 );
  if Assigned(AGa26 ) then L := L + length(AGa26 );
  if Assigned(AGa241) then L := L + length(AGa241);
  if Assigned(AGa242) then L := L + length(AGa242);
  if Assigned(AGb28 ) then L := L + length(AGb28 );
  if Assigned(AGb26 ) then L := L + length(AGb26 );
  if Assigned(AGb241) then L := L + length(AGb241);
  if Assigned(AGb242) then L := L + length(AGb242);

  if Assigned(AG1d0 ) then L := L + length(AG1d0 );
  if Assigned(AG2d0 ) then L := L + length(AG2d0 );
  if Assigned(AG1Dk ) then L := L + length(AG1Dk );
  if Assigned(AG2Dk ) then L := L + length(AG2Dk );
  if Assigned(AG1D  ) then L := L + length(AG1D  );
  if Assigned(AG2D  ) then L := L + length(AG2D  );

  if Assigned(AGL16 ) then L := L + length(AGL16 );
  if Assigned(AGL14 ) then L := L + length(AGL14 );
  if Assigned(AGL26 ) then L := L + length(AGL26 );
  if Assigned(AGL24 ) then L := L + length(AGL24 );
  if Assigned(AGL10 ) then L := L + length(AGL10 );
  if Assigned(AGL20 ) then L := L + length(AGL20 );
  if Assigned(AGL1  ) then L := L + length(AGL1  );
  if Assigned(AGL2  ) then L := L + length(AGL2  );

//if Assigned(AC4   ) then L := L + 4*length(AC4[1]);
//if Assigned(AD4   ) then L := L + 4*length(AD4[1]);
//                           L := L + 4*length(AC4[1]);
//                           L := L + 4*length(AD4[1]);

  if Assigned(AWI1  ) then L := L + length(AWI1  );
  if Assigned(AWI2  ) then L := L + length(AWI2  );
  if Assigned(AWI3  ) then L := L + length(AWI3  );

  if Assigned(AMV1  ) then L := L + length(AMV1  );
  if Assigned(AMV2  ) then L := L + length(AMV2  );
  if Assigned(AHM1  ) then L := L + length(AHM1  );
  if Assigned(AHM2  ) then L := L + length(AHM2  );
  if Assigned(AHG1  ) then L := L + length(AHG1  );
  if Assigned(AHG2  ) then L := L + length(AHG2  );

  if Assigned(AWk1  ) then L := L + length(AWk1  );
  if Assigned(AWk2  ) then L := L + length(AWk2  );
  if Assigned(AWk3  ) then L := L + length(AWk3  );
  if Assigned(AWk4  ) then L := L + length(AWk4  );

  (* временные массивы для входных данных *)


  (* временные массивы для выходных данных *)

  if Assigned(AWo1  ) then L := L + length(AWo1  );
  if Assigned(AWo2  ) then L := L + length(AWo2  );
  if Assigned(AWo3  ) then L := L + length(AWo3  );
  if Assigned(AWo4  ) then L := L + length(AWo4  );
  if Assigned(AWo5  ) then L := L + length(AWo5  );
  if Assigned(AWo6  ) then L := L + length(AWo6  );
  if Assigned(AWo7  ) then L := L + length(AWo7  );
  if Assigned(AWo8  ) then L := L + length(AWo8  );

  L := L * SizeOf(Real);

{
  Finalize(ANE);
  Finalize(AN1);
  Finalize(AN2);
}
  result := L;


end;


procedure TFITS.ClearMData; (* "map" data - строки интегральных карт *)
var i,iFO,iLi : integer;
begin

  Finalize(ACnt);

  (* оценочные массивы *)

  Finalize(AKVI); (* отношения W_abs(V)/W_I *)
{
  Finalize(AKV1); (* отношения W_abs(V)/W_I *)
  Finalize(AKQ1); (* отношения W_abs(Q)/W_I *)
  Finalize(AKU1); (* отношения W_abs(U)/W_I *)
  Finalize(AKW1);  (* W_I *)
  Finalize(AKV2); (* отношения W_abs(V)/W_I *)
  Finalize(AKQ2); (* отношения W_abs(Q)/W_I *)
  Finalize(AKU2); (* отношения W_abs(U)/W_I *)
  Finalize(AKW2);  (* W_I *)
}
  for iFO := 1 to mFine do
    for iLi := 1 to 2 do Finalize(A2[iFO,iLi]);

   
{
  Finalize(Aa1);  (* отношения W_abs(Vp)/W_I *)
  Finalize(Aa2);  (* отношения W_abs(Vp)/W_I *)
  Finalize(Ab1);  (* отношения W_abs(Vn)/W_I *)
  Finalize(Ab2);  (* отношения W_abs(Vn)/W_I *)
  Finalize(Ac1);  (* отношения W_abs(Qp)/W_I *)
  Finalize(Ac2);  (* отношения W_abs(Qp)/W_I *)
  Finalize(Ad1);  (* отношения W_abs(Qn)/W_I *)
  Finalize(Ad2);  (* отношения W_abs(Qn)/W_I *)
  Finalize(Ae1);  (* отношения W_abs(Up)/W_I *)
  Finalize(Ae2);  (* отношения W_abs(Up)/W_I *)
  Finalize(Af1);  (* отношения W_abs(Un)/W_I *)
  Finalize(Af2);  (* отношения W_abs(Un)/W_I *)
  Finalize(Ag1);  (*                     W_I *)
  Finalize(Ag2);  (*                     W_I *)

  Finalize(Ah1);  (* *)
  Finalize(Ai1);  (* *)
  Finalize(Aj1);  (* *)
  Finalize(Ak1);  (* *)
  Finalize(Al1);  (* *)
  Finalize(Am1);  (* *)
  Finalize(Ah2);  (* *)
  Finalize(Ai2);  (* *)
  Finalize(Aj2);  (* *)
  Finalize(Ak2);  (* *)
  Finalize(Al2);  (* *)
  Finalize(Am2);  (* *)
}

  (* основа для вычислений экв.ширин, положений центров тяжети I+V, I-V *)
  Finalize(ALC1); (* полож.центра тяжести в пикселах для инт-ти 6301 *)
  Finalize(ALC2); (* полож.центра тяжести в пикселах для инт-ти 6302 *)

  Finalize(AI_d01); (* центральная глубина в пикселах *)
  Finalize(AI_d02);
  Finalize(AILd01); (* полож.вершины линии 6301 в пикселах *)
  Finalize(AILd02); (* полож.вершины линии 6302 в пикселах *)
  Finalize(ALC51);  (* полож.бисектора .5 6301 в пикселах *)
  Finalize(ALC52);  (* полож.бисектора .5 6302 в пикселах *)

  for i := 1 to mBisec do begin
    Finalize(AbiC1[i]);
    Finalize(AbiW1[i]);
    Finalize(AbiC2[i]);
    Finalize(AbiW2[i]);
  end;

  for i := 3 to 5 do begin
    Finalize(A35C1[i]);
    Finalize(A35I1[i]);
    Finalize(A35D1[i]);
    Finalize(A35C2[i]);
    Finalize(A35I2[i]);
    Finalize(A35D2[i]);
  end;

  Finalize(AGa18 );
  Finalize(AGa16 );
  Finalize(AGa141);
  Finalize(AGa142);
  Finalize(AGb18 );
  Finalize(AGb16 );
  Finalize(AGb141);
  Finalize(AGb142);
  Finalize(AGa28 );
  Finalize(AGa26 );
  Finalize(AGa241);
  Finalize(AGa242);
  Finalize(AGb28 );
  Finalize(AGb26 );
  Finalize(AGb241);
  Finalize(AGb242);

  Finalize(AGD18 );
  Finalize(AGD16 );
  Finalize(AGD141);
  Finalize(AGD142);
  Finalize(AGD28 );
  Finalize(AGD26 );
  Finalize(AGD241);
  Finalize(AGD242);

  Finalize(AG1d0 );
  Finalize(AG2d0 );
  Finalize(AG1Dk );
  Finalize(AG2Dk );
  Finalize(AG1D  );
  Finalize(AG2D  );

  Finalize(AGL16 );
  Finalize(AGL14 );
  Finalize(AGL26 );
  Finalize(AGL24 );
  Finalize(AGL10 );
  Finalize(AGL20 );
  Finalize(AGL1  );
  Finalize(AGL2  );

//  Finalize(AC4);  (* среднее для области спектра без линий *)
//  Finalize(AD4);  (* ср.квадратич.отклон. - '' -           *)

  Finalize(ANE);
  Finalize(AN1);
  Finalize(AN2);

  Finalize(AWI1); (* экв.ширина 6301 (поделена на AC4[1] и привед.к дл.волны *)
  Finalize(AWI2); (* экв.ширина 6302 (поделена на AC4[1] и привед.к дл.волны *)
  Finalize(AWI3); (* экв.ширина 6302.05   *)

  Finalize(AMV1); (* ненормир.момент 6301 *)
  Finalize(AMV2); (* ненормир.момент 6302 *)

  Finalize(AHM1);  (* продольное поле 6301 *)
  Finalize(AHM2);  (* продольное поле 6302 *)

  Finalize(AHG1);  (* продольное поле 6301 *)
  Finalize(AHG2);  (* продольное поле 6302 *)

  (* временные массивы для входных данных *)

  Finalize(AWk1);
  Finalize(AWk2);
  Finalize(AWk3);
  Finalize(AWk4);

  (* временные массивы для выходных данных *)

  Finalize(AWo1);
  Finalize(AWo2);
  Finalize(AWo3);
  Finalize(AWo4);
  Finalize(AWo5);
  Finalize(AWo6);
  Finalize(AWo7);
  Finalize(AWo8);

  SetBit.BICB(Self.KStep,3); (* = KStep - 8 *)
end; (* TFITS.ClearMData *)


procedure TFITS.ClearAData;
var n : integer;
begin
//if Not SetBit.IsBit(KStep,2) then Exit; (* данные не загружены *)
  n := length(aData);
  TLFITS(Owner).nData_s := TLFITS(Owner).nData_s - n*2; (* данные по 2 байта *)
  Finalize(aData);

  SetBit.BICB(Self.KStep,2);  (* = KStep - 4 *)
end; (* TFITS.ClearAData *)



(*------------------------------------------------------*)
(* чтение данных из файла в массив 16-битных слов aData *)
(*   Данные из буфера файла переносятся по два байта    *)
(*   последовательно в буфер aData.                     *)
(*   Байты в каждой паре переставляются местами         *)
(*------------------------------------------------------*)
procedure TFITS.LoadData;
const sP = 'LoadData ';
var I,J : integer;
  B2 : array[1..2] of byte; W : word absolute B2;
  aDataB : TABt; (* массив байт *)
  sFN,sFNa : string;
begin
  Time_routine('FITS.LoadData',true);

SunWorld.MemTrand('LoadData 1');

  if Not Check(sP) then Exit;             (* проверка Self и Owner *)
  if SetBit.IsBit(Self.KStep,2) then Exit; (* данные уже загружены *)


  if Not SetBit.IsBit(TLFITS(Owner).KStep,0) then begin
    WarnAbs('Вызов FITS('+Self.sDtObs+' iX='+ISt(Self.IXI)+
            ').LoadData до привязки LFITS!');

    Exit; (* данные уже загружены *)
  end;



//sDBFITSpath
  sFN := Self.fNam;
  sFNa := DirAndName(TLFITS(Owner).sPath,sFN);

  SunWorld.MemTrand('LoadData 2');


  (*------ чтение из файла во временный буфер aDataB --------*)
  SetLength(aDataB,self.nbData);
  nGrossData := nGrossData + nbData;
  inc(nGrossCount);

  SunWorld.MemTrand('LoadData 3');

{
  if nGrossData > 778960895 then begin
    WarnAbs(sFNa+#10#13+
            ISt(nbHead)+' '+ISt(nbData)+' '+ISt(length(aDataB)) );
  end;
}

  if Not swFile.DBRdRec1(sFNa,nbHead,nbData,1,aDataB) then begin
      WarnAbs('TFITS.LoadData Ошибка при чтении блока из файла '+#13#10+
      '<'+sFNa+'>'+#13#10+
      'I = 1 nbH0='+ISt(nbHead)+' LData='+ISt(nbData)+#13#10+
      'IOResult of Reset = '+ISt(swFile.IOResultLast)+#13#10+
      'ErrLast=<'+swFile.sErrLast+'>'
      );
  end;


  SetLength(aData,self.nData);
  (*----- надо поменять местами байты в элементах aData типа word ---*)

  SunWorld.MemTrand('LoadData 4');

  J := -1;
  for I := 0 to nData-1 do begin
    inc(J); B2[2] := aDataB[J]; (* сначала второй байт *)
    inc(J); B2[1] := aDataB[J]; (* потом первый        *)
    aData[I] := W;
  end;

  if Assigned(Owner) then begin
    if TLFITS(Owner).kRun = $A55AA55A then begin
//    WarnAbs('FMap.Name='+TLFITS(Owner).FMap.Name);
      TLFITS(Owner).nData_s := TLFITS(Owner).nData_s + nData*SizeOf(W);
    end;
  end;
//TLFITS(Owner).nData_s := TLFITS(Owner).nData_s + nbData;

  SunWorld.MemTrand('LoadData 5');


  Finalize(aDataB);
  SunWorld.MemTrand('LoadData 6');
  SetBit.BISB(Self.KStep,2);
  Time_routine('FITS.LoadData',false);
end; (* TFITS.LoadData *)

{
(* чтение данных из файла в массив 16-битных слов aData *)
procedure TFITS.LoadData0;
var I,J : integer;
  B2 : array[1..2] of byte; W : word absolute B2;
  aDataB : TABt; (* массив байт *)
begin
  if SetBit.IsBit(Self.KStep,2) then begin
    WarnAbs('TFITS.LoadData WARNING!'+#13#10+
    'Data Already Loaded!!!');
    Exit;
  end;

  if Not SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TFITS.LoadData ERROR!'+#13#10+
    'Headers Not Loaded Yet!!!');
    Exit;
  end;

  (*------ чтение из файла во временный буфер aDataB --------*)
  SetLength(aDataB,self.nbData);
  if Not swFile.DBRdRec1(sFNa,nbHead,nbData,1,aDataB) then begin
      WarnAbs('TFITS.LoadData Ошибка при чтении блока из файла '+#13#10+
      '<'+sFNa+'>'+#13#10+
      'I = 1 nbH0='+ISt(nbHead)+' LData='+ISt(nbData)+#13#10+
      'IOResult of Reset = '+ISt(swFile.IOResultLast)+#13#10+
      'ErrLast=<'+swFile.sErrLast+'>'
      );
  end;

  SetLength(aData,self.nData);
  (*----- надо поменять местами байты в элементах aData типа word ---*)
  J := -1;
  for I := 1 to nData do begin
    inc(J); B2[2] := aDataB[J]; (* сначала второй байт *)
    inc(J); B2[1] := aDataB[J]; (* потом первый        *)
    aData[I] := W;
  end;

  Finalize(aDataB);
  SetBit.BISB(Self.KStep,2);
end; (* TFITS.LoadData *)
}


(* для трёх измерений !!!       *)
(* i3 - параметр Стокса         *)
(* i2 - точка вдоль щели iY     *)
(* варьируется i1 - длина волны *)
function TFITS.GetCol1(i2,i3:integer):TAIn;
var i,j,m,ii,ijm,K,N : integer; A : TAIn;
begin
//Result := NIL;   ???

  WARNABS('функция GetCol1 должна быть заменена процедурой GetCol3 !!!');



  if Not SetBit.IsBit(KStep,1) then begin
    WarnAbs('TFITS.GetCol1 Err: Header Not Loaded Yet!');
    Exit;
  end;
  if Not SetBit.IsBit(KStep,2) then begin
    WarnAbs('TFITS.GetCol1 Err: Data Not Loaded Yet!');
    Exit;
  end;

  if (i2 < 1) or (i2 > AnAX[2]) then begin
    WarnAbs('TFITS.GetCol1 ERR: i2='+ISt(i2)+' Not in [1..'+ISt(AnAX[2])+']');
    Exit;
  end;
  if (i3 < 1) or (i3 > AnAX[3]) then begin
    WarnAbs('TFITS.GetCol1 ERR: i3='+ISt(i3)+' Not in [1..'+ISt(AnAX[3])+']');
    Exit;
  end;
  Time_routine('FITS.GetCol1',true);

  N := AnAX[1];  (* = NLam *)
  SetLength(A,N+1);

  ii  := 0;                     (* индекс массива результата *)
//ijm := 0;                     (* индекс массива aData      *)
  ijm :=-1;                     (* индекс массива aData      *)


  for m := 1 to AnAX[3] do begin            (* пар-р Стокса  *)
    for j := 1 to AnAX[2] do begin          (* точка на щели *)
      for i := 1 to AnAX[1] do begin        (* дл.волны      *)
        inc(ijm);
        if m = i3 then
          if j = i2 then begin
            inc(ii);              (* ii меняется от 1 до N+1 *)

            if ijm >= nData-1 then begin
              WarnAbs('ijm='+ISt(ijm));
            end;

            K := aData[ijm];
            if (K > 32768) and (i3 <> 1) then A[ii] := K - 65536
                                         else A[ii] := K;
          end;
      end;
    end;
  end;

  (* учитываем SPBSHFT - сдвиг бита в данных FITS *)
  case i3 of
  1   : if iSPBSHFT > 0 then for ii := 1 to N+1 do A[ii] := 2*A[ii];
  2,3 : if iSPBSHFT = 3 then for ii := 1 to N+1 do A[ii] := 2*A[ii];
  4   : if iSPBSHFT > 1 then for ii := 1 to N+1 do A[ii] := 2*A[ii];
  end; (* case *)

  result := A;
  Time_routine('FITS.GetCol1',false);
end; (* TFITS.GetCol1 *)

(* ВОЗВРАЩАЕМ ЦЕЛОЧИСЛЕННУЮ МАТРИЦУ!        *)
(* выборка 112 точек одного профиля         *)
(* для данного iY и данного парам.Стокса    *)
(* индексы i2,i3 (=iYA,iStokes) считаем от ==!!! 1 до n !!!== *)
procedure TFITS.GetCol4(i2,i3,k2:integer;var A:TAIn);
(* k2=(1..2) - для учёта сдвига битов в данных FITS *)
var i,j,m,ii,ijm,K : integer;
begin
  SetLength(A,NLam+1);  (* NLam = AnAX[1] *)

//ijm := 0;                     (* индекс массива aData      *)
  ijm := -1;                    (* индекс массива aData      *)
  ii  := 0;                     (* индекс массива результата *)
  for m := 1 to AnAX[3] do begin       (* пар-р Стокса  = i3 *)
    for j := 1 to AnAX[2] do begin     (* точка на щели = i2 *)
      for i := 1 to AnAX[1] do begin   (* дл.волны       все *)
        inc(ijm);                   (* индекс внутри aData              *)
        (*------------------*)
        if m = i3 then              (* иначе переход к след.эл-ту aData *)
          if j = i2 then begin
            inc(ii);
            K := aData[ijm];
            if (K > 32768) and
                 (i3 <> 1)          (* не I, а Q,U или V       *)
              then K := K - 65536;  (* это отрицательное число *)
            A[ii] := K * k2;        (* учитываем сдвиг бита    *)
          end;
        (*------------------*)
      end;
    end;
  end;

end; (* TFITS.GetCol4 *)


(* выборка 112-ти точек одного профиля *)
(* индексы i2,i3 (=iY,iStokes) считаем от 1 до n *)
procedure TFITS.GetCol3(i2,i3:integer;var A:TAIn);
var // i,j,m,l,lll,II : integer;
    k2 : integer;
begin
//Result := NIL;   ???
  if Not SetBit.IsBit(KStep,1) then begin
    WarnAbs('TFITS.GetCol1 Err: Header Not Loaded Yet!');
    Exit;
  end;
  if Not SetBit.IsBit(KStep,2) then begin
    WarnAbs('TFITS.GetCol1 Err: Data Not Loaded Yet!');
    Exit;
  end;

  if (i2 < 1) or (i2 > AnAX[2]) then begin  (* AnAX[2] размерность оси *)
    WarnAbs('TFITS.GetCol1 ERR: i2='+ISt(i2)+' Not in [1..'+ISt(AnAX[2])+']');
    Exit;
  end;
  if (i3 < 1) or (i3 > AnAX[3]) then begin
    WarnAbs('TFITS.GetCol1 ERR: i3='+ISt(i3)+' Not in [1..'+ISt(AnAX[3])+']');
    Exit;
  end;


  Time_routine('FITS.GetCol3',true);


  (* учитываем SPBSHFT - сдвиг бита в данных FITS *)
  k2 := 1;
  case i3 of
  1   : if iSPBSHFT > 0 then k2 := 2;  (* I *)
  2,3 : if iSPBSHFT = 3 then k2 := 2;  (* Q,U *)
  4   : if iSPBSHFT > 1 then k2 := 2;  (* V *)
  end; (* case *)

  GetCol4(i2,i3,k2,A);  (* выборка 112-ти точек одного профиля *)

  Time_routine('FITS.GetCol3',false);

end; (* TFITS.GetCol3 *)





















function TFITS.iStokes(Ch:char):integer;
var i3 : integer;
begin
  case Ch of
    'Q','q' : i3 := 2;
    'U','u' : i3 := 3;
    'V','v' : i3 := 4;
   else i3 := 1
  end;
  result := i3;
end;

function TFITS.chStokes(i3:integer):char;
begin
  case i3 of
   1 : result := 'I';
   2 : result := 'Q';
   3 : result := 'U';
   4 : result := 'V';
   else begin
     result := 'I';
     WarnAbs('TFITS.chStokes ERR i3='+ISt(i3)+' - Not in [1..4]!');
   end;
  end;
end;


{
(* рассчитать значения континуума и дисперсий для всех точек на щели *)
procedure TFITS.GetSlitCont(S:char;var AC,AD:TARe);
var iYA : integer; rC,rD : real;
begin
  SetLength(AC,AnAX[2]+1); (* точек на щели + 1 *)
  SetLength(AD,AnAX[2]+1);

  for iYA := 1 to AnAX[2] do begin
    GetCont4(IYA,S,rC,rD);
    AC[iYA] := rC;
    AD[iYA] := rD;
  end;
end;



procedure TFITS.CalcSlit4Conts;
var N,i3,iYA : integer; rC,rD : real;
begin
  Time_routine('FITS.GetSlit4Conts',true);
  N := nY; // AnAX[2];
  for i3 := 1 to 4 do begin
    SetLength(AC4[i3],N+1);
    SetLength(AD4[i3],N+1);
  end;

  (* первая версия вычисления CONT - среднее по заданым точкам *)
  for iYA := 1 to N do begin
    for i3 := 1 to 4 do begin
      GetCont4(iYA,i3,rC,rD);
      AC4[i3,iYA] := rC;
      AD4[i3,iYA] := rD;
    end;
  end;
  Time_routine('FITS.GetSlit4Conts',false);
end;
}


function TFITS.ReturnSlitConts:boolean; (* вернуть Cont в FITS.ACnt из LFITS.OuCont *)
begin
  result := ReturnAnyMapLine('CONT',ACnt);
end;

(* вернуть Cont в FITS.ACnt из LFITS.OuCont *)
function TFITS.ReturnAnyMapLine(sNa:string;var A:TARe):boolean;
var iYA, iY : integer; FO : TFIOut;
begin
  result := false;
  FO := LFIO.GetFIOut(TLFITS(Owner).sDtTi,sNa);
  if Not Assigned(FO) then Exit; if Not FO.CheckLoad then Exit;
  SetLength(A,nY+1);
  for iYA := 1 to nY do begin
    iY := iYA - 1; A[iYA] := FO.aData[IXI,iY];   (*  *)
  end;
  result := true;
end;

(* вернуть строку - среднюю для 2-х карт *)
function TFITS.ReturnMid2MapsLine(sNa1,sNa2:string;var A:TARe;
                                  var IErr:integer):boolean;
var iYA, iY : integer; FO1,FO2 : TFIOut; 
begin
  result := false;
  IErr := 0;
  FO1 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,sNa1);
  FO2 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,sNa2);
  if Not Assigned(FO1) then IErr := IErr + 1 else
    if Not FO1.CheckLoad then IErr := IErr + 2;

  if Not Assigned(FO2) then IErr := IErr + 4 else
    if Not FO2.CheckLoad then IErr := IErr + 8;

  SetLength(A,nY+1);
  if Not Assigned(A) then IErr := IErr + 100;

  if IErr > 0 then Exit;

  for iYA := 1 to nY do begin
    iY := iYA - 1; A[iYA] := (FO1.aData[IXI,iY]+FO2.aData[IXI,iY])/2;
  end;
  result := true;
end;





(* заполняем массив ACnt[1..nY]              *)
(* максимум после сглаживания I(Lam) Гауссом *)
(* в КАЖДОЙ точке => ACnt[iY]                *)
procedure TFITS.CalcSlitConts;
var iY,iYA,iC : integer; rC,rD : real;
begin
  if (length(ACnt) = nY+1) then Exit; (* ACnt уже заполнен *)

  (* возможно в списке LFITS есть карта с именем CONT *)
  (* тогда ACnt загрузим оттуда                       *)
  if Not TLFITS(Owner).QCalcCont then (* но не в режиме расчёта!!! *)
    if ReturnSlitConts then Exit;

  Self.iIMax :=0;
  Self.iIMin := 32768;

  SetLength(ACnt,nY+1);

  for iYA := 1 to nY do begin
    iY := iYA-1;
    GetICont_01(iY,rC,rD); (* rC=CONT ; rD=index дл.волны точки CONT *)
    (*-----------------*)
//  if rC = 0 then rC := 1;  (* для областей за краем диска *)
    (*-----------------*)
    ACnt[iYA] := rC;   (* CONT в исходных интенсивностях *)

    iC := round(rC);
    if iC > Self.iIMax then Self.iIMax := iC else
    if iC <> 1 then if iC < Self.iIMin then Self.iIMin := iC;
  end;
end;

(* заполняем массив ACnt[1..nY]              *)
(* максимум после сглаживания I(Lam) Гауссом *)
(* в КАЖДОЙ точке => ACnt[iY]                *)
procedure TFITS.CalcSlitContsL;
var iY,iYA,iC,LC,LC2,iGap : integer; rC,rC2,rL,rL2 : real;
begin
  if (length(ACnt) = nY+1) then Exit; (* ACnt уже заполнен *)

  Self.iIMax :=0;
  Self.iIMin := 32768;

  SetLength(ACnt,nY+1);
  SetLength(AWo1,nY+1); (* временный мавссив под LCONT  *)

  SetLength(AWo2,nY+1); (* временный мавссив под CONT2  *)
  SetLength(AWo3,nY+1); (* временный мавссив под LCONT2 *)

  iGap := 10;

  for iYA := 1 to nY do begin
    iY := iYA-1;
    GetICont_02(iY,iGap,rC,rC2,LC,LC2);(*rC=CONT;LC=index дл.волны точки CONT *)
    rL := LC; rL2 := LC2;
    (*-----------------*)
//  if rC = 0 then rC := 1;  (* для областей за краем диска *)
    (*-----------------*)
    ACnt[iYA] := rC;   (* CONT в исходных интенсивностях *)
    AWo1[iYA] := rL;
    AWo2[iYA] := rC2;
    AWo3[iYA] := rL2;

    iC := round(rC);
    if iC > Self.iIMax then Self.iIMax := iC else
    if iC <> 1 then if iC < Self.iIMin then Self.iIMin := iC;
  end;
end;



procedure TFITS.CalcSlitConts_01(var AC,ACL:TARe;var ICMin,ICMax:integer);
var iY,iYA,iC : integer; rC,rD : real;
begin
  ICMax := 0; ICMin := 32768;

//SetLength(ACnt,nY+1);
  for iYA := 1 to nY do begin
    iY := iYA-1;
    GetICont_01(iY,rC,rD); (* rC=CONT ; rD= индекс дл.волны точки CONT *)
    (*-----------------*)
    if rC = 0        (* if rC < ??? - мы за краем диска Солнца ? *)
      then rC := 1;  (* для областей за краем диска *)
    (*-----------------*)
    AC [iYA] := rC;   (* CONT в исходных интенсивностях *)
    ACL[iYA] := rD;   (* индекс дл.волны *)

    iC := round(rC);
    if iC > ICMax then ICMax := iC else
    if iC <> 1 then                     (* если мы не за краем диска *)
    if iC < ICMin then ICMin := iC;
  end;
end;

(* загрузка из карт GC_1,_2 *)
procedure TFITS.ReturnSlitLC;
var FO1,FO2 : TFIOut; iYA,iY : integer;
begin
//FO1 := TLFITS(Owner).OuGc1; if Not Assigned(FO1) then Exit;
//FO2 := TLFITS(Owner).OuGc2; if Not Assigned(FO2) then Exit;

  FO1 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,'GRC_6301'); // LFITS.OuGc1
  FO2 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,'GRC_6302'); // LFITS.OuGc2

  SetLength(ALC1,Self.nY+1);
  SetLength(ALC2,Self.nY+1);

  for iYA := 1 to nY do begin
    iY := iYA - 1;
    ALC1[iYA] := FO1.aData[IXI,iY];
    ALC2[iYA] := FO2.aData[IXI,iY];
  end;

end; (* TFITS.ReturnSlitLC *)




function TFITS.ReturnSlitMeanV:boolean;
var FO1,FO2 : TFIOut; iYA,iY : integer;
  v1,v2,vs1,vs2 : real;
begin
  result := false;
//FO1 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,'VW_1');
//FO2 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,'VW_2');
  FO1 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,'VW1');
  FO2 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,'VW2');

  if Not Assigned(FO1) then Exit;

  if FO1.kLoad < 2 then FO1.LoadData(FO1.sFn,FO1.nbData0);
  if FO2.kLoad < 2 then FO2.LoadData(FO2.sFn,FO2.nbData0);

  Finalize(ALC51);
  Finalize(ALC52);

  SetLength(ALC52,Self.nY+1);
  SetLength(ALC51,Self.nY+1);

  SetLength(ALC1,Self.nY+1);


  vs1 := 0; vs2 := 0;
  for iYA := 1 to nY do begin
    iY := iYA - 1;
    v1 := FO1.aData[IXI,iY];
    v2 := FO2.aData[IXI,iY];
    ALC51[iYA] := v1;
    ALC52[iYA] := v2;
    vs1 := vs1 + v1;
    vs2 := vs2 + v2;
  end;
  v1 := vs1/nY;
  v2 := vs2/nY;

  Self.V21  := v2 - v1;
  Self.V_   := (v1 + v2)/2;
  Self.vx1_ := v1;
  Self.vx2_ := v2;

  result := true;
end;



function TFITS.ReturnMeanV:boolean;
var FO1,FO2 : TFIOut; iY : integer;
  v1,v2,vs1,vs2 : real;
begin
  result := false;
//FO1 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,'VW_1');
//FO2 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,'VW_2');
  FO1 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,'VW1');
  FO2 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,'VW2');

  if Not Assigned(FO1) then Exit;

  if FO1.kLoad < 2 then FO1.LoadData(FO1.sFn,FO1.nbData0);
  if FO2.kLoad < 2 then FO2.LoadData(FO2.sFn,FO2.nbData0);

  vs1 := 0; vs2 := 0;
  for iY := 0 to nY-1 do begin
    v1 := FO1.aData[IXI,iY];
    v2 := FO2.aData[IXI,iY];
    vs1 := vs1 + v1;
    vs2 := vs2 + v2;
  end;
  v1 := vs1/nY;
  v2 := vs2/nY;

  Self.V21  := v2 - v1;
  Self.V_   := (v1 + v2)/2;
  Self.vx1_ := v1;
  Self.vx2_ := v2;

  result := true;
end;





function TFITS.ReturnSlitLC50:boolean;
var FO1,FO2 : TFIOut; iYA,iY : integer;
begin
  result := false;
  FO1 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,'LC501');
  FO2 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,'LC502');

  if Not Assigned(FO1) then Exit;

  if FO1.kLoad < 2 then FO1.LoadData(FO1.sFn,FO1.nbData0);
  if FO2.kLoad < 2 then FO2.LoadData(FO2.sFn,FO2.nbData0);

  SetLength(ALC51,Self.nY+1);
  SetLength(ALC52,Self.nY+1);

  for iYA := 1 to nY do begin
    iY := iYA - 1;
    ALC51[iYA] := FO1.aData[IXI,iY];
    ALC52[iYA] := FO2.aData[IXI,iY];
  end;
  result := true;

end; (* TFITS.ReturnSlitLC50 *)


function TFITS.ReturnSlitLWbr:boolean;
var FO1,FO2,FO3,FO4 : TFIOut; iYA,iY : integer;
begin
  result := false;
  FO1 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,'LWb1');
  FO2 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,'LWr1');
  FO3 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,'LWb2');
  FO4 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,'LWr2');

  if (Not Assigned(FO1)) or (Not Assigned(FO4))  then Exit;

  if FO1.kLoad < 2 then FO1.LoadData(FO1.sFn,FO1.nbData0);
  if FO2.kLoad < 2 then FO2.LoadData(FO2.sFn,FO2.nbData0);
  if FO3.kLoad < 2 then FO3.LoadData(FO3.sFn,FO3.nbData0);
  if FO4.kLoad < 2 then FO4.LoadData(FO4.sFn,FO4.nbData0);

  SetLength(Self.AWk1,Self.nY+1);
  SetLength(Self.AWk2,Self.nY+1);
  SetLength(Self.AWk3,Self.nY+1);
  SetLength(Self.AWk4,Self.nY+1);

  for iYA := 1 to nY do begin
    iY := iYA - 1;
    AWk1[iYA] := FO1.aData[IXI,iY];
    AWk2[iYA] := FO2.aData[IXI,iY];
    AWk3[iYA] := FO3.aData[IXI,iY];
    AWk4[iYA] := FO4.aData[IXI,iY];
  end;
  result := true;

end; (* TFITS.ReturnSlitLWbr *)




function TFITS.ReturnSlitD0:boolean;
var FO1,FO2 : TFIOut; iYA,iY : integer;
begin
  result := false;
  FO1 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,'d01');
  FO2 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,'d02');

  if Not Assigned(FO1) then Exit;

  if FO1.kLoad < 2 then
    if (FO1.nbData0 = 0) then Exit else FO1.LoadData(FO1.sFn,FO1.nbData0);
  if FO2.kLoad < 2 then
    if (FO2.nbData0 = 0) then Exit else FO2.LoadData(FO2.sFn,FO2.nbData0);

  SetLength(AI_d01,Self.nY+1);
  SetLength(AI_d02,Self.nY+1);

  for iYA := 1 to nY do begin
    iY := iYA - 1;
    AI_d01[iYA] := round(FO1.aData[IXI,iY]);
    AI_d02[iYA] := round(FO2.aData[IXI,iY]);
  end;
  result := true;

end; (* TFITS.ReturnSlitD0 *)


function TFITS.ReturnSlitLd0:boolean;
var FO1,FO2 : TFIOut; iYA,iY : integer;
begin
  result := false;
  FO1 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,'Ld01');
  FO2 := LFIO.GetFIOut(TLFITS(Owner).sDtTi,'Ld02');

  if Not Assigned(FO1) then Exit;

  if FO1.kLoad < 2 then
    if (FO1.nbData0 = 0) then Exit else FO1.LoadData(FO1.sFn,FO1.nbData0);
  if FO2.kLoad < 2 then
    if (FO2.nbData0 = 0) then Exit else FO2.LoadData(FO2.sFn,FO2.nbData0);

  SetLength(AILd01,Self.nY+1);
  SetLength(AILd02,Self.nY+1);

  for iYA := 1 to nY do begin
    iY := iYA - 1;
    AILd01[iYA] := round(FO1.aData[IXI,iY]);
    AILd02[iYA] := round(FO2.aData[IXI,iY]);
  end;
  result := true;

end; (* TFITS.ReturnSlitLd0 *)



(* вариант для "немагнитных точек" *)
(* также рассчитываем средние значения *)
procedure TFITS.CalcL5_1_2; (* для текущ.FITS расчёт среднего знач-я L5 *)
(* L5 - это ср.значения длин волн точек бисекторов 0.5 в пикселях *)
var i,iya,i4 : integer;
  ID,IDmin,IC : integer;
  ICsum : longint; rIC : real; rSum : real;
  n : integer;
  AII : TAIn;  (* целые значения вектора интенсивностей *)
//  AID : TAIn;
//  AIC : TAIn;
  C5 : real; (* текущий уровень сечения бисектора *)
  b1,b2 : real;    (* значения индекса в крыльях на уровне 0.5 *)
  i1,i2 : integer; (* возможные границы индексов для 6302 *)
begin
  (* сначала найдём значения континуума по алгоритму 1 *)

//  WarnAbs('nData='+Ist(nData)+' nbData='+Ist(nbData));
  Self.LoadData;
//  WarnAbs('nbData2='+Ist(nbData)+' = '+ISt(nY*nLam*4*2));

  (*--------- массивы вдоль щели ----------*)
  CalcSlitConts;  (* заполнить массивы вдоль щели FITS.ACnt *)
  CalcSumsFine(0.9,0);       (*  Суммы I, |V| для каждого iY и KVI            *)

//  ASVM  (* сумма значений Abs(V)  *)
//  AKVI  (* отношения W_abs(V)/W_I *)


  (*======================*)
  (*     линия 6301       *)
  (*======================*)

  (* найдём массив самых глубоких точек и их индексов*)

  SetLength(ALC51,Self.nY+1);

  SetLength(AI_d01,Self.nY+1); (* значения d0            *)
  SetLength(AILd01,Self.nY+1); (* индексы для точек с d0 *)
  i4 := 1; (* интенсивность *)



  ICsum := 0;
  n := 0;
  for iya := 1 to nY do begin
    if (AKVI[iya] > k_VI1) then begin
      (* положение вершины профиля 6301 в пикселах *)
      AILd01[iya] := 0;  (* пропускаем профили с большой магнитностью *)
    end
    else begin
//    AII := GetCol1(iya,i4);
      SetLength(AII,nLam+1);
      GetCol3(iya,i4,AII);


      IC := 1;
      IDmin := AII[IC];
      for i := 2 to nLam do begin
        ID := AII[I];
        if ID < IDmin then begin
          IDmin := ID;
          IC    := i;
        end;
      end;
      AI_d01[iya] := IDmin;
      AILd01[iya] := IC;
      ICsum := ICsum + IC;
      inc(n);
      Finalize(AII);
    end;
  end;

  rIC := ICsum/n;(*среднее значение индекса центра 6301 для немагнитных точек *)



  (* возможны "неправильные" профили         *)
  (* отметим их значением 0 в массиве AILd01 *)
  (* и пересчитаем среднее значение          *)
  ICsum := 0;
  n := 0;
  for iya := 1 to nY do begin
    if abs(AILd01[iya]-rIC) >= 5 then begin
      AILd01[iya] := 0
    end
    else begin
      inc(n); ICsum := ICsum + AILd01[iya];
    end;
  end;
  if n < nY then rIC := ICsum / n;

  (* теперь расчитаем "бисекторные" значения *)
  for iya := 1 to nY do begin
    if AILd01[iya] > 0 then begin

      SetLength(AII,nLam+1);
      GetCol3(iya,i4,AII);
//    AII := GetCol1(iya,i4);
      C5 := (AI_d01[iya] + ACnt[iya]) / 2;
      (* двигаемся в обе стороны от значения AILd01[iya] *)
      (* находим пересечения уровня C5 *)
      i := AILd01[iYa];
      repeat
        dec(i);
      until (AII[i] >= C5); // or i < 1
      if AII[i] = C5 then b1:= i else begin
        b1 := i+1 - (C5-AII[i+1])/(AII[i]-AII[i+1]);
      end;
      i := AILd01[iYa];
      repeat
        inc(i);
      until (AII[i] >= C5); // or i >= nLam
      if AII[i] = C5 then b2:= i else begin
        b2 := i-1 + (C5-AII[i-1])/(AII[i]-AII[i-1]);
      end;
      ALC51[iya] := (b1+b2)/2;
      Finalize(AII);
    end
    else ALC51[iya] := 0;
  end;


  (* найдём среднее значение бисектора 6301 *)
  n := 0;
  rSum := 0;
  for iya := 1 to nY do begin
    if ALC51[iya] > 0 then begin
      inc(n);
      rSum := rSum + ALC51[iya];
    end;
  end;
  if n=0 then begin
    WarnAbs('TFITS.CalcL5_1_2 ERR: нет нормальных профилей!');
    Exit;
  end;
  rLC51 := rSum / n;


//  rLC51 := 1;







  (* повторим то же самое для линии 6302 *)

  SetLength(ALC52,Self.nY+1);
  SetLength(AI_d02,Self.nY+1); (* значения d0 *)
  SetLength(AILd02,Self.nY+1); (* индексы для точек с d0 *)

  (* определим возможные границы индексов для 6302 *)
  if rLC51 < (nLam / 2) then begin (* rLC51 < 56 *)
    i1 := round(rLC51 + 45.5 - 22); (* плюс ангстрем минус пол-ангстрема *)
    i2 := round(rLC51 + 45.5 + 22); (* плюс ангстрем плюс  пол-ангстрема *)
  end
  else begin                       (* rLC51 >= 56 *)
    i1 := round(rLC51 - 45.5 - 22); (* минус ангстрем минус пол-ангстрема *)
    i2 := round(rLC51 - 45.5 + 22); (* минус ангстрем плюс  пол-ангстрема *)
  end;

//WarnAbs('i1='+ISt(i1)+' i2='+ISt(i2));

  ICsum := 0;
  n := 0;
  for iya := 1 to nY do begin
    if (AKVI[iya] > k_VI1) then begin
      AILd02[iya] := 0;  (* пропускаем профили с большой магнитностью *)
    end
    else begin

      SetLength(AII,nLam+1);
      GetCol3(iya,i4,AII);
//    AII := GetCol1(iya,i4);

      IC := i1;
      IDmin := AII[IC];
      for i := i1+1 to i2 do begin
        ID := AII[I];
        if ID < IDmin then begin
          IDmin := ID;
          IC    := i;
        end;
      end;
      AI_d02[iya] := IDmin;
      AILd02[iya] := IC;
      ICsum := ICsum + IC;
      inc(n);
      Finalize(AII);
    end;
  end;

  rIC := ICsum / n;


  (* возможны "неправильные" профили         *)
  (* отметим их значением 0 в массиве AILd01 *)
  (* и пересчитаем среднее значение          *)
  ICsum := 0;
  n := 0;
  for iya := 1 to nY do begin
    if abs(AILd02[iya]-rIC) >= 5 then begin
      AILd02[iya] := 0
    end
    else begin
      inc(n); ICsum := ICsum + AILd02[iya];
    end;
  end;
  if n < nY then rIC := ICsum / n;

  (* теперь расчитаем "бисекторные" значения *)
  for iya := 1 to nY do begin
    if AILd02[iya] > 0 then begin

//    AII := GetCol1(iya,i4);
      SetLength(AII,nLam+1);
      GetCol3(iya,i4,AII);
      C5 := (AI_d02[iya] + ACnt[iya]) / 2;
      (* двигаемся в обе стороны от значения AILd02[iya] *)
      (* находим пересечения уровня C5 *)
      i := AILd02[iYa];
      repeat
        dec(i);
      until (AII[i] >= C5); // or i < 1
      if AII[i] = C5 then b1:= i else begin
        b1 := i+1 - (C5-AII[i+1])/(AII[i]-AII[i+1]);
      end;
      i := AILd02[iYa];
      repeat
        inc(i);
      until (AII[i] >= C5); // or i >= nLam
      if AII[i] = C5 then b2:= i else begin
        b2 := i-1 + (C5-AII[i-1])/(AII[i]-AII[i-1]);
      end;
      ALC52[iya] := (b1+b2)/2;
      Finalize(AII);
    end
    else ALC52[iya] := 0;
  end;

  (* найдём среднее значение бисектора 6302 *)
  n := 0;
  rSum := 0;
  for iya := 1 to nY do begin
    if ALC52[iya] > 0 then begin
      inc(n);
      rSum := rSum + ALC52[iya];
    end;
  end;
  if n=0 then begin
    WarnAbs('TFITS.CalcL5_1_2 ERR(2): нет нормальных профилей!');
    Exit;
  end;
  rLC52 := rSum / n;


//  rLC52 := 0;

end;


procedure TFITS.BigCalc;
begin
  Time_routine('FITS.BigCalc',true);
  if Not SetBit.IsBit(Self.KStep,2) then Self.LoadData;


  (*--------- массивы вдоль щели ----------*)
  CalcSlitConts;  (* заполнить массивы вдоль щели CONT и дисперсии *)
//CalcSlit4Conts; (* заполнить массивы вдоль щели CONT и дисперсии *)
//   AC4, AD4 останутся незаполнены
  CalcSums;       (*  Суммы I, |V| для каждого iY и KVI            *)

  (*------------------------------------------*)
  (*                                          *)
  (*     вычисляем центры тяжести линий       *)
  (*                                          *)
  (*------------------------------------------*)

  SetLength(ALC1,nY+1);
  SetLength(ALC2,nY+1);
  SetLength(ANE,nY+1);


  CalcCGravs;
//CalcCGravs0; (* центры линий для простых профилей (5 экстремумов) *)
  MeanLamC0;   (* находим среднюю дл.волны (в пикселях) rLC1,rLC2   *)

  if TLFITS(Owner).QDebug then
  WarnAbs('aFITS.BigCalc '+EFSt0(rLC1,7)+' '+EFSt0(rLC2,7));

//CalcCGravs1; (* центры тяжести 6301, 6302 вдоль щели  ALC массивы *)


//  CalcVCross;
//  CalcICenter; (* определен.точки раздел-я профилей 6301 и 6302 AIC *)

  CalcEqw;     (* AWI1, AWI2, AWI3, AMV1, AMV2, AHM1,AHM2             *)

  (*-----------------------------------------------------*)
  (* ВСЕ ЦИФРЫ В ИСХОДНЫХ ШКАЛАХ ПИКСЕЛЕЙ И ОТСЧЁТОВ !!! *)
  (*-----------------------------------------------------*)
  CalcBisec;   (* расчет ARe полож-я вершин, а также бисекторов *)

  SetBit.BISB(Self.KStep,3);

  (*--------- интегральные значения ----------*)

  MaxMinCont; (* CntMin,CntMax:real; iCntMin,iCntMax:int *)
  MaxMinW;
  MaxH;

  MeanLamC;
  MeanContH0;

  Time_routine('FITS.BigCalc',false);
end; (* TFITS.BigCalc *)


{
procedure TFITS.BigCalc2;
begin
  (*--------- массивы вдоль щели ----------*)
  CalcCGravs2;    (* центры тяжести 6301, 6302 вдоль щели          *)
  CalcSlitConts2; (* заполнить массивы вдоль щели CONT и дисперсии *)
  CalcEqw2;
end;
}



{
procedure TFITS.CalcEqw2;
var AI,AV : TARe; iY,iL : integer; w,m : real;
  i0 : integer; (* ИНДЕКС ПОЛОЖЕНИЯ ЦЕНТРА ЛИНИИ *)
begin

//Self.ALam := Self.GetALam;

//  il1 = bl2.b1.b
//  il2 = bl2.b1.r
//  il3 = bl2.b2.b
//  il4 = bl2.b2.r


  SetLength(AWI21,nY+1);
  SetLength(AWI22,nY+1);
  SetLength(AWI23,nY+1);

  for iY := 1 to nY do begin
    SetLinesArea2(iY);  (* определим значения границ *)
    AI := Self.GetAI2(iY);

    w := 0;
    for iL := bl2.b1.b+1 to bl2.b1.r-1 do begin
      w := w + (1-AI[iL]);
    end;
    w := w + ((1-AI[bl2.b1.b])+(1-AI[bl2.b1.r]))/2;
    w := w * Self.rdLam * 1000;
    AWI21[iY] := w;

    w := 0;
    for iL := bl2.b2.b+1 to bl2.b2.r-1 do begin
      w := w + (1-AI[iL]);
    end;
    w := w + ((1-AI[bl2.b2.b])+(1-AI[bl2.b2.r]))/2;
    w := w * Self.rdLam * 1000;
    AWI22[iY] := w;

    w := 0;
    for iL := bl2.b3.b+1 to bl2.b3.r-1 do begin
      w := w + (1-AI[iL]);
    end;
    w := w + ((1-AI[bl2.b3.b])+(1-AI[bl2.b3.r]))/2;
    w := w * Self.rdLam * 1000;
    AWI23[iY] := w;
  end;



  SetLength(AMV21,nY+1);
  SetLength(AMV22,nY+1);

  for iY := 1 to nY do begin
    SetLinesArea2(iY);  (* определим значения границ *)
    AV := Self.GetAV2(iY);

    i0 := round(AX21[iY]);
    m := 0;
    for iL := bl2.b1.b+1 to bl2.b1.r-1 do begin
      m := m + AV[iL]*(iL-i0);
    end;
    m := m * Self.rdLam * 1000 * Self.rdLam * 1000;
    AMV21[iY] := m;

    i0 := round(AX22[iY]);
    m := 0;
    for iL := bl2.b2.b+1 to bl2.b2.r-1 do begin
      m := m + AV[iL]*(iL-i0);
    end;
    m := m * Self.rdLam * 1000 * Self.rdLam * 1000;
    AMV22[iY] := m;
  end;



  SetLength(AH21,nY+1);
  SetLength(AH22,nY+1);

  for iY := 1 to nY do begin
    m := AMV21[iY]/AWI21[iY];
    AH21[iY] := PHYS.LamToH(m,6301.5,1.669);  //1.503);
    m := AMV22[iY]/AWI22[iY];
    AH22[iY] := PHYS.LamToH(m,6302.5,2.487);
  end;

  iY := 0;

end; (* TFITS.CalcEqw2 *)
}

(* вычисляем "Ичимотограмму" в каждой точке краты *)
(* в параметре Стокса sStokes                     *)
(* в длинах волн от la1 до la2                    *)
(* возможно нармирование на CONT                  *)
(* а также на WV *)
procedure TFITS.CalcFilt(la1,la2:integer;sStokes:string;qAbs:boolean);
var iFO,iLi,iY,iYA : integer;
  i1, i2 : integer;
//iv : longint;
  c,WV1,WV2,WV:real;
//AI,AV,AQ,AU : TAIn;
  AV : TAIn;


procedure SumIV;
var iL : integer;
    v,vc,vn : real;
begin
  v  := 0; (* сумматор абс.значений V-параметра *)
{
  wi := 0; (* сумматор интенсивностей *)
  q  := 0; (* сумматор абс.значений Q-параметра *)
  u  := 0; (* сумматор абс.значений U-параметра *)
}

  (* сумма круг. поляризаций *)
  if qAbs then for iL := i1 to i2 do v := v + abs(AV[iL])
          else for iL := i1 to i2 do v := v +    (AV[iL]);
  if (i2-i1) > 1 then v := v/(i2-i1);
  vc := v/c;   (* нормируем на CONT *)
//vn := v/WV;  (* нормируем на WV2 или WV1 *)
  if (WV<>0) then vn := v/WV else vn := 0;

  (*-------------------------------------------------------------*)
  (*              ПЕРЕНОС ДАННЫХ В МАССИВЫ                       *)
  A2[1,iLi,iYA] :=  vc;
  A2[2,iLi,iYA] :=  vn;
end;

begin
  (* на sStokes пока не обращаем внимания *)
  (* будем рассчитывать abs(V), нормироанное на CONT *)
  (* а также на WV2=add(abs(wVp295),abs(wVn295))     *)

  if la1 > 60 then iLi := 2 else iLi := 1;

  for iFO := 1 to 2 do // mFine do (* mFine = 23 *)
//  for iLi := 1 to 2 do
    SetLength(A2[iFO,iLi],nY+1);

  for iYA := 1 to nY do begin (* цикл по точкам на щели *)

    c := ACnt[iYA] * TLFITS(Owner).kRC;(* уровень континуума (в отсчётах)*kRC *)
    WV2 := AWI2[iYA];
    WV1 := AWI1[iYA];

//  iLi := 2; (* работаем с 6302 только *)
    if iLi = 1 then WV := WV1 else WV := WV2;

{
    GetCol3(iYA,1,AI); (* профиль I параметра Стокса *)
    GetCol3(iYA,2,AQ); (* профиль Q параметра Стокса *)
    GetCol3(iYA,3,AU); (* профиль U параметра Стокса *)
}
    GetCol3(iYA,4,AV); (* профиль V параметра Стокса *)

    i1 := la1;
    i2 := la2;

    SumIV;

    (*от суммы интенсивностей переходим к сумме эквивалентных ширин всех линий*)
  end;


end;




(* вычисляем ---------------------------------- *)
 (* сумму значений I       для каждой точки iYA *)
 (* сумму значений Abs(V)  для каждой точки iYA *)
 (* сумму экв.ширин 2-х линий + все бленды      *)
 (*           W_I := Ic*(nLam-1) - SumI         *)
 (* отношения W_abs(V)/W_I для каждой точки iYA *)
 (* макс.нормир.значение модуля парамера Стокса V для ВСЕХ значений iYA *)
procedure TFITS.CalcSums;
var AI,AV,AQ,AU : TAIn;
   iFO,iLi : integer;
   iYA,iL  : integer;
   ii,iv,iq,iu : integer;
   wi,v,q,u : longint;
   vm,qm,um : longint;

   w,c  : real;

  ri,rc,rs : real;


    nl : integer;   (* число учитываемых точек профиля (= все) *)
    rL0     : real; (* центр текущей линии *)
//  rL1,rL2 : real; (* её границы          *)





  i1,i2,i3,i4 : integer; (* границы линий (индексы точек границ) *)
(*------------------*)

procedure SumIV;
var iL : integer;
begin
  for iL := i1+1 to i2-1 do begin
    ii :=   AI[iL]; (* интенсивность *)
    ri := rc - ii;  (* глубина (с плюсом) *)
    wi := wi + ii;  (* сумма интенсивностей *)
    rs := rs + ri;  (* сумматор глубин *)

    iv := abs(AV[iL]);  (* инт.круг.поляризации *)
    iq := abs(AQ[iL]);  (* инт.круг.поляризации *)
    iu := abs(AU[iL]);  (* инт.круг.поляризации *)
    v  := v  + iv;      (* сумма круг. поляризаций *)
    q  := q  + iq;      (* сумма круг. поляризаций *)
    u  := u  + iu;      (* сумма круг. поляризаций *)

    if iv > iVMax then iVMax := iv; (* попутно находим на профиле макс.знач.*)
  end;

  (* добавим крайние точки профилей *)
  wi := wi + (    AI[i1]  +     AI[i2] ) div 2;
  v  := v  + (abs(AV[i1]) + abs(AV[i2])) div 2;
  q  := q  + (abs(AQ[i1]) + abs(AQ[i2])) div 2;
  u  := u  + (abs(AU[i1]) + abs(AU[i2])) div 2;

  rs := rs + ((rc-AI[i1]) + (rc-AI[i2])) / 2;
end;



(*------------------*)
begin
  Time_routine('FITS.CalcSums',true);
  (* к этому моменту массивы AC4 должны быть рассчитаны *)
  (* расчёт по всему профилю, от линий не зависит       *)

//TLFITS(Owner).kRC := 1.05;

//SetLength(ASI ,nY+1);  (* сумма значений I       *)
  (* временные рабочие массивы FITS     *)
  (* необходимые для расчёта AKVI и др. *)

//  SetLength(ASVM,nY+1);  (* сумма значений Abs(V)  *)
//  SetLength(ASQM,nY+1);  (* сумма значений Abs(Q)  *)
//  SetLength(ASUM,nY+1);  (* сумма значений Abs(U)  *)

//  SetLength(AKVI,nY+1);  (* отношения W_abs(V)/W_I *)
//SetLength(AKQI,nY+1);  (* отношения W_abs(Q)/W_I *)
//SetLength(AKUI,nY+1);  (* отношения W_abs(U)/W_I *)
//SetLength(AKW,nY+1) ;  (* отношения W_abs(U)/W_I *)

{
  SetLength(AKV1,nY+1);  (* отношения W_abs(V)/W_I *)
  SetLength(AKQ1,nY+1);  (* отношения W_abs(Q)/W_I *)
  SetLength(AKU1,nY+1);  (* отношения W_abs(U)/W_I *)
  SetLength(AKW1,nY+1);  (* отношения W_abs(U)/W_I *)
  SetLength(AKV2,nY+1);  (* отношения W_abs(V)/W_I *)
  SetLength(AKQ2,nY+1);  (* отношения W_abs(Q)/W_I *)
  SetLength(AKU2,nY+1);  (* отношения W_abs(U)/W_I *)
  SetLength(AKW2,nY+1);  (* отношения W_abs(U)/W_I *)
}

  for iFO := 1 to mFine do     (* mFine = 23 *)
    for iLi := 1 to 2 do SetLength(A2[iFO,iLi],nY+1);

{
  SetLength(Aa1,nY+1);   (* отношения W_abs(Vp)/W_I *)
  SetLength(Aa2,nY+1);   (* отношения W_abs(Vp)/W_I *)
  SetLength(Ab1,nY+1);   (* отношения W_abs(Vn)/W_I *)
  SetLength(Ab2,nY+1);   (* отношения W_abs(Vn)/W_I *)
  SetLength(Ac1,nY+1);   (* отношения W_abs(Qp)/W_I *)
  SetLength(Ac2,nY+1);   (* отношения W_abs(Qp)/W_I *)
  SetLength(Ad1,nY+1);   (* отношения W_abs(Qn)/W_I *)
  SetLength(Ad2,nY+1);   (* отношения W_abs(Qn)/W_I *)
  SetLength(Ae1,nY+1);   (* отношения W_abs(Up)/W_I *)
  SetLength(Ae2,nY+1);   (* отношения W_abs(Up)/W_I *)
  SetLength(Af1,nY+1);   (* отношения W_abs(Un)/W_I *)
  SetLength(Af2,nY+1);   (* отношения W_abs(Un)/W_I *)
  SetLength(Ag1,nY+1);   (*                     W_I *)
  SetLength(Ag2,nY+1);   (*                     W_I *)

  SetLength(Ah1,nY+1);   (* *)
  SetLength(Ai1,nY+1);   (* *)
  SetLength(Aj1,nY+1);   (* *)
  SetLength(Ak1,nY+1);   (* *)
  SetLength(Al1,nY+1);   (* *)
  SetLength(Am1,nY+1);   (* *)
  SetLength(Ah2,nY+1);   (* *)
  SetLength(Ai2,nY+1);   (* *)
  SetLength(Aj2,nY+1);   (* *)
  SetLength(Ak2,nY+1);   (* *)
  SetLength(Al2,nY+1);   (* *)
  SetLength(Am2,nY+1);   (* *)
}

  iVMax    := 0; (* макс.знач.модуля V в отсчётах *)
  AbsVIMax := 0; (* макс.нормир.значение модуля парамера Стокса V *)

  for iYA := 1 to nY do begin (* цикл по точкам на щели *)
    GetCol3(iYA,1,AI); (* профиль I параметра Стокса *)
    GetCol3(iYA,4,AV); (* профиль V параметра Стокса *)
    GetCol3(iYA,2,AQ); (* профиль Q параметра Стокса *)
    GetCol3(iYA,3,AU); (* профиль U параметра Стокса *)

    wi := 0; (* сумматор интенсивностей *)
    v  := 0; (* сумматор абс.значений V-параметра *)
    q  := 0; (* сумматор абс.значений Q-параметра *)
    u  := 0; (* сумматор абс.значений U-параметра *)

    rc := ACnt[iYA];
    rs := 0;

    i1 := 1;
    i2 := nLam;

    SumIV;

    (*от суммы интенсивностей переходим к сумме эквивалентных ширин всех линий*)
    c := ACnt[iYA] * TLFITS(Owner).kRC;(* уровень континуума (в отсчётах)*kRC *)
    w := (nLam-1) * c - wi;

 // ASI [iYA] := wi;

//    ASVM[iYA] := v;  (* сумма значений abs(V) по длинам волн  НЕ НУЖНА *)
//    ASQM[iYA] := q;  (* сумма значений abs(Q) по длинам волн  НЕ НУЖНА *)
//    ASUM[iYA] := u;  (* сумма значений abs(U) по длинам волн  НЕ НУЖНА *)

(*
    if w <> 0 then begin
                AKVI[iYA] := v/w;
                AKQI[iYA] := q/w;
                AKUI[iYA] := u/w;
              end
              else begin
                AKVI[iYA] := 0;
                AKQI[iYA] := 0;
                AKUI[iYA] := 0;
              end;
*)

//    AKVI[iYA] := v;
//    AKQI[iYA] := q;
//    AKUI[iYA] := u;
(*
    AKW[iYA]  := w;
 *)
//    if iVMax/c > AbsVIMax
//    then AbsVIMax := iVMax/c;(* макс.нормир.значение модуля парамера Стокса V *)

  end;

  Finalize(AI); Finalize(AV); Finalize(AQ); Finalize(AU);

  Time_routine('FITS.CalcSums',false);
end; (* TFITS.CalcSums *)



(* то же самое, что CalcSums *)
(* только берём не все длины волн *)
(* а только области линий *)
(* вычисляем ---------------------------------- *)
 (* сумму значений I       для каждой точки iYA *)
 (* сумму значений Abs(V)  для каждой точки iYA *)
 (* сумму экв.ширин 2-х линий + все бленды      *)
 (*           W_I := Ic*(nLam-1) - SumI         *)
 (* отношения W_abs(V)/W_I для каждой точки iYA *)
 (* макс.нормир.значение модуля парамера Стокса V для ВСЕХ значений iYA *)
procedure TFITS.CalcSumsFine(rC90:real;kCalcStep:integer);
var AI,AV,AQ,AU : TAIn;
    k0  : integer; (* начальный индекс для разных веток kCalcStep  *)
    iFO : integer; (* индекс в списке типов карт - до mFine (= 13) *)
    iLi : integer; (* индекс линии в списке карт 1/2 6301 или 6302 *)
    nLam2 : integer;(* = nLam div 2 = 61 *)


    QAll : boolean;
    iYA,iL  : integer; (* индексы по высоте щели и вдоль длины волны *)
    ii,iv,iq,iu : integer; (* интенсивности в отсчётах прибора *)
    wi    : longint;  (* сумма интенсивностей для вычисл.экв.ширины W *)
    v,q,u : longint;
    w,c : real;
    kw  : real; (* = rdLam*1000/c переводит экв.шир. из отсчётов прибора в mA *)
    rtmp        : double;
    rv, rq, ru  : double;
    rivp,rivm   : double;    (* текущие значения I+V и I-V                *)
    rqu, rquv   : double;    (* текущие значения корней из сумм квадратов *)

    rMivp,rMivm : double;    (* сумматоры моментов *)
    rsivp,rsivm : double;    (* и площадей         *)
    rLivp,rLivm : double;    (* положения центров тяжести *)

    rsv,rsq,rsu : double;    (* сумматоры для положительных лепестков *)
    rsvm,rsqm,rsum : double; (* сумматоры для отрицательных лепестков *)
//  rsv2,rsq2,rsu2 : double; (* сумматоры для квадратичных значений   *)

    rsve,rsqe,rsue,rsv2,rsq2,rsu2,rsqu,rsquv : double;



    rMv,rMvm,rMva : double;  (* суммы моментов rv *)
    rLp,rLn,rLa   : real;    (* положния центров тяжести rv лепестков *)
    rLr,rLb       : real;    (* - '' -                                *)

//  rsquv : double;     (* сумматоры для корней из сумм квадратов *)
//  rsq2 : double;
    rsqb,rsqr,rsqa : double;
//  rMqu       : double;     (* для суммы моментов sqrt(q*q+u*u)       *)


    (* "Моменты" SQRT(Q*Q+U*U) *)
    (* для центрального лепестка - т.е положительной или отриц. части целиком *)
    (* для крайних лепестков - с синей и красной сторон *)
    (* для модуля *)
    rMq2,rMqb,rMqr,rMqa : double;
    rLq2,rLqb,rLqr,rLqa: real;


    AX (*,AY*) : TARe;
    ArV,ArQ,ArU : TARe;

    SivP,SivM : real;(* сумматор момента RV относительно центра линни >0 и <0 *)
    SiqP,SiqM : real;
    SiuP,SiuM : real;
      nvM,nvP : integer;  (* количество точек RV < 0 и > 0 *)
      nqM,nqP : integer;
      nuM,nuP : integer;

    SigV,SigQ,SigU : integer;


//ri : real;
  rc : real;  (* = ACnt[iYA] - текущий CONT *)
//rs : real;  (* сумматор глубин - нигде не используется *)
  i1,i2,i3,i4 : integer; (* границы линий (индексы точек границ) *)
  i0,i00,i01,i02 : integer;
  rl10,rL11,rL12 : real; (* центр линии 6301 и её края *)
  rl20,rL21,rL22 : real; (* центр линии 6302 и её края *)
     rL0,rL1,rL2 : real; (* центр и границы текущей линии *)
  IMin : integer;
  rC9 : real;
  nl : integer; (* число учитываемых точек фрагмента профиля *)

  dLam1,dLam2 : real; (* отступ по дл.волны от центров линий *)


  (*===============================================*)
  i11,i21 : integer;(* результат процедуры GetLineBounds *)
  ii1,ii2,ii3,ii4 : integer; (* индексы границ линий для расчёта Err *)
//wi1, rsv1 : real; (* для отладочного вывода *)
//rs1 : real;       (* для отладочного вывода *)
  R : real;
  S : string;
  (*===============================================*)
(*--------------------------------------------------------------------------*)
(*    1   ВЛОЖЕНИЕ   в   TFITS.CalcSumsFine                                 *)
(* SumIV - расчёт цикла по iYA                                                 *)
(*--------------------------------------------------------------------------*)
procedure SumIV;
var iL : integer;
  rL : double; (* расстояние от центра линии со знаком    *)
  dL : double; (* абс.значение расстояния от центра линии *)
  tL : real; (* дл.волны текущей точки - для вычисл.центров тяжести *)
  Q2 : boolean;
(*----------------------------------------*)


  (*--------------------------------------------------------------------------*)
  (*    1.1   ВЛОЖЕНИЕ   в   TFITS.CalcSumsFine                               *)
  (*                         SumIV                                            *)
  (* SumR  -  тело цикла по длинам волн                                       *)
  (*--------------------------------------------------------------------------*)
  procedure SumR; (* тело цикла по длинам волн *)
  var rvp,rvm : real;
  begin

    (*---------------------------------------------*)
    (*        обрабатываем V  (I+V,I-V)            *)
    (*---------------------------------------------*)

    if rv < 0 then begin     // ветка V < 0
      rMvm := rMvm - rv*tL;  // tL - дл.волны в точках      = +abs(rv)*tL
      rsvm := rsvm + rv;     // сумма V<0   invalid floating point operation
      SivM := SivM - rv*rL;  // rL расст.до ц.линии со знаком
        (* S = S - abs(rv) * rL *)
      inc(nvM)  // кол-во точек rv < 0
    end
    else begin
      rMv  := rMv  + rv*tL;
      rsv  := rsv  + rv;
      SivP := SivP + rv*rL;
       (* S = S + abs(rv) * rL *)
      inc(nvP)
    end;

    rvp := rc*rC90-(ii+rv);(* Ic-(I+V); поправка rC90 предполагалась = 0.95 *)
    rvm := rc*rC90-(ii-rv);(* Ic-(I-V) *)


    (* для LIp/mV *)
    if rvp > 0 then begin     (* иначе точка профиля выше ур-ня Cont *)
      rMivp := rMivp + tL*rvp;  (* сумматоры моментов *)
      rsivp := rsivp + rvp;     (* и площадей         *)
    end;
    if rvm > 0 then begin
      rMivm := rMivm + tL*rvm;
      rsivm := rsivm + rvm;
    end;

(*       СТАРЫЙ ВАРИАНТ --------------->>>>>>>>>>
    if rv < 0 then
      begin
        rsvm := rsvm + rv;      // invalid floating point operation
        SivM := SivM - rL*rv;
        inc(nvM)
      end
      else begin
        rsv  := rsv  + rv;
        SivP := SivP + rL*rv;
        inc(nvP)
      end;
 *       СТАРЫЙ ВАРИАНТ --------------->>>>>>>>>>*)

    rMva := rMva + abs(rv)*tL;

(* слева для отрицательных rV будет положительная добавка в SivM S полярность *)
(* слева для положительных rV будет отрицательная добавка в SivP N полярность *)

    (* SiqM > SiqP => дальше от центра то что снизу *)


    (*---------------------------------------------*)
    (*        обрабатываем QU, QUV                 *)
    (*---------------------------------------------*)

    rqu  := sqrt(rq*rq + ru*ru);
    rquv := sqrt(rq*rq + ru*ru + rv*rv);

    (*--------------------------------------------*)
    (* квадратичные эквивалентные ширины QU и QUV *)
    rsqa := rsqa  + rqu;
    rsquv:= rsquv + rquv;  (* для rquv пока никаких моментов не вычисляем! *)

    rMqa := rMqa + rqu*tL;
    (* моменты для лепестков qu возможно вычислять, только после того *)
    (* как рассчитаны знаки для лепестков SigQ и SigU, то есть        *)
    (* только вторым проходом для данного iYA                         *)

    (*================================================================*)
    (*                                                                *)

    if rq < 0 then begin
      rsqm := rsqm + rq; SiqM := SiqM - dL*rq; inc(nqM)
    end
    else begin
      rsq  := rsq  + rq; SiqP := SiqP + dL*rq; inc(nqP)
    end;
              (* отрицательное rq добавляется в SiqM с плюсом *)
              (* положительное rq добавляется в SiqP с плюсом *)
   (* большей окажется та часть, для которой площадь дальше от центра *)

    (*                                                                *)
    (*================================================================*)


    if ru < 0 then begin
      rsum := rsum + ru; SiuM := SiuM - dL*ru; inc(nuM)
    end
    else begin
      rsu  := rsu  + ru; SiuP := SiuP + dL*ru; inc(nuP)
    end;



  end; (* SumR - вложено в SumIV *)
  (*--------------------------------------------*)



  (*--------------------------------------------------------------------------*)
  (*    1.2   ВЛОЖЕНИЕ   в   TFITS.CalcSumsFine                               *)
  (*                         SumIV                                            *)
  (* SumR2  - тело ВТОРОГО цикла по длинам волн рассч-ем моменты лепестков QU *)
  (*--------------------------------------------------------------------------*)
  procedure SumR2;
  var QQ, QQr, QQb, QU, QUr, QUb : boolean;
  begin
    (* моменты для лепестков qu возможно вычислять, только после того *)
    (* как рассчитаны знаки для лепестков SigQ и SigU, то есть        *)
    (* только вторым проходом для данного iYA                         *)

    (* надо определить три ветки *)
    (* SiqP < SiqM => SigQ > 0 => дальше от центра то что снизу *)
    (* SiuP < SiuM => SigU > 0 => дальше от центра то что снизу *)

    (* центральный лепесток *)
    QQ := ((SigQ < 0) and (rq < 0)) or ((SigQ > 0) and (rq > 0));
    QU := ((SigU < 0) and (ru < 0)) or ((SigU > 0) and (ru > 0));

    (* синий и красный лепестки *)
    if QQ then begin QQr := false; QQb := false end
    else
    if rL < 0 then begin QQb := true; QQr := false end
              else begin QQr := true; QQb := false end;

    if QU then begin QUr := false; QUb := false end
    else
    if rL < 0 then begin QUb := true; QUr := false end
              else begin QUr := true; QUb := false end;

    (*-------------------------------------------------*)
    (*       суммируем в лепестки                      *)
    (* если точка попадает в разные лепестки для Q и U *)
    (* то берём не корень из суммы квадратов           *)
    (* а модуль одной величины Q или U                 *)

    if (QQ or QU) then begin
      if (QQ and QU) then rqu := sqrt(rq*rq + ru*ru)
      else
      if QQ then rqu := abs(rq)
            else rqu := abs(ru);
      rsq2 := rsq2 + rqu;
      rMq2 := rMq2 + tL*rqu;
    end;

    if (QQb or QUb) then begin
      if (QQb and QUb) then rqu := sqrt(rq*rq + ru*ru)
      else
      if QQb then rqu := abs(rq)
             else rqu := abs(ru);
      rsqb := rsqb + rqu;
      rMqb := rMqb + tL*rqu;
    end;

    if (QQr or QUr) then begin
      if (QQr and QUr) then rqu := sqrt(rq*rq + ru*ru)
      else
      if QQr then rqu := abs(rq)
             else rqu := abs(ru);
      rsqr := rsqr + rqu;
      rMqr := rMqr + tL*rqu;
    end;
  end; (* SumR2 - вложено в SumIV *)

(*--------------------------------------------------------------------------*)
(*    1   ВЛОЖЕНИЕ   в   TFITS.CalcSumsFine                                 *)
(* SumIV - тело цикла по iYA                                                *)
(*--------------------------------------------------------------------------*)
Begin (* для вложения 1-го уровня *)

  (*--------------------------------*)
  (*  первый проход по длинам волн  *)
  (*--------------------------------*)
  for iL := i1+1 to i2-1 do begin
    inc(nl); (* число длин волн в текущем интегрировании *)

//  Q2 := ((iL = i1) or (iL = i2));  для КРАЙНИХ точек

    tL := iL;       (* положение текущей точки на шкале длин волн *)
    rL := iL - rl0; (* расстояние до центра со знаком             *)
    dL := abs(rL);  (* расстояние до центра                       *)

//  iv := abs(AV[iL]);  (* инт.круг.поляризации *)
    ii :=  AI[iL];      (* целая интенсивность  *)

    (* целые, преобразованные в real значения   *)
    rv := ArV[iL];
    rq := ArQ[iL];
    ru := ArU[iL];

    wi := wi + ii;  (* сумма интенсивностей *)
//  ri := rc - ii;  (* глубина (с плюсом если I < CONT) *)
//  rs := rs + ri;  (* сумматор глубин *)

//  if Q2 then begin rv := rv/2; rq := rq/2; ru := ru/2 end;

    SumR;


//  v  := v  + iv;      (* сумма круг. поляризаций *)
{
    rsv:= rsv+ rv;
    rsq:= rsq+ rq;
    rsu:= rsu+ ru;
}

//  if iv > iVMax then iVMax := iv; (* попутно находим на профиле макс.знач.*)
  end;

  (* добавим крайние точки профилей *)

  inc(nl);

  iL := i1;
  tL := iL;       (* положение текущей точки на шкале длин волн *)
  rL := iL - rl0;
  dL := abs(rL);
  rv := ArV[iL]; rv := rv/2;
  rq := ArQ[iL]; rq := rq/2;
  ru := ArU[iL]; ru := ru/2;          // исчезновение порядка ???

  wi := wi + ((   AI[i1]  +     AI[i2]) div 2);
//rs := rs + ((rc-AI[i1]) + (rc-AI[i2])) / 2;

  SumR;

  iL := i2;
  tL := iL;       (* положение текущей точки на шкале длин волн *)
  rL := iL - rl0;
  dL := abs(rL);
  rv := ArV[iL]; rv := rv/2;
  rq := ArQ[iL]; rq := rq/2;
  ru := ArU[iL]; ru := ru/2;

  SumR;

(*
  rsv:= rsv+ (abs(ArV[i1]) + abs(ArV[i2])) / 2;
  rsq:= rsq+ (abs(ArQ[i1]) + abs(ArQ[i2])) / 2;
  rsu:= rsu+ (abs(ArU[i1]) + abs(ArU[i2])) / 2;
*)


(* SiqM > SiqP => дальше от центра то что снизу *)

  if SivP < SivM then SigV := 1 else SigV := -1;
  if SiqP < SiqM then SigQ := 1 else SigQ := -1;
  if SiuP < SiuM then SigU := 1 else SigU := -1;

(*
      SigQ = 1  => то что выше 0 расположено ближе к центру
                   дальше от центра то, что снизу
*)

  (*--------------------------------*)
  (*  второй проход по длинам волн  *)
  (*--------------------------------*)
  for iL := i1+1 to i2-1 do begin
    tL := iL;       (* положение текущей точки на шкале длин волн *)
    rL := iL - rl0;
//  rv := ArV[iL];
    rq := ArQ[iL];
    ru := ArU[iL];
    SumR2;
  end;

  iL := i1;
  tL := iL;       (* положение текущей точки на шкале длин волн *)
  rL := iL - rl0;
  rq := ArQ[iL]; rq := rq/2;
  ru := ArU[iL]; ru := ru/2;          // исчезновение порядка ???
  SumR2;

  iL := i2;
  tL := iL;       (* положение текущей точки на шкале длин волн *)
  rL := iL - rl0;
  rq := ArQ[iL]; rq := rq/2;
  ru := ArU[iL]; ru := ru/2;
  SumR2;


  (*==============================================*)
  (*                                              *)
  (*          СВОДНЫЕ ЦИФРЫ ПО ЛИНИИ              *)
  (*                                              *)
  (*==============================================*)

  (* rsv,rsvm, *)
  (* rsq,rsqm, *)
  (* rsu,rsum, *)
  (* w         *)

  w    := nl * c - wi; (* wi = сумма интенсивностей *)
                       (* тогда w - площадь НАД кривой I в единицах прибора *)

  (*--------------------------------------------*)
  (* квадратичные эквивалентные ширины QU и QUV *)
//rsqa := rsqa  + rqu;
//rsquv:= rsquv + rquv;  (* для rquv пока никаких моментов не вычисляем! *)

  (*--------------------------------------------*)
  (*   положения центров тяжести для I+V и I-V  *)
  (*   можно найти разности и вычислить Bcog    *)
//if rsivp=0 then rLivp := rl0 else   rLivp := rMivp/rsivp;
//if rsivm=0 then rLivm := rl0 else   rLivm := rMivm/rsivm;

  if (abs(rsivp) < 1) then rLivp := rl0 else   rLivp := rMivp/rsivp;
  if (abs(rsivm) < 1) then rLivm := rl0 else   rLivm := rMivm/rsivm;



  (*-------------------------------------------*)
  (* положения центров тяжести для V-параметра *)
  (* rLp - для положительной компоненты *)
  (* rLn - для отрицательной компоненты *)
  (* rLa - для суммы модулей компонент  *)
  (* rLb - для синей   компоненты  *)
  (* rLr - для красной компоненты  *)

  if rsv       = 0 then rLp := rl0 else rLp := rMv / abs(rsv);
  if rsvm      = 0 then rLn := rl0 else rLn := rMvm/ abs(rsvm);
  if (rLp+rLn) = 0 then rLa := rl0 else begin
    rTmp := (abs(rsv)+abs(rsvm));
    if rTmp = 0 then rLa := rl0 else rLa := rMva/rTmp;
  end;

  if rLp > rLa then begin rLr := rLp; rLb := rLn end
               else begin rLr := rLn; rLb := rLp end;
  (*-------------------------------------------*)


  (*----------------------------------------------*)
  (* положения центров тяжести для Q+U-параметров *)
  (*-------------------------------------------*)
  (* положение центра тяжести для квадратичного QU целиком  *)
  if rsqa=0 then rLqa := rl0 else rLqa := rMqa/rsqa;

  (*-------------------------------------------*)
  (* положение центра тяжести для лепестков квадратичного QU *)
  if rsq2=0 then rLq2 := rl0 else rLq2 := rMq2/rsq2;
  if rsqr=0 then rLqr := rl0 else rLqr := rMqr/rsqr;
  if rsqb=0 then rLqb := rl0 else rLqb := rMqb/rsqb;



  (*-------------------------------------------------------------*)
  (*              ПЕРЕНОС ДАННЫХ В МАССИВЫ                       *)

  k0 := 0;
//if KCalcStep = 0 then begin
  if KCalcStep < 3 then begin

    A2[1+k0,iLi,iYA] :=  SigV*abs(rsv) *kw; (* отношения W_abs(Vp)/W_I *)
    A2[2+k0,iLi,iYA] :=  SigV*abs(rsvm)*kw; (* отношения W_abs(Vn)/W_I *)
    A2[3+k0,iLi,iYA] :=  SigQ*abs(rsq) *kw; (* отношения W_abs(Qp)/W_I *)
    A2[4+k0,iLi,iYA] :=  SigQ*abs(rsqm)*kw; (* отношения W_abs(Qn)/W_I *)
    A2[5+k0,iLi,iYA] :=  SigU*abs(rsu) *kw; (* отношения W_abs(Up)/W_I *)
    A2[6+k0,iLi,iYA] :=  SigU*abs(rsum)*kw; (* отношения W_abs(Un)/W_I *)
    A2[7+k0,iLi,iYA] :=               w*kw; (*           W_I           *)

    A2[ 8+k0,iLi,iYA] := rLp;  (* момент/площадь = полож.центра тяжести *)
    A2[ 9+k0,iLi,iYA] := rLn;
    A2[10+k0,iLi,iYA] := rLa;
    A2[11+k0,iLi,iYA] := rLb;
    A2[12+k0,iLi,iYA] := rLr;
 // A2[13,   iLi,iYA] := rLa;
  end;

  k0 := 12;
//if KCalcStep = 1 then begin
  if KCalcStep < 3 then begin
    A2[1+k0,iLi,iYA] :=  rsqa *kw; (* квадратичные эквивалентные ширины QU  *)
    A2[2+k0,iLi,iYA] :=  rsquv*kw; (* квадратичные эквивалентные ширины QUV *)
    A2[3+k0,iLi,iYA] :=  rLivp;    (* положение центра тяжести I+V *)
    A2[4+k0,iLi,iYA] :=  rLivm;    (* положение центра тяжести I-V *)
    A2[5+k0,iLi,iYA] :=  rLqa;(* положение ц.тяжести для квадратич.QU целиком *)
    A2[6+k0,iLi,iYA] :=  rLq2;(*положение центра тяжести центрального лепестка*)
    A2[7+k0,iLi,iYA] :=  rLqb;(* положение центра тяжести синего   лепестка *)
    A2[8+k0,iLi,iYA] :=  rLqr;(* положение центра тяжести красного лепестка *)

    A2[ 9+k0,iLi,iYA] := rsq2*kw; (* экв.ширина центрального QU лепестка *)
    A2[10+k0,iLi,iYA] := rsqb*kw; (* экв.ширина синего   QU лепестка *)
    A2[11+k0,iLi,iYA] := rsqr*kw; (* экв.ширина красного QU лепестка *)
  end;



end; (* SumIV - тело цикла по iYA - proc.вложена в TFITS.CalcSumsFine *)
(*-----------------------------------*)




(*------------------*)
procedure SumE;(*тело цикла по iYA - расчёт шума, proc.вложена в CalcSumsFine *)
var iL : integer;
  rL : double; (* расстояние от центра линии со знаком    *)
  dL : double; (* абс.значение расстояния от центра линии *)
  tL : real; (* дл.волны текущей точки - для вычисл.центров тяжести *)
  Q2 : boolean;
(*----------------------------------------*)
  procedure SumR; (* тело цикла по длинам волн *)
  var v2,q2,u2 : real;
  begin

    v2   := rv*rv;
    q2   := rq*rq;
    u2   := ru*ru;


    rsv  := rsv  + abs(rv);
    rsv2 := rsv2 + v2;

    rsq  := rsq  + abs(rq);
    rsq2 := rsq2 + q2;

    rsu  := rsu  + abs(ru);
    rsu2 := rsu2 + u2;

    rsqu := rsqu + q2 + u2;
    rsquv:= rsquv + q2 + u2 + v2;


    rqu  := sqrt(rq*rq + ru*ru);
    rquv := sqrt(rq*rq + ru*ru + rv*rv);

    (*--------------------------------------------*)
    (* квадратичные эквивалентные ширины QU и QUV *)
    rsqa := rsqa  + rqu;
    rsquv:= rsquv + rquv;  (* для rquv пока никаких моментов не вычисляем! *)

    rMqa := rMqa + rqu*tL;
    (* моменты для лепестков qu возможно вычислять, только после того *)
    (* как рассчитаны знаки для лепестков SigQ и SigU, то есть        *)
    (* только вторым проходом для данного iYA                         *)



    if rq < 0 then begin
      rsqm := rsqm + rq; SiqM := SiqM - dL*rq; inc(nqM)
    end
    else begin
      rsq  := rsq  + rq; SiqP := SiqP + dL*rq; inc(nqP)
    end;
              (* отрицательное rq добавляется в SiqM с плюсом *)
              (* положительное rq добавляется в SiqP с плюсом *)
          (* большей окажется та часть, для которой площадь дальше от центра *)

    if ru < 0 then begin
      rsum := rsum + ru; SiuM := SiuM - dL*ru; inc(nuM)
    end
    else begin
      rsu  := rsu  + ru; SiuP := SiuP + dL*ru; inc(nuP)
    end;



  end; (* SumR - вложено в SumE (расчёт шума) *)
(*--------------------------------------------*)
(*----------------------------------------*)
  procedure SumR2; (* тело ВТОРОГО цикла по длинам волн *)
                   (* рассчитываем моменты лепестков QU *)
  var QQ, QQr, QQb, QU, QUr, QUb : boolean;
  begin
    (* моменты для лепестков qu возможно вычислять, только после того *)
    (* как рассчитаны знаки для лепестков SigQ и SigU, то есть        *)
    (* только вторым проходом для данного iYA                         *)

    (* надо определить три ветки *)
    (* SiqP < SiqM => SigQ > 0 => дальше от центра то что снизу *)
    (* SiuP < SiuM => SigU > 0 => дальше от центра то что снизу *)

    (* центральный лепесток *)
    QQ := ((SigQ < 0) and (rq < 0)) or ((SigQ > 0) and (rq > 0));
    QU := ((SigU < 0) and (ru < 0)) or ((SigU > 0) and (ru > 0));

    (* синий и красный лепестки *)
    if QQ then begin QQr := false; QQb := false end
    else
    if rL < 0 then begin QQb := true; QQr := false end
              else begin QQr := true; QQb := false end;

    if QU then begin QUr := false; QUb := false end
    else
    if rL < 0 then begin QUb := true; QUr := false end
              else begin QUr := true; QUb := false end;

    (*-------------------------------------------------*)
    (*       суммируем в лепестки                      *)
    (* если точка попадает в разные лепестки для Q и U *)
    (* то берём не корень из суммы квадратов           *)
    (* а модуль одной величины Q или U                 *)

    if (QQ or QU) then begin
      if (QQ and QU) then rqu := sqrt(rq*rq + ru*ru)
      else
      if QQ then rqu := abs(rq)
            else rqu := abs(ru);
      rsq2 := rsq2 + rqu;
      rMq2 := rMq2 + tL*rqu;
    end;

    if (QQb or QUb) then begin
      if (QQb and QUb) then rqu := sqrt(rq*rq + ru*ru)
      else
      if QQb then rqu := abs(rq)
             else rqu := abs(ru);
      rsqb := rsqb + rqu;
      rMqb := rMqb + tL*rqu;
    end;

    if (QQr or QUr) then begin
      if (QQr and QUr) then rqu := sqrt(rq*rq + ru*ru)
      else
      if QQr then rqu := abs(rq)
             else rqu := abs(ru);
      rsqr := rsqr + rqu;
      rMqr := rMqr + tL*rqu;
    end;
  end; (* SumR2 - вложено в SumE (расчёт шума) *)
(*----------------------------------------*)
(*========================================*)
(*----------------------------------------*)
begin(* SumE (расчёт шума) тело цикла iYA - proc.вложена в TFITS.CalcSumsFine *)
  (*--------------------------------*)
  (*  первый проход по длинам волн  *)
  (*--------------------------------*)
  for iL := i1+1 to i2-1 do begin
    inc(nl); (* число длин волн в текущем интегрировании *)

//  Q2 := ((iL = i1) or (iL = i2));

    tL := iL;       (* положение текущей точки на шкале длин волн *)
    rL := iL - rl0; (* расстояние до центра со знаком             *)
    dL := abs(rL);  (* расстояние до центра                       *)

//  iv := abs(AV[iL]);  (* инт.круг.поляризации *)
    ii :=  AI[iL]; (* целая интенсивность  *)
    rv := ArV[iL];
    rq := ArQ[iL];
    ru := ArU[iL];

    wi := wi + ii;  (* сумма интенсивностей *)
//  ri := rc - ii;  (* глубина (с плюсом если I < CONT) *)
//  rs := rs + ri;  (* сумматор глубин *)

//  if Q2 then begin rv := rv/2; rq := rq/2; ru := ru/2 end;

    SumR;


//  v  := v  + iv;      (* сумма круг. поляризаций *)
{
    rsv:= rsv+ rv;
    rsq:= rsq+ rq;
    rsu:= rsu+ ru;
}

//  if iv > iVMax then iVMax := iv; (* попутно находим на профиле макс.знач.*)
  end;

  (* добавим крайние точки профилей *)

  inc(nl);

  iL := i1;
  tL := iL;       (* положение текущей точки на шкале длин волн *)
  rL := iL - rl0;
  dL := abs(rL);
  rv := ArV[iL]; rv := rv/2;
  rq := ArQ[iL]; rq := rq/2;
  ru := ArU[iL]; ru := ru/2;          // исчезновение порядка ???

  wi := wi + ((   AI[i1]  +     AI[i2]) div 2);
//rs := rs + ((rc-AI[i1]) + (rc-AI[i2])) / 2;

  SumR;

  iL := i2;
  tL := iL;       (* положение текущей точки на шкале длин волн *)
  rL := iL - rl0;
  dL := abs(rL);
  rv := ArV[iL]; rv := rv/2;
  rq := ArQ[iL]; rq := rq/2;
  ru := ArU[iL]; ru := ru/2;

  SumR;

(*
  rsv:= rsv+ (abs(ArV[i1]) + abs(ArV[i2])) / 2;
  rsq:= rsq+ (abs(ArQ[i1]) + abs(ArQ[i2])) / 2;
  rsu:= rsu+ (abs(ArU[i1]) + abs(ArU[i2])) / 2;
*)


(* SiqM > SiqP => дальше от центра то что снизу *)

  if SivP < SivM then SigV := 1 else SigV := -1;
  if SiqP < SiqM then SigQ := 1 else SigQ := -1;
  if SiuP < SiuM then SigU := 1 else SigU := -1;

(*
      SigQ = 1  => то что выше 0 расположено ближе к центру
                   дальше от центра то, что снизу
*)



  if IXI = 1 then begin
    WarnAbs('Старт отладки');
  end;



  (*--------------------------------*)
  (*  второй проход по длинам волн  *)
  (*--------------------------------*)
  for iL := i1+1 to i2-1 do begin
    if true then begin
      WarnAbs('i1='+ISt(i1)+' i2='+ISt(i2)+
           ' IXI='+ISt(IXI)+' Li='+ISt(ILi)+
           ' IYA='+ISt(IYA)+
           ' L(A)='+ISt(Length(ArQ))+' iL='+ISt(IL)
           );
      Sayer.Flush;
    end;


    tL := iL;       (* положение текущей точки на шкале длин волн *)
    rL := iL - rl0;
//  rv := ArV[iL];
    rq := ArQ[iL];
    ru := ArU[iL];
    SumR2;
  end;

  iL := i1;
  tL := iL;       (* положение текущей точки на шкале длин волн *)
  rL := iL - rl0;
  rq := ArQ[iL]; rq := rq/2;
  ru := ArU[iL]; ru := ru/2;          // исчезновение порядка ???
  SumR2;

  iL := i2;
  tL := iL;       (* положение текущей точки на шкале длин волн *)
  rL := iL - rl0;
  rq := ArQ[iL]; rq := rq/2;
  ru := ArU[iL]; ru := ru/2;
  SumR2;


  (*==============================================*)
  (*                                              *)
  (*          СВОДНЫЕ ЦИФРЫ ПО ЛИНИИ              *)
  (*                                              *)
  (*==============================================*)

  (* rsv,rsvm, *)
  (* rsq,rsqm, *)
  (* rsu,rsum, *)
  (* w         *)

  w    := nl * c - wi; (* wi = сумма интенсивностей *)
                       (* тогда w - площадь НАД кривой I в единицах прибора *)

  (*--------------------------------------------*)
  (* квадратичные эквивалентные ширины QU и QUV *)
//rsqa := rsqa  + rqu;
//rsquv:= rsquv + rquv;  (* для rquv пока никаких моментов не вычисляем! *)

  (*--------------------------------------------*)
  (*   положения центров тяжести для I+V и I-V  *)
  (*   можно найти разности и вычислить Bcog    *)
//if rsivp=0 then rLivp := rl0 else   rLivp := rMivp/rsivp;
//if rsivm=0 then rLivm := rl0 else   rLivm := rMivm/rsivm;

  if (abs(rsivp) < 1) then rLivp := rl0 else   rLivp := rMivp/rsivp;
  if (abs(rsivm) < 1) then rLivm := rl0 else   rLivm := rMivm/rsivm;



  (*-------------------------------------------*)
  (* положения центров тяжести для V-параметра *)
  (* rLp - для положительной компоненты *)
  (* rLn - для отрицательной компоненты *)
  (* rLa - для суммы модулей компонент  *)
  (* rLb - для синей   компоненты  *)
  (* rLr - для красной компоненты  *)

  if rsv    = 0 then rLp := rl0 else rLp := rMv / abs(rsv);
  if rsvm   = 0 then rLn := rl0 else rLn := rMvm/ abs(rsvm);
  if rLp+rLn= 0 then rLa := rl0 else rLa := rMva/(abs(rsv)+abs(rsvm));

  if rLp > rLa then begin rLr := rLp; rLb := rLn end
               else begin rLr := rLn; rLb := rLp end;
  (*-------------------------------------------*)




  (*----------------------------------------------*)
  (* положения центров тяжести для Q+U-параметров *)
  (*-------------------------------------------*)
  (* положение центра тяжести для квадратичного QU целиком  *)
  if rsqa=0 then rLqa := rl0 else rLqa := rMqa/rsqa;

  (*-------------------------------------------*)
  (* положение центра тяжести для лепестков квадратичного QU *)
  if rsq2=0 then rLq2 := rl0 else rLq2 := rMq2/rsq2;
  if rsqr=0 then rLqr := rl0 else rLqr := rMqr/rsqr;
  if rsqb=0 then rLqb := rl0 else rLqb := rMqb/rsqb;



  (*-------------------------------------------------------------*)
  (*              ПЕРЕНОС ДАННЫХ В МАССИВЫ                       *)

  k0 := 0;
//if KCalcStep = 0 then begin
  if KCalcStep < 3 then begin

    A2[1+k0,iLi,iYA] :=  SigV*abs(rsv) *kw; (* отношения W_abs(Vp)/W_I *)
    A2[2+k0,iLi,iYA] :=  SigV*abs(rsvm)*kw; (* отношения W_abs(Vn)/W_I *)
    A2[3+k0,iLi,iYA] :=  SigQ*abs(rsq) *kw; (* отношения W_abs(Qp)/W_I *)
    A2[4+k0,iLi,iYA] :=  SigQ*abs(rsqm)*kw; (* отношения W_abs(Qn)/W_I *)
    A2[5+k0,iLi,iYA] :=  SigU*abs(rsu) *kw; (* отношения W_abs(Up)/W_I *)
    A2[6+k0,iLi,iYA] :=  SigU*abs(rsum)*kw; (* отношения W_abs(Un)/W_I *)
    A2[7+k0,iLi,iYA] :=               w*kw; (*           W_I           *)

    A2[ 8+k0,iLi,iYA] := rLp;  (* момент/площадь = полож.центра тяжести *)
    A2[ 9+k0,iLi,iYA] := rLn;
    A2[10+k0,iLi,iYA] := rLa;
    A2[11+k0,iLi,iYA] := rLb;
    A2[12+k0,iLi,iYA] := rLr;
 // A2[13   ,iLi,iYA] := rLa;
  end;

  k0 := 12;
//if KCalcStep = 1 then begin
  if KCalcStep < 3 then begin
    A2[1+k0,iLi,iYA] :=  rsqa *kw; (* квадратичные эквивалентные ширины QU  *)
    A2[2+k0,iLi,iYA] :=  rsquv*kw; (* квадратичные эквивалентные ширины QUV *)
    A2[3+k0,iLi,iYA] :=  rLivp;    (* положение центра тяжести I+V *)
    A2[4+k0,iLi,iYA] :=  rLivm;    (* положение центра тяжести I-V *)
    A2[5+k0,iLi,iYA] :=  rLqa;(* положение ц.тяжести для квадратич.QU целиком *)
    A2[6+k0,iLi,iYA] :=  rLq2;(*положение центра тяжести центрального лепестка*)
    A2[7+k0,iLi,iYA] :=  rLqb;(* положение центра тяжести синего   лепестка *)
    A2[8+k0,iLi,iYA] :=  rLqr;(* положение центра тяжести красного лепестка *)

    A2[ 9+k0,iLi,iYA] := rsq2*kw; (* экв.ширина центрального QU лепестка *)
    A2[10+k0,iLi,iYA] := rsqb*kw; (* экв.ширина синего   QU лепестка *)
    A2[11+k0,iLi,iYA] := rsqr*kw; (* экв.ширина красного QU лепестка *)
  end;



end; (* SumE (расчёт шума - переработано из SumIV)            *)
     (* тело цикла по iYA - proc.вложена в TFITS.CalcSumsFine *)
(*-----------------------------------*)






procedure GetLineBounds;
var iL,i61,i62 : integer;
begin
  i0 := round(rl0);            (* ближайш.точка к LC501/02 *)
  if i0 <   2 then i0 := 2 else
  if i0 > 111 then i0 := 111;
  IMin := AI[i0]; i00 := i0;
  i61 := i0-6; if i61 <   2 then i61 :=   2;
  i62 := i0+6; if i62 > 111 then i62 := 111;
  for iL := i61 to i62 do begin   (* в окрестностях +-6 точек ищем минимум *)
    if AI[iL] < IMin then begin
      IMin := AI[iL]; i00 := iL;
    end;
  end;


  (* если мы за краем Солнца "центр линии" может попасть куда угодно *)
  (* то же самое может случиться в тени *)
  i01 := trunc(rl1);           (* выбираем +- 350 mA в стороны от центра *)
  if i01 < 1 then begin
    Warn('GetLineBounds i1='+ISt(i01)+' iX='+ISt(Self.IXI)+' iYA='+ISt(iYA));
    i01 := 1;
  end
  else
  if i01 > 111 then begin
    Warn('GetLineBounds i1='+ISt(i01)+' iX='+ISt(Self.IXI)+' iYA='+ISt(iYA));
    i01 := 111;
  end;

  i02 := trunc(rl2)+1;
  if i02 > 112 then begin
    Warn('GetLineBounds i2='+ISt(i02)+' iX='+ISt(Self.IXI)+' iYA='+ISt(iYA));
    i02 := 112;
  end
  else
  if i02 < 2 then begin
    Warn('GetLineBounds i2='+ISt(i02)+' iX='+ISt(Self.IXI)+' iYA='+ISt(iYA));
    i02 := 2;
  end;



//rC9 := (rc-IMin)*0.80 + IMin;
  rC9 := (rc-IMin)*rC90 + IMin;  (* верхн.ур-нь интегр-я в отсчётах *)

  iL := i00; dec(iL);
  while (iL > i01) and (AI[iL] < rC9) do dec(iL);
  i1 := iL;

  iL := i00; inc(iL);
  while (iL < i02) and (AI[iL] < rC9) do inc(iL);
  i2 := iL;

  i11 := i1; i21 := i2;
end;
(*----------------*)


procedure ResetSums;
begin
//  rs := 0;
    nl := 0; (* число учтёных точек профиля *)

    SivP := 0; SivM := 0; (* сумма индексов V положит/отрицат *)
    SiqP := 0; SiqM := 0;
    SiuP := 0; SiuM := 0;

    nvM := 0; nvP := 0;
    nqM := 0; nqP := 0;
    nuM := 0; nuP := 0;

    rMivp := 0; rMivm := 0;   (* сумматоры моментов I+V, I-V *)
    rsivp := 0; rsivm :=0;    (* и площадей                  *)


    wi := 0; (* сумматор интенсивностей *)
//  v  := 0; (* сумматор абс.значений V-параметра *)
    rsv:= 0;
    rsq:= 0;
    rsu:= 0;

    rsvm:= 0;
    rsqm:= 0;
    rsum:= 0;

//  rsqu := 0;
    rsquv:= 0;

    rsq2 := 0;
    rsqb := 0;
    rsqr := 0;
    rsqa := 0;


    (* "Моменты" V- профиля *)
    rMv  := 0;
    rMvm := 0;
    rMva := 0;


    (* "Моменты" SQRT(Q*Q+U*U) *)
    rMq2 := 0;
    rMqb := 0;
    rMqr := 0;
    rMqa := 0;

//  rLp,rLn,rLa   : real;
end;

procedure ResetSumE;
begin
    nl   := 0; (* число учтёных точек профиля *)
    rsve := 0;
    rsqe := 0;
    rsue := 0;
    rsv2 := 0;
    rsq2 := 0;
    rsu2 := 0;
    rsqu := 0;
    rsquv:= 0;
end;



begin  (* FITS.CalcSumsFine *)

  Time_routine('FITS.CalcSumsFine',true);
  (* к этому моменту массивы AC4 должны быть рассчитаны *)
  (* расчёт по всему профилю, от линий не зависит       *)

  QAll := (rC90 = 1);
  nLam2 := nLam div 2;

//  SetLength(AKVI,nY+1);  (* отношения W_abs(V)/W_I *)



{
  SetLength(AKV1,nY+1);  (* отношения W_abs(V)/W_I *)
  SetLength(AKQ1,nY+1);  (* отношения W_abs(Q)/W_I *)
  SetLength(AKU1,nY+1);  (* отношения W_abs(U)/W_I *)
  SetLength(AKW1,nY+1);  (* отношения W_abs(U)/W_I *)
  SetLength(AKV2,nY+1);  (* отношения W_abs(V)/W_I *)
  SetLength(AKQ2,nY+1);  (* отношения W_abs(Q)/W_I *)
  SetLength(AKU2,nY+1);  (* отношения W_abs(U)/W_I *)
  SetLength(AKW2,nY+1);  (* отношения W_abs(U)/W_I *)
}


  // array[1..13] of array[1..2] of TARe;


{
  if kCalcStep = 4 then begin
    for iFO := 1 to mFOE do  // mFOE = 8
      SetLength(AE[iFO],nY+1);
  end;
}
  for iFO := 1 to mFine do  // mFine = 13
    for iLi := 1 to 2 do
      SetLength(A2[iFO,iLi],nY+1);


  (* расстояние от центра линии в mA переводим в точки-пиксели *)
  dLam1 := (TLFITS(Owner).dl6301/1000/TLFITS(Owner).rdLam);
  dLam2 := (TLFITS(Owner).dl6302/1000/TLFITS(Owner).rdLam);


  iVMax    := 0; (* макс.знач.модуля V в отсчётах *)
  AbsVIMax := 0; (* макс.нормир.значение модуля парамера Стокса V *)

  for iYA := 1 to nY do begin (* цикл по точкам на щели *)

//  Warn(ISt(Self.IXI)+' '+ISt(iYA));

    rc := ACnt[iYA]; (* текущий CONT *)

    (*--------------------------------------------*)
    (* проверка на попадание за край диска Солнца *)
    (*--------------------------------------------*)

    if rc < 1000 then begin

{
      if kCalcStep = 4 then begin
        for iFO := 1 to mFOE do AE[iFO,iYA] := 0;
      end;
}

      for iFO := 1 to mFine do(*=23 число типов карт,к-рые рассч.CalcSumsFine *)
        for iLi := 1 to 2 do A2[iFO,iLi,iYA] := 0;
    end
    else begin

    (*от суммы интенсивностей переходим к сумме эквивалентных ширин всех линий*)
      c := rc * TLFITS(Owner).kRC;(* уровень континуума (в отсчётах)*kRC *)
//    if c = 0 then c := 1;
      kw := Self.rdLam*1000/c;  (* = миллиАнгстремы / отсчёты_континуума   *)
                                (* переводит экв.ширины в отсчётах прибора *)
                                (* в миллиангстремы *)

       rl10 := Self.ALC51[iYA];  (* центр линии  *)
       rl11 := rl10 - dLam1;     (* граница Blue *)
       rl12 := rl10 + dLam1;     (* граница Red  *)
       rl20 := Self.ALC52[iYA];
       rl21 := rl20 - dLam2;
       rl22 := rl20 + dLam2;

    (*--------------------------------------------------------------------*)
    (* подготовим [сглаженные] профили, знач-я из к-рых будем суммировать *)
    (*--------------------------------------------------------------------*)

                         (* ЦЕЛОЧИСЛЕННЫЕ МАССИВЫ!     *)
      GetCol3(iYA,1,AI); (* профиль I параметра Стокса *)
      GetCol3(iYA,4,AV); (* профиль V параметра Стокса *)
      GetCol3(iYA,2,AQ); (* профиль Q параметра Стокса *)
      GetCol3(iYA,3,AU); (* профиль U параметра Стокса *)

      (* можно свернуть AV,Q,U с гауссианой шириной 5 точек ? *)
      AX  := SetAReI1I2(1,nLam);

      (* преобразуем AIn в ARe *)
      ArV := CopyARe(AV); // ArV := AReGSmooth(AX,ArV,5); сглаживаем гауссом
      ArQ := CopyARe(AQ);
      ArU := CopyARe(AU);

    (*--------------------------------------------------------------------*)
    (*            вынесем определение границ в отдельную секцию           *)
    (*--------------------------------------------------------------------*)
    (*                        6301                                        *)
    (*--------------------------------------------------------------------*)
      iLi := 1;
      rl0 := rL10; rl1 := rL11; rl2 := rL12;
      (* находим границы интегрирования *)
      (* останавливаемся там, где I>rC либо на расст.350 мА от центра *)
      GetLineBounds; (* вложенная проц.*)
      ii1 := i11; ii2 := i21;
    (*--------------------------------------------------------------------*)
    (*                        6302                                        *)
    (*--------------------------------------------------------------------*)
      iLi := 2;
      rl0 := rL20; rl1 := rL21; rl2 := rL22;
      GetLineBounds;
      ii3 := i11; ii4 := i21;




    (*--------------------------------------------------------------------*)
    (*                       собственно расчёты                           *)
    (*--------------------------------------------------------------------*)
    (*                        6301                                        *)
    (*--------------------------------------------------------------------*)

      iLi := 1;
      rl0 := rL10; rl1 := rL11; rl2 := rL12;
//    GetLineBounds; (* вложенная проц.*)
      i11 := ii1; i21 := ii2; i1 := i11; i2 := i21;

      (* nLam2 = nLam div 2 *)
      if QAll then begin i1 := 1; i2 := nLam2; end;

      if i1 < 1     then i1 := 1;
      if i2 > nLam2 then i2 := nLam2;

{
=======================================
=======================================
=======================================
=======================================
=======================================
=======================================
      ResetSumE;
      SumE;
=======================================
=======================================
=======================================
=======================================
=======================================
}


      ResetSums;
      SumIV;

//      w := nl * c - wi; (* wi = сумма интенсивностей *)
//                        (* тогда w - площадь НАД кривой I в единицах прибора *)

    (* SiqM > SiqP => дальше от центра то что снизу *

      if SivP < SivM then SigV := 1 else SigV := -1;
      if SiqP < SiqM then SigQ := 1 else SigQ := -1;
      if SiuP < SiuM then SigU := 1 else SigU := -1;

*
      SigQ = 1  => то что выше 0 расположено ближе к центру
                   дальше от центра то, что снизу
*)





{
      AKV1[iYA] := SigV*(abs(rsv)+abs(rsvm))*kw;
      AKQ1[iYA] := SigQ*(abs(rsq)+abs(rsqm))*kw; // /nl;
      AKU1[iYA] := SigU*(abs(rsu)+abs(rsum))*kw; // /nl;
      AKW1[iYA] := w*kw; // /nl;
}

      (*
        rsvm - отрицательно
        rsv  - положительно
          SigV > 0   - N - полярность

        N полярность
          p*sigP > 0
          n*sigP < 0
          поле = (p+abs(n)) * sigP
          Ri-Le = p-abs(n) * sigP

        S полярность
          p*sigN < 0
          n*sigN > 0
          поле = (p+abs(n)) * sigN
          Ri-Le = -(p-abs(n))

       *)


    (*--------------------------------------------------------------------*)
    (*                        6302                                        *)
    (*--------------------------------------------------------------------*)

      iLi := 2;
      rl0 := rL20; rl1 := rL21; rl2 := rL22;
//    GetLineBounds;
      i11 := ii3; i21 := ii4; i1 := i11; i2 := i21;


      if QAll then begin i1 := nLam2 + 1; i2 := nLam; end;

      if i1 < (nLam2 + 1)  then i1 := nLam2 + 1;
      if i2 >  nLam        then i2 := nLam;


      ResetSums;
      SumIV;

//    w := nl * c - wi;


(*
      if SivP < SivM then SigV := 1 else SigV := -1;
      if SiqP < SiqM then SigQ := 1 else SigQ := -1;
      if SiuP < SiuM then SigU := 1 else SigU := -1;
*)


      (* AKVI выражаем в процентах (|V1|+|V2|)/(W1+W2)*100 *)
      (* выводить в файл не нужно, т.к. можно всегда рассситать *)
{
      AKVI[iYA] := ((abs(Aa1[iYA])+abs(Ab1[iYA]))/ag1[iYA]
                 +  (abs(Aa2[iYA])+abs(Ab2[iYA]))/ag2[iYA]) * 100;
}


//    if iVMax/c > AbsVIMax
//    then AbsVIMax := iVMax/c;(* макс.нормир.значение модуля парамера Стокса V *)
    end; (* CONT > (Some min Val) *)
  end;

  Finalize(AI); Finalize(AV); Finalize(AQ); Finalize(AU);

  Time_routine('FITS.CalcSumsFine',false);
end; (* TFITS.CalcSumsFine *)




procedure TFITS.CalcBisec; (* AbiC1/2 AbiW1/2 A35C1/2 A35I1/2 A35D1/2 *)
var k,iYA : integer;
  dc,dld,d0,c0 : real;
  i1,i2 : integer;
  AI : TAIn;
  AC5,AW5 : TABisec; (* 1..5=>6 of real *)

  AD3,AC3,AI3 : TA3_5;

  S : string;
  NE : integer;
begin
  Time_routine('FITS.CalcBisec',true);

{
  SetLength(A_d01,nY+1); (* центральная глубина (в процентах к ACnt) *)
  SetLength(A_d02,nY+1);
  SetLength(A_c01,nY+1); (* полож.вершины линии 6301 в пикселах *)
  SetLength(A_c02,nY+1);
}

  SetLength(AN1,nY+1);     (* число экстремумов интенсивности *)
  SetLength(AN2,nY+1);

  for k := 1 to mBisec do begin  (* mBisec сменили с 5 на 6 ! *)
    SetLength(AbiC1[k],nY+1); (* положения центров бисекторов *)
    SetLength(AbiW1[k],nY+1); (* абсолютные ширины    6301    *)
    SetLength(AbiC2[k],nY+1); (* положения центров бисекторов *)
    SetLength(AbiW2[k],nY+1); (* абсолютные ширины    6302    *)
  end;

  for k := 3 to 5 do begin
    SetLength(A35C1[k],nY+1);  (* Lam0   ---- 6301 ------------------------- *)
    SetLength(A35I1[k],nY+1);  (* D0   *)
    SetLength(A35D1[k],nY+1);  (* DLD  *)  (* TARe3_5 = array[3..5] of TARe; *)
    SetLength(A35C2[k],nY+1);  (* Lam0   ---- 6302 ------------------------- *)
    SetLength(A35I2[k],nY+1);  (* D0   *)
    SetLength(A35D2[k],nY+1);  (* DLD  *)  (* TARe3_5 = array[3..5] of TARe; *)
  end;




  for iYA := 1 to nY do begin  (* перебираем точки вдоль высоты щели *)
  (*======================================================*)
    dc := ACnt[iYA];
    Self.GetCol3(iYA,1,AI);(* AI - целый массив парам.Стокса 1 вдоль дл.волны *)
    (*-----------------------------------*)
    (*           6301                    *)
    (*-----------------------------------*)
    i1 := 1;



    i2 := 0000; // round(AIC[iYA]); (* точка раздела профилей *)










    LineMetrix(i1,i2,AI,
               dc,dld,c0,d0,
               AC5,AW5,AD3,AC3,AI3,
               NE);
    AN1[iYA]   := NE;
    (* если число вершин в сегменте не равно 3 в AC5 и AW5 будут нули *)
    for k := 1 to mBisec do begin
      AbiC1[k,iYA] := AC5[k];
      AbiW1[k,iYA] := AW5[k];
    end;
    for k := 3 to 5 do begin
      A35C1[k,iYA] := AC3[k];   (* Lam0 *)
      A35I1[k,iYA] := AI3[k];   (* D0   *)
      A35D1[k,iYA] := AD3[k];   (* DLD  *)  (* TARe3_5 = array[3..5] of TARe; *)
    end;



    (*-----------------------------------*)
    (*           6302                    *)
    (*-----------------------------------*)
    i1 := i2; i2 := 112;
    LineMetrix(i1,i2,AI,dc,dld,c0,d0,AC5,AW5,AD3,AC3,AI3,NE);
    for k := 3 to 5 do begin
      A35C2[k,iYA] := AC3[k];   (* Lam0 *)
      A35I2[k,iYA] := AI3[k];   (* D0   *)
      A35D2[k,iYA] := AD3[k];   (* DLD  *)  (* TARe3_5 = array[3..5] of TARe; *)
    end;
    AN2[iYA]   := NE;
    for k := 1 to mBisec do begin
      AbiC2[k,iYA] := AC5[k];
      AbiW2[k,iYA] := AW5[k];
    end;
  (*======================================================*)
  end; (* for iYA *)





{
  for iYA := 1 to nY do begin

    dc := ACnt[iYA];
    Self.GetCol3(iYA,1,AI); (* целый массив парам.Стокса 1 вдоль дл.волны *)

    (*-----------------------------------*)
    (*           6301                    *)
    (*-----------------------------------*)

    i1 := 1; i2 := round(AIC[iYA]);

(*--------
DEBUG
    S := 'dc='+ISt(Round(dc))+' iYA='+ISt(iYA);
    TLFITS(Owner).SLOut.Add(S);
 ---------*)

(*-----------
    if IXI = 22 then
    if IYA = 327 then begin
      TLFITS(Owner).SLOut.Add('ОП-ПААА!');
    end;
------------*)



    LineMetrix(i1,i2,AI,dc,dld,c0,d0,AC5,AW5,AD3,AC3,AI3,NE);

(*
    S := 'NP DLD Lam0 D0'; TLFITS(Owner).SLOut.Add(S);
    for k := 3 to 5 do begin
      S := ISt(k)+' '+
           EFSt0(AD3[k],7)+' '+
           EFSt0(AC3[k],7)+' '+
           EFSt0(AI3[k],7);
      TLFITS(Owner).SLOut.Add(S);
    end;
*)

    AN1[iYA]   := NE;
(*
    A_d01[iYA] := d0;
    A_c01[iYA] := c0;
*)

    (* если число вершин в сегменте не равно 3 в AC5 и AW5 будут нули *)

    for k := 1 to mBisec do begin
      AbiC1[k,iYA] := AC5[k];
      AbiW1[k,iYA] := AW5[k];
    end;

    for k := 3 to 5 do begin
      A35C1[k,iYA] := AC3[k];   (* Lam0 *)
      A35I1[k,iYA] := AI3[k];   (* D0   *)
      A35D1[k,iYA] := AD3[k];   (* DLD  *)  (* TARe3_5 = array[3..5] of TARe; *)
    end;


(*--------
DEBUG
    S := '-- iX='+ISt(IXI);
    TLFITS(Owner).SLOut.Add(S);
  ---------*)

//    if iYA = 183 then
//      TLFITS(Owner).SLOut.Add('ОП-ПААА!');



    (*-----------------------------------*)
    (*           6302                    *)
    (*-----------------------------------*)


    i1 := i2; i2 := 112;
    LineMetrix(i1,i2,AI,dc,dld,c0,d0,AC5,AW5,AD3,AC3,AI3,NE);

(*
    S := 'NP DLD Lam0 D0'; TLFITS(Owner).SLOut.Add(S);
    for k := 3 to 5 do begin
      S := ISt(k)+' '+
           EFSt0(AD3[k],7)+' '+
           EFSt0(AC3[k],7)+' '+
           EFSt0(AI3[k],7);
      TLFITS(Owner).SLOut.Add(S);
    end;
*)

    for k := 3 to 5 do begin
      A35C2[k,iYA] := AC3[k];   (* Lam0 *)
      A35I2[k,iYA] := AI3[k];   (* D0   *)
      A35D2[k,iYA] := AD3[k];   (* DLD  *)  (* TARe3_5 = array[3..5] of TARe; *)
    end;


    AN2[iYA]   := NE;

(*
    A_d02[iYA] := d0;
    A_c02[iYA] := c0;  =  Lam0
*)

    for k := 1 to mBisec do begin
      AbiC2[k,iYA] := AC5[k];
      AbiW2[k,iYA] := AW5[k];
    end;
  end; (* for iYA *)
}

  Time_routine('FITS.CalcBisec',false);
end; (* TFITS.CalcBisec *)


procedure TFITS.CalcCore(OFOH:TObject);
var FOH : TFIOut;
  iYA : integer;
//IXI  индекс в списке FITS файлов
  B : real;
  DLH1, DLH2 : real;
  l1,l2 : real;

  Cont : real;
  DLD,DLDk : real;

  AX,AI : TARe;
  AII : TAIn;

  QL : boolean;



  S : string;

begin
  Time_routine('FITS.CalcCore',true);
  FOH := TFIOut(OFOH);

  SetLength(AGa18 ,nY+1);
  SetLength(AGa16 ,nY+1);
  SetLength(AGa141,nY+1);
  SetLength(AGa142,nY+1);
  SetLength(AGb18 ,nY+1);
  SetLength(AGb16 ,nY+1);
  SetLength(AGb141,nY+1);
  SetLength(AGb142,nY+1);
  SetLength(AGa28 ,nY+1);
  SetLength(AGa26 ,nY+1);
  SetLength(AGa241,nY+1);
  SetLength(AGa242,nY+1);
  SetLength(AGb28 ,nY+1);
  SetLength(AGb26 ,nY+1);
  SetLength(AGb241,nY+1);
  SetLength(AGb242,nY+1);
  SetLength(AGD18 ,nY+1);
  SetLength(AGD16 ,nY+1);
  SetLength(AGD141,nY+1);
  SetLength(AGD142,nY+1);
  SetLength(AGD28 ,nY+1);
  SetLength(AGD26 ,nY+1);
  SetLength(AGD241,nY+1);
  SetLength(AGD242,nY+1);
  SetLength(AG1d0 ,nY+1);
  SetLength(AG2d0 ,nY+1);
  SetLength(AG1Dk ,nY+1);
  SetLength(AG2Dk ,nY+1);
  SetLength(AG1D  ,nY+1);
  SetLength(AG2D  ,nY+1);
  SetLength(AGL16 ,nY+1);
  SetLength(AGL14 ,nY+1);
  SetLength(AGL26 ,nY+1);
  SetLength(AGL24 ,nY+1);
  SetLength(AGL10 ,nY+1);
  SetLength(AGL20 ,nY+1);
  SetLength(AGL1  ,nY+1);
  SetLength(AGL2  ,nY+1);

  AX := swARe.SetAReI1I2(1,112);

  if Not Assigned(CurI) then begin
    WarnAbs('FITS.CalcCore Структура CurI к этому моменту должна быть создана'+
            ' и в неё загружены параметры!');
    Exit;
    CurI := TCurI.Create;
//  CurI.WhichLine;
    SunWorld.CurI_InitParam;
  end;

  CurI.m_iX := Self.IXI;

  l1 := TLFITS(Owner).rLC51; //Self.rLC1;
  l2 := TLFITS(Owner).rLC52; //Self.rLC2;

  QL := (length(ALC51) = (nY + 1)) and
        (length(ALC52) = (nY + 1));

  for iYA := 1 to nY do begin

    CurI.m_iY := iYA-1;

    (* определим крайние точки для интегрирования линий *)
    if QL then begin
      l1 := ALC51[iYA];  (* полож-я центров тяжести в пикселах *)
      l2 := ALC52[iYA];
    end;

    if l1 = 0 then l1 := TLFITS(Owner).rLC51; //Self.rLC1;
    if l2 = 0 then l2 := TLFITS(Owner).rLC52; //Self.rLC2;

//  B := Abs(FOH.aData[IXI,iYA-1]);
//  DLH1 := PHYS.GS2mA(B,TLFITS(Owner).rLa1,1.669);
//  DLH2 := PHYS.GS2mA(B,TLFITS(Owner).rLa2,2.487);

    DLH1 := 0;
    DLH2 := 0;





    Cont := Self.ACnt[iYA];
    Self.GetCol3(iYA,1,AII);
    AI := swARe.CopyARe(AII);

    CurI.AInit(AX,AI);

    (* 6301 *)

    DLD  := 4.15;
    DLDk := 0.8;


    CurI.gsInit(Cont,l1,DLD,DLDk);
    CurI.DLH2H(DLH1);

    S := '6301 iX='+ISt(CurI.m_iX)+' iY='+ISt(CurI.m_iY)+
         ' Cont='+EFSt0(CurI.gs.Cont,6)+
         ' Lam0='+EFSt0(CurI.gs.Lam0,6)+
         ' DLD='+EFSt0(CurI.gs.DLD,6)+
         ' Dk='+EFSt0(CurI.gs.DLDk,6)+
         ' A='+EFSt0(CurI.gs.aIL,6)+
         ' B='+EFSt0(CurI.gs.aIL,6);
    SunWorld.memoGSparam.Lines.Add(S);

    CurI.sOp := 'k1';
    CurI.CheckLam;
    CurI.reLam;
    CurI.Ajust;

    (* собираем результаты *)
    (* в массивы из которых можно сформировать какие-то карты *)

    AGa18 [iYA] := CurI.gs.k_A8;
    AGa16 [iYA] := CurI.gs.k_A6;
    AGa141[iYA] := CurI.gs.k_A41;
    AGa142[iYA] := CurI.gs.k_A42;
    AGb18 [iYA] := CurI.gs.k_B8;
    AGb16 [iYA] := CurI.gs.k_B6;
    AGb141[iYA] := CurI.gs.k_B41;
    AGb142[iYA] := CurI.gs.k_B42;

    AGD18 [iYA] := CurI.gs.DLD8;
    AGD16 [iYA] := CurI.gs.DLD6;
    AGD141[iYA] := CurI.gs.DLD41;
    AGD142[iYA] := CurI.gs.DLD42;

    CurI.gs.d0pix := gs_get_d0pix(CurI.gs);
    AG1d0 [iYA] := CurI.gs.d0pix ;

    AGL10 [iYA] := gs_get_L0(CurI.gs);
    AGL1  [iYA] := CurI.gs.Lam0;

    AGL16 [iYA] := CurI.gs.Lam06;
    AGL14 [iYA] := CurI.gs.Lam04;

    AG1Dk [iYA] := CurI.gs.DLDk;
    AG1D  [iYA] := CurI.gs.DLD;

    (* 6302 *)
    DLD  := 3.31;
    DLDk := 0.88;


    CurI.gsInit(Cont,l2,DLD,DLDk);
    CurI.DLH2H(DLH2);

    S := '6302 iX='+ISt(CurI.m_iX)+' iY='+ISt(CurI.m_iY)+
         ' Cont='+EFSt0(CurI.gs.Cont,6)+
         ' Lam0='+EFSt0(CurI.gs.Lam0,6)+
         ' DLD='+EFSt0(CurI.gs.DLD,6)+
         ' Dk='+EFSt0(CurI.gs.DLDk,6)+
         ' A='+EFSt0(CurI.gs.aIL,6)+
         ' B='+EFSt0(CurI.gs.aIL,6);
    SunWorld.memoGSparam.Lines.Add(S);


    CurI.sOp := 'k1'; CurI.CheckLam; CurI.reLam;
    CurI.Ajust;

    (* собираем результаты *)

    AGa28 [iYA] := CurI.gs.k_A8;
    AGa26 [iYA] := CurI.gs.k_A6;
    AGa241[iYA] := CurI.gs.k_A41;
    AGa242[iYA] := CurI.gs.k_A42;
    AGb28 [iYA] := CurI.gs.k_B8;
    AGb26 [iYA] := CurI.gs.k_B6;
    AGb241[iYA] := CurI.gs.k_B41;
    AGb242[iYA] := CurI.gs.k_B42;

    AGD28 [iYA] := CurI.gs.DLD8;
    AGD26 [iYA] := CurI.gs.DLD6;
    AGD241[iYA] := CurI.gs.DLD41;
    AGD242[iYA] := CurI.gs.DLD42;

    CurI.gs.d0pix := gs_get_d0pix(CurI.gs);
    AG2d0 [iYA] := CurI.gs.d0pix ;

    AGL20 [iYA] := gs_get_L0(CurI.gs);
    AGL2  [iYA] := CurI.gs.Lam0;

    AGL26 [iYA] := CurI.gs.Lam06;
    AGL24 [iYA] := CurI.gs.Lam04;

    AG2Dk [iYA] := CurI.gs.DLDk;
    AG2D  [iYA] := CurI.gs.DLD;







{
    AGa28 [iYA] := CurI.gs. ;
    AGa26 [iYA] := CurI.gs. ;
    AGa241[iYA] := CurI.gs. ;
    AGa242[iYA] := CurI.gs. ;
    AGb28 [iYA] := CurI.gs. ;
    AGb26 [iYA] := CurI.gs. ;
    AGb241[iYA] := CurI.gs. ;
    AGb242[iYA] := CurI.gs. ;

    AGD28 [iYA] := CurI.gs. ;
    AGD26 [iYA] := CurI.gs. ;
    AGD241[iYA] := CurI.gs. ;
    AGD242[iYA] := CurI.gs. ;
    AG1d0 [iYA] := CurI.gs. ;
    AG2d0 [iYA] := CurI.gs. ;
    AG1Dk [iYA] := CurI.gs. ;
    AG2Dk [iYA] := CurI.gs. ;
    AG1D  [iYA] := CurI.gs. ;
    AG2D  [iYA] := CurI.gs. ;
    AGL16 [iYA] := CurI.gs. ;
    AGL14 [iYA] := CurI.gs. ;
    AGL26 [iYA] := CurI.gs. ;
    AGL24 [iYA] := CurI.gs. ;
}


{
  S := edILam6301.Text;  CurI.gs.Lam0 := swStr.ValReal(S);
  S := edICont6301.Text; CurI.gs.Cont := swStr.ValReal(S);
  S := edDLD6301.Text;   CurI.gs.DLD  := swStr.ValReal(S);
  S := edDLDk6301.Text;  CurI.gs.DLDk := swStr.ValReal(S);

  S := edGSa.Text;       CurI.gs.aIL  := swStr.ValReal(S);
  S := edGSb.Text;       CurI.gs.bIL  := swStr.ValReal(S);

  S := edGSdlh.Text;     CurI.gs.DLH  := swStr.ValReal(S);

  S := edGSlevel.Text;   CurI.dLevel  := swStr.ValReal(S);
}



  end;

  Time_routine('FITS.CalcCore',false);
end;






(* AWI1, AWI2, AWI3, AMV1, AMV2, AHM1,AHM2,AHG1,AHG2 *)
(* AMV1, AMV2 - ненормир.моменты. Удалить?         *)
procedure TFITS.CalcEqw;
var AI,AV,AF,AG : TARe; iYA,iL : integer; w,m : real;
  i0 : integer; (* ИНДЕКС ПОЛОЖЕНИЯ ЦЕНТРА ЛИНИИ *)
  l1,l2 : real;
  dl1,dl2:real; (* "размах" вокруг центров линий в пикселах *)
  l11,l12,l21,l22 : real; (* границы линий в пикселах *)

  lIV1,lVI1,lIV2,lVI2 : real;
  dlam1,dlam2         : real;
  ri,rv               : real;
//  HG1,HG2             : real;

begin
  Time_routine('FITS.CalcEqw',true);

//Self.ALam := Self.GetALam;

  (* центры тяжести линий к этому моменту рассчитаны *)
  (* границы линий определяем как центры +/- dl      *)
  (* dl1, dl2 в пикселях *)

  dl1 := Abs(TLFITS(Owner).dl6301/1000/Self.rdLam);  (* dl6301/2=350mA    *)
  dl2 := Abs(TLFITS(Owner).dl6302/1000/Self.rdLam);  (* rdLam - дисперсия *)


//  dl21 := Abs(0.9985/Self.rdLam);   (* среднее расстояние между линиями *)

  (* Экв.ширины *)

  (* выходные данные FITS *)
  SetLength(AWI1,nY+1);
  SetLength(AWI2,nY+1);
//SetLength(AWI3,nY+1);

  (* Ненормированный момент V-параметра Стокса *)

  (* промежуточные данные FITS *)
  SetLength(AMV1,nY+1);
  SetLength(AMV2,nY+1);

  (* значения продольного поля, полученные методом COG *)

  (* выходные данные FITS *)
  SetLength(AHG1,nY+1);
  SetLength(AHG2,nY+1);


  (* Нормированный момент V-параметра Стокса = Значение продольного поля *)

  (* выходные данные FITS *)
  SetLength(AHM1,nY+1);
  SetLength(AHM2,nY+1);

  (* промежуточные данные FITS I+V, I-V *)
  SetLength(AF,nLam+1);
  SetLength(AG,nLam+1);



  for iYA := 1 to nY do begin

    (* определим крайние точки для интегрирования линий *)
    l1 := ALC1[iYA];  (* полож-я центров тяжести в пикселах *)
    l2 := ALC2[iYA];

    l11 := l1 - dl1;
    l12 := l1 + dl1;
    l21 := l2 - dl2;
    l22 := l2 + dl2;

    AI := Self.GetAI(iYA); (* нормированный на CONT[iY] массив *)
    AV := Self.GetAV(iYA);

    for iL := 1 to nLam do begin
      ri := AI[iL];
      rv := AV[iL];
      AF[iL] := 1 - (ri + rv);
      AG[iL] := 1 - (ri - rv);
    end;

    (* найдём центры тяжести профилей CONT-(I+V) = AF и CONT-(I-V) = AG *)

    lIV1 := swARe.LineCenter_d(l11,l12,AF);
    lVI1 := swARe.LineCenter_d(l11,l12,AG);
    lIV2 := swARe.LineCenter_d(l21,l22,AF);
    lVI2 := swARe.LineCenter_d(l21,l22,AG);

    dlam1 := (lVI1-lIV1) * Abs(Self.rdLam) * 1000;
    dlam2 := (lVI2-lIV2) * Abs(Self.rdLam) * 1000;

    AHG1[iYA] := PHYS.LamToH(dlam1/2,6301.5,1.669); // 1.503);
    AHG2[iYA] := PHYS.LamToH(dlam2/2,6302.5,2.487);




    w := swARe.EqWidth(l11,l12,1,AI);
    w := w * Abs(Self.rdLam) * 1000; (* переводим в миллиангстремы *)
    AWI1[iYA] := w;
    m := swARe.EqwMoment(l11,l12,l1,AV);
    m := m * Self.rdLam * 1000 * Self.rdLam * 1000;
    AMV1[iYA] := m;
    AHM1[iYA] := PHYS.LamToH(m/w,6301.5,1.669); // 1.503);


    w := swARe.EqWidth(l21,l22,1,AI);
    w := w * Abs(Self.rdLam) * 1000; (* переводим в миллиангстремы *)
    AWI2[iYA] := w;
    m := swARe.EqwMoment(l21,l22,l2,AV);
    m := m * Self.rdLam * 1000 * Self.rdLam * 1000;
    AMV2[iYA] := m;
    AHM2[iYA] := PHYS.LamToH(m/w,6302.5,2.487);

  end;

  Finalize(AI);
  Finalize(AV);
  Finalize(AF);
  Finalize(AG);

  Time_routine('FITS.CalcEqw',false);
end; (* TFITS.CalcEqw *)




{
procedure TFITS.CalcCGravs2;
const s1 = 'FITS.CalcCGravs ERR : ';
      s2 = 'границы спектральных линий заданы неправильно'+#13#10;
var N,iY,i3 : integer; A : TAIn;

begin

  if Not SetBit.IsBit(KStep,1) then begin
    WarnAbs('TFITS.CalcCGravs1 Err: Header Not Loaded Yet!');
    Exit;
  end;

  SetLength(AX21,nY+1);
  SetLength(AX22,nY+1);

  (* найти полож-я центра тяжести в пикселах для инт-ти 6301 и 6302 *)

  i3 := 1;
  for iY := 1 to nY do begin
    SetLinesArea2(iY);  (* определим значения границ *)
    GetCol3(iY,i3,A);
    AX21[iY] := uPMAS.LineCenter(bl2.b1.b,bl2.b1.r,A);
    AX22[iY] := uPMAS.LineCenter(bl2.b2.b,bl2.b2.r,A);
  end;

  Finalize(A);
end; (* TFITS.CalcCGravs2 *)
}


(*----------------------------------------------------------------*)
(* определение точки разделения профилей 6301 и 6302              *)
(* если kVI < kVI1 то точку разделения находим по центрам тяжести *)
(* если kVI > kVI1 то используем точку разделения V - профилей    *)
(* иначе берем взвешенное среднее между ними                      *)

(* Точка разделения V профилей "гуляет" намного сильнее, чем      *)
(* среднее центров тяжести 6301 и 6302                            *)
(* Однако мы всё равно её берём, так как она существенна при      *)
(*   вычислении момента V-параметра Стокса                        *)

{
procedure TFITS.CalcICenter;
var rC1,rC2,rC,rCV,rCI,kVI,dkV,drc : real; var iY : integer;
begin
  Time_routine('FITS.CalcICenter',true);

  SetLength(AIC ,nY+1); (* положения точки раздела профилей 6301 и 6302 *)

//DeltaRC := 2; (* на 2 пикселя смещаем точку раздела линий в сторону 6301 *)
//drc := TLFITS(Owner).DeltaRC;

  dkV := kVI2-kVI1;
  for iY := 1 to nY do begin
    kVI := AKVI[iY];
    rC1 := ALC1[iY];
    rC2 := ALC2[iY];

//  rC := (ALC1[iY] + ALC2[iY]) / 2;
(* ALCx полож.центра тяжести в пикселах для инт-ти 630x *)

    if kVI < kVI1 then begin
      rC := (rC1 + rC2) / 2;
    end
    else
    if kVI > kVI2 then begin
      rC := AVC[iY];
    end
    else begin
      rCI := (rC1 + rC2) / 2;
      rCV := AVC[iY];

      if rCV > 0 then rC := (rCI*(kVI2 - kVI) + rCV*(kVI - kVI1)) / dkV
                 else rC :=  rCI;
    end;


    (*---------------------------------------------------*)
    (* расчет нормированного V-параметра Стокса даёт     *)
    (* значения для 6301 систематически выше, чем для    *)
    (* 6302, хотя должно быть наоборот                   *)
    (* ----------------                                  *)
    (* мы попробуем это исправить отдав больше места     *)
    (* линии 6302, чем 6301, то есть сместьим точку      *)
    (* разделения линий на пару пикселей в сторону 6301  *)
    (*---------------------------------------------------*)
    if rC1 < rC2 then rC := rC - drc else rC := rC + drc;

    AIC[iY] := rC;

  end;
  Time_routine('FITS.CalcICenter',false);
end;
}


{
procedure TFITS.CalcVCross;
var iY,iLam : integer; AV,AIdx : TAIn; A,A1 : TARe; i1 : integer;
  nLoop : integer; R,R0 : real; idx1,idx2 : integer;
begin
  Time_routine('FITS.CalcVCross',true);

//(* к этому моменту массивы AC4 должны быть рассчитаны *)

  SetLength(AVC ,nY+1); (* положения точки раздела V-профилей 6301 и 6302 *)

  i1 := 5;
  for iY := 1 to nY do begin
    (* можно определять точку VCross не для всех подряд профилей *)
    (*    а только для таких, для которых AKVI[iY] >= (kVI1=0.1) *)

    GetCol3(iY,4,AV);
    A  := CopyARe(AV);
    Extremums(A,i1,AIdx); (* складываем экстремумы массива AV в AIdx *)

    if length(AIdx) < 5 then begin (* их с самого начала слишком мало? *)
      WarnAbs('TFITS.CalcVCross Err NExtremum='+ISt(Length(AIdx)-1));
    end;

    nLoop := 0;
    while (length(AIdx)-1)>4 do begin
      inc(nLoop);
      A1 := CopyARe(A);
      AReSmooth3(A1,A); (* сглаживаем по 3-м соседним точкам *)
      Extremums(A,i1,AIdx);
    end;

    R0 := 0;
    R  := XMonoLevel(A,AIdx[2],AIdx[3],R0);(* пересеч-е "0" между 2 и 3 экстр.*)

    if (R = -1) or (R = length(A)) then begin
(*
      idx1 := AIdx[2];
      idx2 := AIdx[3];

      if (idx1 < 1) or (idx2 >= length(A)) or (idx1 >= idx2) then begin
        WarnAbs('TFITS.CalcVCross ERR iY='+ISt(iY)+'nloop = '+ISt(nloop)+
        #13#10+
        'idx1='+ISt(idx1)+
        ' idx2='+ISt(idx2)
        );

      end

      else begin
        WarnAbs('TFITS.CalcVCross ERR iY='+ISt(iY)+'nloop = '+ISt(nloop)+
        #13#10+
        'V['+ISt(idx1)+']='+EFSt0(A[idx1],11)+
        ' V['+ISt(idx2)+']='+EFSt0(A[idx2],11)
        );
      end;
*)
      R := 0;
    end;

    AVC[iY] := R;
  end;
  Time_routine('FITS.CalcVCross',false);
end;
}

{
(* центры тяжести средние по целому FITS - для nY положений на щели *)
procedure TFITS.CalcCGravs1(j0,j1,j2,j3:integer;var ll1,ll2:real);
var iY,i3,j11,j12,j21,j22 : integer; A : TAIn; lll,ll,l1,l2,l11,l22 : real;
begin
  if (rdLam > 0) then begin j11 := j0; j12 := j1; j21 := j2; j22 := j3 end
                 else begin j21 := j0; j22 := j1; j11 := j2; j12 := j3 end;

  i3  := 1;
  l11 := 0;
  l22 := 0;
  for iY := 1 to nY do begin
    GetCol3(iY,i3,A); (* ненормированный целочисленный профиль интенсивности *)
    l1 := uPMAS.LineCenter(j11,j12,A);
    l2 := uPMAS.LineCenter(j21,j22,A);
    l11 := l11 + l1;
    l22 := l22 + l2;
  end;
  ll1 := l11 / nY;
  ll2 := l22 / nY;
end;

(* по целочисленным границам, к тому же назначенным *)
(* по средним центрам для nY точек                  *)
procedure TFITS.CalcCGravs2(j0,j1,j2,j3:integer);
var iY,i3 : integer; A : TAIn; l1,l2 : real;
begin
  SetLength(ALC1,nY+1);
  SetLength(ALC2,nY+1);
  i3 := 1;
  for iY := 1 to nY do begin
    GetCol3(iY,i3,A);
    l1 := uPMAS.LineCenter(j0,j1,A);
    l2 := uPMAS.LineCenter(j2,j3,A);
    ALC1[iY] := l1;
    ALC2[iY] := l2;
  end;
  Finalize(A);
end;
}



procedure TFITS.CalcC50;
var iYA : integer; id01,id02,ic1,ic2 : integer; rcs1,rcs2 : real;
  rC501,rC502,r : real; I : integer;
  A : TAIn;
begin
  SetLength(ALC51,nY+1);
  SetLength(ALC52,nY+1);
  SetLength(AILd01,nY+1);  (* полож.вершины линии 6301 в пикселах *)
  SetLength(AILd02,nY+1);
  SetLength(AI_d01,nY+1);  (* центральная глубина в пикселах *)
  SetLength(AI_d02,nY+1);


  rcs1 := 0;  (* сумма глубин линии 1 *)
  rcs2 := 0;  (* сумма глубин линии 2 *)
  for iYA := 1 to nY do begin
    GetCol3(iYA,1,A);      (* выборка всех точек iYA-го профиля интенсивности *)
    GetCd012(A,ACnt[iYA],0.5,rC501,rC502,ic1,ic2,id01,id02);
    rcs1 := rcs1 + ic1;
    rcs2 := rcs2 + ic2;
    ALC51[iYA]  := rC501; (* бисекторы "нулевого уровня" для d=0.5 *)
    ALC52[iYA]  := rC502;
    AILd01[iYA] := ic1;
    AILd02[iYA] := ic2;
    AI_d01[iYA] := id01;
    AI_d02[iYA] := id02;
  end;

(* 6301 в среднем глубже 6302, то есть rcs1 < rcs2 *)
(* если получилось наоборот, значит                *)
(*   - дисперсия отрицательна             *)
(*   - линия 6302 находится слева от 6301 *)

  if rcs2 < rcs1 then begin (* rcs2 - это линия 6301? *)
    for iYA := 1 to nY do begin   (* тогда надо переставить местами *)
      r := ALC51[iYA];  ALC51[iYA]  := ALC52[iYA];  ALC52[iYA]  := r;
      I := AILd01[iYA]; AILd01[iYA] := AILd02[iYA]; AILd02[iYA] := I;
      I := AI_d01[iYA]; AI_d01[iYA] := AI_d02[iYA]; AI_d02[iYA] := I;
    end;
  end;
end; (* CalcC50 *)


procedure TFITS.CalcDFull;
var iYA,iX,iY0 : integer;
  iL : integer;
  JL,JR : integer;
  AX,AI : TARe;
  rL0 : real;
  rL,rR : real;
  d0 : real;
begin

  iX := Self.IXI;

  SetLength(AWo1 ,nY+1);
  SetLength(AWo2 ,nY+1);
  SetLength(AWo3 ,nY+1);
  SetLength(AWo4 ,nY+1);
  SetLength(AWo5 ,nY+1);
  SetLength(AWo6 ,nY+1);
  SetLength(AWo7 ,nY+1);
  SetLength(AWo8 ,nY+1);

  if Not Assigned(CurI) then begin
    CurI := TCurI.Create;
//  CurI.WhichLine;
    SunWorld.CurI_InitParam;
  end;

(* iYA-тый профиль Ri *)

  SetLength(AX,Self.nLam+1);

  for iL := 1 to Self.nLam do begin
    AX[iL] := iL;
  end;

  (* нам понадобятся данные из нескольких карт               *)
  (* Cont                     - массив   ACnt                *)
  (* LWb1 + LWr1, LWb2 + LWr2 - массивы  AWk1,AWk2,AWk3,AWk4 *)

//ACnt : TARe; (* уровень континуума. Не нормировано! *)

  if Not Self.ReturnSlitConts then begin
    WarnAbs('ReturnSlitConts');
    Exit;
  end;

  if Not Self.ReturnSlitLWbr then begin
    WarnAbs('Необходимо загрузить/рассчитать данные о крыльях [LW(b,r)]');
    Exit;
  end;

  for iYA := 1 to nY do begin  (* цикл по точкам вдоль Y *)
    iY0 := iYA - 1;
    (* загружаем CurI *)

//  GetCol3(iYA,1,A);      (* выборка всех точек iYA-го профиля интенсивности *)

    AI := Self.GetAI0(iYA);
    CurI.AInit(AX,AI);

    CurI.m_iX := iX;
    CurI.m_iY := iY0;

    (*==========================================================*)
    (*========= 6301 =========*)

    rL := Self.AWk1[iYA];
    rR := Self.AWk2[iYA];
    rL0 := (rL + rR)/2;

    CurI.gs.Lam0 := rL0;
    CurI.gs.Cont := Self.ACnt[iYA];
    CurI.gs.DLD  := 4.15;
    CurI.gs.DLDk := 0.8;
    CurI.gs.aIL  := 0;
    CurI.gs.H    := 0;
    CurI.gs.La12 := 1;

    (* верхняя точка отрезка из 3-х точек - на 1 вверх от базовой линии *)
    if rL > 0 then JL := TruncDn (rL)+2 else JL := 0;
    if rR > 0 then JR := TruncUpp(rR)-2 else JR := 0;

    CurI.li1.ILbase := JL;
    CurI.li1.IRbase := JR;

    CurI.k3L6;
    CurI.Db6k3Loop;

    AWo1[iYA] := CurI.gs.DLD;
    AWo2[iYA] := CurI.gs.aIL;

    AWo5[iYA] := CurI.gs.DLDk;
    d0 := gs_get_d0pix(CurI.gs);
    AWo6[iYA] := d0;

    (*==========================================================*)
    (*========= 6302 =========*)

    rL := Self.AWk3[iYA];
    rR := Self.AWk4[iYA];
    rL0 := (rL + rR)/2;

    CurI.gs.Lam0 := rL0;
    CurI.gs.Cont := Self.ACnt[iYA];
    CurI.gs.DLD  := 3.31;
    CurI.gs.DLDk := 0.88;
    CurI.gs.aIL  := 0;
    CurI.gs.H    := 0;
    CurI.gs.La12 := 2;

    (* верхняя точка отрезка из 3-х точек - на 1 вверх от базовой линии *)
    if rL > 0 then JL := TruncDn (rL)+2 else JL := 0;
    if rR > 0 then JR := TruncUpp(rR)-2 else JR := 0;

    CurI.li2.ILbase := JL;
    CurI.li2.IRbase := JR;

    CurI.k3L6;
    CurI.Db6k3Loop;

    AWo3[iYA] := CurI.gs.DLD;
    AWo4[iYA] := CurI.gs.aIL;

    AWo7[iYA] := CurI.gs.DLDk;
    d0 := gs_get_d0pix(CurI.gs);
    AWo8[iYA] := d0;

  end;


end;


procedure TFITS.CalcDH;
var iYA,iX,iY0 : integer;
  iL : integer;
  JL,JR : integer;
  AX,AI : TARe;
  rL0 : real;
  rL,rR : real;
  d0 : real;
  Q_Rep : boolean;
begin
  Q_Rep := false;

  iX := Self.IXI;

  SetLength(AWo1 ,nY+1);
  SetLength(AWo2 ,nY+1);
  SetLength(AWo3 ,nY+1);
  SetLength(AWo4 ,nY+1);
  SetLength(AWo5 ,nY+1);
  SetLength(AWo6 ,nY+1);
  SetLength(AWo7 ,nY+1);
  SetLength(AWo8 ,nY+1);

  if Not Assigned(CurI) then begin
    CurI := TCurI.Create;
//  CurI.WhichLine;
    SunWorld.CurI_InitParam;
  end;

(* iYA-вый профиль Ri *)

  SetLength(AX,Self.nLam+1);

  for iL := 1 to Self.nLam do begin
    AX[iL] := iL;
  end;

  (* нам понадобятся данные из нескольких карт               *)
  (* Cont                     - массив   ACnt                *)
  (* LWb1 + LWr1, LWb2 + LWr2 - массивы  AWk1,AWk2,AWk3,AWk4 *)

//ACnt : TARe; (* уровень континуума. Не нормировано! *)

  if Not Self.ReturnSlitConts then begin
    WarnAbs('ReturnSlitConts');
    Exit;
  end;

  if Not Self.ReturnSlitLWbr then begin
    WarnAbs('Необходимо загрузить/рассчитать данные о крыльях [LW(b,r)]');
    Exit;
  end;

  CurI.gs.kRed := 0.5;
  CurI.gs.kPi  := 0;

  for iYA := 1 to nY do begin  (* цикл по точкам вдоль Y *)
    iY0 := iYA - 1;
    (* загружаем CurI *)

//  GetCol3(iYA,1,A);      (* выборка всех точек iYA-го профиля интенсивности *)

    AI := Self.GetAI0(iYA); (* RI вдоль длины волны в формате ARe *)
    CurI.AInit(AX,AI);

    CurI.m_iX := iX;
    CurI.m_iY := iY0;

{
    if (iY0 = 37) or (iY0 = 55) then Q_Rep := true
                                else Q_Rep := false;
}
    (*==========================================================*)
    (*========= 6301 =========*)

    rL := Self.AWk1[iYA];
    rR := Self.AWk2[iYA];
    rL0 := (rL + rR)/2;

    CurI.gs.Lam0 := rL0;
    CurI.gs.Cont := Self.ACnt[iYA];
    CurI.gs.DLD  := 4.15;
    CurI.gs.DLDk := 0.8;
    CurI.gs.aIL  := 0;
    CurI.gs.H    := 0;
    CurI.gs.La12 := 1;
    CurI.gs.kH   := 0.5;
    CurI.InitVals;

    (* верхняя точка отрезка из 3-х точек - на 1 вверх от базовой линии *)
    if rL > 0 then JL := TruncDn (rL)+2 else JL := 0;
    if rR > 0 then JR := TruncUpp(rR)-2 else JR := 0;

    CurI.li1.ILbase := JL;
    CurI.li1.IRbase := JR;

                    if Q_Rep then CurI.gs_Report2;
    CurI.k3L6_2;    if Q_Rep then CurI.gs_Report2;
    CurI.xDLoop;    if Q_Rep then CurI.gs_Report2;
    CurI.bH6k3Loop; if Q_Rep then CurI.gs_Report2;

    if CurI.gs.H    > 1500 then CurI.gs.H    := 1500;
    if CurI.gs.DLD  > 10   then CurI.gs.DLD  := 10;
    if CurI.gs.DLDk < 0.4  then CurI.gs.DLDk := 0.4;


    AWo1[iYA] := CurI.gs.DLD;
    AWo2[iYA] := CurI.gs.H;

    AWo5[iYA] := CurI.gs.DLDk;
    AWo6[iYA] := CurI.gs.aIL;

    (*==========================================================*)
    (*========= 6302 =========*)

    rL := Self.AWk3[iYA];
    rR := Self.AWk4[iYA];
    rL0 := (rL + rR)/2;

    CurI.gs.Lam0 := rL0;
    CurI.gs.Cont := Self.ACnt[iYA];
    CurI.gs.DLD  := 3.31;
    CurI.gs.DLDk := 0.88;
    CurI.gs.aIL  := 0;
    CurI.gs.H    := 0;
    CurI.gs.La12 := 2;
    CurI.InitVals;

    (* верхняя точка отрезка из 3-х точек - на 1 вверх от базовой линии *)
    if rL > 0 then JL := TruncDn (rL)+2 else JL := 0;
    if rR > 0 then JR := TruncUpp(rR)-2 else JR := 0;

    CurI.li2.ILbase := JL;
    CurI.li2.IRbase := JR;

                    if Q_Rep then CurI.gs_Report2;
    CurI.k3L6_2;    if Q_Rep then CurI.gs_Report2;
    CurI.xDLoop;    if Q_Rep then CurI.gs_Report2;
    CurI.bH6k3Loop; if Q_Rep then CurI.gs_Report2;
{
    CurI.k3L6_2;
    CurI.xDLoop;
    CurI.bH6k3Loop;
}

    if CurI.gs.H    > 1500 then CurI.gs.H    := 1500;
    if CurI.gs.DLD  > 10   then CurI.gs.DLD  := 10;
    if CurI.gs.DLDk < 0.4  then CurI.gs.DLDk := 0.4;


    AWo3[iYA] := CurI.gs.DLD;
    AWo4[iYA] := CurI.gs.H;

    AWo7[iYA] := CurI.gs.DLDk;
    AWo8[iYA] := CurI.gs.aIL;
  end;


end;

// Self.aCnt должен быть подготовлен!
procedure TFITS.Calc_W_Mom;
var iLi,iA,iY,iYA,nMap : integer;
  rl10,rl20,rl11,rl12,rl21,rl22,dl : real;
  sq2 : real;
  Cont : real;
  C1   : real;
  w1,w2 : real;
  mv1,mv2 : real;
  kma,kma2,kma3 : real; // к-т перевода в mA
  kB1,kB2 : real;
  mq1,mq2,mu1,mu2,ml1,ml2 : real;
  mlq1,mlq2,mlu1,mlu2     : real;

  xi1,xi2,xi0    : real;
  xip1,xip2,xip0 : real;  (* "ПИ" - углы в радианах *)
  c2x,s2x        : real;

  gm1,gm2 : real;
  bv1,bv2,bl1,bl2     : real;
  blq1,blq2,blu1,blu2 : real;

  AX,AI,AQ,AU,AV:TARe;

begin
  sq2 := sqrt(2);
  nMap := 7;
  dl := 12;
  kma := Abs(Self.rdLam) * 1000;
  kma2 := kma*kma;
  kma3 := kma2*kma;


  for iLi := 1 to 2 do
    for iA := 1 to nMap do
      SetLength(A2[iA,iLi],nY+1);

  (* определяем границы интегрирования *)

  for iY := 0 to nY-1 do begin



    iYA := iY + 1;
    Cont := Self.aCnt[iYA];
    if Cont <> 0 then C1 := 1/Cont else C1 := 1/100000;
    rl10 := Self.ALC1[iYA];
    rl20 := Self.ALC2[iYA];
    rl11 := Self.aWk1[iYA]-dl;  if rl11 < 1   then rl11 := 1;
    rl12 := Self.aWk2[iYA]+dl;  if rl12 > 112 then rl12 := 112;
    rl21 := Self.aWk3[iYA]-dl;  if rl21 < 1   then rl21 := 1;
    rl22 := Self.aWk4[iYA]+dl;  if rl22 > 112 then rl22 := 112;


    GetFITARe(iY,'IQUV',AX,AI,AQ,AU,AV);
    AReMul(AI,C1);
    AReMul(AQ,C1);
    AReMul(AU,C1);
    AReMul(AV,C1);




    w1 := EqWidth(rl11,rl12,1,AI)*kma;  (* переводим в миллиангстремы *)
    w2 := EqWidth(rl21,rl22,1,AI)*kma;

    if w1 = 0 then w1 := 150;
    if w2 = 0 then w2 := 100;


    mv1 := EqwMoment(rl11,rl12,rl10,AV)*kma2/w1;
    mv2 := EqwMoment(rl21,rl22,rl20,AV)*kma2/w2;
    bv1 := PHYS.LamToH(-mv1,6301.5,1.669);
    bv2 := PHYS.LamToH(-mv2,6302.5,2.487);

    mq1 := EqwMoment2(rl11,rl12,rl10,AQ)/w1*kma3;
    mq2 := EqwMoment2(rl21,rl22,rl20,AQ)/w2*kma3;
    mu1 := EqwMoment2(rl11,rl12,rl10,AU)/w1*kma3;
    mu2 := EqwMoment2(rl21,rl22,rl20,AU)/w2*kma3;

    xip1 := Math.arctan2(mu1,mq1)/2;
    xi1  := xip1/C_PI180;
    if xi1 < 0 then xi1 := xi1 + 180;

    xip2 := Math.arctan2(mu2,mq2)/2;
    xi2  := xip2/C_PI180;
    if xi2 < 0 then xi2 := xi2 + 180;


//  xi0  := swTy.CircMid0(xi1,xi2,180.0);  (* среднее (на круге) от Xi1,Xi2 *)
    xi0  := swTy.CircMid0Weighted(xi1,xi2,1,2,180.0);



///////////////////////////////////////////////////
    xi0  := 180 - xi0;  //   Надо развернуть  ?????
///////////////////////////////////////////////////



    xip0 := xi0*C_PI180;
    c2x  := cos(2*xip0);
    s2x  := sin(2*xip0);

    ml1 := SQRT(SQRT(mq1*mq1+mu1*mu1));
    ml2 := SQRT(SQRT(mq2*mq2+mu2*mu2));

    mlq1 :=  mq1*c2x+mu1*s2x;
    mlq2 :=  mq2*c2x+mu2*s2x;
    mlu1 := -mq1*s2x+mu1*c2x;
    mlu2 := -mq2*s2x+mu2*c2x;

    if (mlq1 >= 0) then mlq1 := sqrt(mlq1) else mlq1 := -sqrt(abs(mlq1));
    if (mlq2 >= 0) then mlq2 := sqrt(mlq2) else mlq2 := -sqrt(abs(mlq2));
    if (mlu1 >= 0) then mlu1 := sqrt(mlu1) else mlu1 := -sqrt(abs(mlu1));
    if (mlu2 >= 0) then mlu2 := sqrt(mlu2) else mlu2 := -sqrt(abs(mlu2));

    bl1  := sq2*PHYS.LamToH(ml1,6301.5,1.669);
    bl2  := sq2*PHYS.LamToH(ml2,6302.5,2.487);

    blq1 := sq2*PHYS.LamToH(mlq1,6301.5,1.669);
    blq2 := sq2*PHYS.LamToH(mlq2,6302.5,2.487);
    blu1 := sq2*PHYS.LamToH(mlu1,6301.5,1.669);
    blu2 := sq2*PHYS.LamToH(mlu2,6302.5,2.487);

    if mv1 = 0 then gm1 := 90 else gm1 := Math.arctan2(sq2*ml1,-mv1)/C_PI180;
    if mv2 = 0 then gm2 := 90 else gm2 := Math.arctan2(sq2*ml2,-mv2)/C_PI180;


    (*======================================*)

    iA := 1;
    iLi := 1; A2[iA,iLi,iYA] := w1;
    iLi := 2; A2[iA,iLi,iYA] := w2;

    iA := 2;
    iLi := 1; A2[iA,iLi,iYA] := bv1;
    iLi := 2; A2[iA,iLi,iYA] := bv2;

    iA := 3;
    iLi := 1; A2[iA,iLi,iYA] := bl1;
    iLi := 2; A2[iA,iLi,iYA] := bl2;

    iA := 4;
    iLi := 1; A2[iA,iLi,iYA] := gm1;
    iLi := 2; A2[iA,iLi,iYA] := gm2;

    iA := 5;
    iLi := 1; A2[iA,iLi,iYA] := xi1;
    iLi := 2; A2[iA,iLi,iYA] := xi2;

    iA := 6;
    iLi := 1; A2[iA,iLi,iYA] := blq1;
    iLi := 2; A2[iA,iLi,iYA] := blq2;

    iA := 7;
    iLi := 1; A2[iA,iLi,iYA] := blu1;
    iLi := 2; A2[iA,iLi,iYA] := blu2;

{
    iA := 3;
    iLi := 1; A2[iA,iLi,iYA] := mq1;
    iLi := 2; A2[iA,iLi,iYA] := mq2;

    iA := 4;
    iLi := 1; A2[iA,iLi,iYA] := mu1;
    iLi := 2; A2[iA,iLi,iYA] := mu2;

}



    (*----------------------------*)

    (* нормировки *)





  end;


end;




procedure TFITS.Calc_LIV;
var iLi,iA,iY,iYA : integer;
  i1,L1,i2,L2,i12,i22 : integer;
  Cont : real;

  mp,mm,m1,mm1,d1,m2,d2 : real;
  y1,y11,y12, L1p,L1m,L1Wp,L1Wm,L1Wb,L1Wr : real;
  y2,y21,y22, L2p,L2m,L2Wp,L2Wm,L2Wb,L2Wr : real;

begin

  for iLi := 1 to 2 do
    for iA := 1 to 4 do
      SetLength(A2[iA,iLi],nY+1);




  i1 :=  1; L1 := 52; i12 := 52;
  i2 := 59; L2 := 54; i22 := 112;

  for iY := 0 to nY-1 do begin
    iYA := iY + 1;
    Cont := Self.aCnt[iYA];
    Self.GetAIV(iY); (* заполняем aFITS.AIpV,AImV,A_I назначаем iY_cur *)

    mp  := Self.minIpV(i1,L1);
    mm  := Self.minImV(i1,L1);
    m1  := (mp+mm)/2;
    if (mp < mm) then mm1 := mp else mm1 := mm; (* mm1 := min(mp,mm) *)
    d1  := Cont - m1;

    mp  := Self.minIpV(i2,L2);
    mm  := Self.minImV(i2,L2);
    m2  := (mp+mm)/2;
    d2 := Cont - m2;

    y11 := m1 + 0.4*d1;
    y12 := m1 + 0.6*d1;
    y1  := (y11 + y12)/2;

    L1p := swARe.SlicedCOG(i1,i12,y11,y12,Self.AIpV,L1Wp);
    L1m := swARe.SlicedCOG(i1,i12,y11,y12,Self.AImV,L1Wm);

    iLi := 1;

    iA := 1; A2[iA,iLi,iYA] := (L1p+L1m)/2;
    iA := 2; A2[iA,iLi,iYA] := (L1p-L1m);
    if L1p < L1m then begin L1Wb := L1Wp; L1Wr := L1Wm end
                 else begin L1Wb := L1Wm; L1Wr := L1Wp end;
    iA := 3; A2[iA,iLi,iYA] := L1Wb;
    iA := 4; A2[iA,iLi,iYA] := L1Wr;

  (*=================================*)

    y21 := m2 + 0.4*d2;
    y22 := m2 + 0.6*d2;
    y2  := (y11 + y12)/2;

    L2p := swARe.SlicedCOG(i2,i22,y21,y22,Self.AIpV,L2Wp);
    L2m := swARe.SlicedCOG(i2,i22,y21,y22,Self.AImV,L2Wm);

    iLi := 2;

    iA := 1; A2[iA,iLi,iYA] := (L2p+L2m)/2;
    iA := 2; A2[iA,iLi,iYA] := (L2p-L2m);
    if L1p < L1m then begin L2Wb := L2Wp; L2Wr := L2Wm end
                 else begin L2Wb := L2Wm; L2Wr := L2Wp end;
    iA := 3; A2[iA,iLi,iYA] := L2Wb;
    iA := 4; A2[iA,iLi,iYA] := L2Wr;

  end;

end;




procedure TFITS.CalcIVcog(VW1,VW2 : real);
var iLi,iA,iY,iYA,iLev : integer;
  disp : real;
  L00  : real;
  dL01 : real;
  dL02 : real;
  kv1  : real;
  kv2  : real;
  k1   : real;
  k2   : real;

  Cont : real;

  mp  : real;
  mm  : real;
  m1  : real;
  mm1 : real;
  d1  : real;
  dpm1: real;
  m2  : real;
  mm2 : real;
  d2  : real;
  dpm2: real;
  dpm : real;

  y11 : real;
  y12 : real;
  y1  : real;
  L1p,L1m :  real;
  sW : real; (* ширина сегмента [текущей] трапеции, для к-рой считаем COG *)

  B1  : real;
  lam1: real;
  V1  : real;

  y21 : real;
  y22 : real;
  y2  : real;
  L2p,L2m :  real;
  B2  : real;
  lam2: real;
  V2  : real;

  i1,L1,i2,L2,i12,i22 : integer;


begin

  if (VW1=0) and (VW2=0) then begin
    WarnAbs('FITS.CalcIVcog=ERR: В swFITS файле не заданы константы '+#13#10+
            'которые определяют средние скорости для 6301 и 6302');
    Exit;
  end;


  for iLi := 1 to 2 do
    for iA := 1 to 18 do
      SetLength(A2[iA,iLi],nY+1);
  SetLength(A2[19,1],nY+1);


  disp := 21.549;  (* mA/pix *)
  L00  := 56.5;
  dL01 :=  0.5792;
  dL02 := -0.4132;
  kv1  := 47.57477079;
  kv2  := 47.5672796;


  k1 := 2*6301.5*6301.5*4.6686E-10*1.669/disp; (* dLH в mA *)
  k2 := 2*6302.5*6302.5*4.6686E-10*2.487/disp; (* Lam в A  *)

  i1 :=  1; L1 := 52; i12 := 52;
  i2 := 59; L2 := 54; i22 := 112;



  for iY := 0 to nY-1 do begin


//  WarnAbs(NSt(iY,3));



    iYA := iY + 1;
    Cont  := Self.ContiY(iY);
    Self.GetAIV(iY); (* заполняем aFITS.AIpV,AImV,A_I назначаем iY_cur *)

    mp  := Self.minIpV(1,52);
    mm  := Self.minImV(1,52);
    m1  := (mp+mm)/2;
    if (mp < mm) then mm1 := mp else mm1 := mm; (* mm1 := min(mp,mm) *)
    d1  := Cont - m1;


    dpm1 := -(mp-mm)/d1; (* степень отклонения от симметрии для 6301 *)


    mp  := Self.minIpV(59,54);
    mm  := Self.minImV(59,54);
    m2  := (mp+mm)/2;
    d2 := Cont - m2;
    dpm2 := -(mp-mm)/d2; (* степень отклонения от симметрии для 6302 *)

    dpm := 100*(dpm1+dpm2)/2; (* средняя степень отклонения от симметрии % *)
    A2[19,1,iYA] := dpm;

    for iLev := 1 to 9 do begin
{
      y11 := m1 + (10-(iLev+1))*d1/10;
      y12 := m1 + (10-(iLev-1))*d1/10;
      y1  := (y11 + y12)/2;
      if iLev = 1 then y11 := mm1;
}

      y11 := m1 + (iLev-1)*d1/10;    (* 0 ..  8 *)
      y12 := m1 + (iLev+1)*d1/10;    (* 2 .. 10 *)
      y1  := (y11 + y12)/2;
      if iLev = 1 then y11 := mm1;

//    Self.SlicedCOGIV1(y11,y12,L1p,L1m);
      L1p := swARe.SlicedCOG(i1,i12,y11,y12,Self.AIpV,sW);
      L1m := swARe.SlicedCOG(i1,i12,y11,y12,Self.AImV,sW);

      B1 := (L1p - L1m)/k1;
      lam1 := ((L1p + L1m)/2 - L00)*disp/1000 + dL01;
      V1 := lam1*kv1 - VW1;
      iLi := 1;
      A2[iLev  ,iLi,iYA] := B1;
      A2[iLev+9,iLi,iYA] := V1;

{
      y21 := m2 + (10-(iLev+1))*d2/10;
      y22 := m2 + (10-(iLev-1))*d2/10;
      y2  := (y21 + y22)/2;
      if iLev = 1 then y21 := mm2;
}
      y21 := m2 + (iLev-1)*d2/10;    (* 0 ..  8 *)
      y22 := m2 + (iLev+1)*d2/10;    (* 2 .. 10 *)
      y2  := (y21 + y22)/2;
      if iLev = 1 then y21 := mm2;

//    Self.SlicedCOGIV2(y21,y22,L2p,L2m);
      L2p := swARe.SlicedCOG(i2,i22,y21,y22,Self.AIpV,sW);
      L2m := swARe.SlicedCOG(i2,i22,y21,y22,Self.AImV,sW);

      B2 := (L2p - L2m)/k2;
      lam2 := ((L2p + L2m)/2 - L00)*disp/1000 + dL02;
      V2 := lam2*kv2 - VW2;
      iLi := 2;
      A2[iLev  ,iLi,iYA] := B2;
      A2[iLev+9,iLi,iYA] := V2;
    end; (* for iLev *)

  end; (* for iY *)


end;


procedure TFITS.CalcIVcog05(VW1,VW2 : real);
var iLi,iA,iY,iYA,iLev : integer;
  disp : real;
  L00  : real;
  dL01 : real;
  dL02 : real;
  kv1  : real;
  kv2  : real;
  k1   : real;
  k2   : real;

  Cont : real;

//  mp  : real;
//  mm  : real;
  mp1,mm1,mp2,mm2 : real;

{
  m1  : real;
  mm1 : real;
  d1  : real;
  dpm1: real;
  m2  : real;
  mm2 : real;
  d2  : real;
  dpm2: real;
  dpm : real;
}

  y11 : real;
  y12 : real;
//  y1  : real;
  L1p,L1m :  real;
  sW : real; (* ширина сегмента [текущей] трапеции, для к-рой считаем COG *)

  B1  : real;
  lam1: real;
  V1  : real;

  y21 : real;
  y22 : real;
//  y2  : real;
  L2p,L2m :  real;
  B2  : real;
  lam2: real;
  V2  : real;

  i1,L1,i2,L2,i12,i22 : integer;


begin

  if (VW1=0) and (VW2=0) then begin
    WarnAbs('FITS.CalcIVcog05=ERR: В swFITS файле не заданы константы '+#13#10+
            '$VW1 и $VW2, которые определяют средние скорости для 6301 и 6302');
    Exit;
  end;


  for iLi := 1 to 2 do
    for iA := 1 to 4 do
      SetLength(A2[iA,iLi],nY+1);
//SetLength(A2[19,1],nY+1);


  disp := 21.549;  (* mA/pix *)
  L00  := 56.5;
  dL01 :=  0.5792;
  dL02 := -0.4132;
  kv1  := 47.57477079;
  kv2  := 47.5672796;

  k1 := 2*6301.5*6301.5*4.6686E-10*1.669/disp; (* dLH в mA *)
  k2 := 2*6302.5*6302.5*4.6686E-10*2.487/disp; (* Lam в A  *)

  i1 :=  1; L1 := 52; i12 := 52;   (* начало / длина / конец линии 1 *)
  i2 := 59; L2 := 54; i22 := 112;  (* начало / длина / конец линии 2 *)

  for iY := 0 to nY-1 do begin
    iYA := iY + 1;
    Cont  := Self.ContiY(iY);
    Self.GetAIV(iY); (* заполняем aFITS.AIpV,AImV, назначаем iY_cur *)

    mp1 := Self.minIpV(1,52);
    mm1 := Self.minImV(1,52);

    mp2 := Self.minIpV(59,54);
    mm2 := Self.minImV(59,54);

    for iLev := 1 to 2 do begin

      (* 6301 *)

      y11 := mm1;
      case iLev of
      1 : y12 := mm1 + 6*(Cont-mm1)/100;
      2 : y12 := mm1 + 3*(Cont-mm1)/100;
      end; (* case *)
      L1m := swARe.SlicedCOG(i1,i12,y11,y12,Self.AImV,sW);

      y11 := mp1;
      case iLev of
      1 : y12 := mp1 + 6*(Cont-mp1)/100;
      2 : y12 := mp1 + 3*(Cont-mp1)/100;
      end; (* case *)
      L1p := swARe.SlicedCOG(i1,i12,y11,y12,Self.AIpV,sW);

      (* 6302 *)

      y21 := mm2;
      case iLev of
      1 : y22 := mm2 + 6*(Cont-mm2)/100;
      2 : y22 := mm2 + 3*(Cont-mm2)/100;
      end; (* case *)
      L2m := swARe.SlicedCOG(i2,i22,y21,y22,Self.AImV,sW);

      y21 := mp2;
      case iLev of
      1 : y22 := mp2 + 6*(Cont-mp2)/100;
      2 : y22 := mp2 + 3*(Cont-mp2)/100;
      end; (* case *)
      L2p := swARe.SlicedCOG(i2,i22,y21,y22,Self.AIpV,sW);


      (*========================================*)

      B1 := (L1p - L1m)/k1;
      lam1 := ((L1p + L1m)/2 - L00)*disp/1000 + dL01;
      V1 := lam1*kv1 - VW1;
      iLi := 1;
      A2[iLev  ,iLi,iYA] := B1;
      A2[iLev+2,iLi,iYA] := V1;

      B2 := (L2p - L2m)/k2;
      lam2 := ((L2p + L2m)/2 - L00)*disp/1000 + dL02;
      V2 := lam2*kv2 - VW2;
      iLi := 2;
      A2[iLev  ,iLi,iYA] := B2;
      A2[iLev+2,iLi,iYA] := V2;
    end; (* for iLev *)

  end; (* for iY *)


end;






procedure TFITS.CalcLW(var QErr:boolean;FOCB0:TObject);
var iYA : integer; rd1,rd2 : real;

  A : TAIn;
  ic : integer;

  li1,li2,ri1,ri2 : integer;

  r,RL,RR : real;
  ll,lr : real;
  il,ir : integer;

  ic1,ic2,id01,id02 : integer;

  iA,iLi : integer;

  QMinPoint : boolean;

begin
  QErr := false;

  for iLi := 1 to 2 do
//  for iA := 1 to 5 do
    for iA := 1 to 3 do
      SetLength(A2[iA,iLi],nY+1);

{
  SetLength(ALC1 ,nY+1);  (* полож.вершины линии 6301 в пикселах *)
  SetLength(ALC51,nY+1);
  SetLength(ALC2 ,nY+1);  (* центральная глубина в пикселах *)
  SetLength(ALC52,nY+1);
  SetLength(AWI1 ,nY+1);
  SetLength(AWI2 ,nY+1);
}

  QMinPoint := true;


  (* проверим существование FO 'CB0' *)


  (* если мы находимся в "тени" *)
  (* то точку ic1, ic2 берём как среднее значение длины волны для линии *)



  rd1 := 0; rd2 := 0;
  for iYA := 1 to nY do begin
    GetCol3(iYA,1,A);      (* выборка всех точек iYA-го профиля интенсивности *)

    if QMinPoint then begin
      AInMinPoint(A,10,50,ic1,id01); (* точка с мин.глубиной 6301 *)
      AInMinPoint(A,57,94,ic2,id02); (* -''- 6302 - может быть сигма-комп!!! *)
    end;



    ic := ic1;          (* = 6301 *)


    LeWi(ic,A,li1,li2); (* ищем границы монотонного диапазона (=крыла) слева *)
    RiWi(ic,A,ri1,ri2);

    RL := (A[li1]+A[li2])/2;
    RR := (A[ri1]+A[ri2])/2;

    r := (RL+RR)/2;

    ll := ipolLeWi(li1,li2,il,A,r);
    lr := ipolRiWi(ri1,ri2,ir,A,r);

    if abs(ll - li2) < 1E-5 then begin
      WarnAbs('CalcLW iYA='+ISt(iYA)+
              ' Left: ic='+ISt(ic)+' ->i2='+ISt(li2)+' ,i1='+ISt(li1)+
              ' A[i2]='+ISt(A[li2])+' Lvl='+FSt(r,1)+
              ' A[i1]='+ISt(A[li1])
              );
      QErr := true;
    end;
    if abs(lr - ri1) < 1E-5 then begin
      WarnAbs('CalcLW iYA='+ISt(iYA)+
              ' Right: ic='+ISt(ic)+' ->i1='+ISt(ri1)+' ,i2='+ISt(ri2)+
              ' A[i1]='+ISt(A[ri1])+' Lvl='+FSt(r,1)+
              ' A[i2]='+ISt(A[ri2])
              );
      QErr := true;
    end;

{
    ALC1 [iYA] := ll;
    ALC51[iYA] := lr;
    AWI1 [iYA] := r;
}
    A2[1,1,iYA] := ll;
    A2[2,1,iYA] := lr;
    A2[3,1,iYA] := r;

{
    A2[4,1,iYA] := li1;
    A2[5,1,iYA] := ri2;
}

    ic := ic2;
    LeWi(ic,A,li1,li2);
    RiWi(ic,A,ri1,ri2);

    RL := (A[li1]+A[li2])/2;
    RR := (A[ri1]+A[ri2])/2;

    r := (RL+RR)/2;

    ll := ipolLeWi(li1,li2,il,A,r);
    lr := ipolRiWi(ri1,ri2,ir,A,r);


    if abs(ll - li2) < 1E-5 then begin
      WarnAbs('CalcLW iYA='+ISt(iYA)+
              ' Left: ic='+ISt(ic)+' ->i2='+ISt(li2)+' ,i1='+ISt(li1)+
              ' A[i2]='+ISt(A[li2])+' Lvl='+FSt(r,1)+
              ' A[i1]='+ISt(A[li1])
              );
      QErr := true;
    end;
    if abs(lr - ri1) < 1E-5 then begin
      WarnAbs('CalcLW iYA='+ISt(iYA)+
              ' Right: ic='+ISt(ic)+' ->i1='+ISt(ri1)+' ,i2='+ISt(ri2)+
              ' A[i1]='+ISt(A[ri1])+' Lvl='+FSt(r,1)+
              ' A[i2]='+ISt(A[ri2])
              );
      QErr := true;
    end;

{
    ALC2 [iYA] := ll;
    ALC52[iYA] := lr;
    AWI2 [iYA] := r;
}

    A2[1,2,iYA] := ll;
    A2[2,2,iYA] := lr;
    A2[3,2,iYA] := r;

{
    A2[4,2,iYA] := li1;
    A2[5,2,iYA] := ri2;
}

  end;

end;



procedure TFITS.CalcCxx(d:real);
var iYA : integer; id01,id02,ic1,ic2 : integer; rd1,rd2 : real;
  rC501,rC502,r : real; I : integer;
  A : TAIn; Q : boolean;
begin
  SetLength(ALC51,nY+1);
  SetLength(ALC52,nY+1);

  rd1 := 0; rd2 := 0;

  Q := Self.ReturnSlitD0 and Self.ReturnSlitLd0;

  if Q then begin
    for iYA := 1 to nY do begin
      GetCol3(iYA,1,A);      (* выборка всех точек iY-го профиля интенсивности *)
      GetCd012_(A,iYA,ACnt[iYA],d,rC501,rC502,AI_d01,AI_d02,AILd01,AILd02);
      rd1 := rd1 + AI_d01[iYA];
      rd2 := rd2 + AI_d02[iYA];
      ALC51[iYA]  := rC501;
      ALC52[iYA]  := rC502;
    end;
  end
  else begin
    SetLength(AILd01,nY+1);  (* полож.вершины линии 6301 в пикселах *)
    SetLength(AILd02,nY+1);
    SetLength(AI_d01,nY+1);  (* центральная глубина в пикселах *)
    SetLength(AI_d02,nY+1);
    for iYA := 1 to nY do begin
      GetCol3(iYA,1,A);    (* выборка всех точек iYA-го профиля интенсивности *)
      GetCd012(A,ACnt[iYA],d,rC501,rC502,ic1,ic2,id01,id02);
      rd1 := rd1 + id01;
      rd2 := rd2 + id02;
      ALC51[iYA]  := rC501;
      ALC52[iYA]  := rC502;
      AILd01[iYA] := ic1;
      AILd02[iYA] := ic2;
      AI_d01[iYA] := id01;
      AI_d02[iYA] := id02;
    end;
  end;

  if rd2 < rd1 then begin (* rd2 - это линия 6301? *)
    for iYA := 1 to nY do begin   (* тогда надо переставить местами *)
      r := ALC51[iYA];  ALC51[iYA]  := ALC52[iYA];  ALC52[iYA]  := r;
      I := AILd01[iYA]; AILd01[iYA] := AILd02[iYA]; AILd02[iYA] := I;
      I := AI_d01[iYA]; AI_d01[iYA] := AI_d02[iYA]; AI_d02[iYA] := I;
    end;
  end;
end;





procedure TFITS.CalcCGravs0;
var // j0,j1,j2,j3 : integer;
  l1,l2 : real;
  iYA : integer;
  AIE : TAIn; AEE : TARe;
begin
  if Not SetBit.IsBit(KStep,1) then begin
    WarnAbs('TFITS.CalcCGravs Err: Header Not Loaded Yet!');
    Exit;
  end;
  Time_routine('FITS.CalcCGravs0',true);

{
  (*----------------------------------------------------------------*)
  (* найти полож-я центра тяжести в пикселах для инт-ти 6301 и 6302 *)

  (* первый проход - делим спектральный участок пополам               *)
  (* центры тяжести средние по целому FITS - для nY положений на щели *)
  CalcCGravs1(1,56,57,112,l1,l2);

  (* второй проход - // делим спект.участок по точке, найденной в 1-м проходе
                     берём примерно по 350 mA по сторонам от каждой
                     предварительной точки.
                     Если взять больше - попадут бленды в тени пятна
   *)

  j0 := round(l1) - 16; j1 := j0 + 32;
  j2 := round(l2) - 16; j3 := j2 + 32;
  CalcCGravs2(J0,j1,j2,J3);
  (* Будет ли работать для отрицательной дисперсии ???? *)
}


  for iYA := 1 to nY do begin
    CalcCGrav5(iYA,l1,l2,AIE,AEE);
    if Self.ANE[iYA] <> 5 then begin
//    CalcCGrav(iYA,l1,l2); (* положение центров тяжести (без континуума) *)
    end
    else begin
      ALC1[iYA] := l1;
      ALC2[iYA] := l2;
    end;
  end;
  Time_routine('FITS.CalcCGravs0',false);

end; (* TFITS.CalcCGravs0 *)





(* включает в себя CalcCGrav и CalcCGrav5 *)
procedure TFITS.CalcCGravs;
var // j0,j1,j2,j3 : integer;
  l1,l2 : real;
  iYA : integer;
  AIE : TAIn; AEE : TARe;
begin
  Time_routine('FITS.CalcCGravs',true);
  if Not SetBit.IsBit(KStep,1) then begin
    WarnAbs('TFITS.CalcCGravs Err: Header Not Loaded Yet!');
    Time_routine('FITS.CalcCGravs',false);
    Exit;
  end;

{
  (*----------------------------------------------------------------*)
  (* найти полож-я центра тяжести в пикселах для инт-ти 6301 и 6302 *)

  (* первый проход - делим спектральный участок пополам               *)
  (* центры тяжести средние по целому FITS - для nY положений на щели *)
  CalcCGravs1(1,56,57,112,l1,l2);

  (* второй проход - // делим спект.участок по точке, найденной в 1-м проходе
                     берём примерно по 350 mA по сторонам от каждой
                     предварительной точки.
                     Если взять больше - попадут бленды в тени пятна
   *)

  j0 := round(l1) - 16; j1 := j0 + 32;
  j2 := round(l2) - 16; j3 := j2 + 32;
  CalcCGravs2(J0,j1,j2,J3);
  (* Будет ли работать для отрицательной дисперсии ???? *)
}
{
  SetLength(ALC1,nY+1);
  SetLength(ALC2,nY+1);
  SetLength(ANE,nY+1);
}
  for iYA := 1 to nY do begin
    CalcCGrav5(iYA,l1,l2,AIE,AEE);
    if Self.ANE[iYA] <> 5 then begin
      CalcCGrav(iYA,l1,l2); (* положение центров тяжести (без континуума) *)
    end;

    ALC1[iYA] := l1;
    ALC2[iYA] := l2;
  end;
  Time_routine('FITS.CalcCGravs',false);

end; (* TFITS.CalcCGravs *)


(* включает в себя CalcCGrav и CalcCGrav5 *)
procedure TFITS.CalcCGravs_01(var AL1,AL2:TARe);
var // j0,j1,j2,j3 : integer;
  l1,l2 : real;
  iYA : integer;
  AIE : TAIn; AEE : TARe;
begin
  if Not SetBit.IsBit(KStep,1) then begin
    WarnAbs('TFITS.CalcCGravs Err: Header Not Loaded Yet!');
    Time_routine('FITS.CalcCGravs',false);
    Exit;
  end;

  for iYA := 1 to nY do begin
    CalcCGrav5(iYA,l1,l2,AIE,AEE);(* + даёт число экстремумов инт-ти ANE[iY]*)
    if Self.ANE[iYA] <> 5 then begin (* профиль "ненормальный" *)
      CalcCGrav(iYA,l1,l2); (* положение центров тяжести (без континуума) *)
    end;

    AL1[iYA] := l1;
    AL2[iYA] := l2;
  end;
end; (* TFITS.CalcCGravs_01 *)




(* включает в себя CalcCGrav, работает для точек в к-рых число вершин <> 5 *)
procedure TFITS.CalcCGravs1;
var l1,l2 : real; iYA : integer;
begin
  Time_routine('FITS.CalcCGravs1',true);
  for iYA := 1 to nY do begin
    if Self.ANE[iYA] <> 5 then begin
      CalcCGrav(iYA,l1,l2); (* положение центров тяжести (без континуума) *)
      ALC1[iYA] := l1;
      ALC2[iYA] := l2;
    end;
  end;
  Time_routine('FITS.CalcCGravs1',false);
end; (* TFITS.CalcCGravs *)




(*-------------------------------------------------------*)
(* Вычисление центров тяжести 6301 и 6302                *)
(* для единичной точки на щели iY                        *)
(*   требуются:                                          *)
(*   сырые данные aData                                  *)
(*   дисперсия rdLam                                     *)
(*   "размах" длин волн от центров линий dl6301 и dl6302 *)
(*                                                       *)
(* Внутри процедуры - итерации до момента, пока новое    *)
(*   значение не будет близко к предыдущему ( < 1/20)    *)
(*                                                       *)
(*                                                       *)



procedure TFITS.CalcCGrav(iYA:integer;var l1,l2:real);
var j11,j12,j21,j22 : real; A : TAIn; AA : TARe;
    i11,i12,i21,i22 : integer;
//  ContIY : real;
  dl1,dl2 : real;
  l10,l20 : real;

  (* массивы положений центров *)
  AL1 : array [1..15] of real;
  AL2 : array [1..15] of real;


  AK1 : array [1..15] of real;
  AK2 : array [1..15] of real;
  i,k,k1 : integer;
  sl1,sl2 : real;
  QDone : boolean;
  QDone1: boolean;
  QDone2: boolean;
  QWarn : boolean;
  dPix,k_dPix : real;

  kRep : integer; (* текущий индекс рекурсии нахождения центров *)

  S : string;

  AI : TAIn;
  AE : TARe;

  dPix1,dPix2 : real;

  rMin,rMax,DeltaY : real;

  sErr : string;

begin
  Time_routine('FITS.CalcCGrav',true);
  (*----------------------------------------------------------------*)
  (* найти полож-я центра тяжести в пикселах для инт-ти 6301 и 6302 *)

  (* "размах" профилей от их центров (обычно по rdLam=350 mA) *)
  dl1 := Abs(TLFITS(Owner).dl6301/1000/Self.rdLam);
  dl2 := Abs(TLFITS(Owner).dl6302/1000/Self.rdLam);


  GetCol3(iYA,1,A);        (* профиль интенсивности -> A:TAIn *)
  AA := swARe.CopyARe(A); (* TAIn -> TARe *)

  Extremums(AA,1,112,AI,AE); (* I-индексы,E-значения эксиремумов *)
{
  WarnAbs('Экстремумы ВЕСЬ I ПРОФИЛЬ до редукции:'+#13#10+
           AReSt(AE,4)
           +#13#10+
           swStr.AInSt(AI)
           );
}

  (* изучим "перепад высот на кривой *)
  AReMinMax(AE,rMin,rMax);
  DeltaY := rMax - rMin;

  (* исключим мелкие пики из описания массива экстремумов *)
  ExtremReduce(AE,AI,DeltaY/10);


////// РЕЖИМ ОТЛАДКИ:

  if TLFITS(Owner).QDebug then begin
    sErr := ('---CalcCGrav---'+#13#10+
           'iX='+ISt(IXI)+' iYA='+ISt(iYA)+
           ' Экстремумы после редукции ВЕСЬ I ПРОФИЛЬ:'+#13#10+
           AReSt(AE,4)
           +#13#10+
           swStr.AInSt(AI)
           );
    TLFITS(Self.Owner).SLOut.Add(SErr);
  end;

/////////////////////


  (*----------------------------------------------------------------*)
  (* первый проход - делим спектральный участок пополам             *)


  if (rdLam > 0) then begin i11 := 1; i12 := 56; i21 := 57; i22 := 112 end
                 else begin i21 := 1; i22 := 56; i11 := 57; i12 := 112 end;


//SetLength(AA,nLam+1);
//for i := 0 to nLam do AA[i] := A[i];



  l10 := swARe.LineCenter0_IR(i11,i12,A); (* из массива остат.инт-тей! *)
  l20 := swARe.LineCenter0_IR(i21,i22,A);

  AL1[1] := l10;
  AL2[1] := l20;


  (*-------------------------------------------------------------*)
  (* второй проход - отступаем по ~ 350mA от найденных центров   *)
  (*    в каждую сторону                                         *)

  QWarn := true;

  QDone1 := false;
  QDone2 := false;
  QDone  := QDone1 and QDone2;
  k_dPix := 0.05;  (* =0.05*21.5 около 1 mA = критерий разброса приближений *)
  kRep   := 1;

  repeat

    AK1[kRep] := l10;     (* AK - 15 "версий" центра *)
    AK2[kRep] := l20;


    inc(kRep);

    j11 := l10 - dl1; j12 := l10 + dl1;  (* крайние точки куска профиля *)
    j21 := l20 - dl2; j22 := l20 + dl2;

    if (j11 < 1) or (j21 < 1) or (j12 >= nLam) or (j22 >= nLam) then begin
      sErr := ('CalcCGrav-jjErr:(iYA='+ISt(iYA)+' IXI='+ISt(IXI)+
      ') l1='+EFSt0(l1,6)+' l2='+EFSt0(l2,6)+
      ' j11='+EFSt0(j11,6)+' j12='+EFSt0(j12,6)+
      ' j21='+EFSt0(j21,6)+' j22='+EFSt0(j22,6));
      TLFITS(Self.Owner).SLOut.Add(SErr);

      (* корректируем значения *)
      if (j11 < 1)    then J11 := 1;
      if (j21 < 1)    then J21 := 1;
      if (j12 > nLam) then J12 := nLam;
      if (j22 > nLam) then J22 := nLam;

    end;

    (* второй проход выполняется обязательно kRep = 2 *)

    if Not QDone1 then begin
      l1 := swARe.LineCenter_RI(j11,j12,AA);
      if l1 = 0 then l1 := l10+2*k_dPix;
      AL1[kRep] := l1;
      dPix1 := Abs(l1-l10);
      if dPix1 < k_dPix then QDone1 := true;

      if Not QDone1 then begin
        if kRep = 2 then begin
          l10 := l1;
        end else
        if kRep = 3 then begin
          l10 := (l1+l10)/2;
        end else
        if kRep > 3 then
        begin
          (*-------------------------*)
          if (dPix > 3) then begin   (* смещение больше, чем на 3*21=63 mA *)
            if kRep > 6 then begin     (* поле шестой итерации *)

              (*-----------------------------------*)
              (*         сообщить о проблеме       *)
              (*-----------------------------------*)
              S := #13#10;
              for k := 1 to kRep do begin
                S := S + ISt(k)+' '+
                         EFSt0(AL1[k],6)+' '+EFSt0(AL2[k],6)+' // '+
                         EFSt0(AK1[k],6)+' '+EFSt0(AK2[k],6)+#13#10;
              end;

              sErr:=('FITS.CalcCGrav(iYA='+ISt(iYA)+' IXI='+ISt(IXI)+
                    ') Lam6302 пошёл в разнос:'+#13#10+
              'kRep='+ISt(kRep)+' dPix='+EFSt0(dPix,4)+
              ' l10='+EFSt(l10,6)+' => l1='+EFSt0(l1,6)+
              ' l20='+EFSt(l20,6)+' => l2='+EFSt0(l2,6)
              +S
              );
              WarnAbs(sErr);
//            TLFITS(Self.Owner).SLOut.Add(SErr);
              (*-----------------------------------*)

            end; (* kRep > 6 *)
          end; (* смещение центтра более, чем на 3 точки *)
          (*-------------------------*)


          if (AL1[kRep]-AL1[kRep-1])*(AL1[kRep-1]-AL1[kRep-2]) > 0
          then begin
           l10 := (AL1[kRep] + l1)/2;
          end
          else begin
            k1 := 4; if k1 < kRep - 5 then k1 := kRep - 5;
            sl1 := 0;
            for k := k1 to kRep do sl1 := sl1 + AL1[k];
            sl1 := sl1/(kRep-k1+1);
            if kRep > 12 then l10 := (48*sl1 + l1)/49 else
            if kRep > 8  then l10 := ( 6*sl1 + l1)/7
                         else l10 := ( 2*sl1 + l1)/3;
          end;

          if (kRep > 14) then begin
            if QWarn then begin
              S := #13#10;
              for k := 1 to kRep do begin
                S := S + ISt(k)+' '+EFSt0(AL1[k],6)+' '+EFSt0(AL2[k],6)+
                ' // '+EFSt0(AK1[k],6)+' '+EFSt0(AK2[k],6)+
                #13#10;
              end;
              sErr := ('FITS.CalcCGrav(iYA='+ISt(iYA)+' IXI='+ISt(IXI)+
                    ') Lam6301 походу мы зациклились:'+#13#10+
              'kRep='+ISt(kRep)+' dPix='+EFSt0(dPix,4)+
              ' l10='+EFSt(l10,6)+' => l1='+EFSt0(l1,6)+
              ' l20='+EFSt(l20,6)+' => l2='+EFSt0(l2,6)
              +S);
              TLFITS(Self.Owner).SLOut.Add(SErr);
            end;
            k1 := kRep - 5;
            sl1 := 0;
            for k := k1 to kRep do sl1 := sl1 + AL1[k];
            l1 := sl1/(kRep-k1+1); (* среднее значение версий центра *)
            QDone1 := true;
          end; (* if KRep > 14 *)


        end; (* if KRep > 3 *)
      end; (* if Not QDone1 второй раз *)
    end; (* if Not QDone1 *)

    if Not QDone2 then begin
      l2 := swARe.LineCenter_RI(j21,j22,AA);
      if l2 = 0 then l2 := l20+2*k_dPix;
      AL2[kRep] := l2;
      dPix2 := Abs(l2-l20);
      if dPix2 < k_dPix then QDone2 := true;

      if Not QDone2 then begin
        if kRep = 2 then begin
          l20 := l2;
        end else
        if kRep = 3 then begin
          l20 := (l2+l20)/2;
        end else
        if kRep > 3 then
        begin
          (*-------------------------*)
          if (dPix > 3) then begin   (* смещение больше, чем на 3*21=63 mA *)
            if kRep > 6 then begin     (* поле шестой итерации *)
              S := #13#10;
              for k := 1 to kRep do begin
                S := S + ISt(k)+' '+
                         EFSt0(AL1[k],6)+' '+EFSt0(AL2[k],6)+' // '+
                         EFSt0(AK1[k],6)+' '+EFSt0(AK2[k],6)+#13#10;
              end;

              sErr := ('FITS.CalcCGrav(iYA='+ISt(iYA)+' IXI='+ISt(IXI)+
                    ') Lam6301 пошёл в разнос:'+#13#10+
              'kRep='+ISt(kRep)+' dPix='+EFSt0(dPix,4)+
              ' l10='+EFSt(l10,6)+' => l1='+EFSt0(l1,6)+
              ' l20='+EFSt(l20,6)+' => l2='+EFSt0(l2,6)
              +S
              );
              WarnAbs(sErr);
//            TLFITS(Self.Owner).SLOut.Add(SErr);
            end;
          end;
          (*-------------------------*)
          if (AL2[kRep]-AL2[kRep-1])*(AL2[kRep-1]-AL2[kRep-2]) > 0 then begin
           l20 := (AL2[kRep] + l2)/2;
          end
          else begin
            k1 := 4; if k1 < kRep - 5 then k1 := kRep - 5;
            sl2 := 0;
            for k := k1 to kRep do sl2 := sl2 + AL2[k];
            sl2 := sl2/(kRep-k1+1);
            if kRep > 12 then l20 := (48*sl2 + l2)/49 else
            if kRep > 8  then l20 := (6*sl2  + l2)/7
                         else l20 := (2*sl2  + l2)/3;
          end;

          if (kRep > 14) then begin
            if QWarn then begin
              S := #13#10;
              for k := 1 to kRep do begin
                S := S + ISt(k)+' '+EFSt0(AL1[k],6)+' '+EFSt0(AL2[k],6)+
                ' // '+EFSt0(AK1[k],6)+' '+EFSt0(AK2[k],6)+
                #13#10;
              end;
              sErr := ('FITS.CalcCGrav(iYA='+ISt(iYA)+' IXI='+ISt(IXI)+
                    ') Lam6302 походу мы зациклились:'+#13#10+
              'kRep='+ISt(kRep)+' dPix='+EFSt0(dPix,4)+
              ' l10='+EFSt(l10,6)+' => l1='+EFSt0(l1,6)+
              ' l20='+EFSt(l20,6)+' => l2='+EFSt0(l2,6)
              +S);
              TLFITS(Self.Owner).SLOut.Add(SErr);
            end;
            k1 := kRep - 5;
            sl2 := 0;
            for k := k1 to kRep do sl2 := sl2 + AL2[k]; l2 := sl2/(kRep-k1+1);
            QDone2 := true;
          end; (* if KRep > 14 *)
        end; (* if KRep > 3 *)
      end; (* if Not QDone2 второй раз *)
    end; (* if Not QDone2 *)

    QDone  := QDone1 and QDone2;

{
    ##

    Из данных "щели" выяснить CONT невозмущенной фотосферы.
    Если текущий CONT < 25 % выполнить поиск центра для третьей линии.
}
  until QDone;


  Finalize(A);
  Finalize(AA);
  Time_routine('FITS.CalcCGrav',false);
end; (* TFITS.CalcCGrav *)








(*-------------------------------------------------------*)
(* Вычисление центров тяжести 6301 и 6302                *)
(* для единичной точки на щели iY                        *)
(* в случае, когда "изгибов" на кривой I много           *)
(*  ---------------------------------------------------- *)
(*   требуются:                                          *)
(*   сырые данные aData                                  *)
(*   дисперсия rdLam                                     *)
(*   "размах" длин волн от центров линий dl6301 и dl6302 *)

{
procedure TFITS.CalcCGravN(iY:integer;var l1,l2:real);
var j11,j12,j21,j22 : real; A : TAIn; AA : TARe;
    i11,i12,i21,i22 : integer;
//  ContIY : real;
  dl1,dl2 : real;
  l10,l20 : real;
  AL1 : array [1..15] of real;
  AL2 : array [1..15] of real;
  AK1 : array [1..15] of real;
  AK2 : array [1..15] of real;
  i,k,k1 : integer;
  sl1,sl2 : real;
  QDone : boolean;
  QDone1: boolean;
  QDone2: boolean;
  QWarn : boolean;
  dPix,k_dPix : real;
  kRep : integer;
  S : string;

  AI : TAIn;
  AE : TARe;

  dPix1,dPix2 : real;

  rMin,rMax,DeltaY : real;

begin
  Time_routine('FITS.CalcCGravN',true);
  (*----------------------------------------------------------------*)
  (* найти полож-я центра тяжести в пикселах для инт-ти 6301 и 6302 *)

  dl1 := Abs(TLFITS(Owner).dl6301/1000/Self.rdLam);
  dl2 := Abs(TLFITS(Owner).dl6302/1000/Self.rdLam);


  GetCol3(iY,1,A);
  AA := swARe.CopyARe(A);


  j11 := rLC1 - dl1; j12 := rLC1 + dl1;
  j21 := rLC2 - dl2; j22 := rLC2 + dl2;

  (* определяем число вершин в поддиапазоне *)
  (* если их 3, 5 или 7, то объявляем границами вершины *)
  (* и ищем центр с выравниванием границ *)

  (* если больше - оставляем те же границы и ищем без выравнивания *)

  (* если вершин чётное число, то надо делать дополнительный анализ! *)


//  #########################################
//   МЕСТО ПОСЛЕДНЕГО РЕДАКТИРОВАНИЯ !!!!!!!!! 2019_10_05



  l1 := swARe.LineCenter_RI(j11,j12,AA);






  l10 := swARe.LineCenter0_IR(i11,i12,A);
  l20 := swARe.LineCenter0_IR(i21,i22,A);

  AL1[1] := l10;
  AL2[1] := l20;



  Finalize(A);
  Finalize(AA);
  Time_routine('FITS.CalcCGravN',false);
end; (* TFITS.CalcCGravN *)
}










(*-------------------------------------------------------*)
(* Вычисление центров тяжести 6301 и 6302                *)
(* для единичной точки на щели iY                        *)
(*   требуются:                                          *)
(*   сырые данные aData                                  *)
(* Расчёт проводим только для тех профилей, которые      *)
(*   показывают только 5 экстремумов - это случай        *)
(*   отсутствия поля или слабого поля                    *)
(*                                                       *)
(* Заполняем Self.ANE[iY] - число экстремумов            *)
(*                                                       *)
(* Расчёт приблизительный, т.к. области несимметричны,   *)
(*   хотя процедура внутри "подравнивает" края           *)

procedure TFITS.CalcCGrav5(iYA:integer;var L1,L2:real;var AI:TAIn;var AE:TARe);
var  A : TAIn;
  rMin,rMax,DeltaY : real;
  nExtrem : integer;
  AEI     : TAIn;

//iMin,iMax,iD : integer;

begin
  Time_routine('FITS.CalcCGrav5',true);

  L1 := 0; L2 := 0;

  GetCol3(iYA,1,A);      (* выборка всех точек iYA-го профиля интенсивности *)

  (*----------------------------------------------------*)
  (*----------------------------------------------------*)
  (*         определяем кол-во экстремумов              *)
  (*                                                    *)

  (* сначала собираем все пики, включая мелкие *)
  Extremums(A,1,112,AI,AEI);     (* I,EI - индексы и значения экстремумов *)
  AE := swARe.CopyARe(AEI);
{
  WarnAbs('Экстремумы ВЕСЬ I ПРОФИЛЬ до редукции:'+#13#10+
           AReSt(AE,4)
           +#13#10+
           swStr.AInSt(AI)
           );
}

  AReMinMax(AE,rMin,rMax);     (* изучим "перепад высот на кривой *)
  DeltaY := rMax - rMin;

  (* исключим мелкие пики из описания массива экстремумов *)
  ExtremReduce(AE,AI,DeltaY/10);
{
  WarnAbs('iX='+ISt(IXI)+' iYA='+ISt(iYA)+' Экстремумы ВЕСЬ I ПРОФИЛЬ:'+#13#10+
           AReSt(AE,4)+#13#10+
           swStr.AInSt(AI));
}
  nExtrem := length(AI) - 1;
  ANE[iYA] := nExtrem;

  (*                                                    *)
  (*         определяем кол-во экстремумов              *)
  (*----------------------------------------------------*)
  (*----------------------------------------------------*)

  if nExtrem > 5 then Exit; (* значения l1,l2 не меняются *)

  L1 := swARe.LineCenter1_IR(AI[1],AI[3],A); (* от экстремума до экстремума *)
  L2 := swARe.LineCenter1_IR(AI[3],AI[5],A);

  Finalize(A);
  Finalize(AEI);
  Time_routine('FITS.CalcCGrav5',false);
end; (* TFITS.CalcCGrav5 *)





(* получить значение континуума [интенсивности]     *)
(*   сглаживаем I гауссом с шириной lsmooth (90 mA) *)
(*   находим максимум и его позицию                 *)
(*   iY = [0..NY-1]                                 *)
(* а также находим второй максимум, но не ближе,    *)
(*   в iGap точках от первого                       *)
procedure TFITS.GetICont_02
                (iY,iGap:integer;var rC,rC2:real;var iC,iC2:integer);
var A : TAIn; AY : TARe; I3,iYA : integer;
begin
  if (TLFITS(Owner).lsmooth = 0) then begin
    WarnAbs('FITS('+ISt(iY)+').GetICont_01 lsmooth=0!!!');
  end;

  i3  := 1; (* параметр Стокса "1" - интенсивность *)
  iYA := iY + 1;

  GetCol3(iYA,i3,A);  (* целые значения i3=интенсивности *)
  AY := CopyARe(A);
  with TLFITS(Owner) do
    AY := AReGSmooth(ALam,AY,lsmooth/1000);  (* сглаживаем гауссом *)
//AReMax(AY,rC,iC); (* rC - максимальное значение, iC - его индекс *)
  AReMax2(AY,iGap,rC,rC2,iC,iC2);

  rC := rC * TLFITS(Owner).kRC0;
  rC2:= rC2* TLFITS(Owner).kRC0;


{
  if iY = 10 then begin
    rC := rC * 2;
    rC := rC * 0.5;
  end;
}

  Finalize(A);
  Finalize(AY);
end;






(* получить значение континуума [интенсивности]     *)
(*   сглаживаем I гауссом с шириной lsmooth (90 mA) *)
(*   находим максимум и его позицию                 *)
(*   iY = [0..NY-1]                                 *)
procedure TFITS.GetICont_00(iY:integer;var rC:real;var iC:integer);
var A : TAIn; AY : TARe; I3,iYA : integer;
begin
  if (TLFITS(Owner).lsmooth = 0) then begin
    WarnAbs('FITS('+ISt(iY)+').GetICont_01 lsmooth=0!!!');
  end;

  i3  := 1; (* параметр Стокса "1" - интенсивность *)
  iYA := iY + 1;


{
  для точки останова :
  -------------------
  if iY = 10 then begin
    lc := i3 * 2;
    lc := lc * 5;
  end;
}

  GetCol3(iYA,i3,A);  (* целые значения i3=интенсивности *)
  AY := CopyARe(A);
  with TLFITS(Owner) do
    AY := AReGSmooth(ALam,AY,lsmooth/1000);  (* сглаживаем гауссом *)
  AReMax(AY,rC,iC); (* rC - максимальное значение, iC - его индекс *)

  rC := rC * TLFITS(Owner).kRC0;


{
  if iY = 10 then begin
    rC := rC * 2;
    rC := rC * 0.5;
  end;
}

  Finalize(A);
  Finalize(AY);
end;


(* получить значение континуума [интенсивности]     *)
(*   сглаживаем I гауссом с шириной lsmooth (90 mA) *)
(*   находим максимум и его позицию                 *)
(*   iY = [0..NY-1]                                 *)
procedure TFITS.GetICont_01(iY:integer;var rC,lC:real);
var iC : integer;
begin
  GetICont_00(iY,rC,iC);
  lC := self.ItoLam(iC);
end;




(* iY [0..nY-1] *)
function TFITS.ContiY(iY:integer):real;
var
  L,iYA : integer;
  rC,lC : real; (* rC - значение и lC - положение на развёртке по дл.волны *)
begin
  if Not Assigned (Self) then begin
    WarnAbs('Not Assigned aFITS['+ISt(iY)+'] при вызове расчёта Cont(iY)');
    result := 0;
    Exit;
  end;
  L := length(Self.aCnt);
  iYA := iY + 1;
  if L = 0 then begin  (* если вектор значений I_CONT не рассчитан *)
    Self.GetICont_01(iY,rC,lC); (* считаем прямо здесь *)
    result := rC;
  end
  else result := Self.aCnt[iYA];
end;



{
(* рассчитать значение континуума и его дисперсию    *)
(* для параметра Стокса S, для положения на щели iYA *)
(* для заданных поддиапазонов континуума i-i *)
procedure TFITS.GetCont4(iYA,i3:integer;var rC,rD:real);
const s1 = 'FITS.GetCont ERR : ';
      s2 = 'диапазоны для подсчета континуума ';

var I : integer; A : TAIn; II : longint; D : real; N : integer;
  Q : boolean;

begin

  WarnAbs('FITS.GetCont4 - НЕ ВЫЗЫВАЙТЕ ЭТУ ПРОЦЕДУРУ!');


  if Not SetBit.IsBit(KStep,1) then begin
    WarnAbs('TFITS.GetCont Err: Header Not Loaded Yet!');
    Exit;
  end;


  N := ic2-ic1+1;
  if ic4>ic3 then N := N + (ic4-ic3+1);
  if ic6>ic5 then N := N + (ic6-ic5+1);

  if N = 0 then begin
    WarnAbs(s1+s2+' не заданы!');
    Exit;
  end;

  if ic1 <= 0 then begin
    WarnAbs(s1+s2+': i1='+ISt(ic1));
    Exit;
  end;

//nX := nLam;

  Q := true;
  if (ic1 > ic2) or
     (ic2 > nLam) then Q := false;

  if (ic3 <> ic4) then
    if (ic3 < ic2) or
       (ic4 < ic3) or
       (ic4 > nLam) then Q := false;

  if (ic5 <> ic6) then
    if (ic5 < ic4) or
       (ic6 < ic5) or
       (ic6 > nLam) then Q := false;

  if Not Q then begin
    WarnAbs(s1+s2+': '+#10#13+
    'i1,i2=('+ISt(ic1)+','+ISt(ic2)+') '+
    'i3,i4=('+ISt(ic3)+','+ISt(ic4)+') '+
    'i5,i6=('+ISt(ic5)+','+ISt(ic6)+')');
    Exit;
  end;


  GetCol3(iYA,i3,A);

  II := 0;
  for I := ic1 to ic2 do II := II + A[I];
  if (ic4 > ic3) then for I := ic3 to ic4 do II := II + A[I];
  if (ic6 > ic5) then for I := ic5 to ic6 do II := II + A[I];

  rC := II/N;

  D := 0;
  for I := ic1 to ic2 do D := D + SQR(A[I]-rC);
  if (ic4 > ic3) then for I := ic3 to ic4 do D := D + SQR(A[I]-rC);
  if (ic6 > ic5) then for I := ic5 to ic6 do D := D + SQR(A[I]-rC);

  rD := SQRT(D/N); (* среднеквадратичное уклонение *)

  Finalize(A);
end; (* GetCont4 *)

procedure TFITS.GetCont4(iYA:integer;S:char;var rC,rD:real);
begin
  GetCont4(iYA,iStokes(S),rC,rD);
end;
}

(* для трёх измерений !!! *)
(* i3 = параметр Стокса   *)
(* варьируется i2 = точка вдоль щели *)
(* i1 = длина волны       *)
function TFITS.GetCol2(i1,i3:integer):TAIn;
var i,j,m,jj,ijm,K,N : integer; A : TAIn;
begin
  if Not SetBit.IsBit(KStep,1) then begin
    WarnAbs('TFITS.GetCol2 Err: Header Not Loaded Yet!');
    Exit;
  end;

//Result := NIL;   ???
  if (i1 < 1) or (i1 > AnAX[1]) then begin
    WarnAbs('TFITS.GetCol2 ERR: i1='+ISt(i1)+' Not in [1..'+ISt(AnAX[1])+']');
    Exit;
  end;
  if (i3 < 1) or (i3 > AnAX[3]) then begin
    WarnAbs('TFITS.GetCol2 ERR: i3='+ISt(i3)+' Not in [1..'+ISt(AnAX[3])+']');
    Exit;
  end;

  N := AnAX[2]; (* = nY *)
  SetLength(A,N+1);

  jj  := 0;
//ijm := 0;
  ijm := -1;
  for m := 1 to AnAX[3] do begin
    for j := 1 to AnAX[2] do begin
      for i := 1 to AnAX[1] do begin
        inc(ijm);
        if m = i3 then
          if i = i1 then begin
            inc(jj);            (* jj меняется от 1 до N+1 *)
            K := aData[ijm];
            if (K > 32768) and (i3 <> 1) then A[jj] := K - 65536
                                         else A[jj] := K;
          end;
      end;
    end;
  end;

  (* учитываем SPBSHFT *)
  case i3 of
  1   : if iSPBSHFT > 0 then for jj := 1 to N+1 do A[jj] := 2*A[jj];
  2,3 : if iSPBSHFT = 3 then for jj := 1 to N+1 do A[jj] := 2*A[jj];
  4   : if iSPBSHFT > 1 then for jj := 1 to N+1 do A[jj] := 2*A[jj];
  end; (* case *)

  result := A;
end;


procedure TFITS.byteReOrder(iDir:integer);
var B2 : array [1..2] of byte;
    W : word absolute B2;
    B : byte; I : integer;
begin
  Time_routine('FITS.byteReOrder',true);
  if iDir = Self.byteOrder then Exit;

  (*----- надо поменять местами байты в элементах aData типа word ---*)
  for I := 0 to nData-1 do begin
    W := aData[I];
    B := B2[1]; B2[1] := B2[2]; B2[2] := B;
    aData[I] := W;
  end;

  Self.byteOrder := iDir;
  Time_routine('FITS.byteReOrder',false);
end;


(* объём данных для FITS. nData = nx*ny*4, nbData = nData*4 *)
procedure TFITS.CalcVolume;
var I,NN,nByte : integer;
begin
  nByte := ((nBITPIX - 1) div 8) + 1;
//NN := nByte;
  NN := 1;
  for I := 1 to nAXIS do begin
    if AnAX[I] = 0 then begin
      WarnAbs('TFITS.CalcVolume WARNING: Для оси '+ISt(I)+' не задан размер!'
      );
    end
    else NN := NN * AnAX[I];
  end;
  nData := NN;
  nbData := nData * nByte;
end;


function TFITS.GetAXIS(sKey:string):TAsAXIS;(* масиив строк описания осей *)
var A : TAsAXIS; sKeyI,sVal : string; I : integer;
begin
  if nAXIS = 0 then begin
    WarnAbs('TFITS.GetAXIS WARNING: Key <'+sKey+'> '+#13#10+
            ' число осей ещё не задано!!!');
  end;

  for I := 1 to Self.nAXIS do begin
    sKeyI := sKey + NumStr(I,1);
    sVal := Self.GetKeyS(sKeyI);
    A[I] := sVal;
  end;
  result := A;
end;


function TFITS.GetAXISi(sKey:string):TAiAXIS;(* масиив размерностей осей *)
var A : TAsAXIS; AI : TAiAXIS; I,K,IErr : integer;
begin
  Time_routine('FITS.GetAXISi',true);
  A := GetAXIS(sKey);
  for I := 1 to Self.nAXIS do begin
    if A[I] = '' then AI[I] := 0 else begin
      Val(A[I],K,IErr);
      if IErr <> 0 then begin
        WarnAbs('TFITS.GetAXISi WARNING: для ключа <'+sKey+ISt(I)+'>'+#13#10+
        'найдено недопустимое целое значение <'+A[I]+'> !!!');
        AI[I] := 0;
      end
      else AI[I] := K;
    end;
  end;

  if (AI[3] = 1) and (AI[4] = 4) then begin
    AI[3] := 4; AI[4] := 1;
  end;

  result := AI;
  Time_routine('FITS.GetAXISi',false);
end;





function TFITS.GetKeyS(sKey:string):string;
begin
  result := GetFITKey(sKey,HSL,0,nsHead-1);
end;

procedure TFITS.SplitHeaderStr(S:string;var sKey,sVal:string);
var W : string; P : integer;
begin
  Time_routine('FITS.SplitHeaderStr',true);
  P := pos('=',S);
  if P > 0 then begin
    sKey := TRIM(swStr.left (S,P-1));
    S    := swStr.RightFrom(S,P+1);
    W    := swStr.RightFrom(S,23);
    S    := Trim(swStr.left(S,22) + swStr.left(w,'/'));
    sVal := Trim(swStr.TrimAnyQuot(S,#39));
  end
  else begin
    sKey := TRIM(swStr.left     (S,8));
    sVal := TRIM(swStr.RightFrom(S,9));
  end;
  Time_routine('FITS.SplitHeaderStr',false);
end;

function TFITS.sKeysList:string;
var I : integer; s,w : string;
begin
  s := '';
  for I := 0 to HSL.Count-1 do begin
    w := swStr.left(HSL.Strings[I],9);
    s := s+w;
    if ((I+1) mod 6) = 0 then s := s + #13#10;
  end;
  result := s;
end;






function TFITS.GetKeyI(sKey:string):integer;
var I : integer; IErr : integer; S : string;
begin
  result := 0;
  S := GetKeyS(sKey);
  if S = '' then begin
    WarnAbs('TFITS.GetKeyI WARNING: Key <'+sKey+'> Not Found!'+#13#10+
             'файл=<'+SELF.sFN+'> IX='+ISt(IXI)+' HSL.Count='+ISt(HSL.Count)
             +#13#10+'LFITS.sFN='+TLFITS(OWNER).sFSW);
    WarnAbs(sKeysList);
  end
  else begin
    Val(S,I,IErr);
    if IErr <> 0 then begin
      WarnAbs('TFITS.GetKeyI WARNING: для ключа <'+sKey+'> '+#13#10+
      'найдено недопустимое целое значение <'+S+'> !!!'+#13#10+
             'файл=<'+SELF.sFN+'>'
             +#13#10+'LFITS.sFN='+TLFITS(OWNER).sFSW);
    end;
  end;
  result := I;
end;

function TFITS.GetKeyR(sKey:string):real;
var R : real; IErr : integer; S : string;
begin
  result := 0;
  S := GetKeyS(sKey);
  if S = '' then begin
    WarnAbs('TFITS.GetKeyR WARNING: Key <'+sKey+'> Not Found!'+#13#10+
             'файл=<'+SELF.sFN+'> IX='+ISt(IXI)+' HSL.Count='+ISt(HSL.Count)
             +#13#10+'LFITS.sFN='+TLFITS(OWNER).sFSW);
    WarnAbs(sKeysList);
  end
  else begin
    Val(S,R,IErr);
    if IErr <> 0 then begin
      WarnAbs('TFITS.GetKeyR WARNING: для ключа <'+sKey+'> '+#13#10+
      'найдено недопустимое действительное значение <'+S+'> !!!'+#13#10+
             'файл=<'+SELF.sFN+'>'
             +#13#10+'LFITS.sFN='+TLFITS(OWNER).sFSW);
    end;
  end;
  result := R;
end;


function TFITS.GetKeyVal(sKey:string):real;(* преобразовать в число по ключу *)
var R : real; IErr : integer; S : string;
begin
  result := 0;
  S := GetKeyS(sKey);
  if S = '' then begin
    WarnAbs('TFITS.GetKeyVal WARNING: Key <'+sKey+'> Not Found!'+#13#10+
             'файл=<'+SELF.sFN+'>  IX='+ISt(IXI)+'HSL.Count='+ISt(HSL.Count)
             +#13#10+'LFITS.sFN='+TLFITS(OWNER).sFSW);
    WarnAbs(sKeysList);
  end
  else begin
    Val(S,R,IErr);
    if IErr <> 0 then begin
      (* пытаемся интерпретировать как дату    *)
      (* если это дата - преобразуем её в Real *)
      (* '2019-11-16T06:14:18.000' *)
      (* '14:04:17.608' *)
      (* 'Sat Nov  9 14:04:17 2019'  CTIME *)
      if length(S)=23 then begin
        R := swDate.sDT232Real(S);
      end
      else begin
        R := 0;
        WarnAbs('FITS.GetKeyVal-ERR: Не понятно как интерпретировать число'
                +#13#10+
                '<'+S+'> Ключ=<'+sKey+'>');
      end;
    end;
  end;
  result := R;
end;





procedure TFITS.ReadHeader(sPath0,sFN0:string);
const sP = 'ReadHeader';
var S,sKey,sT,ss,sB80,sFNa : string; SL1 : TStringList;
  f : System.Text;
  I,IErr : integer;
  B80 : array [1..80] of char;
  B48 : array [1..80*600] of char;
  Buf : TABt0 absolute B48;
  nStr,I1 : integer;
  nbH0,nBuf,mBuf : DWORD;
  ALam : TARe;
  rT : real;
begin
  (*-----------------------------------------*)
  (* заголовков может быть в файле несколько *)
  (*                                         *)
  (* заголовок занимает место, кратное       *)
  (*    2880 байтам  (36 строкам)            *)
  (*                                         *)
  (*  когда заканциваются данные, связанные  *)
  (*    с одним заголовком, то далее идет    *)
  (*    выравнивающее пустое место и далее   *)
  (*    следующий блок со следующим заголов- *)
  (*    ком                                  *)
  (*                                         *)
  (*-----------------------------------------*)

//if Not CheckI(sP) then Exit; (* проверка Owner Assigned *)

  if SetBit.IsBit(Self.KStep,1) then begin
//    WarnAbs('TFITS.ReadHeader WARNING!'+#13#10+
//    'Header Already Loaded!!!');
    Exit;
  end;

  if Not DirectoryExists(sPath0) then begin
    WarnAbs('TFITS.ReadHeader('+sFN0+') Err:'+#13#10+
            'Directory <'+sPath0+'> Not Exists!');
    Exit;
  end;

//  Time_routine('FITS.ReadHeader',true);

  if Not (swStr.left(sFN0,4) = 'SP3D') then begin
    WarnAbs('FITS.ReadHeader-ERR: sFN <> SP3D....'+#13#10+
            'sFN=<'+sFN0+'>'+#13#10+
            'IXI='+ISt(Self.IXI)+' IXP='+ISt(Self.IXP)+
            ' IXpos='+ISt(Self.IXpos));
    Exit;
  end;



{
  if Not SetBit.IsBit(Self.KStep,0) then begin
    WarnAbs('TFITS.ReadHeader ERROR!'+#13#10+
    'File_Name Not Linked Yet!!!');
    Exit;
  end;

  if sFN = '' then begin
    WarnAbs('TFITS.ReadHeader ERR: FileName Not Linked yet!');
    Exit;
  end;
}

  if sPath0 = '' then sFNa := sFN0 else begin
    sFNa := DirAndName(sPath0,sFN0);
  end;

  if Not FileExists(sFNa) then begin
    WarnAbs('TFITS.ReadHeader Err:'+#13#10+
              'File <'+sFNa+'> Not Exists!');
//    Time_routine('FITS.ReadHeader',false);
    Exit;
  end;


  if Not Assigned(HSL) then begin
    HSL := TStringList.Create;
  end;

  nbH0 := 0;       (* начальное смещение *)
  nStr := 80;      (* длина записи       *)
  nBuf := 80*600;  (* длина буфера для всего заголовка *)

  sKey := '';
  I := 0;

  if HSL.Count <> 0 then begin
    WarnAbs('TFITS.LoadHeader iX='+ISt(Self.IXI)+' HSL.Count='+ISt(HSL.Count));
  end;


{===========================================================================}
  while (sKey <> 'END') and (I < 600) do begin
    inc(I);
    if Not swFile.DBRdRec(sFNa,nbH0,nStr,I,B80) then begin
      WarnAbs('Ошибка при чтении блока из файла '+#13#10+
      '<'+sFNa+'>'+#13#10+
      'I = '+ISt(I)+' nbH0=0, LStr=80'+#13#10+
      'IOResult of Reset = '+ISt(swFile.IOResultLast)+#13#10+
      'ErrLast=<'+swFile.sErrLast+'>'
                );
//      Time_routine('FITS.ReadHeader',false);
      Exit;
    end;
//  SetLength(S,nStr);
    S := copy(B80,1,nStr);
    sKey := swStr.GetWordN(S,1);
    HSL.Add(S);
  end;
{============================================================================}


{================================================
  (* считываем сразу 600 строк     *)
  (* а потом их режем по 80 байтов *)

  mBuf := ReadBufAt(sFNa,nbH0,nBuf,Buf);

  if (mBuf = 0) then begin
    WarnAbs('Ошибка при чтении блока из файла '+#13#10+
    '<'+sFNa+'>'+#13#10
    +' nbH0=0, nBuf='+ISt(nBuf)+#13#10+
    'IOResult of Reset = '+ISt(swFile.IOResultLast)+#13#10+
    'ErrLast=<'+swFile.sErrLast+'>'
              );
//    Time_routine('FITS.ReadHeader',false);
    Exit;
  end;


  I1 := 1;
  sKey := '';
  I := 0;
  while ((I1 <= (mBuf-nStr)) and (sKey <> 'END')) do begin
    S := copy(B48,I1,nStr);
    sKey := swStr.GetWordN(S,1);
    HSL.Add(S);
    inc(I1,nStr);
    inc(I);
  end;
 ==============================================}


  nsHead := I;

  (*                                             *)
  (* Остановили чтение, когда нашли sKey = 'END' *)


  (* sB80 - пустая строка длиной 80 символов *)
  SetLength(sB80,nStr);
  FillChar(sB80[1],nStr,' ');

  (*--------------------------------------------------*)
  (* далее пропускаем место, занятое пустыми строками *)
  (* чтобы узнать, где начинаются данные              *)
  (*                                                  *)



  S := sB80;



{=============================================}
  while (S = sB80) do begin
    inc(I);
    if Not swFile.DBRdRec(sFNa,nbH0,nStr,I,B80) then begin
      WarnAbs('Ошибка при чтении блока из файла '+#13#10+
      '<'+sFNa+'>'+#13#10+
      'I = '+ISt(I)+' nbH0=0, LStr=80'+#13#10+
      'IOResult of Reset = '+ISt(swFile.IOResultLast)+#13#10+
      'ErrLast=<'+swFile.sErrLast+'>'
                );
//      Time_routine('FITS.ReadHeader',false);
      Exit;
    end;
    S := copy(B80,1,nStr);
//  SL.Add(S);
  end;
{=============================================}

{=============================================
  while (S = sB80) do begin
    S := copy(B48,I1,nStr);
    inc(I1,nStr);
    inc(I);
  end;
 ============================================}

  if S <> sB80 then dec(I);  (* последняя прочитанная строка не была пустой *)

  nlHead := I;            (* место в "строках" под заголовок *)
  nbHead := nlHead*nStr;  (* место в байтах под заголовок    *)



  (* !!!!! Бывает, что в сырых FITS файлах, проскакивают какие-то симовлы *)
  (*   - не пробелы в месте, до окончания 2880 байт                       *)
  (* в этом случае насильно выравниваем место под Header *)

  if (nbHead mod 2880) > 0 then
  begin
    nbHead := ((nbHead div 2880)+1) * 2880;
    nlHead := nbHead div 80;
  end;




  (* парсим заголовок, заносим данные в TFITS *)

  sKey := 'BITPIX'  ; nBITPIX  := GetKeyI(sKey); (* бит на пиксель *)
  sKey := 'NAXIS'   ; nAXIS    := GetKeyI(sKey); (* число осей *)
  sKey := 'NAXIS'   ; AnAX     := GetAXISi(sKey);
  nLam := AnAX[1];
  nY   := AnAx[2];

  sKey := 'CRVAL1'  ; rLa0     := GetKeyR(sKey);(* дл.волны центральн.пиксела *)
  sKey := 'CDELT1'  ; rdLam    := GetKeyR(sKey);(* дисперсия Angstrem/pixel   *)
  sKey := 'CRPIX1'  ; rLamIdx0 := GetKeyR(sKey);(* "индекс" центральн.пиксела *)

  sKey := 'SPBSHFT' ; iSPBSHFT := GetKeyI(sKey);(* битовый сдвиг I|Q|U|V      *)


{
  if rdLam < 0 then begin
    Self.QLamMinus := true;
    rdLam := - rdLam;
    rLam0 := 6302.08;
  end;
}



  sKey := 'XCEN'    ; rX0      := GetKeyR(sKey);(* полож-е мех-ма по X arcsec *)

  sKey := 'XSCALE'  ; rdX      := GetKeyR(sKey);(* масштаб по X *)
  sKey := 'NSLITPOS'; nXP      := GetKeyI(sKey);(* N поз.щели                 *)
  sKey := 'SLITINDX'; IXP      := GetKeyI(sKey);(* инд.щели в шагах механизма *)
  sKey := 'SLITPOS' ; IXpos    := GetKeyI(sKey);(* поз.щели в шагах механизма *)
//               rXI  := rX0 + (rdX * IXP);(* тек.полож-е щели, arcsec   *)
                 rXI  := rX0 + (rdX * IXPos);(* тек.полож-е щели, arcsec   *)

  sKey := 'DATE_OBS'; sDtObs   := GetKeyS(sKey);(*дата/время начала экспозиции*)

  (* распарсим время в две переменные *)
  (* время в минутах (для последующего определения длительности сеанса) *)
  (* время в долях суток (для опредления момента суток середины сеанса) *)

  (* 2017-09-06T00:02:32.154 *)
  sT := swStr.RightFrom(sDtObs,'T');  (* подстрока времени *)
  ss := copy(sT,1,2); //    swStr.left(S,':');
  rt := ValReal(ss)*60;    (* rt - время в минутах *)
  ss := copy(sT,4,2); //
  rt := rt + ValReal(ss);
  ss := copy(sT,7,6); //
  rt := rt + ValReal(ss)/60;
  tMin := rt;     (* tDay = tMin / 24 / 60 *)


  sKey := 'YCEN'    ; rY0      := GetKeyR(sKey);(* полож-е центра щели по Y   *)

  sKey := 'EXPTIME' ; rExpTime := GetKeyR(sKey);(* Экспозиция *)


  (* рассчитаем объем данных в байтах *)
  Self.CalcVolume; (* nByte, nData, nbData *)

{
  if Not TLFITS(Owner).CheckNY(nY) then begin
    WarnAbs('TFITS.ReadHeader WARN число точек на щели nY изменилось для IXI='+
            ISt(IXI)+#13#10+
             'файл=<'+SELF.sFN+'>'
             +#13#10+'LFITS.sFN='+TLFITS(OWNER).sFSW);
  end;

  if Not TLFITS(Owner).CheckNXP(nXP) then begin
    WarnAbs('TFITS.ReadHeader WARN число точек NSLITPOS изменилось для IXI='+
            ISt(IXI)+#13#10+
             'файл=<'+SELF.sFN+'>'
             +#13#10+'LFITS.sFN='+TLFITS(OWNER).sFSW);
  end;

  if Not TLFITS(Owner).CheckExpTime(rExpTime) then begin
    WarnAbs('TFITS.ReadHeader WARN время экспозиции EXPTIME изменилось для IXI='
            +ISt(IXI)+#13#10+
             'файл=<'+SELF.sFN+'>'
             +#13#10+'LFITS.sFN='+TLFITS(OWNER).sFSW);
  end;
}

 (*======== данные, которые не являются необходимыми ========*)


//  Time_routine('FITS.ReadHeader_5',true);

  sKey := 'DATA_LEV'; DATA_LEV := GetKeyI(sKey);


  sKey := 'CTYPE'   ; ACTYPE   := GetAXIS(sKey);
  sKey := 'CUNIT'   ; ACUNIT   := GetAXIS(sKey);




  sKey := 'DOPVUSED'; dVlos    := GetKeyR(sKey);(* доп.компенсатор Vlos (m/s) *)
  sKey := 'DOP_RCV' ; dV_los   := GetKeyR(sKey);(*     компенсатор Vlos (m/s) *)

//sKey := 'T_FGCCD' ; T_CCD    := GetKeyR(sKey);(* температура CCD *)
//T_CCD    : real;  (* T_FGCCD   температура FG CCD со стороны камеры *)

  sKey := 'T_SPCCD'; T_1 := GetKeyR(sKey);
  sKey := 'T_FGCCD'; T_2 := GetKeyR(sKey);
  sKey := 'T_CTCCD'; T_3 := GetKeyR(sKey);
  sKey := 'T_SPCEB'; T_4 := GetKeyR(sKey);
  sKey := 'T_FGCEB'; T_5 := GetKeyR(sKey);
  sKey := 'T_CTCEB'; T_6 := GetKeyR(sKey);



  sKey := 'FOVX'    ; wdX      := GetKeyR(sKey);(* ширина щели, arcsec        *)

  sKey := 'CRVAL2'  ; rY1      := GetKeyR(sKey);(* полож.пиксела 1 по Y       *)
  sKey := 'CRPIX2'  ; rYI      := GetKeyR(sKey);(* "индекс" пикселя 1         *)
  sKey := 'CDELT2'  ; rdY      := GetKeyR(sKey);(* дисперсия по Y?            *)
  sKey := 'YSCALE'  ; rdY1     := GetKeyR(sKey);(* масштаб по Y? *)
  sKey := 'FOVY'    ; wdY      := GetKeyR(sKey);(* wdY = rdY * (nY - 1) ???   *)

  (* сравним размер данных с размером файла *)

{
  SL1 := TStringList.Create;

  S := 'File <'+sFNa+'>';                   SL1.Add(S);
  S := 'Header_NLines = '+ISt(Self.nsHead); SL1.Add(S);
  S := 'Header_Volume = '+ISt(Self.nbHead); SL1.Add(S);
  S := 'Data_Volume   = '+ISt(Self.nbData); SL1.Add(S);
  S := 'Head+Data='+ISt(nbHead+nbData)+' FileSize='+ISt(swFile.File_Size(sFNa));
                                            SL1.Add(S);
  S := '';                                  SL1.Add(S);

  result := swStr.SListAdd(SL1,SL);
}

  SetBit.BISB(KStep,1); (* = +2 *)

//  Time_routine('FITS.ReadHeader_5',false);

{
  (* заполним массив длин волн *)
  ALam := Self.GetALam;
  if Not TLFITS(Owner).CheckALam(ALam) then begin
    WarnAbs('TFITS.ReadHeader WARN список длин волн изменился IXI='+ISt(IXI)
    +#13#10+'файл=<'+SELF.sFN+'>'
    +#13#10+'LFITS.sFN='+TLFITS(OWNER).sFSW);
  end;
}

//    Time_routine('FITS.ReadHeader',false);
end; (* TFITS.ReadHeader *)


function TFITS.SLKeys:TStringList; (* выдать список ключей хидера *)
var SL : TStringList; S,sKey : string; I : integer;
begin
  SL := TStringList.Create;
  if (Not Assigned (HSL)) or (HSL.Count < 2) then begin
    S := 'FITS_HSL-Empty!';
    SL.Add(S);
  end
  else begin
    for I := 0 to HSL.Count-1 do begin
      S    := HSL.Strings[I];
      sKey := Trim(swStr.Left(S,8));
      if sKey <> 'HISTORY' then
      SL.Add(sKey);
    end;
  end;
  result := SL;
end;


function TFITS.SLVals:TStringList; (* выдать список значений хидера *)
var SL : TStringList; S,sKey,sVal : string; I : integer;
begin
  SL := TStringList.Create;
  if (Not Assigned (HSL)) or (HSL.Count < 2) then begin
    S := '0';
    SL.Add(S);
  end
  else begin
    for I := 0 to HSL.Count-1 do begin
      S    := HSL.Strings[I];
      sKey := Trim(swStr.Left(S,8));
      if sKey <> 'HISTORY' then begin
        S    := swStr.RightFrom(S,'=');
        S    := Trim(swStr.Left(S,'/'));
        sVal := swStr.TrimAnyQuot(S,#39); // #39 = одиночная кавычка
        SL.Add(sVal);
      end;
    end;
  end;
  result := SL;
end;






procedure TFITS.ReadHeader;
const sP = 'ReadHeader';
var S,sKey,sB80,sFNa : string; SL1 : TStringList;
//sFN : string;
  f : System.Text;
  I,IErr : integer;
  B80 : array [1..80] of char;
  B48 : array [1..80*600] of char;
  Buf : TABt0 absolute B48;
  nStr,I1 : integer;
  nbH0,nBuf,mBuf : DWORD;
//  sPath : string;
  ALam : TARe;
begin
  (*-----------------------------------------*)
  (* заголовков может быть в файле несколько *)
  (*                                         *)
  (* заголовок занимает место, кратное       *)
  (*    2880 байтам  (36 строкам)            *)
  (*                                         *)
  (*  когда заканциваются данные, связанные  *)
  (*    с одним заголовком, то далее идет    *)
  (*    выравнивающее пустое место и далее   *)
  (*    следующий блок со следующим заголов- *)
  (*    ком                                  *)
  (*                                         *)
  (*-----------------------------------------*)

  if Not CheckI(sP) then Exit; (* проверка наличия IXI *)

  if SetBit.IsBit(Self.KStep,1) then begin
    WarnAbs('TFITS.ReadHeader WARNING!'+#13#10+
    'Header Already Loaded!!!');
    Exit;
  end;

//sPath := sDBFITSpath;
  sPath := TLFITS(Owner).sPath;
  sFN := Self.fNam;

  ReadHeader(sPath,sFN);

  if Not TLFITS(Owner).CheckNY(nY) then begin
    WarnAbs('TFITS.ReadHeader WARN число точек на щели nY изменилось для IXI='+
            ISt(IXI)+#13#10+
             'файл=<'+SELF.sFN+'>'
             +#13#10+'LFITS.sFN='+TLFITS(OWNER).sFSW);
  end;

  if Not TLFITS(Owner).CheckNXP(nXP) then begin
    WarnAbs('TFITS.ReadHeader WARN число точек NSLITPOS изменилось для IXI='+
            ISt(IXI)+#13#10+
             'файл=<'+SELF.sFN+'>'
             +#13#10+'LFITS.sFN='+TLFITS(OWNER).sFSW);
  end;

  if Not TLFITS(Owner).CheckExpTime(rExpTime) then begin
    WarnAbs('TFITS.ReadHeader WARN время экспозиции EXPTIME изменилось для IXI='
            +ISt(IXI)+#13#10+
             'файл=<'+SELF.sFN+'>'
             +#13#10+'LFITS.sFN='+TLFITS(OWNER).sFSW);
  end;

{

 (*======== данные, которые не являются необходимыми ========*)


  Time_routine('FITS.ReadHeader_5',true);

  sKey := 'DATA_LEV'; DATA_LEV := GetKeyI(sKey);


  sKey := 'CTYPE'   ; ACTYPE   := GetAXIS(sKey);
  sKey := 'CUNIT'   ; ACUNIT   := GetAXIS(sKey);




  sKey := 'DOPVUSED'; dVlos    := GetKeyR(sKey);(* компенсатор Vlos (m/s)     *)

  sKey := 'FOVX'    ; wdX      := GetKeyR(sKey);(* ширина щели, arcsec        *)

  sKey := 'CRVAL2'  ; rY1      := GetKeyR(sKey);(* полож.пиксела 1 по Y       *)
  sKey := 'CRPIX2'  ; rYI      := GetKeyR(sKey);(* "индекс" пикселя 1         *)
  sKey := 'CDELT2'  ; rdY      := GetKeyR(sKey);(* дисперсия по Y?            *)
  sKey := 'YSCALE'  ; rdY1     := GetKeyR(sKey);(* масштаб по Y? *)
  sKey := 'FOVY'    ; wdY      := GetKeyR(sKey);(* wdY = rdY * (nY - 1) ???   *)




  (* сравним размер данных с размером файла *)

(*
  SL1 := TStringList.Create;

  S := 'File <'+sFNa+'>';                   SL1.Add(S);
  S := 'Header_NLines = '+ISt(Self.nsHead); SL1.Add(S);
  S := 'Header_Volume = '+ISt(Self.nbHead); SL1.Add(S);
  S := 'Data_Volume   = '+ISt(Self.nbData); SL1.Add(S);
  S := 'Head+Data='+ISt(nbHead+nbData)+' FileSize='+ISt(swFile.File_Size(sFNa));
                                            SL1.Add(S);
  S := '';                                  SL1.Add(S);

  result := swStr.SListAdd(SL1,SL);
*)

  SetBit.BISB(KStep,1); (* = +2 *)

  Time_routine('FITS.ReadHeader_5',false);
  Time_routine('FITS.ReadHeader',false);
}


  (* заполним массив длин волн *)
  ALam := Self.GetALam;
  if Not TLFITS(Owner).CheckALam(ALam) then begin
    WarnAbs('TFITS.ReadHeader WARN список длин волн изменился IXI='+ISt(IXI)
    +#13#10+'файл=<'+SELF.sFN+'>'
    +#13#10+'LFITS.sFN='+TLFITS(OWNER).sFSW);
  end;


end; (* TFITS.ReadHeader *)





{
function TFITS.ReportIntegrVal2:TStringList;
var S : string; SL,SL2 : TStringList; I : integer; m1,m2,m21,m22 : real;
begin


  if Not SetBit.IsBit(KStep,2) then begin
    Self.LoadData;
    Self.BigCalc;
  end;

  Self.BigCalc2;



  (*====== вывести колонки вдоль щели в редактор ========*)

  SL := TStringList.Create;

    S := 'I ' +
         'CONT '+
         'CONT2 '+
         'DISP '+
         'DISP2 '+
         'dLam_1 '+
         'dLam_21 '+
         'dLam_2 '+
         'dLam_22 '+

         'W_1 '+
         'W_21 '+
         'W_2 '+
         'W_22 '+
         'W_3 '+
         'W_23 '+
         'Mv0_1 '+
         'Mv2_1 '+
         'Mv0_2 '+
         'Mv2_2 '+

         'Mv1 '+
         'Mv21 '+
         'Mv2 '+
         'Mv22 '+

         'H||_1 '+
         'H||_21 '+
         'H||_2 '+
         'H||_22 '+

         'Mv2/Mv1';

  SL.Add(S);


  for I := 1 to Self.nY do begin
    m1 := AMV1[I]/AWI1[I];
    m2 := AMV2[I]/AWI2[I];
    m21 := AMV21[I]/AWI21[I];
    m22 := AMV22[I]/AWI22[I];

    S := ISt(I) + ' ' +
         EFSt0(Self.AC4[1,I],6)+' '+
         EFSt0(Self.AC24[1,I],6)+' '+
         EFSt0(Self.AD4[1,I],6)+' '+
         EFSt0(Self.AD24[1,I],6)+' '+
         EFSt0(Self.ALC1[I],6)+' '+
         EFSt0(Self.AX21[I],6)+' '+
         EFSt0(Self.ALC2[I],6)+' '+
         EFSt0(Self.AX22[I],6)+' '+

         EFSt0(Self.AWI1[I],6)+' '+
         EFSt0(Self.AWI21[I],6)+' '+
         EFSt0(Self.AWI2[I],6)+' '+
         EFSt0(Self.AWI22[I],6)+' '+
         EFSt0(Self.AWI3[I],6)+' '+
         EFSt0(Self.AWI23[I],6)+' '+

         EFSt0(Self.AMV1[I],6)+' '+
         EFSt0(Self.AMV21[I],6)+' '+
         EFSt0(Self.AMV2[I],6)+' '+
         EFSt0(Self.AMV22[I],6)+' '+

         EFSt0(m1,6)+' '+
         EFSt0(m21,6)+' '+
         EFSt0(m2,6)+' '+
         EFSt0(m22,6)+' '+

         EFSt0(LamToH(m1,6301.5,1.669),6)+' '+      // 1.503
         EFSt0(LamToH(m21,6301.5,1.669),6)+' '+     // 1.503
         EFSt0(LamToH(m2,6302.5,2.487),6)+' '+
         EFSt0(LamToH(m22,6302.5,2.487),6)+' '+

         EFSt0(m22/m21,6); // +' '+


    SL.Add(S);
  end;
  swStr.LineTabStrings(SL,1);
  result := SL;
end;
}


procedure TFITS.GetIYData(iY:integer;
                    var H1,H2,HG1,HG2,Cnt,Dsp,Vc1,Vc2,W1,W2,kVI(*,II0,VV0*):real);
var m1,m2,m01,m02,eLC1,eLC2,dLC1,dLC2 : real;
// w1,w2,H1,H2,
    cont,mcnt,mLC1,mLC2 : real;
    iYA : integer;

begin
  if Not Assigned(Owner) then begin
    WarnAbs('TFITS.GetIYData('+ISt(iY)+') Owner Not Assigned!');
    Exit;
  end;

  mLC1 := TLFITS(Owner).rLC1M;  (* коорд.центров тяжести линий в пикселах *)
  mLC2 := TLFITS(Owner).rLC2M;
  mcnt := TLFITS(Owner).rCntMH0;

  Cnt := 0; (* индицирует, что процедура GetIYData не сработала *)

  iYA := iY+1;

  if (mLC1 = 0) or (mLC2 = 0) then begin
    WarnAbs('TFITS.GetIYData('+ISt(iY)+') Call BigCalc for LFITS first!!!');
    Exit;
  end;

  kVI  := AKVI[iYA];
  cont := Self.ACnt[iYA];
//cont := cont * TLFITS(Owner).kRC;

  if mcnt <> 0 then Cnt := cont/mcnt
               else Cnt := cont;

  Dsp := 0;
{
  if Assigned(AD4[1]) then
  if length(AD4[1])>=nY then Dsp := Self.AD4[1,iYA];
}
  (* если заданы условия на граничные значения rMag или rcnt *)
  (*
     ...
     ...
   *)

  (*====== W и H ======*)

  m01 := AMV1[iYA]; m02 := AMV2[iYA];
  w1  := AWI1[iYA]; w2  := AWI2[iYA];
  if w1 <> 0 then m1 := m01/w1 else m1 := m01;
  if w2 <> 0 then m2 := m02/w1 else m2 := m02;
  H1  := LamToH(m1,6301.5,1.669); // 1.503);
  H2  := LamToH(m2,6302.5,2.487);

  HG1 := Self.AHG1[iYA];
  HG2 := Self.AHG2[iYA];

//HH := (H1+H2)/2;
//HD := (H2-H1); if HH < 0 then HD := -HD;

  (*====== Vlos ======*)

  eLC1 := ALC1[iYA]; eLC2 := ALC2[iYA];

  dLC1 := (eLC1 - mLC1) * rdLam;  (* в ангстремах *)
  dLC2 := (eLC2 - mLC2) * rdLam;

  Vc1  := dLC1/rLa0*(PHYS.C_c/100/1000);  (* в километрах в секунду *)
  Vc2  := dLC2/rLa0*(PHYS.C_c/100/1000);

  (*==== точки раздела 6301 и 6302 =====*)

//  VV0 := Self.AVC[iYA];   (* индекс точки деления V профилей *)
//  II0 := Self.AIC[iYA];   (* индекс точки деления I профилей *)

end;


function TFITS.ReportIY(iY:integer):string;
//var m1,m2,m01,m02,w1,w2,H1,H2,eLC1,eLC2,dLC1,dLC2,rLC,mLC1,mLC2 : real;
//    cont,rcnt,mcnt,rMag : real;
var H1,H2,HG1,HG2,Cnt,Dsp,Vc1,Vc2,W1,W2,kVI(*,II0,VV0*):real; S : string;
begin
  result := '';

  if Not Assigned(Owner) then begin
    WarnAbs('TFITS.ReportIY('+ISt(iY)+') Owner Not Assigned!');
    Exit;
  end;

  GetIYData(iY,H1,H2,HG1,HG2,Cnt,Dsp,Vc1,Vc2,W1,W2,kVI(*,II0,VV0*));

  if Cnt = 0 then begin
    WarnAbs('TFITS.ReportIY('+ISt(iY)+') GetIYData Failed!!!');
    Exit;
  end;

    S := ISt(Self.IXP) + ' ' +
         ISt(iY) + ' ' +
         FSt(H1,1)+' '+
         FSt(H2,1)+' '+

         FSt(HG1,1)+' '+
         FSt(HG2,1)+' '+


         FSt(W1,2)+' '+
         FSt(W2,2)+' '+

         FSt(Cnt,4)+' '+ (* знач.CONT нормир.на сред.знач.немагн.пикселов *)
         FSt(Dsp,1)+' '+  (* знач.дисперсии (условное!) *)

         FSt0(kVI,4)+' '+

         FSt0(Vc1,3)+' '+  (* луч.скорость 6301 *)
         FSt0(Vc2,3)+' '   (* луч.скорость 6302 *)

{
         EFSt0(Self.AX21[iY],5)+' '+
         EFSt0(Self.AX22[iY],5)+' '+
}
//         EFSt0(VV0,5)+' '+(* индекс точки деления V профилей *)
//         EFSt0(II0,5)     (* индекс точки деления I профилей *)

//         +' '+

{
         EFSt0(Self.AMV1[iY],6)+' '+
         EFSt0(Self.AMV2[iY],6)+' '+
         EFSt0(m1,6)+' '+
         EFSt0(m2,6)+' '+
}

{
         EFSt0(HH,6)+' '+
         EFSt0(HD,6)
}
{
         +' '+
         EFSt0(m2/m1,6)
}

         ; // +' '+

  result := S;
end;

function TFITS.ReportHead:string;
var S : string;
begin
  S := 'XI YI H||1 H||2 HG1 HG2 W1 W2 CONT Disp |V|/W Vlos1 Vlos2'; //  IV0 II0
  result := S;
end;



{
function TFITS.ReportIntegrVal(i1,i2,i3,i4,i5,i6:integer):TStringList;
var S : string; SL,SL2 : TStringList; I : integer; m1,m2,H1,H2,HH,HD,LC : real;
  dLC1,dLC2 : real;
  d_C1,d_C2 : array [3..5] of real;
  k : integer;
begin

  Self.DefaultContArea;
  Self.SetLinesArea(i1,i2,i3,i4,i5,i6);

  if Not SetBit.IsBit(KStep,2) then begin  (* KStep не содержит 4 (012->124) *)
    Self.LoadData;
  end;

  if Not SetBit.IsBit(KStep,3) then begin (* KStep не содержит 8 (0123->1248) *)
    Self.BigCalc;
    CalcSlit4Conts; (* заполнить массивы вдоль щели CONT и дисперсии *)
//   AC4, AD4 ЗАПОЛНЯЕМ

  end;



  (*====== вывести колонки вдоль щели в редактор ========*)

  SL := TStringList.Create;

    S := 'I ' +
         'N1 '+
         'N2 '+
         'H||_1 '+
         'H||_2 '+

         'W_1 '+
         'W_2 '+
//       'W_3 '+
         '';

   for k := 3 to 5 do begin
         S := S +
         'd0/'+ISt(k)+'_1 ' +
         'd0/'+ISt(k)+'_2 ';
   end;

         S := S +
         'CONT '+
         'DISP '+
         '|V|/I '+


         'V_LOS1 ' + //  Lam0_1 '+
         'V_LOS2 ';  //  Lam0_2 '+

   for k := 3 to 5 do begin
         S := S +
         'V_d'+ISt(k)+'_1 ' +
         'V_d'+ISt(k)+'_2 ';
   end;

   for k := 3 to 5 do S := S + 'La0'+ISt(k)+' ';
   for k := 3 to 5 do S := S + 'd0' +ISt(k)+' ';
   for k := 3 to 5 do S := S + 'dld'+ISt(k)+' ';

   for k := 1 to mBisec do S := S + 'Bi'+ISt(k)+' ';
   for k := 1 to mBisec do S := S + 'FW'+ISt(k)+' ';

   S := S +
         'LamV_div '+


         'Lam_div '+


         'Mv0_1 '+
         'Mv0_2 '+
         'Mv1 '+
         'Mv2 '

         ;
  SL.Add(S);


  for I := 1 to Self.nY do begin
    m1 := AMV1[I]/AWI1[I];
    m2 := AMV2[I]/AWI2[I];

    H1 := LamToH(m1,6301.5,1.669); //1.503);
    H2 := LamToH(m2,6302.5,2.487);
    HH := (H1+H2)/2;
    HD := (H2-H1); if HH < 0 then HD := -HD;

    dLC1 := (Self.ALC1[I] - rLC1) * rdLam;  (* в ангстремах *)
    dLC2 := (Self.ALC2[I] - rLC2) * rdLam;

    dLC1 := dLC1/rLam0*(PHYS.C_c/100/1000);  (* в километрах в секунду *)
    dLC2 := dLC2/rLam0*(PHYS.C_c/100/1000);



  for k := 3 to 5 do begin

    d_C1[k] := (Self.A35C1[k,I] - rLC1) * rdLam;  (* в ангстремах *)
    d_C2[k] := (Self.A35C2[k,I] - rLC2) * rdLam;

    d_C1[k] := d_C1[k]/rLam0*(PHYS.C_c/100/1000);  (* в километрах в секунду *)
    d_C2[k] := d_C2[k]/rLam0*(PHYS.C_c/100/1000);

  end;



    LC := Self.AD4[1,I]; if (LC > 6300) and (LC < 6304) then LC := LC-6300;


    S := ISt(I) + ' ' +
         ISt(AN1[I])+' '+
         ISt(AN2[I])+' '+
         FSt(H1,1)+' '+
         FSt(H2,1)+' '+

         FSt(Self.AWI1[I],2)+' '+
         FSt(Self.AWI2[I],2)+' ';


  for k := 3 to 5 do begin
         S := S +
         FSt0(A35I1[k,I]/ACnt[I],3)+' '+     // делить на I_CONT !
         FSt0(A35I2[k,I]/ACnt[I],3)+' ';
  end;

         S := S +
//         FSt(Self.A_d01[I],2)+' '+   //
//         FSt(Self.A_d02[I],2)+' '+   //


//       FSt0(Self.AWI3[I],2)+' '+

         FSt(Self.ACnt[I],1)+' '+
         FSt(LC,5)+' '+

         FSt0(Self.AKVI[I],2)+' '+

         FSt0(dLC1,3)+' '+
         FSt0(dLC2,3)+' ';



  for k := 3 to 5 do begin
         S := S +
         FSt0(d_C1[k],3)+' '+
         FSt0(d_C2[k],3)+' ';
  end;

  for k := 3 to 5 do S := S + FSt0(Self.A35C1[k,I],3)+' ';
  for k := 3 to 5 do S := S + FSt0(Self.A35I1[k,I],3)+' ';
  for k := 3 to 5 do S := S + FSt0(Self.A35D1[k,I],3)+' ';


  for k := 1 to mBisec do S := S + FSt0(Self.ABiC2[k,I],3)+' ';
  for k := 1 to mBisec do S := S + FSt0(Self.ABiW2[k,I],3)+' ';



  S := S +
//         EFSt0(Self.AVC[I],5)+' '+
//         EFSt0(Self.AIC[I],5)
//         +' '+


         EFSt0(Self.AMV1[I],6)+' '+
         EFSt0(Self.AMV2[I],6)+' '+
         EFSt0(m1,6)+' '+
         EFSt0(m2,6)+' '



         ; // +' '+


    SL.Add(S);
  end;
  swStr.LineTabStrings(SL,1);
  SL.Insert(0,'');

  (*========================================*)
  (*----------------------------------------*)
  (* добавим к отчёту интегральные значения *)

  SL2 := TStringList.Create;


//  rLC1   : real;     (* среднее значение центра тяжести 6301 (в ед.IY) *)
//  rLC2   : real;     (* среднее значение центра тяжести 6302 (в ед.IY) *)
//  rCntH0 : real;     (* среднее значение континуума в немагнитных областях *)


  S :=
  'MinCont MaxCont ContH0 MinW MaxW MaxHMin MaxHPls 6301_C 6302_C 6301_C 6302_C'
  ;
  SL2.Add(S);
  S := EFSt0(Self.CntMin,6)+' '+
       EFSt0(Self.CntMax,6)+' '+
       EFSt0(Self.rCntH0,6)+' '+
       EFSt0(Self.wMin,6)+' '+
       EFSt0(Self.wMax,6)+' '+
       EFSt0(Self.HMaxM,6)+' '+
       EFSt0(Self.HMaxP,6)+' '+
       EFSt0(Self.rLC1,6)+' '+
       EFSt0(Self.rLC2,6)+' '+
       EFSt0(IToLam(rLC1),8)+' '+
       EFSt0(IToLam(rLC2),8)
       ;
  SL2.Add(S);
  S := ISt(Self.iCntMin)+' '+
       ISt(Self.iCntMax)+' '+
       '- '+
       ISt(Self.iwMin)+' '+
       ISt(Self.iwMax)+' '+
       ISt(Self.iHMaxM)+' '+
       ISt(Self.iHMaxP)+' '+
       '- '+
       '- '+
       '- '+
       '- '
       ;
  SL2.Add(S);
  swStr.LineTabStrings(SL2,1);
  SL2.Add(
'=============================================================='+
'===================================='
  );
  SL2.Add('');

  SL2.Insert(0,'IXP='+ISt(IXP)+' IXI='+ISt(IXI)+' DtObs='+Self.sDtObs+
  #13#10+
'--------------------------------------------------------------'+
'------------------------------------'
  );

  (*========================================*)

  (* содиняем *)
  SL := swStr.SLMerge(SL2,SL);

(*
  SL2.Clear;
  S := Self.ValRepHd;  SL2.Add(S);
  S := Self.ValReport; SL2.Add(S);
  swStr.LineTabStrings(SL2,1);
  SL2.Add('');

  SL := swStr.SLMerge(SL2,SL);
*)

  result := SL;


end; (* TFITS.ReportIntegrVal *)
}








function TFITS.ValReport:string;
var S : string;
begin
  S :=
  Self.sDtObs + ' ' +
  EFSt0(dVlos,7) + ' ' +
  EFSt0(rY0,15) + ' ' +
  EFSt0(rY1,10) + ' ' +
  EFSt0(rX0,7) + ' ' +
  ISt(IXP) + ' ' +

       EFSt0(CntMin,6)+' '+
       EFSt0(CntMax,6)+' '+
       ISt(iCntMin)+' '+
       ISt(iCntMax)+' '+


       EFSt0(wMin,6)+' '+
       EFSt0(wMax,6)+' '+
       ISt(iwMin)+' '+
       ISt(iwMax)+' '+

       EFSt0(HMaxM,6)+' '+
       EFSt0(HMaxP,6)+' '+
       ISt(iHMaxM)+' '+
       ISt(iHMaxP);

  result := S;

end;


function TFITS.ValRepHd:string;
var S : string;
begin
  S :=
  'Date_Obs ' +
  'dVlos ' +
  'Y0 ' +
  'Y1 ' +
  'X0 ' +
  'IX ' +

  'ContMin '+
  'ContMax '+
  'ICMin '+
  'ICMax '+

  '2wMin '+
  '2wMax '+
  'IwMin '+
  'IwMax '+

  'HMaxM '+
  'HMaxP '+
  'IHM '+
  'IHP '+
  '';

  result := S;
end;


function TFITS.ListRepHd:string;
var S : string;
begin
  S :=
  'Date_Obs ' +         // время
  'minutes ' +          // минуты от начала дня (для графиков)
  'IXP ' +              // позиция щели (в отсчётах)
  'XP ' +               // позиция щели (в угловых секундах)
  'Y0 ' +               // позиция половины высоты щели (в угловых секундах)
  'dVlos ' +
  'V_ ' +
  'V2-1 ' +
  'T1 ' +
  'T2 ' +
  'T3 ' +
  'T4 ' +
  'T5 ' +
  'T6 ' +
  '';

  result := S;
end;


function TFITS.ListReport:string;
var S : string;
begin
  S :=
  Self.sDtObs  + ' ' +   // время
  FSt0(tMin,3) + ' ' +   // минуты от начала дня (для графиков)
  ISt(IXpos)   + ' ' +   // позиция щели
  EFSt0(rXI,6) + ' ' +   // позиция щели в угл.секундах = rX0 + (rdX1 * IX)
  EFSt0(rY0,6) + ' ' +   // позиция центра высоты щели в угл.секундах
  EFSt0(dV_los,7)+' '+   // поправка луч.скорости м/с
  EFSt0(V_,7)  + ' ' +   // средняя лучевая скорость
  EFSt0(V21,7) + ' ' +   // разность лучевых скоростей 6302 и 6301
  EFSt0(T_1,7)  + ' ' +   // температура
  EFSt0(T_2,7)  + ' ' +   // температура
  EFSt0(T_3,7)  + ' ' +   // температура
  EFSt0(T_4,7)  + ' ' +   // температура
  EFSt0(T_5,7)  + ' ' +   // температура
  EFSt0(T_6,7)  + ' ' +   // температура



{
  EFSt0(rY0,15) + ' ' +
  EFSt0(rY1,10) + ' ' +
  EFSt0(rdY,7) + ' ' +
  EFSt0(rdY1,7) + ' ' +
  EFSt0(rYI,5) + ' ' +
  EFSt0(wdY,7) + ' ' +

  EFSt0(rX0,7) + ' ' +
  EFSt0(wdX,7) + ' ' +
  EFSt0(rdX,7) + ' ' +
  EFSt0(rXI,7) + ' ' +
  ISt(IXP) + ' ' +
}
  '';


  result := S;
end;


function TFITS.HeadReport:string;
var S : string;
begin
  S :=
  Self.sDtObs + ' ' +
  ISt(nLam) + ' ' +
  ISt(nY)   + ' ' +
  ISt(nXP)  + ' ' +
  EFSt0(rLa0,7)     + ' ' +
  EFSt0(rdLam,9)    + ' ' +
  EFSt0(rLamIdx0,4) + ' ' +
  EFSt0(dVlos,7)    + ' ' +

  EFSt0(rY0,15) + ' ' +
  EFSt0(rY1,10) + ' ' +
  EFSt0(rdY,7)  + ' ' +
  EFSt0(rdY1,7) + ' ' +
  EFSt0(rYI,5)  + ' ' +
  EFSt0(wdY,7)  + ' ' +

  EFSt0(rX0,7) + ' ' +
  EFSt0(wdX,7) + ' ' +
  EFSt0(rdX,7) + ' ' +
  EFSt0(rXI,7) + ' ' +
  ISt(IXP) + ' ' +
  '';


  result := S;
end;

function TFITS.HeadHd:string;
var S : string;
begin
  S :=
  'Date_Obs ' +
  'nLam ' +
  'nY ' +
  'nXP ' +
  'Lam0 ' +
  'dLam ' +
  'LamI0 ' +
  'dVlos ' +

  'Y0 ' +
  'Y1 ' +
  'dY ' +
  'dY1 ' +
  'YI0 ' +
  'FOVY ' +

  'X0 ' +
  'FOWX ' +
  'dX ' +
  'XI0 ' +
  'IXP ' +
  '';

  result := S;
end;



(* произвести вычисления LFITS.CalcKVI и сохранить результаты *)
procedure LFITS_SaveKVI;
var s,s9,sDt0,sTi0 : string; iFO,iLi,kCalcStep : integer;
begin
  (*===========================================================*)
  (* сохраняем ранее вычесленную "магнитность"                 *)
  (* (отношение |V|/I) в 2-х вариантах                         *)

  s9 := SunWorld.Get_rC90;(* читаем параметр из интерфейсного элемента      *)
                          (* уровень интенсивности, на котором заканчиваем  *)
                          (* интегрирование, следуя из центра линии к краям *)

  with SunWorld do begin

    sDt0 := swStr.left     (LFITS.sDtTi,'_');
    sTi0 := swStr.rightfrom(LFITS.sDtTi,'_');

    s := Trim(edKVI_Step.Text); (* опция счёта. Загружается из интерфейса *)
    if s = '1' then kCalcStep := 1 else kCalcStep := 0;

//if Not Assigned(LFITS.OuAnyC) then begin

    (*----------------------------------------------*)
    (*                 Р А С Ч Ё Т                  *)
    (*----------------------------------------------*)
    LFITS.CalcKVI(kCalcStep);  (*  OuKVI, OuKVIfine *)

    (*----------------------------------------------*)
    (*           ВЫВОД РЕЗУЛЬТАТОВ В ФАЙЛ           *)
    (*----------------------------------------------*)



    for iFO := 1 to mFOE do begin(* число типов карт FO_Err из CalcSumsFine*)
      if assigned(LFITS.OuErr[iFO])
      then LFITS.OuErr[iFO].Save
      else ;
    end;

    for iFO := 1 to mFine do(* число типов карт, к-рые рассчит-ет CalcSumsFine*)
      for iLi := 1 to 2 do begin
        if assigned(LFITS.OuAny[iFO,iLi])
        then LFITS.OuAny[iFO,iLi].Save
        else ;
      end;
  end; (* with SunWorld *)

end;

procedure LFITS_Ou_d0_Init(var Q4:boolean);
var sDt0,sTi0 : string;
begin
  (*-------------------------------------------------*)
  (* Определим служебные массивы                     *)
  (*   индексов точек экстремумов d0                 *)
  (*   значений d0                                   *)
  (*-------------------------------------------------*)


  with SunWorld do begin

  sDt0 := swStr.left     (LFITS.sDtTi,'_');
  sTi0 := swStr.rightfrom(LFITS.sDtTi,'_');

  LFITS.Ou_d01 := LFIO.GetFIOut(sDt0,sTi0,'d01');
  LFITS.Ou_d02 := LFIO.GetFIOut(sDt0,sTi0,'d02');
  LFITS.Ou_c01 := LFIO.GetFIOut(sDt0,sTi0,'Ld01');
  LFITS.Ou_c02 := LFIO.GetFIOut(sDt0,sTi0,'Ld02');

  Q4 := true;
  if Not Assigned(LFITS.Ou_d01) then Exit;

  with LFITS do begin
    if Ou_d01.nbData0 > 0 then begin
      Ou_d01.LoadData(Ou_d01.sFn,Ou_d01.nbData0);
      Ou_d02.LoadData(Ou_d02.sFn,Ou_d02.nbData0);
      Ou_c01.LoadData(Ou_c01.sFn,Ou_c01.nbData0);
      Ou_c02.LoadData(Ou_c02.sFn,Ou_c02.nbData0);
    end;
    Q4 := (length(Ou_d01.aData) = 0);
  end;
  end; (* with SunWorld *)
end;



begin
  QExport := false;  (* если true выводим 2.5E-2 иначе 2.5-2 см.TabStart *)

  rMapScale := 1.0;  (* масштабирование размеров картинки 1 или 2,3,4... *)
  QFITS320 := false; (* в FITS файлах ME/SW вручную разбираем пустые куски *)


  (* список унарных функций *)
  SLFun1 := TStringList.Create;
  SLFun1.Add('abs');
  SLFun1.Add('neg');
  SLFun1.Add('inv');
  SLFun1.Add('log');
  SLFun1.Add('exp10');
  SLFun1.Add('sig');
  SLFun1.Add('sin');
  SLFun1.Add('cos');
  SLFun1.Add('sq');
  SLFun1.Add('sqrt');


  (* список бинарных функций *)
  SLFun := TStringList.Create;
  SLFun.Add('add');
  SLFun.Add('mid');
  SLFun.Add('sub');
  SLFun.Add('rat');
  SLFun.Add('mul');

  (* бинарные функции + параметр *)
  SLFun2C := TStringList.Create;
  SLFun2C.Add('circsub');


  (* список функций работы с константой *)
  SLFunC := TStringList.Create;
  SLFunC.Add('add');
  SLFunC.Add('mul');
  SLFunC.Add('sub');
  SLFunC.Add('rat');

  (* для отслеживания расхода памяти *)
  nGrossData  := 0;
  nGrossCount := 0;

end.