#-------------------------------------------------------------------------
# Copyright 2004, 2005, 2006, 2007, 2008, 2009, 2010 E.D.G.
# seismic@ix.netcom.com
#------------------------------------------------------------------------
# This file is part of ETDPROG.
#
# ETDPROG is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.#
#
# ETDPROG is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with ETDPROG. If not, see .
#
# This present program is a slightly modified copy of Etdprog.exe Version
# ETDPROG.2.C.5.2004/05/20 It has been stored here so that computer
# programmers can see what the source code for the latest version of
# Etdprog.exe looks like. Most of the added code in the newer versions
# is used to generate Charts and Maps. The basic probability equations
# are largely the same as the ones in this version.
#
# Version ETDPROG.2.C.5.2004/05/20 or another one created around that
# time was formally registered with the U.S. Copyright Office in 2004.
#------------------------------------------------------------------------
# ASSIGN VALUES TO INITIAL PROGRAM VARIABLES
$programdirectory = 'C:\ETDPROG';# Program directory.
# The program directory is specified above. It can be any existing directory.
# All of the program, test, and data files must be stored in that directory.
$displayprob = 100;
# That is the number which the highest probability values in the results data output file will have.
# Any number can be used. But values over 999 might not display properly.
# I personally prefer using a number around 14 as I find that it makes the probability data easier to evaluate.
print "\n\n\n";
print 'Assigning values to the initial program variables', "\n\n";
use Math::Trig;# Perl requires this command for pi, atan, and asin functions
$gravityratio = 2.5;# The moon gravity/sun gravity strength ratio used in the program.
$programdirectory = $programdirectory.chr(92);
$filetests = $programdirectory.'testdata.txt';# $filetests is the file containing test data lines and settings
$filedatasm = $programdirectory.'datasm';# $filedatasm are sun and moon lat & lon data files (first part of the name)
$filetideci = $programdirectory.'datatdci.txt';# The Christmas Island ocean tide data file
$filetidela = $programdirectory.'datatdla.txt';# The Los Angeles ocean tide data file
$filetidesa = $programdirectory.'datatdsa.txt';# The South America Solid Earth Tide data file
$filedisplaycontrol = $programdirectory.'display.bat';# Causes the results file to be displayed
$filenumber = $programdirectory.'filenum.txt';# File containing sequence number of output file to use
# LOAD THE TESTDATA FILE
print 'Loading the test data file', "\n\n";
open file, '< '.$filetests;
@tlin = ;
close file;
# EXTRACT DATA LINES FROM THE TESTDATA FILE
print 'Extracting datalines from the testdata file', "\n\n";
$num = -1;
getdatalines:; # start and return point of loop to process another test file line - includes next 15 lines
$num1 = $num + 1;
if ($num1 > 1000){goto programerror};# at end of program
$dataline[$num1] = $word;
$charnum = -1;
$word = "";
$num = $num + 1;
$numdatalines = $num;
if (substr($tlin[$num], 0, 45) eq '***** END OF THE CONTROL SETTINGS SECTION ***'){goto processtestdata2};
# the above line jumps about 8 lines down when the extract data lines routine ends
nextchar:;# start of and return point to get settings values - includes next 8 lines
$charnum = $charnum + 1;
$char = substr($tlin[$num],$charnum,1);
if ($char eq " " || $char eq "," || $char eq ""){goto getdatalines};
# the above line jumps back to start of routine about 15 lines up
$word = $word.$char;
goto nextchar;# jump 6 lines up to test another character
# ASSIGN SETTING VALUES FROM THE TESTDATA FILE TO THE PROGRAM VARIABLES
processtestdata2:;# previous routine jumps to here from 12 lines up
print 'Assigning setting values from the testdata file to the program variables', "\n\n";
# These are the settings values which are stored at the top of the testdata file.
$percenttoprint = $dataline[1];# percentage of probability matches to display
$fatalcutoff = $dataline[2];# quakes with fatalities below this number will not display
$outputchoice = $dataline[3];# which sorts get displayed
$linestoprint = $dataline[4];# number of lines to print - works best with probability display
$override = $dataline[5];# can set each warning signal to have a strength of 1
$fatalweight = $dataline[6];# increases probabilities for higher fatality earthquakes
$magcutoff = $dataline[7];# quakes with magnitudes below this number will not display
$magweight = $dataline[8];# increases probabilities for higher magnitude earthquakes
$lonval = $dataline[9];# display only earthquakes with this longitude
$lonrange = $dataline[10];# actual longitude range $lonval + - $lonrange
$latval = $dataline[11];# display only earthquakes with this latitude
$latrange = $dataline[12];# actual latitude range $latval + - $latrange
$enddate = $dataline[13];# display only quakes occurring before this date
$startdate = $dataline[14];# display only quakes occurring after this date
$compdbtest = $dataline[15];# compare test lines with quakes or warning signals or both
$compdbtestww = $dataline[16];# adjustment factor to enhance signal - signal matches
$compdbtestqw = $dataline[17];# adjustment factor to enhance signal - earthquake matches
$fileeqdatabase = $dataline[18];# $fileeqdatabase is the earthquake and warning signal line database
$fileresults = $dataline[19];# file where program results are stored
# ASSIGN DEFAULT VALUES TO THE PROGRAM VARIABLES
if ($percenttoprint eq ''){$percenttoprint = 01};
$percentval = $percenttoprint;
if ($outputchoice eq ''){$outputchoice = 'p'};
if ($override eq ''){$override = 'r'};
if ($compdbtest eq ''){$compdbtest = 'q'};
if ($fileeqdatabase eq ''){$fileeqdatabase = 'dataeqs.txt'};
if ($fileresults eq ''){$fileresults = 'results.out'};
$fileeqdatabase = $programdirectory.$fileeqdatabase;
$fileresults = $programdirectory.$fileresults;
# SEE IF OUTPUT FILE SHOULD BE SEQUENCED
# if file name does not begin with # then skip this routine
# if file name is # by itself then clear sequence number file
# if file name is #filename.out (any extension) then make it filename2.out or filename3.out etc.
print 'Checking for output data file sequencing', "\n\n";
$templength1 = length($programdirectory), $templength2 = length($fileresults);
if (substr($fileresults, $templength1, 1) ne '#'){goto sequenceend};# skip routine and jump down about 20 lines
if ($templength2 < $templength1 +3){;# if end is 4 lines down - clear sequence number and exit program at bottom
open filenam, '> '.$filenumber;
close filenam;
print 'OUTPUT FILE SEQUENCE NUMBER CLEARED - EXITING PROGRAM', "\n\n";
goto endit};# end of if statement started 4 lines up - end program at bottom
for $num($templength1..$templength2){;# end of for is about 15 lines down
if (substr($fileresults, $num, 1) eq '.'){;# check for . end of if is about 10 lines down
open filenam, '< '.$filenumber;
$sequencenumber = readline(filenam);
close filenam;
$sequencenumber = $sequencenumber + 1;
open filenam, '> '.$filenumber;
print filenam $sequencenumber;
close filenam;
$fileresults = substr($fileresults, 0, $templength1).substr($fileresults, $templength1 +1, $num - $templength1 -1).$sequencenumber.substr($fileresults, $num, 100);
goto sequenceend;
};# end of if statement started 10 lines up
};# end of for statement started 15 lines up
goto programerror;# could not find a . - goto end of program and exit
sequenceend:;# jump to here from about 20 lines up
print $fileresults, ' Data output file', "\n\n";
# CLEAR THE DATA OUTPUT FILE
print 'Clearing the output data file', "\n\n";
open fileout, '> '.$fileresults;
print fileout "\n";
print fileout 'If this message is present in the data output file it means',"\n";
print fileout 'that the output data did not store properly in the file.',"\n";
print fileout 'Or, your text editor might have read an older copy of the',"\n";
print fileout 'output file.',"\n";
close fileout;
# IGNORE TEMPORARY, UNPROCESSED DATA LINES
print 'Removing temporary, unprocessed data lines from the testdata file', "\n\n";
$numskiplines = 0;
extractskiplines:;# start of and return point to ignore testdata file storage area lines - includes next 5 lines
$numskiplines = $numskiplines + 1;
if (substr($tlin[$numskiplines + $numdatalines], 0, 45) eq '***** BEGINNING OF THE TEST LINES SECTION ***'){goto eqdatabase};
# the above line jumps 6 lines down when this routine ends
if ($numskiplines > 1000){goto programerror};# at end of program
goto extractskiplines;# jump up 6 lines to check another storage area line
# LOAD THE EARTHQUAKES DATABASE FILE
eqdatabase:;# jump to here from about 6 lines up
if ($outputchoice eq 'x'){goto extracttestdata1};# jump down about 65 lines - do not load the earthquake database file
print 'Loading the earthquake and warning signal database file', "\n\n";
open file, '< '.$fileeqdatabase;
@qwlin = ;
close file;
# RESET THE EARTHQUAKES DATABASE ARRAY AND COUNT THE
# NUMBER OF DATABASE LINES
print 'Resetting the earthquake and warning signal database array', "\n";
print 'and determining the number of file lines', "\n\n";
$num = 0;
dbslinescount:;# return to here from 5 lines down
if (length($qwlin[$num]) < 5){goto extractquakedata};# end of routine - jump about 10 lines down to next routine
$numdbs = $num -1;# $numdbs is the number of earthquake and warning signal database file lines
$num = $num + 1;
$qwlin[$num -1] = $qwlin[$num];# reset array so that the first line is 0
goto dbslinescount;# go back and get another earthquake line
# EXTRACT DATA FROM THE EARTHQUAKES DATABASE FILE LINES
extractquakedata:;#
print 1*$numdbs +1, ' earthquake and warning signal lines in the database file', "\n\n";
print 'Extracting data from the earthquake and warning signal data file', "\n\n";
for $ndb(0..$numdbs){;# start of loop for extracting data from the earthquake database file end is 3 lines down
$offset = 1, $prsigstrength = 1, 1, $dbsigstrength[$ndb] = 1*(substr $qwlin[$ndb], $offset, $prsigstrength);
$offset = $offset + 4, $prsigtype = 3, $dbsigtype[$ndb] = substr($qwlin[$ndb], $offset, $prsigtype);
$offset = $offset + 6, $prquakeabbrev = 3, $dbquakeabbrev[$ndb] = substr($qwlin[$ndb], $offset, $prquakeabbrev);
$offset = $offset + 6, $prtype = 1, $dbtype[$ndb] = substr($qwlin[$ndb], $offset, $prtype);
if ($dbtype[$ndb] ne 'q'){$dbquakeabbrev[$ndb] = ''};
if ($dbtype[$ndb] eq 'q'){$dbsigtype[$ndb] = ''};
$offset = $offset + 4, $prang = 4, $dbang[$ndb] = 1*(substr $qwlin[$ndb], $offset, $prang);
$offset = $offset + 7, $pr[1] = 2, $db[1][$ndb] = 1*(substr $qwlin[$ndb], $offset, $pr[1]), $dbn[1] = 'eqlon';
if ($dbtype[$ndb] ne 'q'){$db[1][$ndb] = ''};
$offset = $offset + 5, $pr[2] = 2, $db[2][$ndb] = 1*(substr $qwlin[$ndb], $offset, $pr[2]), $dbm[2] = 'glon';
$offset = $offset + 5, $pr[3] = 2, $db[3][$ndb] = 1*(substr $qwlin[$ndb], $offset, $pr[3]), $dbn[3] = 'mlon';
$offset = $offset + 5, $pr[4] = 2, $db[4][$ndb] = 1*(substr $qwlin[$ndb], $offset, $pr[4]), $dbn[4] = 'cilon';
$offset = $offset + 5, $pr[5] = 2, $db[5][$ndb] = 1*(substr $qwlin[$ndb], $offset, $pr[5]), $dbn[5] = 'lalon';
$offset = $offset + 5, $pr[6] = 2, $db[6][$ndb] = 1*(substr $qwlin[$ndb], $offset, $pr[6]), $dbn[6] = 'salon';
$temp = 2*$db[3][$ndb] - $db[2][$ndb];
$db[7][$ndb] = $temp + 90*($temp < 0) - 90*($temp > 89), $dbn[7] = 'glon2';
$temp = 2*$db[2][$ndb] - $db[3][$ndb];
$db[8][$ndb] = $temp + 90*($temp < 0) - 90*($temp > 89), $dbn[8] = 'mlon2';
$offset = $offset + 5, $prdate = 10, $dbdate[$ndb] = substr($qwlin[$ndb], $offset, $prdate);
$offset = $offset + 13, $prtime = 8, $dbtime[$ndb] = substr($qwlin[$ndb], $offset, $prtime);
$offset = $offset + 11, $prfatal = 8, $dbfatal[$ndb] = 1*(substr $qwlin[$ndb], $offset, $prfatal);
if ($dbtype[$ndb] ne 'q'){$dbfatal[$ndb] = ''};
$offset = $offset + 11, $prinjured = 8, $dbinjured[$ndb] = 1*(substr $qwlin[$ndb], $offset, $prinjured);
if ($dbtype[$ndb] ne 'q'){$dbinjured[$ndb] = ''};
$offset = $offset + 11, $prdamage = 8, $dbdamage[$ndb] = 1*(substr $qwlin[$ndb], $offset, $prdamage);
if ($dbtype[$ndb] ne 'q'){$dbdamage[$ndb] = ''};
$offset = $offset + 11, $prlat = 3, $dblat[$ndb] = 1*(substr $qwlin[$ndb], $offset, $prlat);
if ($dbtype[$ndb] ne 'q'){$dblat[$ndb] = ''};
$offset = $offset + 6, $prlon = 4, $dblon[$ndb] = 1*(substr $qwlin[$ndb], $offset, $prlon);
if ($dbtype[$ndb] ne 'q'){$dblon[$ndb] = ''};
$offset = $offset + 7, $prdepth = 3, $dbdepth[$ndb] = 1*(substr $qwlin[$ndb], $offset, $prdepth);
if ($dbtype[$ndb] ne 'q'){$dbdepth[$ndb] = ''};
$offset = $offset + 6, $prmag = 3, $dbmag[$ndb] = 1*(substr $qwlin[$ndb], $offset, $prmag);
if (length($dbmag[$ndb]) == 1){$dbmag[$ndb] = $dbmag[$ndb].'.0'};
if ($dbtype[$ndb] ne 'q'){$dbmag[$ndb] = ''};
$offset = $offset + 6, $prcountry = 17, $dbcountry[$ndb] = substr($qwlin[$ndb], $offset, $prcountry);
if ($dbtype[$ndb] ne 'q'){$dbcountry[$ndb] = ''};
$offset = $offset + 20, $prquake = 41, $dbquake[$ndb] = substr($qwlin[$ndb], $offset, 100);
};# end of the earthquake line data extraction loop which started about 40 lines up
# EXTRACT TEST LINES FROM TESTDATA FILE
extracttestdata1:;# jump to here if data are not be extracted from the earthquake database
$num = 0;
print 'Extracting and processing test lines from the testdata file', "\n\n";
extracttestdata:;# start of and return point for process loop which includes the next 350 lines
# when finished with a testdata data line the following process loops back
# to the above extracttestdata label and begins testing the next test data line
$numtests = $num;
$num = $num + 1;
$skipprint[$num] = 0;
$numtlin = $num + $numdatalines + $numskiplines;
if ($tlin[$numtlin] eq ''){goto settestweights};# no more test lines - jump about 350 lines down to next routine
# next line - see if it is a regular earthquake or warning signal line
if (substr($tlin[$numtlin], 0, 1) eq ' '){;
goto processregular};# end of the above if statement - jump about 20 lines down
# next line - see if it is a NEIS earthquake line
if (substr($tlin[$numtlin], 4, 1) eq '/' && length($tlin[$numtlin]) > 30){;
goto processneis};# end of the above if statement - jump about 80 lines down
# next line - see if it is a RedPuma earthquake line
if (substr($tlin[$numtlin], 12, 1) eq ':'){;
goto processredpuma};# end of the above if statement - jump about 115 lines down
# next line - if it is not one of the other type lines then it must be
# a standard warning signal time entry line
goto processtime;# jump about 50 lines down
#######################################################################
# PROCESS THE DIFFERENT TYPES OF TESTDATA FILE ENTRIES #
#######################################################################
# PROCESS A REGULAR EARTHQUAKE OR WARNING SIGNAL ENTRY
# routine which extracts data from each test line (this is not a true subroutine)
processregular:;# routine entry point from about 20 lines up
$skipprint[$num] = 1;
$offset = 1, $testsigstrength[$num] = 1*(substr($tlin[$numtlin], $offset, $prsigstrength));
if ($testsigstrength[$num] == 0){$testsigstrength[$num] = '1'};
$offset = $offset + 4, $testsigtype[$num] = substr($tlin[$numtlin], $offset, $prsigtype);
$offset = $offset + 6, $testquakeabbrev[$num] = substr($tlin[$numtlin], $offset, $prquakeabbrev);
$offset = $offset + 6, $testtype[$num] = substr($tlin[$numtlin], $offset, $prtype);
$offset = $offset + 4, $testang[$num] = 1*(substr($tlin[$numtlin], $offset, $prang));
$offset = $offset + 7, $test[1][$num] = 1*(substr($tlin[$numtlin], $offset, $pr[1])), $testn[1] = 'eqlon';
if ($testtype[$num] ne 'q'){$test[1][$num] = ''};
$offset = $offset + 5, $test[2][$num] = 1*(substr($tlin[$numtlin], $offset, $pr[2])), $testn[2] = 'glon';
$offset = $offset + 5, $test[3][$num] = 1*(substr($tlin[$numtlin], $offset, $pr[3])), $testn[3] = 'mlon';
$offset = $offset + 5, $test[4][$num] = 1*(substr($tlin[$numtlin], $offset, $pr[4])), $testn[4] = 'cilon';
$offset = $offset + 5, $test[5][$num] = 1*(substr($tlin[$numtlin], $offset, $pr[5])), $testn[5] = 'lalon';
$offset = $offset + 5, $test[6][$num] = 1*(substr($tlin[$numtlin], $offset, $pr[6])), $testn[6] = 'salon';
$temp = 2*$test[3][$num] - $test[2][$num];
$test[7][$num] = $temp + 90*($temp < 0) - 90*($temp > 89), $testn[7] = 'glon2';
$temp = 2*$test[2][$num] - $test[3][$num];
$test[8][$num] = $temp + 90*($temp < 0) - 90*($temp > 89), $testn[8] = 'mlon2';
$offset = $offset + 5, $testdate[$num] = substr($tlin[$numtlin], $offset, $prdate);
$offset = $offset + 13, $testtime[$num] = substr($tlin[$numtlin], $offset, $prtime);
$offset = $offset + 11, $testfatal[$num] = 1*(substr($tlin[$numtlin], $offset, $prfatal));
if ($testtype[$num] ne 'q'){$testfatal[$num] = ''};
$offset = $offset + 11, $testinjured[$num] = 1*(substr($tlin[$numtlin], $offset, $prinjured));
if ($testinjured[$num] ne 'q'){$testinjured[$num] = ''};
$offset = $offset + 11, $testdamage[$num] = 1*(substr($tlin[$numtlin], $offset, $prdamage));
if ($testtype[$num] ne 'q'){$testdamage[$num] = ''};
$offset = $offset + 11, $testlat[$num] = 1*(substr($tlin[$numtlin], $offset, $prlat));
if ($testtype[$num] ne 'q'){$testlat[$num] = ''};
$offset = $offset + 6, $testlon[$num] = 1*(substr($tlin[$numtlin], $offset, $prlon));
if ($testtype[$num] ne 'q'){$testlon[$num] = ''};
$offset = $offset + 7, $testdepth[$num] = 1*(substr($tlin[$numtlin], $offset, $prdepth));
if ($testdepth[$num] == 0){$testdepth[$num] = ''};
if ($testtype[$num] ne 'q'){$testdepth[$num] = ''};
$offset = $offset + 6, $testmag[$num] = 1*(substr($tlin[$numtlin], $offset, $prmag));
if (length($testmag[$num]) == 1){$testmag[$num] = $testmag[$num].'.0'};
if ($testmag[$num] == 0){$testmag[$num] = ''};
if ($testtype[$num] ne 'q'){$testmag[$num] = ''};
$offset = $offset + 6, $testcountry[$num] = substr($tlin[$numtlin], $offset, $prcountry);
$offset = $offset + 20, $testquake[$num] = substr($tlin[$numtlin], $offset, 100);
goto extracttestdata;# go up about 60 lines and start checking another test data line
# PROCESS A WARNING SIGNAL TIME ENTRY
processtime:;# entry point from about 50 lines up (not a true subroutine)
$lentlin = length($tlin[$numtlin]);
$timeline = substr($tlin[$numtlin], 0, $lentlin -1);
$tim1 = substr($timeline, 0, 4).substr($timeline, 5, 2).substr($timeline, 8, 2);
$tim = $tim1.'.'.substr($timeline, 11, 2).substr($timeline, 14, 2);
$yr = substr($timeline, 0, 4);
$mo = substr($timeline, 5, 2);
$da = substr($timeline, 8, 2);
$hr = substr($timeline, 11, 2);
$min = substr($timeline, 14, 2);
$testsigstr = substr($timeline, 20, 1);
$testsigtyp = substr($timeline, 22, 3);
$utcdate = substr($timeline, 0, 10);
$utctime = substr($timeline, 11, 8);
$dahrmin = $da + ($hr*60 + $min)/1440;
$testtype[$num] = 'w';
goto getsmlatlondata;# go to the sun and moon data line routine several routines down
# PROCESS A NEIS EARTHQUAKE ENTRY
processneis:;# entry point from about 80 lines up (not a true subroutine)
$lentlin = length($tlin[$numtlin]);
$timeline = $tlin[$numtlin];
$tim1 = substr($timeline, 0, 4).substr($timeline, 5, 2).substr($timeline, 8, 2);
$tim = $tim1.'.'.substr($timeline, 12, 2).substr($timeline, 15, 2);
$yr = substr($timeline, 0, 4);
$mo = substr($timeline, 5, 2);
$da = substr($timeline, 8, 2);
$hr = substr($timeline, 12, 2);
$min = substr($timeline, 15, 2);
$testsigstr = 1;
$utcdate = substr($timeline, 0, 10);
$utctime = substr($timeline, 12, 8);
$dahrmin = $da + ($hr*60 + $min)/1440;
$testsigstr = '1';
$testsigtyp = ' ';
$wordnum = 0, $qword = 0;
for $i(20..$lentlin){$char = substr($timeline, $i, 1);# for $i loop ends 4 lines down
if ($wordnum == 5){goto endofusgsline};# jump 4 lines down
if ($char ne ' '){$qword = $qword.$char};
if ($char eq ' '){$quakeword[$wordnum] = $qword, $qword = '', $wordnum = $wordnum +1};
};# end of the for $i statement which started 4 lines up
endofusgsline:;# entry point from 4 lines up
$testtype[$num] = 'q';
$temp1 = length($quakeword[1]);
$temp = substr('-', 0, (substr($quakeword[1], $temp1 -1, 1)eq 'S'));
$testlat[$num] = int($temp.substr($quakeword[1], 0, $temp1 -1) +.5 -1*($temp eq '-'));
$temp5 = length($quakeword[2]);
$temp1 = 1;
if (substr($quakeword[2], $temp5 -1, 1) eq 'W'){$temp1 = -1};
$temp2 = $temp1*substr($quakeword[2], 0, $temp5 -1);
$testlon[$num] = int($temp2 +.5 -1*($temp1 == -1));
$temp3 = -1*$testlon[$num] + 180;
$temp4 = int($temp3/90);
$test[1][$num] = $temp3 - $temp4*90;
$testdepth[$num] = $quakeword[3];
$testmag[$num] = $quakeword[4];
$testquake[$num] = $timeline;
goto getsmlatlondata;# go to the sun and moon data line routine several routines down
# PROCESS A REDPUMA EARTHQUAKE ENTRY
processredpuma:;# entry point from about 115 lines up (not a true subroutine)
$lentlin = length($tlin[$numtlin]);
$timeline = $tlin[$numtlin];
$yr = substr($timeline, 5, 4);
$mo1 = substr($tlin[$numtlin], 2, 3);
if ($mo1 eq 'Jan'){$mo = '01'};
if ($mo1 eq 'Feb'){$mo = '02'};
if ($mo1 eq 'Mar'){$mo = '03'};
if ($mo1 eq 'Apr'){$mo = '04'};
if ($mo1 eq 'May'){$mo = '05'};
if ($mo1 eq 'Jun'){$mo = '06'};
if ($mo1 eq 'Jul'){$mo = '07'};
if ($mo1 eq 'Aug'){$mo = '08'};
if ($mo1 eq 'Sep'){$mo = '09'};
if ($mo1 eq 'Oct'){$mo = '10'};
if ($mo1 eq 'Nov'){$mo = '11'};
if ($mo1 eq 'Dec'){$mo = '12'};
$tim1 = substr($timeline, 5, 4).$mo.substr($timeline, 0, 2);
$tim = $tim1.'.'.substr($timeline, 10, 2).substr($timeline, 13, 2);
$da = substr($timeline, 0, 2);
$hr = substr($timeline, 10, 2);
$min = substr($timeline, 13, 2);
$testsigstr = 1;
$utcdate = $yr.'/'.$mo.'/'.$da;
$utctime = substr($timeline, 10, 8);
$dahrmin = $da + ($hr*60 + $min)/1440;
$testsigstr = '1';
$testsigtyp = ' ';
$testtype[$num] = 'q';
$temp = substr('-', 0, (substr($timeline, 25, 1) eq 'S'));
$testlat[$num] = int($temp.substr($timeline, 21, 4) +.5 -1*($temp eq '-'));
$temp1 = 1;
if (substr($timeline, 32, 1) eq 'W'){$temp1 = -1};
$temp2 = $temp1*substr($timeline, 27, 5);
$testlon[$num] = int($temp2 +.5 -1*($temp1 == -1));
$temp3 = -1*$testlon[$num] + 180;
$temp4 = int($temp3/90);
$test[1][$num] = $temp3 - $temp4*90;
$testdepth[$num] = substr($timeline, 33, 3);
$testmag[$num] = substr($timeline, 40, 3);
$testquake[$num] = $timeline;
goto getsmlatlondata;# go to the sun and moon data line routine - the next routine
############################################################################
# GET AND PROCESS DIFFERENT TYPES OF DATA FROM THE DATA FILES #
############################################################################
# GET A SUN AND MOON LATITUDE AND LONGITUDE DATA LINE
getsmlatlondata:;# most of the above test line data checks jump to here
print 'Get sun and moon latitude and longitude data - ', "\n";
open filein, '< '.$filedatasm.$mo.'.txt';
@sunmoonlin = ;
close filein;
$numtl = -1;
checksunmoon:;# return point from 4 lines down
$numtl = $numtl + 1;
if ($sunmoonlin[$numtl] eq ''){goto programerror};# at end of program
if (substr($sunmoonlin[$numtl], 0, 13) eq $tim){goto sunmoonmatch};# jump 2 lines down
goto checksunmoon;# return to 4 lines up
sunmoonmatch:;# jump here from 2 lines up
$sunmoonlin = substr($sunmoonlin[$numtl], 0, length($sunmoonlin[$numtl]) -1);
# GET A CHRISTMAS ISLAND OCEAN TIDE DATA LINE
print 'Get Christmas Island ocean tide data - ', "\n";
open filein, '< '.$filetideci;
@cilin = ;
close filein;
$numtl = -1;
checkci:;# return point for check loop from 4 lines down
$numtl = $numtl + 1;
if ($cilin[$numtl] eq ''){goto programerror};# at end of program
if ($tim >= substr($cilin[$numtl], 0, 13)){goto cimatch};# jump down 2 lines
goto checkci;# jump to check loop start 4 lines up
cimatch:;
$ciline = substr($cilin[$numtl +1], 0, length($cilin[$numtl +1]) -1);
# GET A LOS ANGELES OCEAN TIDE DATA LINE
print 'Get Los Angeles ocean tide data - ', "\n";
open filein, '< '.$filetidela;
@lalin = ;
close filein;
$numtl = -1;
checkla:;# return point for check loop from 4 lines down
$numtl = $numtl + 1;
if ($lalin[$numtl] eq ''){goto programerror};# at end of program
if ($tim >= substr($lalin[$numtl], 0, 13)){goto lamatch};# jump down 2 lines
goto checkla;# jump to check loop start 4 lines up
lamatch:;# jump to here from 2 lines up
$laline = substr($lalin[$numtl +1], 0, length($lalin[$numtl +1]) -1);
# GET A SOUTH AMERICA SOLID EARTH TIDE DATA LINE
print 'Get South America Solid Earth Tide data - ', "\n";
open filein, '< '.$filetidesa;
@salin = ;
close filein;
$numtl = -1;
checkset:;# return point for check loop from 4 lines down
$numtl = $numtl + 1;
if ($salin[$numtl] eq ''){goto programerror};# at end of program
if ($tim >= substr($salin[$numtl], 0, 13)){goto setmatch};# jump down 2 lines
goto checkset;# jump to check loop start 4 lines up
setmatch:;# jump to here from 2 lines up
$saline = substr($salin[$numtl +1], 0, length($salin[$numtl +1]) -1);
# EXTRACT THE SUN AND MOON LATITUDE AND LONGITUDE DATA
print 'Process the sun and moon latitude and longitude data - ', "\n";
$sunlat = substr($sunmoonlin, 15, 7);
$sunlon = substr($sunmoonlin, 24, 7);
$moonlat = substr($sunmoonlin, 40, 7);
$moonlon = substr($sunmoonlin, 49, 7);
$mlon = $moonlon - (int($moonlon/90))*90;
# PROCESS THE SUN AND MOON LATITUDE AND LONGITUDE DATA
# add the sun and moon gravities together to get the gravity point location,
# the gravity point gravity strength, and the sun - Earth - moon angle
$sunlatrads = $sunlat*2*pi/360;
$sunlonrads = $sunlon*2*pi/360;
$moonlatrads = $moonlat*2*pi/360;
$moonlonrads = $moonlon*2*pi/360;
$sxval = cos($sunlatrads)*cos($sunlonrads);# sun x
$mxval = cos($moonlatrads)*cos($moonlonrads);# moon x
$syval = cos($sunlatrads)*sin($sunlonrads);# sun y
$myval = cos($moonlatrads)*sin($moonlonrads);# moon y
$szval = sin($sunlatrads);# sun z
$mzval = sin($moonlatrads);# moon z
$smxtot = $sxval + $mxval*$gravityratio;# sum sun and moon x values
$smytot = $syval + $myval*$gravityratio;# sum sun and moon y values
$smztot = $szval + $mzval*$gravityratio;# sum sun and moon z values
$gplat1 = sqrt($smxtot**2 +$smytot**2), $gplat2 = $gplat1 + .00001*($gplat1 == 0);
$gplat = int(atan($smztot/$gplat2)*360/(2*pi) +.5);# gp lat
$gplon1 = $smxtot + .00001*($smxtot == 0);
$gplon2 = atan($smytot/$gplon1)*360/(2*pi);# gravity point longitude
$gplon = int($gplon2 + 90*($gplon2 < 0) +.5);# adjusted gravity point longitude
$gpstrength1 = sqrt($smxtot**2 + $smytot**2 + $smztot**2);# gravity point strength
$gpstrength = int($gpstrength1*10 +.5)/10;
$base = ($sxval - $mxval)**2+($syval - $myval)**2;# angle base
$height = $szval - $mzval;# angle height
$gpangle1 = asin(sqrt($base + $height**2)/2)*2*360/2/pi;# temp angle value
$gpangle2 = $gpangle1*(1 -2*($sunlon - $moonlon > 180) -2*($moonlon - $sunlon > 0 && $moonlon - $sunlon < 180));
$gpangle = int($gpangle2 + .5*($gpangle2 >= 0) -.5*($gpangle2 < 0));
# PROCESS THE CHRISTMAS ISLAND OCEAN TIDE DATA
# get the averaged ocean tide crest or trough longitude
print 'Process the Christmas Island ocean tide data - ', "\n";
$cit1day = substr($ciline, 24, 2);
$cit1 = $cit1day + (substr($ciline, 27, 2)*60 + substr($ciline, 30, 2))/1440;
$cit2day = substr($ciline, 34, 2);
$cit2 = $cit2day + $cit1day*($cit1day > $cit2day) + (substr($ciline, 37, 2)*60 + substr($ciline, 40, 2))/1440;
$cit3day = substr($ciline, 44, 2);
$cit3 = $cit3day + $cit1day*($cit1day > $cit3day) + (substr($ciline, 47, 2)*60 + substr($ciline, 50, 2))/1440;
$cit4day = substr($ciline, 54, 2);
$cit4 = $cit4day + $cit1day*($cit1day > $cit4day) + (substr($ciline, 57, 2)*60 + substr($ciline, 60, 2))/1440;
$citdelay = $dahrmin - ($cit1 + $cit2 + $cit3 + $cit4)/4;
$cilont = ($citdelay/0.04167)*14.5+29;
$cilon = int($cilont - (int($cilont/90) - ($cilont < 0))*90 +.5);
# PROCESS THE LOS ANGELES OCEAN TIDE DATA
# get the averaged ocean tide crest or trough longitude
print 'Process the Los Angeles ocean tide data - ', "\n";
$lat1day = substr($laline, 24, 2);
$lat1 = $lat1day + (substr($laline, 27, 2)*60 + substr($laline, 30, 2))/1440;
$lat2day = substr($laline, 34, 2);
$lat2 = $lat2day + $lat1day*($lat1day > $lat2day) + (substr($laline, 37, 2)*60 + substr($laline, 40, 2))/1440;
$lat3day = substr($laline, 44, 2);
$lat3 = $lat3day + $lat1day*($lat1day > $lat3day) + (substr($laline, 47, 2)*60 + substr($laline, 50, 2))/1440;
$lat4day = substr($laline, 54, 2);
$lat4 = $lat4day + $lat1day*($lat1day > $lat4day) + (substr($laline, 57, 2)*60 + substr($laline, 60, 2))/1440;
$latdelay = $dahrmin - ($lat1 + $lat2 + $lat3 + $lat4)/4;
$lalont = ($latdelay/0.04167)*14.5+73;
$lalon = int($lalont - (int($lalont/90) - ($lalont < 0))*90 +.5);
# PROCESS THE SOUTH AMERICA SOLID EARTH TIDE DATA
# get the averaged Solid Earth Tide crest or trough longitude
print 'Process the South America Solid Earth Tide data - ', "\n\n";
$sat1day = substr($saline, 24, 2);
$sat1 = $sat1day + (substr($saline, 27, 2)*60 + substr($saline, 30, 2))/1440;
$sat2day = substr($saline, 34, 2);
$sat2 = $sat2day + $sat1day*($sat1day > $sat2day) + (substr($saline, 37, 2)*60 + substr($saline, 40, 2))/1440;
$sat3day = substr($saline, 44, 2);
$sat3 = $sat3day + $sat1day*($sat1day > $sat3day) + (substr($saline, 47, 2)*60 + substr($saline, 50, 2))/1440;
$sat4day = substr($saline, 54, 2);
$sat4 = $sat4day + $sat1day*($sat1day > $sat4day) + (substr($saline, 57, 2)*60 + substr($saline, 60, 2))/1440;
$satdelay = $dahrmin - ($sat1 + $sat2 + $sat3 + $sat4)/4;
$salont = ($satdelay/0.04167)*14.5+30;
$salon = int($salont - (int($salont/90) - ($salont < 0))*90 +.5);
# ASSIGN WARNING SIGNAL TIME ENTRY VALUES TO THE TEST ARRAY
$testsigstrength[$num] = $testsigstr;
$testsigtype[$num] = $testsigtyp;
$testdate[$num] = $utcdate;
$testtime[$num] = $utctime;
$testang[$num] = $gpangle;
$test[2][$num] = $gplon;
$test[3][$num] = $mlon;
$test[4][$num] = $cilon;
$test[5][$num] = $lalon;
$test[6][$num] = $salon;
$temp = 2*$test[3][$num] - $test[2][$num];
$test[7][$num] = $temp + 90*($temp < 0) - 90*($temp > 89), $testn[7] = 'glon2';
$temp = 2*$test[2][$num] - $test[3][$num];
$test[8][$num] = $temp + 90*($temp < 0) - 90*($temp > 89), $testn[8] = 'mlon2';
goto extracttestdata;# return to get another test line about 350 lines up
############################################################################
# MATCH THE TEST LINE DATA WITH THE EARTHQUAKE AND WARNING SIGNAL DATA #
############################################################################
# ASSIGN IMPORTANCE (WEIGHT) FACTORS TO COMPARISONS
# $testwt[1][] values point to the $db[1][] and $db[2][] ... database file earthquake and warning signal eqlon glon ... values
# $testwt[2][] values point to the $test[1][] and $test[2][] ... test file earthquake and warning signal eqlon glon ... values
# $testwt[3][] are the actual comparison weights for given $db[$num][] $test[$num][] comparison test
# $testwt[4][] this is the comparison which is being made. Ex. 'db eqlon test glon' would be a comparison between the earthquake database eqlon value and the testdata file line glon value.
settestweights:;
print ' - all of the test data extraction and processing steps are done' , "\n\n";
if ($outputchoice eq 'x'){goto skipprobcalcs};# jump down about 200 lines - do not calculate probabilities - just create new earthquake datafile lines
print 'Assigning weight factors to data comparisons', "\n\n";
$num = 0;
$num = $num + 1, $testwt[1][$num] = 1, $testwt[2][$num] = 2;
$testwt[3][$num] = 3, $testwt[4][$num] = 'db eqlon test glon';# 1
$num = $num + 1, $testwt[1][$num] = 2, $testwt[2][$num] = 1;
$testwt[3][$num] = 3, $testwt[4][$num] = 'db glon test eqlon';# 2
$num = $num + 1, $testwt[1][$num] = 1, $testwt[2][$num] = 3;
$testwt[3][$num] = 2, $testwt[4][$num] = 'db eqlon test mlon';# 3
$num = $num + 1, $testwt[1][$num] = 3, $testwt[2][$num] = 1;
$testwt[3][$num] = 2, $testwt[4][$num] = 'db mlon test eqlon';# 4
$num = $num + 1, $testwt[1][$num] = 1, $testwt[2][$num] = 4;
$testwt[3][$num] = 2, $testwt[4][$num] = 'db eqlon test cilon';# 5
$num = $num + 1, $testwt[1][$num] = 4, $testwt[2][$num] = 1;
$testwt[3][$num] = 2, $testwt[4][$num] = 'db cilon test eqlon';# 6
$num = $num + 1, $testwt[1][$num] = 1, $testwt[2][$num] = 5;
$testwt[3][$num] = 1, $testwt[4][$num] = 'db eqlon test lalon';# 7
$num = $num + 1, $testwt[1][$num] = 5, $testwt[2][$num] = 1;
$testwt[3][$num] = 1, $testwt[4][$num] = 'db lalon test eqlon';# 8
$num = $num + 1, $testwt[1][$num] = 1, $testwt[2][$num] = 6;
$testwt[3][$num] = 1, $testwt[4][$num] = 'db eqlon test salon';# 9
$num = $num + 1, $testwt[1][$num] = 6, $testwt[2][$num] = 1;
$testwt[3][$num] = 1, $testwt[4][$num] = 'db salon test eqlon';# 10
$num = $num + 1, $testwt[1][$num] = 2, $testwt[2][$num] = 2;
$testwt[3][$num] = 9, $testwt[4][$num] = 'db glon test glon';# 11
$num = $num + 1, $testwt[1][$num] = 2, $testwt[2][$num] = 3;
$testwt[3][$num] = 3, $testwt[4][$num] = 'db glon test mlon';# 12
$num = $num + 1, $testwt[1][$num] = 3, $testwt[2][$num] = 2;
$testwt[3][$num] = 3, $testwt[4][$num] = 'db mlon test glon';# 13
$num = $num + 1, $testwt[1][$num] = 3, $testwt[2][$num] = 3;
$testwt[3][$num] = 7, $testwt[4][$num] = 'db mlon test mlon';# 14
$num = $num + 1, $testwt[1][$num] = 4, $testwt[2][$num] = 4;
$testwt[3][$num] = 2, $testwt[4][$num] = 'db cilon test cilon';# 15
$num = $num + 1, $testwt[1][$num] = 5, $testwt[2][$num] = 5;
$testwt[3][$num] = 1, $testwt[4][$num] = 'db lalon test lalon';# 16
$num = $num + 1, $testwt[1][$num] = 6, $testwt[2][$num] = 6;
$testwt[3][$num] = 1, $testwt[4][$num] = 'db salon test salon';# 17
$num = $num + 1, $testwt[1][$num] = 1, $testwt[2][$num] = 7;
$testwt[3][$num] = .5, $testwt[4][$num] = 'db eqlon test glon2';# 18
$num = $num + 1, $testwt[1][$num] = 7, $testwt[2][$num] = 1;
$testwt[3][$num] = .5, $testwt[4][$num] = 'db glon2 test eqlon';# 19
$num = $num + 1, $testwt[1][$num] = 1, $testwt[2][$num] = 8;
$testwt[3][$num] = .5, $testwt[4][$num] = 'db eqlon test mlon2';# 20
$num = $num + 1, $testwt[1][$num] = 8, $testwt[2][$num] = 1;
$testwt[3][$num] = .5, $testwt[4][$num] = 'db mlon2 test eqlon';# 21
$num = $num + 1, $testwt[1][$num] = 2, $testwt[2][$num] = 7;
$testwt[3][$num] = .5, $testwt[4][$num] = 'db glon test glon2';# 22
$num = $num + 1, $testwt[1][$num] = 2, $testwt[2][$num] = 8;
$testwt[3][$num] = .5, $testwt[4][$num] = 'db glon test mlon2';# 23
$num = $num + 1, $testwt[1][$num] = 3, $testwt[2][$num] = 7;
$testwt[3][$num] = .5, $testwt[4][$num] = 'db mlon test glon2';# 24
$num = $num + 1, $testwt[1][$num] = 3, $testwt[2][$num] = 8;
$testwt[3][$num] = .5, $testwt[4][$num] = 'db mlon test mlon2';# 25
$num = $num + 1, $testwt[1][$num] = 7, $testwt[2][$num] = 7;
$testwt[3][$num] = .5, $testwt[4][$num] = 'db glon test glon2';# 26
$num = $num + 1, $testwt[1][$num] = 7, $testwt[2][$num] = 8;
$testwt[3][$num] = .5, $testwt[4][$num] = 'db glon test mlon2';# 27
$num = $num + 1, $testwt[1][$num] = 8, $testwt[2][$num] = 7;
$testwt[3][$num] = .5, $testwt[4][$num] = 'db mlon test glon2';# 28
$num = $num + 1, $testwt[1][$num] = 8, $testwt[2][$num] = 8;
$testwt[3][$num] = .5, $testwt[4][$num] = 'db mlon test mlon2';# 29
$numwts = $num;
# CALCULATE PROBABILITIES
# Three calculation runs are done so that longitudes near 0 can be compared
# with longitudes near 90 calcprobs() is a true subroutine
print 'Calculating probabilities - (may take 1 to 15 seconds or longer)', "\n";
$highprobdb = 1;
$numtested = 0;
$dbadd = 0, $testadd = 0, calcprobs();# use original quake and test values
$dbadd = 90, $testadd = 0, calcprobs();# add 90 to quake and warning signal values
$dbadd = 0, $testadd = 90, calcprobs();# add 90 to test values
goto calcpercents;# done calculating probabilities - jump down about 50 lines
# Subroutine for calculating probabilities
# Note: these are not true probabilities. They simply show how closely the
# data evaluation program comparison calculations indicated the test data
# matched the earthquake or warning signal data.
sub calcprobs{;# entry point from 7 lines up (this is a true subroutine)
for $ndb(0..$numdbs){;# run check on earthquake data file lines one at a time
$numtested = $numtested +1;
if (int($numtested/10000) == $numtested/10000){print $numtested.'/'.($numdbs*3).' tests completed',"\n"};
if ($compdbtest eq 'q' && $dbtype[$ndb] ne 'q'){goto skipdbline};
if ($compdbtest eq 'w' && $dbtype[$ndb] ne 'w'){goto skipdbline};
if ($fatalcutoff ne '' && $dbtype[$ndb] eq 'q' && $dbfatal[$ndb] < $fatalcutoff){goto skipdbline};
if ($magcutoff ne '' && $dbmag[$ndb] < $magcutoff){goto skipdbline};
if ($enddate ne '' && $enddate lt $dbdate[$ndb]){goto skipdbline};
if ($startdate ne '' && $startdate gt $dbdate[$ndb]){goto skipdbline};
if ($latval ne '' && ($dblat[$ndb] < ($latval -$latrange) || $dblat[$ndb] > ($latval +$latrange))){goto skipdbline};
if ($lonval ne '' && ($dblon[$ndb] < ($lonval -$lonrange) || $dblon[$ndb] > ($lonval +$lonrange))){goto skipdbline};
for $ntest(1..$numtests){;# start of tests loop for each earthquake line
for $nwt(1..$numwts){;# start of weight loop for each test
# next line - skip present comparison if test line is not an earthquake;
if (substr($testwt[4][$nwt], length($testwt[4][$nwt]) -10, 10) eq 'test eqlon' && $testtype[$ntest] ne 'q'){goto skipwttest};
$dblonval = $db[$testwt[1][$nwt]][$ndb] + $dbadd;# eqlon etc. for that earthquake;
$testlonval = $test[$testwt[2][$nwt]][$ntest] + $testadd;# eqlon etc. for that test;
if ($dblonval > $testlonval +9 || $dblonval < $testlonval -9){goto skipwttest};# longitudes too far apart
$testsigstren = $testsigstrength[$ntest];# sig str for that test;
if ($override eq 'o'){$testsigstren = 1};
$testweight = $testwt[3][$nwt];# weight for that test;
# THE NEXT TWO LINES ARE THIS PROGRAM'S BASIC DATA COMPARISON CALCULATIONS
# the first line increases (in a nonlinear manner) the probability value for closer longitude matches
$londiff = 2**(1 + (abs($dblonval - $testlonval)/3.9));
$probvalue = $testsigstren*$testweight*(10 - $londiff);
# the next two lines can increase probability values for fatal and higher magnitude earthquakes
if ($fatalweight ne ''){$probvalue = $probvalue*($dbfatal[$ndb] != 0)*$fatalweight/100 + $probvalue*($dbfatal[$ndb] == 0)*(1 - $fatalweight/100)};
if ($magweight ne ''){$probvalue = $probvalue*$dbmag[$ndb]*$magweight/100 + $probvalue*(1 - $magweight/100)};
# the next 2 lines can compensate for the higher earthquake - earthquake probability values associated with the extra eqlon - ... comparisons;
if ($compdbtestww ne '' && $dbtype[$ndb] eq 'w' && $testtype[$ntest] eq 'w'){$probvalue = $probvalue*$compdbtestww};
if ($compdbtestqw ne '' && (($dbtype[$ndb] eq 'q' && $testtype[$ntest] eq 'w') || ($dbtype[$ndb] eq 'w' && $testtype[$ntest] eq 'q'))){$probvalue = $probvalue*$compdbtestqw};
$probdb[$ndb] = $probdb[$ndb] + $probvalue;# create probability values for each earthquake line
if ($probdb[$ndb] > $highprobdb){$highprobdb = $probdb[$ndb]};
$probtest[$ndb][$ntest] = $probtest[$ndb][$ntest] + $probvalue;# create probability values for each earthquake line test
if ($probtest[$ndb][$ntest] > $highprobtest[$ndb]){$highprobtest[$ndb] = $probtest[$ndb][$ntest]};
skipwttest:;# jump to here to skip over a test;
};# end of $nwt - the weight loop for each test
};# end of $ntest - the test loop for each earthquake line
skipdbline:;# jump to here if it is not a usable earthquake data line;
};# end of $ndb - individual earthquake line loop
};# end of calcprobs subroutine - jump up about 50 lines for the next check (3 total)
# CALCULATE PERCENTAGES FOR EARTHQUAKES AND TESTS
calcpercents:;# jump to here from about 50 lines up
print 'Calculating probabilities - done', "\n\n";
print 'Calculating percents', "\n\n";
for $ndb(0..$numdbs){;# start of the earthquake lines loop
$percentdb[$ndb] = 100*$probdb[$ndb]/$highprobdb;
for $ntest(1..$numtests){;# start of the tests loop for each earthquake line
if ($highprobtest[$ndb] != 0){$percenttest[$ndb][$ntest] = $percentdb[$ndb]*$probtest[$ndb][$ntest]/$highprobtest[$ndb]}
};# end of the tests for each earthquake line loop started 4 lines up
};# end of the earthquake lines loop started 3 lines up
# CREATE ARRAY SORTED BY SINGLE LONGITUDE DEGREE $dbsortlondeg[]
print 'Creating longitude degree sort array', "\n\n";
$highlondeg = 1;
for $ndb(0..$numdbs){;# start of the earthquake lines loop - ends 9 lines down
if ($dbtype[$ndb] eq 'q'){;# if ends 7 lines down
$temp1 = $dblon[$ndb];
if ($temp1 == -180){$temp1 = 180};
if ($temp1 == 181){$temp1 = -179};
if ($temp1 < 0){$temp1 = $temp1 + 360};
if (int($percentdb[$ndb] +0.5) >= $percentval){$dbtemp1[$temp1] = $dbtemp1[$temp1] + $percentdb[$ndb]};
if ($dbtemp1[$temp1] > $highlondeg){$highlondeg = $dbtemp1[$temp1]};
};# end of if started 7 lines up
};# end of for loop started 9 lines up
for $num(0..359){;# loop ends 2 lines down
$dbsortlondeg[$num] = int(($dbtemp1[$num]*100/$highlondeg) +0.5);
};# end of for loop started 2 lines up
# CREATE ARRAY SORTED BY EARTHQUAKE LATITUDE $dbsortlat[]
print 'Creating latitude sort array', "\n\n";
for $ndb(0..$numdbs){;# start of the earthquake lines loop
$temp1 = '000000'.($numdbs -$ndb), $temp1 = substr($temp1, length($temp1) -6, 6);
$temp = (90 +$dblat[$ndb]).$temp1;
$temp = ' '.$temp;
$dbtemp1[$ndb] = substr($temp, length($temp) -11, 11).'-'.$ndb;
};# end of the earthquake line loop started 5 lines up
@dbtemp2 = sort(@dbtemp1);
for $ndb(0..$numdbs){$dbsortlat[$ndb] = substr($dbtemp2[$numdbs -$ndb], 12, 100);
};# end of sort line loop started 1 line up
# CREATE ARRAY SORTED BY EARTHQUAKE LONGITUDE $dbsortlon[]
# use $dblon[$dbsortlon[ndb]] to print longitudes starting at
# -30(W) to -180 to +180(e) to -30 going east to west
print 'Creating longitude sort array', "\n\n";
for $ndb(0..$numdbs){;# start of the earthquake lines loop
$temp1 = '000000'.($ndb), $temp1 = substr($temp1, length($temp1) -6, 6);
$temp = -1*$dblon[$ndb];
if ($temp < 30){$temp = $temp + 360};
$temp = ' '.$temp.$temp1;
$dbtemp1[$ndb] = substr($temp, length($temp) -11, 11).'-'.$ndb;
};# end of the earthquake line loop started 5 lines up
@dbtemp2 = sort(@dbtemp1);
for $ndb(0..$numdbs){$dbsortlon[$ndb] = substr($dbtemp2[$ndb], 12, 100);
};# end of earthquake line loop started 1 line up
# CREATE ARRAY SORTED BY EARTHQUAKE PROBABILITY $dbsortprob[]
print 'Creating probability sort array', "\n\n";
for $ndb(0..$numdbs){;# start of the earthquake lines loop
$temp1 = '000000'.($numdbs -$ndb), $temp1 = substr($temp1, length($temp1) -6, 6);
$temp = (' '.(int($probdb[$ndb]*10))).$temp1;
$dbtemp1[$ndb] = substr($temp, length($temp) -16, 16).'-'.$ndb;
};# end of the earthquake line loop started 3 lines up
@dbtemp2 = sort(@dbtemp1);
for $ndb(0..$numdbs){$dbsortprob[$ndb] = substr($dbtemp2[$numdbs -$ndb], 17, 100);
};# end of earthquake line loop started 1 line up
# CREATE ARRAY SORTED BY SUN - EARTH - MOON ANGLE $dbsortang[]
# use $dbang[$dbsortang[ndb]] to print sun - Earth - moon angles starting at
# 45(sun 45 degrees to west of moon) to 0 to -180 to +180(e) to 45
print 'Creating sun - Earth - moon angle sort array', "\n\n";
for $ndb(0..$numdbs){;# start of the earthquake lines loop
$temp1 = '000000'.($numdbs -$ndb), $temp1 = substr($temp1, length($temp1) -6, 6);
$temp = (180 + 361*($dbang[$ndb] <= 45) +$dbang[$ndb]).$temp1;
$temp = ' '.$temp;
$dbtemp1[$ndb] = substr($temp, length($temp) -11, 11).'-'.$ndb;
};# end of the earthquake line loop started 5 lines up
@dbtemp2 = sort(@dbtemp1);
for $ndb(0..$numdbs){$dbsortang[$ndb] = substr($dbtemp2[$numdbs -$ndb], 12, 100);
};# end of earthquake line loop started 1 line up
####################################################################
# SEND DATA TO THE RESULTS FILE #
####################################################################
# OPEN THE RESULTS DATA FILE
skipprobcalcs:;# jump to here from about 200 lines up if only earthquake database lines are being created
print 'Opening the output data file', "\n\n";
open fileout, '> '.$fileresults;
# PRINT RESULTS ETC. TO THE OUTPUT DATA FILE
print 'Printing results to output file', "\n\n";
for $npr(1..length($outputchoice)){;# start of print sort arrays loop - it ends about 50 lines down
$sopc = substr($outputchoice, $npr - 1, 1);
# the following routine generates the longitude degree table
if ($sopc eq 'c'){;# if ends 13 lines down
print 'Printing single longitude degree sort lines to output file', "\n\n";
print fileout ' lon probs Results sorted by earthquake SINGLE LONGITUDE DEGREE lon', "\n";
for $num(0..359){;# loop ends 8 lines down
$temp1 = 330 -$num;# this tells it to start the table at -30 longitude degrees and reverse the print order
if ($temp1 < 0){$temp1 = $temp1 +360};
$temp2 = ' '.($temp1 - 360*($temp1 >180));
$temp2 = substr($temp2, length($temp2) -5, 5);
if ($temp2/15 == int($temp2/15)){print fileout "\n", $temp2, ' '};# print the longitude
$temp4 = $dbsortlondeg[$temp1];
if ($temp4 == 0){$temp4 = '.'};
$temp3 = ' '.$temp4;
$temp3 = substr($temp3, length($temp3) -4, 4);
print fileout $temp3;# print the percent values
if (($temp2 -1)/15 == int(($temp2 -1)/15)){print fileout " ", $temp2};# print the longitude
};# end of for loop started 8 lines up
print fileout "\n";
goto printeqlinesdone};# end of if started 13 lines up - goto check for more array prints
# PRINT THE TEST DATA LINES
# the following routines generate data for most of the array prints
print fileout 'Original test data Probability cutoff = ', $percentval, "\n";
for $ntest(1..$numtests){;# start of tests loop - it ends 16 lines down
$temp1 = ' '.$testang[$ntest], $temp = substr($temp1, length($temp1) -4, 4), print fileout $temp;
$temp1 = ' ';
if ($testtype[$ntest] eq 'q'){$temp1 = ' '.$test[1][$ntest]};
$temp = substr($temp1, length($temp1) -4, 4), print fileout $temp.' ';
$temp1 = ' '.$test[2][$ntest], $temp = substr($temp1, length($temp1) -4, 4), print fileout $temp;
$temp1 = ' '.$test[3][$ntest], $temp = substr($temp1, length($temp1) -4, 4), print fileout $temp;
$temp1 = ' '.$test[4][$ntest], $temp = substr($temp1, length($temp1) -4, 4), print fileout $temp;
$temp1 = ' '.$test[5][$ntest], $temp = substr($temp1, length($temp1) -4, 4), print fileout $temp;
$temp1 = ' '.$test[6][$ntest], $temp = substr($temp1, length($temp1) -4, 4), print fileout $temp.' ';
$temp1 = ' '.(substr($testdate[$ntest],2,8)), $temp = substr($temp1, length($temp1) -9, 9), print fileout $temp;
$tempstrength = $testsigstrength[$ntest];
if ($override eq 'o'){$tempstrength = 1};
print fileout ' # ', $ntest,' ', $tempstrength, ' ', $testsigtype[$ntest];
if ($testtype[$ntest] eq 'q'){ print fileout ' '.substr($testquake[$ntest], 0, length($testquake[$ntest]) -1)};
print fileout "\n";
};# end of the tests loop started 16 lines up
#######################################################################
# PRINT EARTHQUAKE AND WARNING SIGNAL LINES TO THE RESULTS FILE #
#######################################################################
print fileout "\n";
print fileout "\n";
$linesprinted = 0;
if ($sopc eq 'a'){print fileout ' Results sorted by earthquake LATITUDE', "\n"};
if ($sopc eq 'g'){print fileout ' Results sorted by sun - Earth - moon ANGLE', "\n"};
if ($sopc eq 'n'){print fileout ' Results NOT SORTED', "\n"};
if ($sopc eq 'o'){print fileout ' Results sorted by earthquake LONGITUDE', "\n"};
if ($sopc eq 'p'){print fileout ' Results sorted by PROBABILITY', "\n"};
print fileout ' ang eqlon gl ml ci la sa date loc/typ m/s ft PR: lon lat probs / area, country, state, or city', "\n";
print fileout "\n";
if ($sopc eq 'a'){print 'Printing latitude sort lines to output file', "\n\n"};
if ($sopc eq 'g'){print 'Printing sun - Earth - moon angle sort lines to output file', "\n\n"};
if ($sopc eq 'n'){print 'Printing unsorted lines to output file', "\n\n"};
if ($sopc eq 'o'){print 'Printing longitude sort lines to output file', "\n\n"};
if ($sopc eq 'p'){print 'Printing probability sort lines to output file', "\n\n"};
for $num1(0..$numdbs){;# start of print earthquake lines loop - it ends about 30 lines down with the too low label
if ($sopc eq 'a'){$num = $dbsortlat[$num1]};
if ($sopc eq 'g'){$num = $dbsortang[$num1]};
if ($sopc eq 'n'){$num = $num1};
if ($sopc eq 'o'){$num = $dbsortlon[$num1]};
if ($sopc eq 'p'){$num = $dbsortprob[$num1]};
if (int($percentdb[$num] +0.5) < $percentval){goto toolow};
$linesprinted = $linesprinted + 1;
if ($linestoprint ne '' && $linesprinted > $linestoprint){goto printeqlinesdone};
$temp1 = ' '.$dbang[$num], $temp = substr($temp1, length($temp1) -4, 4), print fileout $temp;
$temp1 = ' '.$db[1][$num], $temp = substr($temp1, length($temp1) -4, 4), print fileout $temp;
if ($dbtype[$num] eq 'q'){print fileout '.'};
if ($dbtype[$num] ne 'q'){print fileout ' '};
$temp1 = ' '.$db[2][$num], $temp = substr($temp1, length($temp1) -4, 4), print fileout $temp;
$temp1 = ' '.$db[3][$num], $temp = substr($temp1, length($temp1) -4, 4), print fileout $temp;
$temp1 = ' '.$db[4][$num], $temp = substr($temp1, length($temp1) -4, 4), print fileout $temp;
$temp1 = ' '.$db[5][$num], $temp = substr($temp1, length($temp1) -4, 4), print fileout $temp;
$temp1 = ' '.$db[6][$num], $temp = substr($temp1, length($temp1) -4, 4), print fileout $temp, ' ';
$temp1 = ' '.(substr($dbdate[$num],2,8)), $temp = substr($temp1, length($temp1) -9, 9), print fileout $temp;
if ($dbtype[$num] eq 'q'){$temp1 = ' '.$dbquakeabbrev[$num], $temp = substr($temp1, length($temp1) -5, 5), print fileout $temp};
if ($dbtype[$num] ne 'q'){$temp1 = ' '.$dbsigtype[$num], $temp = substr($temp1, length($temp1) -5, 5), print fileout $temp};
if ($dbtype[$num] eq 'q'){$temp1 = ' '.$dbmag[$num], $temp = substr($temp1, length($temp1) -4, 4), print fileout $temp};
if ($dbtype[$num] ne 'q'){$temp1 = ' '.$dbsigstrength[$num], $temp = substr($temp1, length($temp1) -4, 4), print fileout $temp};
$lf1 = (log($dbfatal[$num] +.0001)/log(10) +1), $logfatal = ' '.int($lf1).'';
if ($lf1 < 1){$logfatal = ' '};
print fileout $logfatal;
$temp1 = ' '.(int($displayprob*0.01*$percentdb[$num] +.5)), $temp = substr($temp1, length($temp1) -4, 4), print fileout $temp.':';
$temp1 = ' '.$dblon[$num], $temp = substr($temp1, length($temp1) -4, 4), print fileout $temp;
$temp1 = ' '.$dblat[$num], $temp = substr($temp1, length($temp1) -3, 3), print fileout $temp.' .';
for $ntest(1..$numtests){;# start of print probs loop - it ends 3 lines down
$temp1 = ' '.(int($displayprob*0.01*$percenttest[$num][$ntest]+.5)), $temp = substr($temp1, length($temp1) -3, ), print fileout $temp;
if (($ntest < $numtests) && ($ntest/3 == int($ntest/3))){print fileout ' .'};
};# end of print probs loop which started 3 lines up
print fileout ' /', $dbcountry[$num];
if ($dbtype[$num] eq 'q'){print fileout ' ', substr($dbquake[$num], 0, length($dbquake[$num]) - 1)};
print fileout "\n";
toolow:};# not an earthquake line or percentage too low - end of print earthquake lines loop which started 30 lines up
printeqlinesdone:;
print fileout "\n";
print fileout "\n";
};# end of print sort arrays loop which started 50 lines up
#######################################################################
# PRINT ANY NEW TEST AND EARTHQUAKE LINES TO RESULTS FILE #
#######################################################################
print 'Printing any new test and earthquake lines to the output file', "\n\n";
print fileout 'New earthquake and test data lines (there might not be any)', "\n";
print fileout "\n";
$prfill = ' ';
for $ntest(1..$numtests){;# start of print new earthquake and test lines loop - it ends 54 lines down
if ($skipprint[$ntest] == 1){goto donotprint};
$num = 0;
$temp = $testsigstrength[$ntest];
if ($testtype[$ntest] eq 'q'){$temp = ''};
$num = $num +1, $temp1 = $prfill.$temp.' ,', $temp2 = substr($temp1, length($temp1) - $prsigstrength -3, 100);
print fileout $temp2;
$num = $num +1, $temp1 = $prfill.$testsigtype[$ntest].' ,', $temp2 = substr($temp1, length($temp1) - $prsigtype -3, 100);
print fileout $temp2;
$num = $num +1, $temp1 = $prfill.$testquakeabbrev[$ntest].' ,', $temp2 = substr($temp1, length($temp1) - $prquakeabbrev -3, 100);
print fileout $temp2;
$num = $num +1, $temp1 = $prfill.$testtype[$ntest].' ,', $temp2 = substr($temp1, length($temp1) - $prtype -3, 100);
print fileout $temp2;
$num = $num +1, $temp1 = $prfill.$testang[$ntest].' ,', $temp2 = substr($temp1, length($temp1) - $prang -3, 100);
print fileout $temp2;
$num = $num +1, $temp1 = $prfill.$test[1][$ntest].' ,', $temp2 = substr($temp1, length($temp1) - $pr[1] -3, 100);
print fileout $temp2;
$num = $num +1, $temp1 = $prfill.$test[2][$ntest].' ,', $temp2 = substr($temp1, length($temp1) - $pr[2] -3, 100);
print fileout $temp2;
$num = $num +1, $temp1 = $prfill.$test[3][$ntest].' ,', $temp2 = substr($temp1, length($temp1) - $pr[3] -3, 100);
print fileout $temp2;
$num = $num +1, $temp1 = $prfill.$test[4][$ntest].' ,', $temp2 = substr($temp1, length($temp1) - $pr[4] -3, 100);
print fileout $temp2;
$num = $num +1, $temp1 = $prfill.$test[5][$ntest].' ,', $temp2 = substr($temp1, length($temp1) - $pr[5] -3, 100);
print fileout $temp2;
$num = $num +1, $temp1 = $prfill.$test[6][$ntest].' ,', $temp2 = substr($temp1, length($temp1) - $pr[6] -3, 100);
print fileout $temp2;
$num = $num +1, $temp1 = $prfill.$testdate[$ntest].' ,', $temp2 = substr($temp1, length($temp1) - $prdate -3, 100);
print fileout $temp2;
$num = $num +1, $temp1 = $prfill.$testtime[$ntest].' ,', $temp2 = substr($temp1, length($temp1) - $prtime -3, 100);
print fileout $temp2;
$num = $num +1, $temp1 = $prfill.$testfatal[$ntest].' ,', $temp2 = substr($temp1, length($temp1) - $prfatal -3, 100);
print fileout $temp2;
$num = $num +1, $temp1 = $prfill.$testinjured[$ntest].' ,', $temp2 = substr($temp1, length($temp1) - $prinjured -3, 100);
print fileout $temp2;
$num = $num +1, $temp1 = $prfill.$testdamage[$ntest].' ,', $temp2 = substr($temp1, length($temp1) - $prdamage -3, 100);
print fileout $temp2;
$num = $num +1, $temp1 = $prfill.$testlat[$ntest].' ,', $temp2 = substr($temp1, length($temp1) - $prlat -3, 100);
print fileout $temp2;
$num = $num +1, $temp1 = $prfill.$testlon[$ntest].' ,', $temp2 = substr($temp1, length($temp1) - $prlon -3, 100);
print fileout $temp2;
$temp = int($testdepth[$ntest]);
if ($testtype[$ntest] ne 'q'){$temp = ''};
$num = $num +1, $temp1 = $prfill.$temp.' ,', $temp2 = substr($temp1, length($temp1) - $prdepth -3, 100);
print fileout $temp2;
$num = $num +1, $temp1 = $prfill.$testmag[$ntest].' ,', $temp2 = substr($temp1, length($temp1) - $prmag -3, 100);
print fileout $temp2;
$num = $num +1, $temp1 = $prfill.$testcountry[$ntest].' ,', $temp2 = substr($temp1, length($temp1) - $prcountry -3, 100);
print fileout $temp2;
$temp2 = ' ';
if ($testtype[$ntest] eq 'q'){$temp2 = ' '.substr($testquake[$ntest], 0, length($testquake[$ntest]) -1)};
print fileout $temp2, "\n";
donotprint:;
};# end of print new test and earthquakes lines loop which started 54 lines up
print 'Closing the output file', "\n\n";
close fileout;
#######################################################################
# DISPLAY THE RESULTS FILE AND END AND EXIT THE PROGRAM #
#######################################################################
print 'Displaying the output file', "\n\n";
sleep 1;
open file, '> '.$filedisplaycontrol;
# use the following command for Windows XP
print file 'notepad.exe '.$fileresults, "\n";# Windows XP
# use the following command for Windows 98
# you will need to exit the Progman.exe program before starting the next run
# print file 'c:\windows\progman.exe '.$fileresults, "\n";# Windows 98
close file;
exec $filedisplaycontrol;
# The above "exec" command is the program's normal exit point when
# everything runs properly.
#######################################################################
# JUMP TO HERE TO EXIT THE PROGRAM WHEN CERTAIN ERRORS OCCUR #
#######################################################################
goto endit;
programerror:;
print "\n", 'program error', "\n";
endit:;
print "\n", 'press the PAUSE/BREAK KEY to freeze the screen', "\a\n\n";
for $i(1..5){;
print 6 - $i, "\n";
sleep 1};
exit;
__END__