Сравнительный анализ методов определения индекса пожарной опасности по российской и канадской системам

kw: =k1*0.581*exp (0.0365*t);

m: =ew- (ew-m0) *power (10,-kw);

end;

end;

ffmc: =59.5* (mm-m) / (147.2+m);

if ffmc>101 then ffmc: =101;

if ffmc<0 then ffmc: =0;

f0: =ffmc;

end;

procedure calculatedmc;

var tt: real;

begin

if t<-1.1 then tt: =-1.1 else tt: =t;

k: =1.894* (tt+1.1) * (100-h) *le [month] *power (10,-6);

if r0>1.5 then

begin

re: =0.92*r0-1.27;

m0: =20+exp (5.6348-p0/43.43);

if p0<=33 then b: =100/ (0.5+0.3*p0) else

if p0<=65 then b: =14-1.3*ln (p0) else

b: =6.2*ln (p0) - 17.2;

mr: =m0+1000*re/ (48.77+b*re);

pr: =244.72-43.43*ln (mr-20);

if pr<0 then pr: =0;

p: =pr+100*k;

end else p: =p0+100*k;

if p<0 then p: =0;

p0: =p;

end;

procedure calculatedc;

var tt: real;

begin

if t<-2.8 then tt: =-2.8 else tt: =t;

v: =0.36* (tt+2.8) +lf [month];

if v<0 then v: =0;

if r0>2.8 then

begin

rd: =0.83*r0-1.27;

q0: =800*exp (-d0/400);

qr: =q0+3.937*rd;

dr: =400*ln (800/qr);

if dr<0 then dr: =0;

d: =dr+0.5*v;

end else d: =d0+0.5*v;

if d<0 then d: =0;

d0: =d;

end;

begin

form1. panel2. show;

if lang=0 then form1. label1. caption: ='Расчет коэффициентов'

else form1. label1. caption: ='Calculation';

application. ProcessMessages;

form1. progressbar2. max: =form7. StringGrid1. RowCount-1;

form1. progressbar2. position: =0;

application. ProcessMessages;

val (copy (mindate,7,4),year1,code);

val (copy (maxdate,7,4),year2,code);

for meteo: =1 to form7. StringGrid1. RowCount-1 do

begin

form1. progressbar2. position: =meteo;

if form7. StringGrid1. cells [5,meteo] ='+' then

for year: =year1 to year2 do

begin

f0: =0;

p0: =0;

d0: =0;

for month: =1 to 12 do

for day: =1 to 31 do

if dateok (datetostring (day,month)) then

for i: =1 to form1. StringGrid1. RowCount-1 do

if (form1. StringGrid1. cells [1, i] =form7. StringGrid1. cells [0,meteo]) and

(form1. StringGrid1. cells [0, i] =datetostring (day,month) +'. '+inttostr (year)) then

begin

val (form1. StringGrid1. cells [10, i],t,code);

val (form1. StringGrid1. cells [11, i],r0,code);

val (form1. StringGrid1. cells [12, i],w,code);

w: =w/3.6;

if f0=0 then calculateffmc;

calculateffmc;

str (ffmc: 0: 9,s);

form1. StringGrid1. cells [13, i]: =s;

if p0=0 then calculatedmc;

calculatedmc;

str (p: 0: 9,s);

form1. StringGrid1. cells [14, i]: =s;

if d0=0 then calculatedc;

calculatedc;

str (d: 0: 9,s);

form1. StringGrid1. cells [15, i]: =s;

fm: =147.2* (101-f0) / (59.5+f0);

sf: =19.115*exp (fm* (-0.1386)) * (1+power (fm,5.31) /4.93e7);

si: =sf*exp (0.05039*w);

str (si: 0: 9,s);

form1. StringGrid1. cells [16, i]: =s;

if (p0=0) and (d0=0) then bui1: =0 else bui1: = (0.8*d0*p0) / (p0+0.4*d0);

if bui1<p0 then

begin

p: = (p0-bui1) /p0;

cc: =0.92+power (0.0114*p0,1.7);

bui1: =p0-cc*p;

if bui1<0 then bui1: =0;

end;

if bui1<=80 then

bb: =0.1*si* (0.626*power (bui1,0.809) +2) else

bb: =0.1*si* (1000/ (25+108.64/exp (0.023*bui1)));

if bb-1<0 then fwi1: =bb else

fwi1: =exp (2.72*power (0.434*ln (bb),0.647));

str (bui1: 0: 9,s);

form1. StringGrid1. cells [17, i]: =s;

str (fwi1: 0: 9,s);

form1. StringGrid1. cells [18, i]: =s;

end;

end;

end;

form1. panel2. hide;

index: =1;

end;

procedure TForm1. XT1Click (Sender: TObject);

var t: textfile;

s: string;

i,j,k: integer;

function convdate (s: string): string;

begin

convdate: =copy (s,7,4) +copy (s,4,2) +copy (s,1,2);

end;

begin

if opendialog2. execute then

begin

for i: =1 to form7. StringGrid1. RowCount-1 do

form7. StringGrid1. cells [5, i]: ='-';

filename: =opendialog2. filename;

formcaptionstatus;

assignfile (t,filename);

reset (t);

form1. StringGrid1. RowCount: =2;

readln (t,s);

if s='Index' then

begin

index: =1;

readln (t,s);

end else index: =0;

texttogrid (1,s);

while not eof (t) do

begin

form1. StringGrid1. RowCount: =form1. StringGrid1. RowCount+1;

readln (t,s);

texttogrid (form1. StringGrid1. RowCount-1,s);

end;

closefile (t);

mindate: =form1. StringGrid1. cells [0,1];

maxdate: =mindate;

for j: =1 to form1. StringGrid1. RowCount-1 do

begin

for i: =1 to form7. StringGrid1. RowCount-1 do

if form1. StringGrid1. cells [1,j] =form7. StringGrid1. cells [0, i] then

begin

for k: =1 to 4 do

form1. StringGrid1. cells [k+1,j]: =form7. StringGrid1. cells [k, i];

form7. StringGrid1. cells [5, i]: ='+';

end;

if convdate (form1. StringGrid1. cells [0,j]) <convdate (mindate) then mindate: =form1. StringGrid1. cells [0,j];

if convdate (form1. StringGrid1. cells [0,j]) >convdate (maxdate) then maxdate: =form1. StringGrid1. cells [0,j];

end;

vis (true);

if lang=0 then

begin

label2. Caption: ='Начальная дата (с '+mindate+') ';

label3. Caption: ='Конечная дата (до '+maxdate+') ';

end else

begin

label2. Caption: ='Begin date (from '+mindate+') ';

label3. Caption: ='End date (to '+maxdate+') ';

end;

end;

end;

procedure texttogrid2 (n: integer; s: shortstring);

var i,j,code: integer;

q: shortstring;

lat,lon: double;

procedure next;

begin

q: ='';

while (s [i] <>#9) and (i<=length (s)) do

begin

q: =q+s [i];

i: =i+1;

end;

i: =i+1;

end;

begin

i: =1;

next;

form1. StringGrid2. cells [0,n]: =q;

for j: =2 to 9 do next;

form1. StringGrid2. cells [1,n]: =q;

val (q,lat,code);

next;

form1. StringGrid2. cells [2,n]: =q;

val (q,lon,code);

next;

form1. StringGrid2. cells [3,n]: =q;

if (lat>50) and (lat<80) and (lon>80) and (lon<110) then

else if form1. StringGrid2. RowCount>2 then form1. StringGrid2. RowCount: =form1. StringGrid2. RowCount-1;

end;

procedure TForm1. XT2Click (Sender: TObject);

var t: textfile;

s: string;

i,j,k: integer;

begin

if opendialog2. execute then

begin

filename: =opendialog2. filename;

formcaptionstatus;

assignfile (t,filename);

reset (t);

form1. StringGrid2. RowCount: =2;

readln (t,s);

readln (t,s);

texttogrid2 (1,s);

while not eof (t) do

begin

form1. StringGrid2. RowCount: =form1. StringGrid2. RowCount+1;

readln (t,s);

texttogrid2 (form1. StringGrid2. RowCount-1,s);

end;

closefile (t);

vis2 (true);

if lang=0 then

begin

label2. Caption: ='Начальная дата (с '+stringgrid2. Cells [0,1] +') ';

label3. Caption: ='Конечная дата (до '+stringgrid2. Cells [0,StringGrid2. rowcount-1] +') ';

end else

begin

label2. Caption: ='Begin date (from '+stringgrid2. Cells [0,1] +') ';

label3. Caption: ='End date (to '+stringgrid2. Cells [0,StringGrid2. rowcount-1] +') ';

end;

end;

end;

procedure TForm1. N26Click (Sender: TObject);

begin

panel1. hide;

stringgrid2. hide;

stringgrid1. show;

if lang=0 then

begin

label2. Caption: ='Начальная дата (с '+stringgrid1. Cells [0,1] +') ';

label3. Caption: ='Конечная дата (до '+stringgrid1. Cells [0,StringGrid1. rowcount-1] +') ';

end else

begin

label2. Caption: ='Begin date (from '+stringgrid1. Cells [0,1] +') ';

label3. Caption: ='End date (to '+stringgrid1. Cells [0,StringGrid1. rowcount-1] +') ';

end;

end;

procedure TForm1. N28Click (Sender: TObject);

begin

panel1. hide;

stringgrid1. hide;

stringgrid2. show;

if lang=0 then

begin

label2. Caption: ='Начальная дата (с '+stringgrid2. Cells [0,1] +') ';

label3. Caption: ='Конечная дата (до '+stringgrid2. Cells [0,StringGrid2. rowcount-1] +') ';

end else

begin

label2. Caption: ='Begin date (from '+stringgrid2. Cells [0,1] +') ';

label3. Caption: ='End date (to '+stringgrid2. Cells [0,StringGrid2. rowcount-1] +') ';

end;

end;

procedure TForm1. BitBtn1Click (Sender: TObject);

var x: integer;

begin

for x: =0 to 3 do

begin

carte [x]. canvas. draw (0,0,oldfires [x]);

end;

drawcarte (xcarte,ycarte);

end;

procedure TForm1. BitBtn2Click (Sender: TObject);

var x: integer;

begin

for x: =0 to 3 do

begin

oldfires [x]. canvas. draw (0,0,carte [x]);

carte [x]. canvas. draw (0,0,carteload [x]);

end;

drawcarte (xcarte,ycarte);

end;

procedure TForm1. BitBtn3Click (Sender: TObject);

var x,y,k,n,c: integer;

t: longint;

a,rc,g,b: byte;

r,fi,f: real;

lat,lon,sq: array [0.10000] of real;

d: array [0.10000] of byte;

s: string;

begin

for x: =0 to 3 do carte [x]. canvas. draw (0,0,carteload [x]);

n: =0;

for x: =1 to form1. StringGrid2. RowCount-1 do

if (strtodate (edit1. text) <=strtodate (stringgrid2. cells [0,x])) and

(strtodate (edit2. text) >=strtodate (stringgrid2. cells [0,x])) then

begin

if strtodate (edit2. text) =strtodate (stringgrid2. cells [0,x]) then

d [n]: =1 else d [n]: =0;

s: =form1. StringGrid2. cells [1,x];

for y: =1 to length (s) do

if s [y] =',' then s [y]: ='. ';

val (s,lat [n],k);

s: =form1. StringGrid2. cells [2,x];

for y: =1 to length (s) do

if s [y] =',' then s [y]: ='. ';

val (s,lon [n],k);

val (form1. StringGrid2. cells [3,x],sq [n],k);

sq [n]: =ln (sq [n] /100000+1) /30;

if n<10000 then n: =n+1;

end;

form1. ProgressBar1. max: =carte [3]. width+carte [1]. width-1;

form1. ProgressBar1. Position: =0;

for x: =0 to carte [3]. width-1 do

begin

form1. ProgressBar1. Position: =x;

for y: =0 to carte [3]. height-1 do

begin

polar (x,y,1,r,fi);

c: =255;

a: =0;

for k: =0 to n-1 do

if sqr (r-lat [k]) +sqr (fi-lon [k]) <sq [k] *sq [k] then

begin

if d [k] =1 then a: =1;

if (a=0) and (sq [k] <c) then c: =round (sq [k] *900);

end;

if c<0 then c: =0;

if c<255 then

for k: =2 to 3 do

begin

t: =carte [k]. canvas. pixels [x,y];

rc: =t and 255;

if (a=0) and (rc>c) then rc: =c;

g: = (t shr 8) and 255;

if (a=0) and (g>c) then g: =c;

b: = (t shr 16) and 255;

if b>c then b: =c;

carte [k]. canvas. pixels [x,y]: =rc+g shl 8+b shl 16;

end;

end;

end;

for x: =0 to carte [1]. width-1 do

begin

form1. ProgressBar1. Position: =x+carte [3]. width;

for y: =0 to carte [1]. height-1 do

begin

polar (x,y,0,r,fi);

c: =255;

a: =0;

for k: =0 to n-1 do

if sqr (r-lat [k]) +sqr (fi-lon [k]) <sq [k] *sq [k] *0.55 then

begin

if d [k] =1 then a: =1;

if (a=0) and (sq [k] <c) then c: =round (sq [k] *900);

end;

if c<0 then c: =0;

if c<255 then

for k: =0 to 1 do

begin

t: =carte [k]. canvas. pixels [x,y];

rc: =t and 255;

if (a=0) and (rc>c) then rc: =c;

g: = (t shr 8) and 255;

if (a=0) and (g>c) then g: =c;

b: = (t shr 16) and 255;

if b>c then b: =c;

carte [k]. canvas. pixels [x,y]: =rc+g shl 8+b shl 16;

end;

end;

end;

form1. ProgressBar1. Position: =0;

drawcarte (xcarte,ycarte);

end;

procedure TForm1. ListBox3Click (Sender: TObject);

begin

drawinggraphix1 (460,460,form1. image4. canvas);

end;

function gridtotext (i: integer): string;

var s: string;

begin

s: =form1. StringGrid1. Cells [0, i] +#9+#9+

form1. StringGrid1. Cells [1, i] +#9+

form1. StringGrid1. Cells [10, i] +#9+#9+

form1. StringGrid1. Cells [12, i] +#9+#9+#9+

form1. StringGrid1. Cells [11, i] +#9+#9+#9+

form1. StringGrid1. Cells [6, i] +#9+

form1. StringGrid1. Cells [7, i] +#9+#9+

form1. StringGrid1. Cells [8, i] +#9+

form1. StringGrid1. Cells [9, i];

if index=1 then

s: =s+#9+form1. StringGrid1. Cells [13, i]

+#9+form1. StringGrid1. Cells [14, i]

+#9+form1. StringGrid1. Cells [15, i]

+#9+form1. StringGrid1. Cells [16, i]

+#9+form1. StringGrid1. Cells [17, i]

+#9+form1. StringGrid1. Cells [18, i];

gridtotext: =s;

end;

procedure TForm1. N4Click (Sender: TObject);

var t: textfile;

i: integer;

begin

if savedialog1. execute then

begin

filename: =savedialog1. filename;

assignfile (t,filename);

rewrite (t);

if index=1 then writeln (t,'Index');

for i: =1 to form1. StringGrid1. RowCount-1 do

writeln (t,gridtotext (i));

closefile (t);

end;

end;

procedure TForm1. ListBox4Click (Sender: TObject);

begin

drawinggraphix1 (460,460,form1. image4. canvas);

end;

procedure TForm1. N8Click (Sender: TObject);

begin

lang: =0;

form1. caption: ='База данных по метеостанциям';

progname: =form1. caption;

form7. caption: ='Данные о метеостанциях';

form8. caption: ='График';

n1. caption: ='Метеостанции';

n26. caption: ='Показать базу';

xt1. caption: ='Открыть';

n4. caption: ='Сохранить';

n2. caption: ='Все метеостанции';

n7. caption: ='Выход';

n21. caption: ='Пожары';

n28. caption: ='Показать базу';

xt2. caption: ='Открыть';

n13. caption: ='Карта';

n14. caption: ='Показать карту';

n5. caption: ='Выбор языка';

n8. caption: ='Русский';

n9. caption: ='Английский';

n20. caption: ='На весь экран';

n10. caption: ='Расчет коэффициентов';

n11. caption: ='Коэффициенты корреляции';

groupbox1. caption: ='Данные для графиков';

groupbox2. caption: ='Карта';

groupbox3. caption: ='Пожары';

radiobutton1. caption: ='График T и W';

radiobutton2. caption: ='График ПВ1';

radiobutton3. caption: ='График ПВ2';

if label2. caption [length (label2. caption)] =') ' then

begin

label2. Caption: ='Начальная дата (с '+copy (label2. caption,length (label2. caption) - 10,11);

label3. Caption: ='Конечная дата (до '+copy (label3. caption,length (label3. caption) - 10,11);

end else begin

label2. caption: ='Начальная дата';

label3. caption: ='Конечная дата';

end;

button4. caption: ='Построить';

formcaptionstatus;

shownames7;

drawcarte (xcarte,ycarte);

shownames;

end;

procedure TForm1. N9Click (Sender: TObject);

begin

lang: =1;

form1. caption: ='Data base of meteostations';

progname: =form1. caption;

form7. caption: ='Meteostations data';

form8. caption: ='Graphic';

n1. caption: ='Meteostations';

n26. caption: ='Show data base';

xt1. caption: ='Open';

n4. caption: ='Save';

n2. caption: ='All meteostations';

n7. caption: ='Exit';

n21. caption: ='Fires';

n28. caption: ='Show data base';

xt2. caption: ='Open';

n13. caption: ='Carte';

n14. caption: ='Show carte';

n5. caption: ='Languages';

n8. caption: ='Russian';

n9. caption: ='English';

n20. caption: ='Full screen';

n10. caption: ='Calculation';

n11. caption: ='Correlation'+#39+'s indexes';

groupbox1. caption: ='Graphics data';

groupbox2. caption: ='Carte';

groupbox3. caption: ='Fires';

radiobutton1. caption: ='Graphic T и W';

radiobutton2. caption: ='Graphic ПВ1';

radiobutton3. caption: ='Graphic ПВ2';

if label2. caption [length (label2. caption)] =') ' then

begin

label2. Caption: ='Begin date (с '+copy (label2. caption,length (label2. caption) - 10,11);

label3. Caption: ='End date (до '+copy (label3. caption,length (label3. caption) - 10,11);

end else begin

label2. caption: ='Begin date';

label3. caption: ='End date';

end;

button4. caption: ='Draw';

formcaptionstatus;

shownames7;

drawcarte (xcarte,ycarte);

shownames;

end;

procedure TForm1. CheckBox1Click (Sender: TObject);

begin

if checkbox1. checked then checkbox2. checked: =false;

end;

procedure TForm1. CheckBox2Click (Sender: TObject);

begin

if checkbox2. checked then checkbox1. checked: =false;

end;

procedure TForm1. FormActivate (Sender: TObject);

begin

n9. click;

end;

procedure TForm1. N10Click (Sender: TObject);

begin

canadian;

end;

procedure TForm1. N11Click (Sender: TObject);

begin

memo3. show;

end;

procedure TForm1. Memo3Click (Sender: TObject);

begin

memo3. hide;

end;

end.

unit Unit7;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, Grids;

type

TForm7 = class (TForm)

StringGrid1: TStringGrid;

procedure FormCreate (Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form7: TForm7;

procedure shownames;

implementation

uses Unit1, Unit8;

{$R *. dfm}

procedure shownames;

const maxnames=6;

name: array [0.1,0. maxnames-1] of string= ( // названия колонок базы данных

('Код метеостанции',

'Название метеостанции',

'GRID',

'Широта',

'Долгота',

'В загруженной базе'),

('Meteostation'+#39+'s code',

'Meteostation'+#39+'s name',

'GRID',

'Latitude',

'Longitude',

'In loaded data base'));

var i: integer;

begin

for i: =0 to maxnames-1 do

form7. stringgrid1. cells [i,0]: =name [lang, i]; // отображение названий колонок базы данных

end;

procedure TForm7. FormCreate (Sender: TObject);

const meteofile='meteostations. dat';

var t: textfile;

s: string;

i: integer;

begin

if fileexists (meteofile) then

begin

assignfile (t,meteofile);

reset (t);

s: =''; if not eof (t) then readln (t,s); form7. stringgrid1. cells [0,1]: =s;

s: =''; if not eof (t) then readln (t,s); form7. stringgrid1. cells [1,1]: =s;

s: =''; if not eof (t) then readln (t,s); form7. stringgrid1. cells [2,1]: =s;

s: =''; if not eof (t) then readln (t,s); form7. stringgrid1. cells [3,1]: =s;

s: =''; if not eof (t) then readln (t,s); form7. stringgrid1. cells [4,1]: =s;

while not eof (t) do

begin

stringgrid1. rowcount: =stringgrid1. rowcount+1;

s: =''; if not eof (t) then readln (t,s); form7. stringgrid1. cells [0,stringgrid1. rowcount-1]: =s;

s: =''; if not eof (t) then readln (t,s); form7. stringgrid1. cells [1,stringgrid1. rowcount-1]: =s;

s: =''; if not eof (t) then readln (t,s); form7. stringgrid1. cells [2,stringgrid1. rowcount-1]: =s;

s: =''; if not eof (t) then readln (t,s); form7. stringgrid1. cells [3,stringgrid1. rowcount-1]: =s;

s: =''; if not eof (t) then readln (t,s); form7. stringgrid1. cells [4,stringgrid1. rowcount-1]: =s;

end;

closefile (t);

end else form8. showmodal;

form1. listbox2. items. Clear;

for i: =1 to form7. StringGrid1. rowcount-1 do

form1. listbox2. items. add (form7. StringGrid1. cells [0, i] +' '+form7. StringGrid1. cells [1, i]);

form1. listbox2. ItemIndex: =0;

shownames;

end;

end.

unit Unit8;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, StdCtrls, ExtCtrls;

type

TForm8 = class (TForm)

Image1: TImage;

ListBox1: TListBox;

ListBox2: TListBox;

procedure Image1Click (Sender: TObject);

procedure ListBox1Click (Sender: TObject);

procedure FormCreate (Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form8: TForm8;

implementation

{$R *. dfm}

uses Unit1;

procedure TForm8. Image1Click (Sender: TObject);

begin

close;

end;

procedure TForm8. ListBox1Click (Sender: TObject);

var i: integer;

begin

for i: =0 to form1. listbox1. count-1 do

form1. listbox1. selected [i]: =form8. listbox1. selected [i];

for i: =0 to form1. listbox3. count-1 do

form1. listbox3. selected [i]: =form8. listbox2. selected [i];

drawinggraphix1 (700,890,form8. Image1. canvas);

end;

procedure TForm8. FormCreate (Sender: TObject);

begin

listbox1. left: =listbox1. left+600;

listbox2. left: =listbox2. left+600;

end;

end.

Приложение 2. Корреляционный анализ российской и канадской систем определения индекса пожарной опасности по данным метеостанций Ярцево, Кежма, Богучаны, Ванавара

а) м/с Ярцево б) м/с Кежма

в) м/с Богучаны г) м/с Ванавара

Размещено на Allbest.ru