#------------------------------------------------------------------------- # 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__