unit Gaia_1476conv;

{$MODE Delphi}

{written for HNSKY quickly from some modules, Han K, 21-2-2015, update 2020}
interface

uses
  LCLIntf, LCLType, {LMessages, Messages,} SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, ExtCtrls,
   strutils, math,
  {$ifdef mswindows}
  windows {for shutdown}
  {$else} {unix}
   unix {for fpsystem}
  {$endif}
  ;

type

  { TMain_form }

  TMain_form = class(TForm)
    countstars1: TButton;
    includemissing1: TCheckBox;
    Label11: TLabel;
    Bevel1: TBevel;
    Label15: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    thefile1: TLabel;
    Label3: TLabel;
    Label16: TLabel;
    status1: TStaticText;
    sort_magnitude1: TButton;
    Bevel2: TBevel;
    bp_magnitude1: TRadioButton;
    v_magnitude2: TRadioButton;
    convert_to_smaller_record1: TButton;
    abbreviation1: TEdit;
    Bevel3: TBevel;
    step1_magnitude1: TEdit;
    step1_maxmagnitude1: TUpDown;
    Label7: TLabel;
    Label9: TLabel;
    Label4: TLabel;
    Label10: TLabel;
    Bevel4: TBevel;
    Label13: TLabel;
    Label5: TLabel;
    powerdown_enabled: TCheckBox;
    Label17: TLabel;
    magedit: TEdit;
    Label1: TLabel;
    epoch1: TEdit;
    Label_epoch: TLabel;
    UpDown1: TUpDown;
    gaia_missing_stars1: TEdit;
    Label14: TLabel;
    make290files1: TButton;
    Label6: TLabel;
    Label12: TLabel;
    Label2: TLabel;
    V_magnitude_and_BR1: TRadioButton;
    Label18: TLabel;
    Label8: TLabel;
    procedure bp_magnitude1Change(Sender: TObject);
    procedure countstars1Click(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure make290files1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure sort_magnitude1Click(Sender: TObject);
    procedure convert_to_smaller_record1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


var
  Main_form: TMain_form;
  maximum,mag_active                      :  double;
  bufferstring1,bufferstring2             : Tstrings;
  file_counter                            : integer;
  filen_out                               : string; {file namer to write}
implementation

{$R *.lfm}
uses   unit_1476;

var
  epoch2:double;
  ra1,dec1:double;
  mag1,b_r    :integer;
  leadname: string;
  readposition1,readposition2,nr_of_straylight : integer;
  ftext: textfile;
  thepath, typ : string;
  starcount, starcount2,starcount3 : array[-150..2000] of integer;


  G_to_V_correctie  : double=0.3; {V:=GP+0.3}
  G_to_BP_correctie : double=0.5; {BP:=GP+0.5}
  v_sort, BP_sort   : boolean;

const
  keypressed :word=0;

{$ifdef mswindows}
function ShutMeDown:string;
var
  hToken : THandle;
  tkp,p : TTokenPrivileges;
  RetLen : DWord;
  ExReply: LongBool;
  Reply : DWord;
begin
  if OpenProcessToken(GetCurrentProcess,TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken) then
  begin
    if LookupPrivilegeValue(nil,'SeShutdownPrivilege',tkp .Privileges[0].Luid) then
    begin
      tkp.PrivilegeCount := 1;
      tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
      AdjustTokenPrivileges(hToken,False,tkp,SizeOf(TTokenPrivileges),p,RetLen);
      Reply := GetLastError;
      if Reply = ERROR_SUCCESS then
      begin
        ExReply:= ExitWindowsEx(EWX_POWEROFF or EWX_FORCE, 0);
        if ExReply then Result:='Shutdown Initiated'
        else
        Result:='Shutdown failed with ' + IntToStr(GetLastError);
      end;
    end;
  end;
end;
{$else} {unix}
{$endif}


function inttostr(inp:integer): string;
begin
  str(inp,result);
end;
function doubletostr(inp:double): string;
begin
  str(inp:0:5,result);
end;

function strtostr_divide10(s1:string):string; {this give much smaller exe file then using strtofloat}
var
   err:integer; r:double;
begin
  val(s1,r,err);
  if err=0 then
  begin
    r:=r/10;
    str(r:0:1,result);
  end;
end;

function floattostr_one_digit(r:double):string;
begin
    str(r:0:1,result);
end;
procedure writetextfile(new1:boolean; name, message1:string);
var F: TextFile;
begin
  AssignFile(F,thepath+PathDelim+'Gaia'+PathDelim+name);
  if new1 then Rewrite(F) {clear previous info}
          else Append(f);
  Writeln(F,formatdatetime('c', now)+'; '+message1);
  Flush(f);  { Ensures that the text was actually written to file. }
  CloseFile(F);
end;

procedure writeLONGREPORT;
var F: TextFile;
    i : integer;
begin
  AssignFile(F,thepath+PathDelim+'Gaia'+PathDelim+'result_sort_small_steps'+typ+'.txt');
  Rewrite(F); {clear previous info}
  Writeln(F,'mag x 100; bp_stars; stars_without_bp; stars_effect_by_straylight');
  for i:=-150 to 2000 do
      Writeln(F,inttostr(i)+';'+inttostr(starcount[i])+';'+inttostr(starcount2[i])+';'+inttostr(starcount3[i]) );{keep record in steps of 0.01 magnitude. first value stars with BP other without}
  CloseFile(F);
end;

procedure convert_A6to5;
var i,j:integer;
    name1:string;
    info1  : array[0..112] of ansichar;
    fromf    : file;
    buf6: array[1..12] of byte;
    buf5: array[1..12] of byte;
    p5           : ^hnskyhdr1476_5;		        { pointer to hnskyrecord }
    marker_record, mag2, rec_pos_start, rec_pos_stop,
    filesizevalue                                       :  integer;
    all_records  : array of hnskyhdr1476_A6;
    recordposition, nr_of_records :integer;
begin
  writetextfile(true,'result6to5.txt','Started');{clear previous message}
  nr_of_stars:=0;

  for i:=1 to 1476 do {create,  reset output files}
  begin
    name1:= Main_form.abbreviation1.text+'_' +filenames1476(i); {use for destination TYC file names and not UCAC4 names}
    main_form.caption:='Making 5 byte record database from: '+name1;
    Application.ProcessMessages; {allow application  to update form1 with above messages}

    assignfile(fromf,name1);
    filemode:=0;{read}
    reset(fromf,1);
    Blockread(fromf,info1,110);

    if info1[109]=#$A6 then
        info1[109]:=#5 {5 byte record}
    else
     begin
       messagebox(main_form.handle,pchar('Error not $A6 byte record source file !'),pchar('Converting 6 to 5 bytes'),MB_ICONINFORMATION);
       exit;
    end;


    filesizevalue:=FileSize(fromf);
    nr_of_records:=round((filesizevalue-110)/SizeOf(hnskyhdr1476_A6));
    SetLength(all_records,nr_of_records+1);
    Blockread(fromf,all_records[0],nr_of_records*SizeOf(hnskyhdr1476_A6));{read all records at once}
    recordposition:=0;

    assignfile(tof,'tmp_' +filenames1476(i));{designation files}
    filemode:=2;{read/write}
    rewrite(tof,1);
    Blockwrite(tof,info1,110,Numwritten);{header is 110 bytes }
    if numwritten<>110 then
    begin
      messagebox(main_form.handle,pchar('ERROR !!! Can"t create file files. Close HNSKY'),pchar('Error'),MB_ICONERROR);
      exit;
    end;


    rec_pos_start:=0;{skip header, start where the magnitude starts}
    rec_pos_stop:=0;{skip header, start where the magnitude stops}

    repeat
      marker_record:=-999;
      for j:=0 to 255 do
      begin
        recordposition:=rec_pos_start;
        p5:= @buf5[1];			{ set pointer }
        repeat {do all 255 dec9 values}
          if  ((all_records[recordposition].ra7=255) and (all_records[recordposition].ra8=255) and (all_records[recordposition].ra9=255))  then  {special magnitude record is found}
          begin {special 6 byte record}
            if all_records[recordposition].dec9>-20 then mag2:=all_records[recordposition].dec9 else  mag2:=256+all_records[recordposition].dec9;{new magn 12.8 is -12.8, 12.9 = -12.7}
             {magnitude is stored in mag2 till new magnitude record is found}
             rec_pos_stop:=recordposition;{where the magnitude starts}
          end
          else
          begin {same magnitude}

            if all_records[recordposition].dec9+128=j then {within dec9 range}
            begin
              if all_records[recordposition].dec9+128<>marker_record then {compare highest shortint of Dec if already seen and written}
              begin
                marker_record:=j; {remember first marker record is written}
              {Right accension===========================================}
                p5.ra7 := $FF;
                p5.ra8 := $FF;
                p5.ra9 := $FF;{set marker for new magnitude in record}
                {declination part===========================================}
                {store 2 bytes for dec9 and mag0}
                p5.dec7 := all_records[recordposition].dec9+128;{store dec9 shortint as byte}
                p5.dec8 := mag2+16;{store mag0 shortint as byte with 16 offset for negative numbers}
                blockwrite(tof,buf5, SizeOf(hnskyhdr1476_5),Numwritten);
              end;
             {now write real data,{dec9 and mag0 are stored ONCE in marker record}
              {Right accension===========================================}
              p5.ra7 :=all_records[recordposition].ra7;
              p5.ra8 :=all_records[recordposition].ra8;
              p5.ra9 :=all_records[recordposition].ra9;
              {declination===========================================}
              p5.dec7 := all_records[recordposition].dec7;
              p5.dec8 := all_records[recordposition].dec8;{dec9 and mag0 are stored in marker record}
              blockwrite(tof,buf5, SizeOf(hnskyhdr1476_5),Numwritten);
              inc(nr_of_stars);
            end;{withing dec9 range}
          end;{do all 255 dec9 values}
          inc(recordposition);
        until   ((rec_pos_stop>rec_pos_start+1) or (recordposition>=nr_of_records) );{where the magnitude starts}
        if j<>255 then recordposition:=rec_pos_start;{go back to the beginning of the magnitude, but not at last cyclus to enable eof dectection}

        if keypressed=vk_F4 then begin closefile(tof);  main_form.caption:='Stopped';exit; end;;
        if keypressed=vk_F7  then
        begin
          repeat
            main_form.status1.caption:='Paused';
            sleep(500);
            Application.ProcessMessages; {allow application  to update form1 with above messages}
          until keypressed=vk_F8;
          main_form.status1.caption:='Running';
        end;
        main_form.caption:='Making 6 byte record database from: '+name1+', magn: '+inttostr(mag2)+', stars_done: '+inttostr(nr_of_stars);;
      end;{for j loop}
      rec_pos_start:=rec_pos_stop; {do next magnitude}
    until recordposition>=nr_of_records; ;{all magnitudes done}

    writetextfile(false,'result6to5.txt',name1+ ' total stars_done:'+inttostr(nr_of_stars));{write result to file}
    closefile(tof);
    closefile(fromf);
  end;{i loop}

end;

procedure convert_A7to6;
var i,j:integer;
    name1:string;
    info1  : array[0..112] of ansichar;
    fromf    : file;
    buf6: array[1..12] of byte;
    buf5: array[1..12] of byte;
//    p5           : ^hnskyhdr1476_5;		        { pointer to hnskyrecord }
    p6         : ^hnskyhdr1476_6;
    marker_record, mag2, rec_pos_start, rec_pos_stop,
    filesizevalue                                       :  integer;
    all_records  : array of hnskyhdr1476_A7;
    recordposition, nr_of_records :integer;
begin
  writetextfile(true,'result7to6.txt','Started');{clear previous message}
  nr_of_stars:=0;

  for i:=1 to 1476 do {create,  reset output files}
  begin
    name1:= Main_form.abbreviation1.text+'_' +filenames1476(i); {use for destination TYC file names and not UCAC4 names}
    main_form.caption:='Making 5 byte record database from: '+name1;
    Application.ProcessMessages; {allow application  to update form1 with above messages}

    assignfile(fromf,name1);
    filemode:=0;{read}
    reset(fromf,1);
    Blockread(fromf,info1,110);

    if info1[109]=#$A7 then
        info1[109]:=#6 {6 byte record}
    else
    begin
       messagebox(main_form.handle,pchar('Error not $A7 byte record source file !'),pchar('Converting 7 to 6 bytes'),MB_ICONINFORMATION);
       exit;
    end;


    filesizevalue:=FileSize(fromf);
    nr_of_records:=round((filesizevalue-110)/SizeOf(hnskyhdr1476_A7));
    SetLength(all_records,nr_of_records+1);
    Blockread(fromf,all_records[0],nr_of_records*SizeOf(hnskyhdr1476_A7));{read all records at once}
    recordposition:=0;

    assignfile(tof,'tmp_' +filenames1476(i));{designation files}
    filemode:=2;{read/write}
    rewrite(tof,1);
    Blockwrite(tof,info1,110,Numwritten);{header is 110 bytes }
    if numwritten<>110 then
    begin
      messagebox(main_form.handle,pchar('ERROR !!! Can"t create file files. Close HNSKY'),pchar('Error'),MB_ICONERROR);
      exit;
    end;


    rec_pos_start:=0;{skip header, start where the magnitude starts}
    rec_pos_stop:=0;{skip header, start where the magnitude stops}

    repeat
      marker_record:=-999;
      for j:=0 to 255 do
      begin
        recordposition:=rec_pos_start;
        p6:= @buf6[1];			{ set pointer }

        repeat {do all 255 dec9 values}
          if  ((all_records[recordposition].ra7=255) and (all_records[recordposition].ra8=255) and (all_records[recordposition].ra9=255))  then  {special magnitude record is found}
          begin {special 6 byte record}
            if all_records[recordposition].dec9>-20 then mag2:=all_records[recordposition].dec9 else  mag2:=256+all_records[recordposition].dec9;{new magn 12.8 is -12.8, 12.9 = -12.7}
             {magnitude is stored in mag2 till new magnitude record is found}
             rec_pos_stop:=recordposition;{where the magnitude starts}
          end
          else
          begin {same magnitude}

            if all_records[recordposition].dec9+128=j then {within dec9 range}
            begin
              if all_records[recordposition].dec9+128<>marker_record then {compare highest shortint of Dec if already seen and written}
              begin
                marker_record:=j; {remember first marker record is written}
              {Right accension===========================================}
                 p6.ra7 := $FF;
                 p6.ra8 := $FF;
                 p6.ra9 := $FF;{set marker for new magnitude in record}

                {declination part===========================================}
                {store 2 bytes for dec9 and mag0}
                 p6.dec7 := all_records[recordposition].dec9+128;{store dec9 shortint as byte}
                 p6.dec8 := mag2+16;{store mag0 shortint as byte with 16 offset for negative numbers}
                 p6.bp_rp := 0;
                 blockwrite(tof,buf6, SizeOf(hnskyhdr1476_6),Numwritten);
              end;
              {now write real data,{dec9 and mag0 are stored ONCE in marker record}
              {Right accension===========================================}
              p6.ra7 :=all_records[recordposition].ra7;
              p6.ra8 :=all_records[recordposition].ra8;
              p6.ra9 :=all_records[recordposition].ra9;
              {declination===========================================}
              p6.dec7 := all_records[recordposition].dec7;
              p6.dec8 := all_records[recordposition].dec8;{dec9 and mag0 are stored in marker record}
              p6.bp_rp:=all_records[recordposition].bp_rp;
              blockwrite(tof,buf6, SizeOf(hnskyhdr1476_6),Numwritten);
              inc(nr_of_stars);

            end;{withing dec9 range}
          end;{do all 255 dec9 values}
          inc(recordposition);
        until   ((rec_pos_stop>rec_pos_start+1) or (recordposition>=nr_of_records) );{where the magnitude starts}
        if j<>255 then recordposition:=rec_pos_start;{go back to the beginning of the magnitude, but not at last cyclus to enable eof dectection}

        if keypressed=vk_F4  then begin closefile(tof);  main_form.caption:='Stopped';exit; end;;
        if keypressed=vk_F7 then
        begin
          repeat
            main_form.status1.caption:='Paused';
            sleep(500);
            Application.ProcessMessages; {allow application  to update form1 with above messages}
          until keypressed=vk_F8;
          main_form.status1.caption:='Running';
        end;
        main_form.caption:='Making 5 byte record database from: '+name1+', magn: '+inttostr(mag2)+', stars_done: '+inttostr(nr_of_stars);;
      end;{for j loop}
      rec_pos_start:=rec_pos_stop; {do next magnitude}
    until recordposition>=nr_of_records; ;{all magnitudes done}

    writetextfile(false,'result7to6.txt',name1+ ' total stars_done:'+inttostr(nr_of_stars));{write result to file}
    closefile(tof);
    closefile(fromf);
  end;{i loop}


end;

procedure TMain_form.convert_to_smaller_record1Click(Sender: TObject);
var
  i : integer;
  name1,name2,tempname : string;
  fileDate    : Integer;
  newDateTime : TDateTime;

begin
  bp_sort:=main_form.bp_magnitude1.checked;
  V_sort:=((main_form.v_magnitude2.checked) or  (main_form.V_magnitude_and_BR1.checked));
  if v_sort then typ:='V' else typ:='B';

  if ((main_form.v_magnitude2.checked=false) and (main_form.BP_magnitude1.checked=false) and (main_form.V_magnitude_and_BR1.checked=false)) then
  begin
    messagebox(main_form.handle,pchar('Selection missing. Specify magnitude type in step 1'),pchar('Error'),MB_ICONERROR);
    exit;
  end;

  if V_magnitude_and_BR1.checked=false then
                                       convert_A6to5
                                       else
                                       convert_A7to6;
  for i:=1 to 1476 do
  begin

    name1:= Main_form.abbreviation1.text+'_' +filenames1476(i); {source files}
    tempname:='gxx_' +filenames1476(i);
    renamefile(name1,tempname);{G16 source to gxx}

    name2:='tmp_' +filenames1476(i);{result file files}
    renamefile(name2,name1);{tmp result to g16}

    renamefile(tempname,name2);{rename gxx to tmp}


    newDateTime :=date;
    FileSetDate(name1, DateTimeToFileDate(newDateTime));{set date to midnight}
  end;

  if ((Main_form.powerdown_enabled.checked)and (nr_of_stars>100)) then
  {$ifdef mswindows}
  main_form.caption:= ShutMeDown
  {$else} {unix}
  fpSystem('/sbin/shutdown -P now')
  {$endif}
  else
  messagebox(main_form.handle,pchar('Ready.   Stars done:'+ inttostr(nr_of_stars)),pchar('Ready'),MB_ICONINFORMATION);
  main_form.status1.caption:='Finished';


end;

procedure read_Tycho(epoch2:double; var ra1,dec1: double; var  mag1, b_r: integer);
var
   info  : string;
   error0,error1,error2, error_total,errorhip,komma1,oldkomma,tyc1,tyc2,tyc3,hip1:integer;
   mag1R,magVT, magBT,pmRA, pmDEC, V,I  : double;
   star_ok: boolean;

begin
   repeat
     if (readposition2>=bufferstring2.count) then
     begin
        RA1:=99999;
        exit;
     end;
     if (length(bufferstring2.strings[readposition2])<2) then  {empthy line}
     begin
        inc(readposition2);
         RA1:=99999;
         exit;
     end;
     error_total:=0;

     komma1:=posex(',',bufferstring2.strings[readposition2],1);
     info:=copy(bufferstring2.strings[readposition2],1,komma1-1);{ra}
     val(info,ra1,error1); error_total:=error_total+error1;
     oldkomma:=komma1+1;

     komma1:=posex(',',bufferstring2.strings[readposition2],oldkomma);
     info:=copy(bufferstring2.strings[readposition2],oldkomma,komma1-oldkomma);{dec}
     val(info,dec1,error1); error_total:=error_total+error1;
     oldkomma:=komma1+1;

     komma1:=posex(',',bufferstring2.strings[readposition2],oldkomma);
     info:=copy(bufferstring2.strings[readposition2],oldkomma,komma1-oldkomma);{tyc1}
     val(info,tyc1,error1);
     oldkomma:=komma1+1;

     komma1:=posex(',',bufferstring2.strings[readposition2],oldkomma);
     info:=copy(bufferstring2.strings[readposition2],oldkomma,komma1-oldkomma);{tyc2}
     val(info,tyc2,error1);
     oldkomma:=komma1+1;

     komma1:=posex(',',bufferstring2.strings[readposition2],oldkomma);
     info:=copy(bufferstring2.strings[readposition2],oldkomma,komma1-oldkomma);{tyc3}
     val(info,tyc3,error1);
     oldkomma:=komma1+1;


//     IF pos(',17,1398,',bufferstring2.strings[readposition2])>0 then
//      beep;

//_RAJ2000,_DEJ2000,TYC1,TYC2,TYC3,pmRA,pmDE,BTmag,VTmag,HIP,RA(ICRS),DE(ICRS)
//deg,deg, , , ,mas/yr,mas/yr,mag,mag, ,deg,deg

     komma1:=posex(',',bufferstring2.strings[readposition2],oldkomma);
     info:=copy(bufferstring2.strings[readposition2],oldkomma,komma1-oldkomma);{pmRA}
     val(info,pmRA,error1);
     oldkomma:=komma1+1;

     komma1:=posex(',',bufferstring2.strings[readposition2],oldkomma);
     info:=copy(bufferstring2.strings[readposition2],oldkomma,komma1-oldkomma); {pmdec}
     val(info,pmDEC,error1);
     oldkomma:=komma1+1;

     komma1:=posex(',',bufferstring2.strings[readposition2],oldkomma);
     info:=copy(bufferstring2.strings[readposition2],oldkomma,komma1-oldkomma);{magBT}
     if pos(' ',info)>0  then error1:=1 else  val(info,magBT,error1);
     oldkomma:=komma1+1;

     komma1:=posex(',',bufferstring2.strings[readposition2],oldkomma);
     info:=copy(bufferstring2.strings[readposition2],oldkomma,komma1-oldkomma); {magVT}
     if pos(' ',info)>0 then error2:=1 else val(info,magVT,error2);
     oldkomma:=komma1+1;

     komma1:=posex(',',bufferstring2.strings[readposition2],oldkomma);
     info:=copy(bufferstring2.strings[readposition2],oldkomma,komma1-oldkomma); {hip}
     val(info,hip1,errorhip);
     oldkomma:=komma1+1;


      b_r:=-128; {unknown Bp-Rp value for Tycho stars, will be calculated later if within range}

     if ((error1=0) and (error2=0)) then
     begin
       if BP_sort then
          mag1R := magVt -0.006739+0.2758*(magBt-magVt)-0.135*sqr(magBt-magVt)  {Gaia BPg := Vt -0.006739+0.2758*(Bt-Vt)-0.135*(Bt-Vt)^2+0.01098(Bt-Vt)^3}
                          +0.01098*sqr(magBt-magVt)*(magBt-magVt)
       else
       if V_sort then
       begin
         mag1r:=magVT - 0.090 * (magBT - magVT);  {V = VT - 0.090 * (BT - VT)}
         if ((magBT-magVT>=-0.2) and (magBT-magVt<=2.0)) then {valid conversion range}
         begin
            b_r:=round(10*(0.03147 +1.456*(magBt-magVt) -0.6043*sqr(magBt-magVt)+0.1750*sqr(magBt-magVt)*(magBt-magVt) )); {Gaia GBP-GRP formula}
         end;

         if  ((tyc1=  129	) and (tyc2=	1873	) and (tyc3=	1	)) then begin b_r:=round(10*2.1);end;	;{M0, Betelgeuze}
         if  ((tyc1= 6803	) and (tyc2=	2158	) and (tyc3=	1	)) then begin b_r:=round(10*2.1);end;	;{M0, Antares}

         if  ((tyc1= 7689	) and (tyc2=	2617	) and (tyc3=	1	)) then begin b_r:=round(10*1.5);end;	;{K5}
         if  ((tyc1= 7663	) and (tyc2=	4093	) and (tyc3=	1	)) then begin b_r:=round(10*-0.3);end;	;{03}
         if  ((tyc1= 1991	) and (tyc2=	1895	) and (tyc3=	1	)) then begin b_r:=round(10*1.5);end;	;{K0}
         if  ((tyc1= 1423	) and (tyc2=	1349	) and (tyc3=	2	)) then begin b_r:=round(10*1.5);end;	;{K0}


       end
       else
       halt;

     end
     else
     if error1=0 then  mag1R:=MagBT{no VT magnitude, use BT instead 25 stars only}
     else
     if error2=0 then
     begin
       mag1R:=MagVT;

       I:=-99;
       if  ((tyc1=	5949	) and (tyc2=	2777	) and (tyc3=	1	)) then begin mag1r:=	-1.46;{A1} b_r:=round(10*0.3);end;	;{sirus, simbad reports for tyc an other magnitude then hip ??}
       if  ((tyc1=	3105	) and (tyc2=	2070	) and (tyc3=	1	)) then begin mag1r:=	0.03;{A0} b_r:=round(10*0.3); end;
       if  ((tyc1=	9007	) and (tyc2=	5849	) and (tyc3=	1	)) then begin mag1r:=	0.01;{G2}b_r:=round(10*0.9); end;
       if  ((tyc1=	1472	) and (tyc2=	1436	) and (tyc3=	1	)) then begin mag1r:=	-0.05;{K1}b_r:=round(10*1.5); end;
       if  ((tyc1=	3358	) and (tyc2=	3141	) and (tyc3=	1	)) then begin mag1r:=	0.08;{G3}b_r:=round(10*0.9);end;
       if  ((tyc1=	187	) and (tyc2=	2184	) and (tyc3=	1	)) then   begin mag1r:=	0.37;{F5}b_r:=round(10*0.7);end;
       if  ((tyc1=	9005	) and (tyc2=	3919	) and (tyc3=	1	)) then begin mag1r:=	0.6	;{B1}b_r:=round(10*0.0);end;
       if  ((tyc1=	9007	) and (tyc2=	5848	) and (tyc3=	1	)) then begin mag1r:=	1.33;{K1};b_r:=round(10*1.5);end; {alpha Centauri 2}
       if  ((tyc1=	2457	) and (tyc2=	2407	) and (tyc3=	1	)) then begin mag1r:=	1.93;{A1}b_r:=round(10*0.3);end;{castor}
       if  ((tyc1=	8573	) and (tyc2=	3571	) and (tyc3=	1	)) then begin mag1r:=	1.99;{A0}b_r:=round(10*0.3); end;
       if  ((tyc1=	4146	) and (tyc2=	1274	) and (tyc3=	1	)) then begin mag1r:=	2	;{G9/k0}b_r:=round(10*1.2);end; {dubhe}
       if  ((tyc1=	1329	) and (tyc2=	1746	) and (tyc3=	1	)) then begin mag1r:=	1.92;{A1}b_r:=round(10*0.3);end; {alhena}
       if  ((tyc1=	8579	) and (tyc2=	2692	) and (tyc3=	1	)) then begin mag1r:=	2.01;{K3}b_r:=round(10*1.5); end; {avior}
       if  ((tyc1=	4766	) and (tyc2=	2445	) and (tyc3=	1	)) then begin mag1r:=	2.41;{B0}b_r:=round(10*0.0);end;
       if  ((tyc1=	2457	) and (tyc2=	2407	) and (tyc3=	2	)) then begin mag1r:=	2.97;end;
       if  ((tyc1=	1472	) and (tyc2=	1436	) and (tyc3=	2	)) then begin mag1r:=	4.05;{}end;
       if  ((tyc1=	1423	) and (tyc2=	1349	) and (tyc3=	2	)) then begin mag1r:=	4.225;{o9} end;
       if  ((tyc1=	4766	) and (tyc2=	2445	) and (tyc3=	2	)) then begin mag1r:=	3.76;{} end; {some of these hip numbers are double used !!, so use tyc}
       if  ((tyc1=	9005	) and (tyc2=	3919	) and (tyc3=	2	)) then begin mag1r:=	4.58;end; {some of these hip numbers are double used !!, so use tyc}
       if  ((tyc1=	8579	) and (tyc2=	2692	) and (tyc3=	2	)) then begin mag1r:=	3.85;end; {some of these hip numbers are double used !!, so use tyc}
       if  ((tyc1=	4146	) and (tyc2=	1274	) and (tyc3=	2	)) then begin mag1r:=	4.91;end; {some of these hip numbers are double used !!, so use tyc}
       if  ((tyc1=	7892	) and (tyc2=	7679	) and (tyc3=	2	)) then begin mag1r:=	6.22;end; {some of these hip numbers are double used !!, so use tyc}
       if  ((tyc1=	8573	) and (tyc2=	3571	) and (tyc3=	2	)) then begin mag1r:=	5.57;end; {some of these hip numbers are double used !!, so use tyc}

     end
     else
     begin
       mag1R:=9999;
       error_total:=999;
     end;

     mag1:=round(mag1r*10);

     if mag1<>round(mag_active*10) then  error_total:=7; {not the correct magnitude}

     if error_total<>0 then mag1:=999 {ignore this star entry, try next }
     else
     begin
       DEC1 {(epoch T)} := (DEC1 + pmDEC * (epoch2 - 1991.25)/(3600*1000))*  (pi/180);  {DEC first}
       RA1  {(epoch T)} := (RA1  + pmRA / cos(dec1)*(epoch2 - 1991.25)/(3600*1000))*(pi/180);
     end;
     inc(readposition2);
   until ((readposition2>=bufferstring2.count) or (error_total=0));
end;


procedure read_gaia(epoch2:double;var ra1,dec1: double;var  mag1, b_r: integer);
var
   info ,regel : string;
   error1,error2, error_total,komma1,oldkomma:integer;
   magG,magBP, magRP,pmRA, pmDEC  : double;
   star_ok: boolean;
   blink       : boolean;

begin

   repeat
     error_total:=0;
     regel:=bufferstring1.strings[readposition1];


     komma1:=posex(',',regel,1);
     info:=copy(regel,1,komma1-1);{RA}
     val(info,ra1,error1); error_total:=error_total+error1;
     oldkomma:=komma1+1;

     komma1:=posex(',',regel,oldkomma);
     info:=copy(regel,oldkomma,komma1-oldkomma);{DEC}
     val(info,dec1,error1); error_total:=error_total+error1;
     oldkomma:=komma1+1;

     komma1:=posex(',',regel,oldkomma);
     info:=copy(regel,oldkomma,komma1-oldkomma);{pmRA}
     val(info,pmRA,error1);
     oldkomma:=komma1+1;

     komma1:=posex(',',regel,oldkomma);
     info:=copy(regel,oldkomma,komma1-oldkomma); {pmdec}
     val(info,pmDEC,error1);
     oldkomma:=komma1+1;

//main_form.caption:=inttostr(nr_of_stars);
//     if  nr_of_stars>=21861 then
//     beep(100,1000);

     komma1:=posex(',',regel,oldkomma); {G magnitude}
     info:=copy(regel,oldkomma,komma1-oldkomma);{G magnitude}
     val(info,magG,error1); error_total:=error_total+error1;
     oldkomma:=komma1+1;

     komma1:=posex(',',regel,oldkomma); {}
     info:=copy(regel,oldkomma,komma1-oldkomma);{BP magnitude}
     val(info,magBP,error1);
     oldkomma:=komma1+1;

     komma1:=posex(',',regel,oldkomma); {}
     if komma1=0 then komma1:=999;{last value without ending with a komma}
     info:=copy(regel,oldkomma,komma1-oldkomma);{RP magnitude}
     val(info,magRP,error1);


//     if  abs(dec1+3.68652760191)<0.0001 then
//       if  abs((ra1)-82.86754111476)<0.0001 then   {tyc 4770-574}
//       beep(100,800);

     if error_total<>0 then
     mag1:=999 {ignore this star entry, try next }
     else
     begin                                                       {GAIA eDR3 2016 epoch !!!!!!}
       DEC1 {(epoch T)} := (DEC1 + pmDEC * (epoch2 - 2016.0)/(3600*1000))*  (pi/180);  {DEC first}
       RA1  {(epoch T)} := (RA1  + pmRA / cos(dec1)*(epoch2 - 2016.0)/(3600*1000))*(pi/180);

       b_r:=-128;{no info}
       if ((magBP<>0) and (magRP<>0)) then {gaia color info}
       begin
         if abs(magBP-magRP)<=12.7 then
         b_r:=round((magBP-magRP)*10);
       end;

       mag1:=round(mag_active*10);{magnitude is already defined by sort, no need to read or calculate}
     end;

     inc(readposition1);


   until ((readposition1>bufferstring1.count-1) or  (error_total=0));

   if frac(nr_of_stars/1000)=0 then
   begin
     main_form.caption:=('Now doing magnitude: '+floattostr_one_digit(mag_active)+'    Stars done: '+ inttostr(nr_of_stars));
     if keypressed=vk_F4 then halt;
     if keypressed=vk_F then
     repeat
       main_form.status1.caption:='Paused';
       if blink then main_form.status1.color:=Clred else main_form.status1.color:=CLblack;
       if blink then blink:=false else  blink:=true;{blinker}
       sleep(500);
       Application.ProcessMessages; {allow application  to update form1 with above messages}
     until keypressed=vk_F8;
     main_form.status1.caption:='Running';
     Application.ProcessMessages; {allow application  to update form1 with above messages}
   end;
end;

procedure AppendToFile(s: TStrings; fn: TFileName);{append Tstring to file. To save memory}
var
  i: Integer;
  f: textfile;
begin
  assign(f,fn);
  append(f);
  for i:=0 to s.Count-1 do
    writeln(f,s.Strings[i]);
  closefile(f);
end;


procedure Read_ftext(var st: TStrings);{read file to Tstring in pieces to save memory. Above 300 mbytes problems}
var
  i: Integer;
  line1 :string;
begin
  i:=0;
  st.clear;{clear tstrings}
  repeat
    readln(ftext,line1);
    st.Add(line1);
    inc(i);
  until ((i>=20000) or (eof(ftext)));
end;



procedure gaia_sort_magnitude(mag_active: double); {sort on magnitude}
var
   info,filen,regel  : string;
   error1,error2, error_total,komma1,oldkomma:integer;
   magG,magBP, magRP,pmRA, pmDEC,Gflux,BPflux,RPflux,C,magBPold,magRPold  : double;
   star_ok: boolean;
   blink,straylight   : boolean;

begin
   readposition1:=0;{skip first text line}
   repeat

     error_total:=0;
     regel:=bufferstring1.strings[readposition1];

     komma1:=posex(',',regel,1);    {ra}
     oldkomma:=komma1+1;



     komma1:=posex(',',regel,oldkomma); {dec}
     oldkomma:=komma1+1;

//     if pos('579900822252441',regel)<>0 then
//     beep;

     komma1:=posex(',',regel,oldkomma);{pmra}
     oldkomma:=komma1+1;

     komma1:=posex(',',regel,oldkomma);{pmdec}
     oldkomma:=komma1+1;


     komma1:=posex(',',regel,oldkomma); {G magnitude}
     info:=copy(regel,oldkomma,komma1-oldkomma);{G magnitude}
     val(info,magG,error1); error_total:=error_total+error1;
     oldkomma:=komma1+1;

     komma1:=posex(',',regel,oldkomma); {}
     info:=copy(regel,oldkomma,komma1-oldkomma);{BP magnitude}
     val(info,magBP,error1);
     oldkomma:=komma1+1;

     komma1:=posex(',',regel,oldkomma); {}
     if komma1=0 then komma1:=999;{last value without ending with a komma}
     info:=copy(regel,oldkomma,komma1-oldkomma);{RP magnitude}
     val(info,magRP,error1);



     {quality check by flux ratio}
     magBPold:=magBP;{for debugging}
     magRPold:=magRP;
     //SELECT gaia_source.ra,gaia_source.dec, gaia_source.pmra, gaia_source.pmdec, gaia_source.phot_g_mean_mag, gaia_source.phot_bp_mean_mag, gaia_source.phot_rp_mean_mag, phot_g_mean_flux, phot_bp_mean_flux, phot_rp_mean_flux
     //FROM gaiaedr3.gaia_source
     //WHERE (gaiaedr3.gaia_source.phot_bp_mean_mag>=12.7 AND gaiaedr3.gaia_source.phot_bp_mean_mag<12.8)
     //
     //C:=(BPflux +RPflux)/Gflux  is normally a little above 1 so about 1.15.. So chapter 6 "Gaia Early Data Release 3 Photometric content and validation"
     //if flux is calculated from the magnitudes it is a little above 2}

     //De flux kan ik ook terugrekenen van de magnitude. Dat is gemakkelijker want de flux heb ik nog niet in de database.
     //Het blijkt als je de flux uitrekend dan is de ratio (BPflux+RPflux)/Gflux meestal iets boven circa 2. Maar loopt voor de
     //slechte waarden op tot wel 27. Het idee is nu wanneer deze ratio groter dan 4 en G>BP de G magnitude te gebruiken, anders BP.
     //De conditie G>BP is nodig voor hele rode sterren om te voorkomen dat je een infrarood magnitude neemt.
     straylight:=false;
     if ((magBP<>0) and (magRP<>0)) then {do quality check}
     begin
       Gflux:=power(10,(20-magG)/2.5);
       BPflux:=power(10,(20-magBP)/2.5);
       RPflux:=power(10,(20-magRP)/2.5);
       c:=(BPflux+RPflux)/Gflux;
       if ((c>4) and (magG>magBP)) then {straylight do not rely on BP and RP. C is normally a little above 2}
          begin
            magBP:=0;
            magRP:=0;
            straylight:=true;
          end;
     end;


     if BP_sort then
     begin
       if magBP<>0 {BP magn data available} then
         mag1:=round(magBP*10)
       else
         mag1:=round((magG+G_to_BP_correctie)*10); {add half magnitude, average for mag 15. 0.51 for mag 15, 0.41 for mag 10.8 }
     end
     else
     if V_sort then
     begin {V magnitude}
       if ((magBP<>0) and (magRP<>0)) then
         begin
           if ((magBP-magRP>=-0.5) and (magBP-magRP<=5.0)) then {formula valid edr3}
           mag1:=round((magG + 0.02704 - 0.0124*(magBP-magRP) + 0.2156*sqr(magBP-magRP) -0.01426*sqr(magBP-magRP)*(magBP-magRP) )*10)  {edr3}
           else {1% of the stars}
           mag1:=round((magBP-0.18)*10);{rough estimate -0.187 for mag 15}
         end
         else
         mag1:=round((magG+G_to_V_correctie)*10); {rough estimate for 0.26 for mag 10.8, 0.33 for mag 15}
     end;

    //Voor een fotografische sterren database gebaseerd op BPg kan ik de Tycho aanvullende sterren omrekenen
    //Tycho -> BPg
    //BPg := Vt -0.006739+0.2758*(Bt-Vt)-0.135*(Bt-Vt)^2+0.01098(Bt-Vt)^3
    //En voor de Gaia met de ontbrekende BPg magnitude zoiets als:
    //BPg := G+0.5

    //Voor een V magnitude database kan ik V bereken voor zowel Gaia als Tycho:
    //Gaia -> V
    //V := G + 0.01760 + 0.006860 * (BPg−RPg) + 0.1732 * (BPg−RPg)^2
    //En voor de ontbrekende BPg magnitudes zoiets als:
    //V:= G+0.3
    //Tycho->V
    //V := Vt - 0.090 * (Bt - Vt) {oude formule}


//     if ((round(mag_active*10)=42) AND ('16.5209'=copy(regel,1,7)))  then
//     beep(200,600);


     star_ok:=(mag1=round(mag_active*10)); {magnitude filter}

     if star_ok then
     begin
       inc(nr_of_stars);
       if magBP<>0 {BP magn data available} then inc(starcount[round(magBP*100)],1){for checking if database is complete}
                                            else inc(starcount2[round((magG+0.5)*100)],1);{for checking if database is complete}

       if straylight then
       begin
         inc(starcount3[round((magG+0.5)*100)],1);{stars effected by straylight}
         inc(nr_of_straylight);
       end;

       bufferstring2.Add(regel);

     end;

     if bufferstring2.count>=20000 then {interim save to save memory}
     begin
        AppendToFile(bufferstring2,filen_out);{write last part}
        bufferstring2.Clear;
     end;

     inc(readposition1);
     if frac(readposition1/10000)=0 then
     begin
       main_form.caption:=('Now doing magnitude: '+floattostr_one_digit(mag_active)+'    Stars done: '+ inttostr(nr_of_stars));
       if keypressed=vk_F4  then halt;
       if keypressed=vk_F7 then
       repeat
         main_form.status1.caption:='Paused';
         if blink then main_form.status1.color:=Clred else main_form.status1.color:=CLblack;
         if blink then blink:=false else  blink:=true;{blinker}
         sleep(500);
         Application.ProcessMessages; {allow application  to update form1 with above messages}
       until keypressed=vk_F8;
       main_form.status1.caption:='Running';
       Application.ProcessMessages; {allow application  to update form1 with above messages}
     end;

   until ((readposition1>=bufferstring1.count));


   if star_ok=false then mag1:=1000;{last star is not okay to include in this run}
end;


procedure write_new_magnitude_record6(magn:integer);{marker record indicating new magnitude step of 0.1 magn for 6 byte records}
var
  buf2: array[1..12] of byte;
  p6           : ^hnskyhdr1476_A6;		        { pointer to hnskyrecord }
  decst        :  shortint;

begin
  p6:= @buf2[1];			{ set pointer }
  with p6^ do
  begin
   {Right accension===========================================}
    ra7 := $FF;
    ra8 := $FF;
    ra9 := $FF;{set marker for new magnitude in record}

   {declination===========================================}
    decst:=magn;

   {make 3 byte integer:}
    dec7 := 0;
    dec8 := 0;
    dec9 :=  decst;{store magnitude in highest byte, allowing more digits later}
  end;
  blockwrite(tof,buf2, SizeOf(hnskyhdr1476_6),Numwritten);
end;

procedure write_new_magnitude_recordA7(magn:integer);{marker record indicating new magnitude step of 0.1 magn for 6 byte records}
var
  buf2: array[1..12] of byte;
  pA7           : ^hnskyhdr1476_A7;		        { pointer to hnskyrecord }
  decst        :  shortint;

begin
  pA7:= @buf2[1];			{ set pointer }
  with pA7^ do
  begin
   {Right accension===========================================}
    ra7 := $FF;
    ra8 := $FF;
    ra9 := $FF;{set marker for new magnitude in record}

   {declination===========================================}
    decst:=magn;

   {make 3 byte integer:}
    dec7 := 0;
    dec8 := 0;
    dec9 :=  decst;{store magnitude in highest byte, allowing more digits later}
    bp_rp:= 0;

  end;
  blockwrite(tof,buf2, SizeOf(hnskyhdr1476_A7),Numwritten);
end;


PROCEDURE sortpartGAIA; {read file and find stars between magn_start and magn_start+step}
var nr_of_errors                : longint;
    rastart,decstart,filenr,error9, nr_regio,nr_star,nr_extra   : integer;

    buf2: array[1..12] of byte;
    p6           : ^hnskyhdr1476_A6;		        { pointer to hnskyrecord }
    file_opened,to_open : string;
    blink       : boolean;

BEGIN
  file_opened:=''; {indicates of file is open}

  repeat

    if ((eof(ftext)=false) and (readposition1>=bufferstring1.count)) then
    begin
      readposition1:=0;
       Read_ftext(bufferstring1);{load next part}
    end;


    if ((readposition2>=bufferstring2.count) and
       (readposition1>=bufferstring1.count)) {Gaia}    then {buffer processed}
    begin
      if file_opened<>'' then close(Tof);{close file already open}
      if keypressed=vk_F4 then halt;
      if keypressed=vk_F7 then
      repeat
        main_form.status1.caption:='Paused';
        if blink then main_form.status1.color:=Clred else main_form.status1.color:=CLblack;
        if blink then blink:=false else  blink:=true;{blinker}
        sleep(500);
        Application.ProcessMessages; {allow application  to update form1 with above messages}
      until keypressed=vk_F8;
      main_form.status1.caption:='Running';
      Application.ProcessMessages; {allow application  to update form1 with above messages}
      exit;
    end;

    nr_regio:=0;
    nr_star:=0;
    nr_extra:=0;

    if (readposition2>=bufferstring2.count)=false then
    read_Tycho(epoch2, ra1,dec1, mag1,b_r) {magnitude filter is in read_tycho !!! for speed}
    else
    read_GAIA(epoch2,ra1,dec1, mag1,b_r);{read GAIA sorted files}


    if mag1<999 then  {999 check if last record is within}
    begin
      begin {6 byte record}
        p6:= @buf2[1];			{ set pointer }
        with p6^ do
        begin
         {Right accension===========================================}

          rastart := round(((256*256*256)-1)*(limit_radialen(ra1))/(2*pi));
          if rastart>=$FFFFFF then rastart:=0; { $FFFFFF is used as marker and should never occur. This value equals 2*pi could happen sometimes due to rounding}
          {make 3 byte word:}
          ra7 := lo(word(rastart));
          ra8 := hi(word(rastart));
          ra9 := rastart shr 16;{make 3 byte word};

          {declination===========================================}
          decstart :=round(( ((256*256*128)-1)*(dec1)/(0.5*pi)));

          {make 3 byte integer:}
          dec7 := lo(word(decstart));
          dec8 := hi(word(decstart));
          dec9 := decstart shr 16 ;{make 3 byte integer, important decstart must be longint};

         {magnitude===========================================}
          if (((mag1/10)>25.4-2) or ((mag1/10)<-2.0)) then  inc(nr_of_errors)
          else
          begin
            {no magnitude is written in record for 6 byte records}
           {====write to 1476  files====}
            to_open:=leadname+name1476(ra1,dec1);

            if file_opened<>to_open then {dump file not open yet}
            begin {other dump file required,  close and open other section}
              if file_opened<>'' then close(Tof);{close file already open}

              assignfile(tof,to_open);{assign correct 1476 file}
              filemode:=2;{read/write}
              reset(tof,1);
              seek(tof,filesize(tof));
              file_opened:=to_open;{remember file openened}
            end;
            {write special magnitude record if required}
            val(copy(file_opened,5,4),filenr,error9);{which filenr to check}
            if new_magnitude_record_written[filenr]<>mag1 then
            begin
              write_new_magnitude_record6(mag1);{write special header with magnitude}
              new_magnitude_record_written[filenr]:=mag1; {store that here  magnitude record is written}
            end;
            {end write special magnitude record if required}

            blockwrite(tof,buf2, SizeOf(hnskyhdr1476_6),Numwritten);


            inc(nr_of_stars);


        //    close(tof);
        //    file_opened:='';
        //    Application.ProcessMessages; {allow application  to update form1 with above messages}
        //     if nr_of_stars>=3749 then
        //     begin
        //       beep(800,100);
        //      main_form.caption:=inttostr(nr_of_stars);
        //     end;

          end;
         {====write to 1476 files end====}
        end;
      end;{6 byte records}
    end;{mag1<999}
  until false;
END;

PROCEDURE sortpartGAIA_type_A7; {read file and find stars between magn_start and magn_start+step}
var nr_of_errors                : longint;
    rastart,decstart,filenr,error9, nr_regio,nr_star,nr_extra   : integer;

    buf2: array[1..12] of byte;
    pA7        : ^hnskyhdr1476_A7;		        { pointer to hnskyrecord }
    file_opened,to_open : string;
    blink       : boolean;

BEGIN
  file_opened:=''; {indicates of file is open}

  repeat

    if ((eof(ftext)=false) and (readposition1>=bufferstring1.count)) then
    begin
      readposition1:=0;
       Read_ftext(bufferstring1);{load next part}
    end;


    if ((readposition2>=bufferstring2.count) and
       (readposition1>=bufferstring1.count)) {Gaia}    then {buffer processed}
    begin
      if file_opened<>'' then close(Tof);{close file already open}
      if keypressed=vk_F4 then halt;
      if keypressed=vk_F7  then
      repeat
        main_form.status1.caption:='Paused';
        if blink then main_form.status1.color:=Clred else main_form.status1.color:=CLblack;
        if blink then blink:=false else  blink:=true;{blinker}
        sleep(500);
        Application.ProcessMessages; {allow application  to update form1 with above messages}
      until keypressed=vk_F8;
      main_form.status1.caption:='Running';
      Application.ProcessMessages; {allow application  to update form1 with above messages}
      exit;
    end;

    nr_regio:=0;
    nr_star:=0;
    nr_extra:=0;

    if (readposition2>=bufferstring2.count)=false then
    read_Tycho(epoch2, ra1,dec1, mag1,b_r) {magnitude filter is in read_tycho !!! for speed}
    else
    read_GAIA(epoch2,ra1,dec1, mag1,b_r);{read GAIA sroted files}


    if mag1<999 then  {999 check if last record is within}
    begin
      begin {6 byte record}
        pA7:= @buf2[1];			{ set pointer }
        with pA7^ do
        begin
         {Right accension===========================================}
          rastart := round(((256*256*256)-1)*(limit_radialen(ra1))/(2*pi));
          if rastart>=$FFFFFF then rastart:=0; { $FFFFFF is used as marker and should never occur. This value equals 2*pi could happen sometimes due to rounding}
          {make 3 byte word:}
          ra7 := lo(word(rastart));
          ra8 := hi(word(rastart));
          ra9 := rastart shr 16;{make 3 byte word};

          {declination===========================================}
          decstart :=round(( ((256*256*128)-1)*(dec1)/(0.5*pi)));

          {make 3 byte integer:}
          dec7 := lo(word(decstart));
          dec8 := hi(word(decstart));
          dec9 := decstart shr 16 ;{make 3 byte integer, important decstart must be longint};
          Bp_Rp := b_r;
         {magnitude===========================================}
          if (((mag1/10)>25.4-2) or ((mag1/10)<-2.0)) then  inc(nr_of_errors)
          else
          begin
            {no magnitude is written in record for 6 byte records}
           {====write to 1476  files====}
            to_open:=leadname+name1476(ra1,dec1);

            if file_opened<>to_open then {dump file not open yet}
            begin {other dump file required,  close and open other section}
              if file_opened<>'' then close(Tof);{close file already open}
              assignfile(tof,to_open);{assign correct 1476 file}
              filemode:=2;{read/write}
              reset(tof,1);
              seek(tof,filesize(tof));
              file_opened:=to_open;{remember file openened}
            end;
            {write special magnitude record if required}
            val(copy(file_opened,5,4),filenr,error9);{which filenr to check}
            if new_magnitude_record_written[filenr]<>mag1 then
            begin
              write_new_magnitude_recordA7(mag1);{write special header with magnitude}
              new_magnitude_record_written[filenr]:=mag1; {store that here  magnitude record is written}
            end;
            {end write special magnitude record if required}

            blockwrite(tof,buf2, SizeOf(hnskyhdr1476_A7),Numwritten);
            inc(nr_of_stars);
          end;
         {====write to 1476 files end====}
        end;
      end;{6 byte records}
    end;{mag1<999}
  until false;
END;


procedure loadbuffer2(naam1:string);{FOR missing tycho stars}
begin
 with bufferstring2 do
 begin
   try
     LoadFromFile(naam1);	{ load from file }
   except;
    {action none}
     clear;
     sysutils.beep;
     main_form.caption:='Error reading file: '+naam1;
   end;
 end;
 readposition2:=0;
end;


function floattostr2(x: double):string;
begin
  str(x:0:1,result);
end;
procedure TMain_form.make290files1Click(Sender: TObject);
var
  error2 : integer;
  i,j    : integer;
  name1,filen,name2,tychofile  : string;
  info1        : array[0..112] of ansichar;

begin

  bp_sort:=main_form.bp_magnitude1.checked;
  V_sort:=((main_form.v_magnitude2.checked) or  (main_form.V_magnitude_and_BR1.checked));
  if v_sort then typ:='V' else typ:='B';

  writetextfile(true,'result1476'+typ+'.txt','Started');{clear previous message}
  main_form.status1.caption:='Running';
  nr_of_stars:=0;
  nr_of_skipped:=0;

  val(epoch1.text,epoch2,error2);
  if error2<>0 then
  begin
    epoch1.color:=clred;
    exit;
  end
  else
  epoch1.color:=clwindow;

  maximum:=updown1.position/10;


  if includemissing1.checked then
  begin
    tychofile:=thepath+PathDelim+'Gaia'+PathDelim+gaia_missing_stars1.text;
    if fileexists(tychofile)=false then
    begin
      application.MessageBox(pchar('Does not exist :'+gaia_missing_stars1.text), 'Error', MB_OK) ;
      exit;
    end
    else
    loadbuffer2(tychofile); {load tycho file supplement in Tstrings}
    readposition2:=0;
  end
  else
  begin
    bufferstring2.clear;
  end;

  if bp_sort then leadname:='g'+copy(magedit.Text,1,2)+'_' {g17_}
     else         leadname:='v'+copy(magedit.Text,1,2)+'_'; {v17_}

  {make header begin===========================================================}
  if main_form.v_magnitude2.checked then strpcopy(info1,copy('GAIA eDR3, stars up to V magnitude '+ strtostr_divide10(magedit.text) +', Epoch='+epoch1.text+'. Including '+inttostr(bufferstring2.count-1)+' bright Tycho2 stars. Magnitude is V                                                  ',1,112)){do not  override  length of info1, otherwise error at the end of program}
  else
  if main_form.BP_magnitude1.checked then strpcopy(info1,copy('GAIA eDR3, stars up to BP magnitude '+ strtostr_divide10(magedit.text) +', Epoch='+epoch1.text+'. Including '+inttostr(bufferstring2.count-1)+' bright Tycho2 stars. Magnitude is BP                                               ',1,112)){do not  override  length of info1, otherwise error at the end of program}
  else
  if main_form.V_magnitude_and_BR1.checked then strpcopy(info1,copy('GAIA eDR3, stars up to V magnitude '+ strtostr_divide10(magedit.text) +', Epoch='+epoch1.text+'. + '+inttostr(bufferstring2.count-1)+' Tycho2 stars. Magnitude is V, Bp-Rp info included                                                  ',1,112)){do not  override  length of info1, otherwise error at the end of program}
  else
  begin
    messagebox(main_form.handle,pchar('Selection missing. Specify magnitude type'),pchar('Error'),MB_ICONERROR);
    exit;
  end;


  if main_form.V_magnitude_and_BR1.checked=false then info1[109]:=#$A6    {interim 6 byte record}
                                                 else info1[109]:=#$A7;  {interim A7, 7 byte record with B_R included}

  info1[108]:=ansichar(round((mag_active)*10));{store maximum magnitude limit}


  for i:=1 to 1476 do {create, reset output files. Note result is saved in pieces to save memory using Tstrings}
  begin
    name1:=leadname+filenames1476(i); {use for destination TYC file names and not UCAC4 names}

    if ((i=1) and (FileExists(name1)=true)) then {some pre checks}
    begin
      if Application.MessageBox('Destination files exist, overwrite ?','Attention !',	MB_YESNO or MB_ICONEXCLAMATION) = IDNO then halt;
    end;

    assignfile(tof,name1);
    filemode:=2;{read/write}
    rewrite(tof,1);
    Blockwrite(tof,info1,110,Numwritten);{header is 110 bytes, was 111 bytes }
    closefile(tof);
    if numwritten<>110 then
    begin
      messagebox(main_form.handle,pchar('ERROR !!! Can"t create file files. Close HNSKY'),pchar('Error'),MB_ICONERROR);
      exit;
    end;
  end;
  {make header end===========================================================}

  for i:=1 {was 0}to 1801 do new_magnitude_record_written[i]:=-99;{6 byte records, clear step positions. Store here is magnitude record written}

  {sort file}


  mag_active:=-1.5;{start magnitude}

  repeat

    file_counter:=0;

    main_form.caption:=('Now doing magnitude: '+floattostr_one_digit(mag_active)+'    Stars done: '+ inttostr(nr_of_stars));

    Application.ProcessMessages; {allow application  to update form1 with above messages}

    {tap vizier instruction to download}
    //SELECT TOP 250000000 "I/337/gaia".ra, "I/337/gaia".dec, "I/337/gaia".source_id, "I/337/gaia".ref_epoch, "I/337/gaia".pmRA, "I/337/gaia".pmDEC, "I/337/gaia".
    //duplicated_source, "I/337/gaia".phot_g_mean_mag
    //FROM "I/337/gaia"
    //WHERE "I/337/gaia".phot_g_mean_mag<=13.6 and "I/337/gaia".phot_g_mean_mag>13.5

   {Gaia_DR2_BP_10.1-10.0.csv will result in stars 10.0 and 10.1=round(10.077)}

    if BP_sort then name2:='gaia_dr3-BP_sorted'
    else
    if V_sort then name2:='gaia_dr3-V_sorted'
    else
    halt;

    filen:=thepath+PathDelim+'Gaia'+PathDelim+name2+inttostr(round(mag_active*10))+'.csv';
    main_form.thefile1.caption:=filen; {show which file is processed}
    assignfile(ftext,filen); {assign Gaia file in Tstrings}
    reset(ftext);
    bufferstring1.Clear;{make empthy}
    readposition1:=0;{No comments, so start with zero}
    readposition2:=0;

    if Main_form.V_magnitude_and_BR1.checked=false then
       sortpartGAIA  {read buffer and find stars between magn_start and magn_start+step}
    else
       sortpartGAIA_type_A7;{include Bp-Rp info}

    closefile(ftext);

    writetextfile(false,'result1476'+typ+'.txt','Up_to_mag '+ floattostr_one_digit(mag_active)+' stars_done:'+inttostr(nr_of_stars));{write result to file}
    mag_active:=mag_active+0.1;{0.1 magnitude step}
  until mag_active+0.000001>=maximum+0.1;
  writetextfile(false,'result1476'+typ+'.txt','Ready.   Stars done:'+ inttostr(nr_of_stars));{write result to file}
  if ((powerdown_enabled.checked)and (nr_of_stars>100)) then
  {$ifdef mswindows}
  main_form.caption:= ShutMeDown
  {$else} {unix}
  fpSystem('/sbin/shutdown -P now')
  {$endif}
  else
  messagebox(main_form.handle,pchar('Ready.   Stars done:'+ inttostr(nr_of_stars)),pchar('Ready'),MB_ICONINFORMATION);

end;

procedure TMain_form.countstars1Click(Sender: TObject);
var
  bp_active_x10 : integer;
  file_name,line1: string;
begin
  nr_of_stars:=0;
  for bp_active_x10:=100 to 180 do
  begin
    file_name:=thepath+PathDelim+'Gaia'+PathDelim+'Gaia_DR3_BP_'+floattostr2(bp_active_x10/10)+'.csv';
    main_form.caption:=('Counting stars: ');
    main_form.thefile1.caption:=file_name;
    application.processmessages;
    if fileexists(file_name) then
    begin
      assignfile(ftext,file_name); {load  file in Tstrings}
      reset(ftext);
      repeat
       readln(ftext,line1);
       nr_of_stars:=nr_of_stars+1;
      until (eof(ftext));
      closefile(ftext);
      nr_of_stars:=nr_of_stars-1;{remove comment}
    end
    else
    application.MessageBox(pchar('Does not exist :'+file_name), 'Error', MB_OK);
  end;

  file_name:=thepath+PathDelim+'Gaia'+PathDelim+'Gaia_DR3_BP_0.0-09.95.csv';
  assignfile(ftext,file_name); {load  file in Tstrings}
  reset(ftext);
  repeat
   readln(ftext,line1);
   nr_of_stars:=nr_of_stars+1;
  until (eof(ftext));
  closefile(ftext);
  nr_of_stars:=nr_of_stars-1;{remove comment}


  file_name:=thepath+PathDelim+'Gaia'+PathDelim+'Gaia_DR3_missing_BP_G_0.0-17.3.csv';   {will contain stars in GP range 0 ..17.35 equivalent to V 0.4 ..16.75 and BP 0.5 ..17.85.}
  assignfile(ftext,file_name); {load  file in Tstrings}
  reset(ftext);
  repeat
   readln(ftext,line1);
   nr_of_stars:=nr_of_stars+1;
  until (eof(ftext));
  closefile(ftext);
  nr_of_stars:=nr_of_stars-1;{remove comment}



  file_name:=thepath+PathDelim+'Gaia'+PathDelim+'Gaia_DR3_missing_BP_G_17.4-17.7.csv';    {will contain stars in GP range 17.35 ..17.75 equivalent to V 17.65 ..18.05 and BP 17.85 ..18.25/  So range required 17.65 ..18.25}
  assignfile(ftext,file_name); {load  file in Tstrings}
  reset(ftext);
  repeat
   readln(ftext,line1);
   nr_of_stars:=nr_of_stars+1;
  until (eof(ftext));
  closefile(ftext);
  nr_of_stars:=nr_of_stars-1;{remove comment}


  messagebox(main_form.handle,pchar('Ready.   Stars counted:'+ inttostr(nr_of_stars)),pchar('Ready'),MB_ICONINFORMATION);
end;

procedure TMain_form.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  keypressed:=key
end;


procedure TMain_form.bp_magnitude1Change(Sender: TObject);
begin
  if bp_magnitude1.checked then Main_form.abbreviation1.text:=StringReplace(Main_form.abbreviation1.text, 'V', 'G',[rfReplaceAll])
  else
  Main_form.abbreviation1.text:=StringReplace(Main_form.abbreviation1.text, 'G', 'V',[rfReplaceAll]);

end;


function getinstalldir:string;
begin
  result:=extractfiledir(paramstr(0));
end;

procedure TMain_form.sort_magnitude1Click(Sender: TObject);
var
  i,j,overlap2,stars_without_bp, oldnrstars,bp_active_x10,gp_active_x10  : integer;
  overlapfaint, overlapbright : double;
  file_name  : string;
  name2     : string;

begin
  bp_sort:=main_form.bp_magnitude1.checked;
  V_sort:=((main_form.v_magnitude2.checked) or  (main_form.V_magnitude_and_BR1.checked));
  if v_sort then typ:='-V' else typ:='-BP';

  writetextfile(true,'result_sort'+typ+'.txt','Up to magn; All stars cumulative; Stars without BP;  stars_effect_by_straylight');{clear previous message}


  for i:=-150 to 2000 do
  begin
    starcount[i]:=0;{keep record in steps of 0.01 magnitude}
    starcount2[i]:=0;{keep record in steps of 0.01 magnitude}
    starcount3[i]:=0;{straylight}
  end;

  main_form.status1.caption:='Running';
  nr_of_stars:=0;
  nr_of_skipped:=0;
  nr_of_straylight:=0;{stars effected by straylight}
  stars_without_bp:=0;{stars without bp magn}

//  mag_active:=1;{start magnitude}

//  mag_active:=8;{start magnitude}

  //mag_active:=17.7;{start magnitude}

  maximum:=main_form.step1_maxmagnitude1.position/10; {180}

 if BP_sort then
  begin
    name2:='gaia_dr3-BP_sorted';
    overlapbright:=5; {############## BP can be 5 magnitude brighter=lower then G due to straylight, then G will be selected. See quality section gaia_sort_magnitude}
    overlapfaint:=0;
   end
  else
  if V_sort then
  begin
   name2:='gaia_dr3-V_sorted';
   overlapbright:=5;  {############## BP can be 5 magitude brighter=lower then V}
   overlapfaint:=2;{############### BP can be 1.8 magnitudes fainter=higher then V. Probably some stars with errors}
  end
  else
  begin
    application.MessageBox(pchar('Select a magnitude type. Warning do not override existing results!'+file_name), 'Error', MB_ICONERROR);
    exit;
  end;

  for i:=-15 to 180 do {create,  reset output files, just to be sure}
  begin
    assignfile(tof,thepath+PathDelim+'Gaia'+PathDelim+name2+inttostr(round(i))+'.csv');
    filemode:=2;{read/write}
    rewrite(tof,1);
    closefile(tof);
  end;

  repeat
    bufferstring2.Clear; {clear buffer2}
    file_counter:=0;
    filen_out:=thepath+PathDelim+'Gaia'+PathDelim+name2+inttostr(round(mag_active*10))+'.csv';


    main_form.caption:=('Now doing magnitude: '+floattostr_one_digit(mag_active)+'    Stars done: '+ inttostr(nr_of_stars));
    Application.ProcessMessages; {allow application  to update form1 with above messages}


    if  mag_active*10 - round(+overlapbright{-5}*10)<=100  then {below BP magnitude 10 (9.95)}
    begin
      file_name:=thepath+PathDelim+'Gaia'+PathDelim+'Gaia_DR3_BP_0.0-09.95.csv';
      main_form.caption:=('Now doing magnitude: '+floattostr_one_digit(mag_active)+'     Overlap: '+floattostr_one_digit(overlap2/10));
      main_form.thefile1.caption:=file_name;
      application.processmessages;
      if fileexists(file_name) then
      begin
        assignfile(ftext,file_name); {load  file in Tstrings}
        reset(ftext);
        repeat
          Read_ftext(bufferstring1);
          gaia_sort_magnitude(mag_active); ; {gaia sort on magnitude}
        until (eof(ftext));
        closefile(ftext);
      end
      else
      application.MessageBox(pchar('Does not exist :'+file_name), 'Error', MB_OK);
    end;


    //database BP      search range V
    //mag 10             5 to 11.5
    //    18            13 to 19.5
    for overlap2:=round(-overlapbright {-5}*10) to round(+overlapfaint{+0.5}*10) do    {mag -5 to +0.5 search range to find magnitudeactive=V }
    begin
      bp_active_x10:=round(mag_active*10+overlap2);{calculate bp_active x 10}

      if ((bp_active_x10>=100 {mag 10}) and (bp_active_x10<=180 {mag 18.0})) then {magnitude range}
      begin
        file_name:=thepath+PathDelim+'Gaia'+PathDelim+'Gaia_DR3_BP_'+floattostr2(bp_active_x10/10)+'.csv';
        main_form.caption:=('Now doing magnitude: '+floattostr_one_digit(mag_active)+'     Overlap: '+floattostr_one_digit(overlap2/10));
        main_form.thefile1.caption:=file_name;
        application.processmessages;
        if fileexists(file_name) then
        begin
          assignfile(ftext,file_name); {load  file in Tstrings}
          reset(ftext);
          repeat
            Read_ftext(bufferstring1);
            gaia_sort_magnitude(mag_active); ; {gaia sort on magnitude}
          until (eof(ftext));
          closefile(ftext);
        end
        else
        application.MessageBox(pchar('Does not exist :'+file_name), 'Error', MB_OK);

      end;



    end;
   // stringlist maximum size 134,217,728

   //overlap2:=0;
   oldnrstars:=nr_of_stars;

   if BP_sort then gp_active_x10:=round ((mag_active{BP or V}- G_to_BP_correctie{0.5})*10)  {Assumed is GP:=V-0.3 / V:=GP+ 0.3 for magn 15  or GP:=BP-0.5}
              else gp_active_x10:=round ((mag_active{BP or V}- G_to_V_correctie {0.3})*10) ;{Assumed is GP:=V-0.3               for magn 15  or GP:=BP-0.5}


   {now do stars without BP magnitude file 1}
   if ((gp_active_x10>=0) and (gp_active_x10<=173)) then {magnitude range.5}
   begin
     file_name:=thepath+PathDelim+'Gaia'+PathDelim+'Gaia_DR3_missing_BP_G_0.0-17.3.csv';   {will contain stars in GP range 0 ..17.35 equivalent to V 0.4 ..16.75 and BP 0.5 ..17.85.}

     main_form.caption:=('Now doing magnitude: '+floattostr_one_digit(mag_active)+'     Overlap: '+floattostr_one_digit(overlap2/10));
     main_form.thefile1.caption:=file_name;
     application.processmessages;

     if fileexists(file_name) then
     begin
       assignfile(ftext,file_name); {load  file in Tstrings}
       reset(ftext);
       repeat
         Read_ftext(bufferstring1);
         gaia_sort_magnitude(mag_active); ; {gaia sort on magnitude}
       until (eof(ftext));
       closefile(ftext);
     end
     else
     application.MessageBox(pchar('Does not exist :'+file_name), 'Error', MB_OK);
   end;

   {now do stars without BP magnitude file 2}
   if ((gp_active_x10>=174) and (gp_active_x10<=177)) then {magnitude range.5}
   begin
     file_name:=thepath+PathDelim+'Gaia'+PathDelim+'Gaia_DR3_missing_BP_G_17.4-17.7.csv';    {will contain stars in GP range 17.35 ..17.75 equivalent to V 17.65 ..18.05 and BP 17.85 ..18.25/  So range required 17.65 ..18.25}
     main_form.caption:=('Now doing magnitude: '+floattostr_one_digit(mag_active)+'     Overlap: '+floattostr_one_digit(overlap2/10));
     main_form.thefile1.caption:=file_name;
     application.processmessages;
     if fileexists(file_name) then
     begin
       assignfile(ftext,file_name); {load  file in Tstrings}
       reset(ftext);
       repeat
         Read_ftext(bufferstring1);
         gaia_sort_magnitude(mag_active); ; {gaia sort on magnitude}
       until (eof(ftext));
       closefile(ftext);
     end
     else
     application.MessageBox(pchar('Does not exist :'+file_name), 'Error', MB_OK);
   end;

   stars_without_bp:=stars_without_bp+(nr_of_stars-oldnrstars);{how many stars where added without bp magnitude}


    AppendToFile(bufferstring2,filen_out);{write last part}


    writetextfile(false,'result_sort'+typ+'.txt',floattostr_one_digit(mag_active)+'; '+ inttostr(nr_of_stars)+'; '+inttostr(stars_without_bp)+'; '+inttostr(nr_of_straylight));{write result to file}
    mag_active:=mag_active+0.1;{0.1 magnitude step}
  until mag_active+0.000001>=maximum+0.1;
  writetextfile(false,'result_sort'+typ+'.txt','Ready.   Stars done:'+ inttostr(nr_of_stars));{write result to file}

  writelongreport;{write log file in steps of 0.01 magn}



  if ((powerdown_enabled.checked)and (nr_of_stars>100)) then
  {$ifdef mswindows}
  main_form.caption:= ShutMeDown
  {$else} {unix}
  fpSystem('/sbin/shutdown -P now')
  {$endif}
  else
  messagebox(main_form.handle,pchar('Ready.   Stars done:'+ inttostr(nr_of_stars)),pchar('Ready'),MB_ICONINFORMATION);

end;


procedure TMain_form.FormCreate(Sender: TObject);
begin
  bufferstring1 := Tstringlist.Create;
  bufferstring2 := Tstringlist.Create;

  thepath:=getinstalldir;
end;

procedure TMain_form.FormDestroy(Sender: TObject);
begin
  bufferstring1.free;{free suppl1}
  bufferstring2.free;{free suppl2}
end;

end.

