home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Phoenix CD 2.0
/
Phoenix_CD.cdr
/
02a
/
orbsrc14.zip
/
ORBUPDAT.BAS
< prev
Wrap
BASIC Source File
|
1987-11-03
|
8KB
|
270 lines
'ORBUPDAT.BAS
'Compile as .TBC file
'871103-1
cls
color 0,7
PRINT" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
PRINT" = =
PRINT" = ORBITAL ELEMENT UPDATE PROGRAM =
PRINT" = =
PRINT" = 11/03/1987 =
PRINT" = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
color 7,0
PRINT
dim el$(14) 'array of individual element identifiers
el$(1) = "Satellite:" :el$(2) = "number:" :el$(3) = "Epoch time:"
el$(4) = "set:" :el$(5) = "Inclination:" :el$(6) = "RA of node:"
el$(7) = "Eccentricity:":el$(8) = "Arg of perigee:" :el$(9) = "Mean anomaly:"
el$(10)= "Mean motion:" :el$(11)= "Decay rate:" :el$(12)= "rev:"
el$(13)= "F1:" :el$(14)= "F2:"
dim elval$(14) 'array of individual element values for one Satellite
inputfile$ = "ELEMENTS"
outputfile$= "KEPLER.ORB"
restart:
strpos% = 1
endpos% = 1
nrsats% = 0
?
?"Scanning input file... please wait."
?
OPEN inputfile$ for INPUT as #1 LEN = 80
'- - - Scan to see how many satellites in the file
while not EOF(1)
line input# 1, rawline$ 'read line from file
if len(rawline$) = 0 then wend1 'invalid line
strpos% = instr(rawline$,el$(1)) 'search for [Satellite:]
if strpos% < 1 then wend1 'keyword not found
'We have a valid satellite name
nrsats% = nrsats% + 1
wend1:
wend
'- - -
close #1
? "Total number of satellites read from the ";inputfile$;" file =";nrsats%
'- - - now open the file again and generate the Kepler file.
OPEN inputfile$ for INPUT as #1 LEN = 80
OPEN outputfile$ for OUTPUT as #2
outrecords% = 0 'count of output records
for snr% = 1 to nrsats%
retry:
flag = 0 'good set flag
for el% = 1 to 14 'extract elements for 1 satellite
if eof(1) then EXIT for 'get out if done
line input# 1, rawline$ 'read a record
strpos% = instr(rawline$,el$(el%)) 'search for keyword
if strpos% < 1 then EXIT for 'keywd not found
'found the keyword sought
strpos% = instr(strpos%,rawline$,": ") + 1
call bracket 'bracket the value following keywd
elval$(el%) = mid$(rawline$,strpos%,endpos%-strpos%) 'load array
select CASE el% 'test range of values
case 3 'test Julian date
if NOT ((val(elval$(el%)) >= 78000)_
and (val(elval$(el%)) <= 99366)) then EXIT for
case 5 'test Inclination
if NOT ((val(elval$(el%)) >= 0)_
and (val(elval$(el%)) <= +180)) then EXIT for
case 6, 8, 9 'test RAAN, ARGP & MANOM
if NOT ((val(elval$(el%)) >= 0)_
and (val(elval$(el%)) <= 360)) then EXIT for
case 7 'test Eccentricity
if NOT ((val(elval$(el%)) >= 0)_
and (val(elval$(el%)) < 1)) then EXIT for
case 10 'test Mean Motion
if NOT ((val(elval$(el%)) >= 0)_
and (val(elval$(el%)) <= 20)) then EXIT for
case 11 'test Decay rate
if NOT ((val(elval$(el%)) > -1)_
and (val(elval$(el%)) < +1)) then EXIT for
end select
flag = el%
if el% = 1 then
nametest: 'trim trailing blanks
if right$(elval$(1),1) = " " then ' from Satellite name
elval$(1) = left$(elval$(1),(len(elval$(1))-1))
goto nametest
else
endpos% = (len(elval$(1))+ 1)
end if
end if
next el%
'test
if flag >= 12 then setok 'no F1 and/or F2 is OK
if flag = 0 then retry 'blank line between sets?
'if you fall thru here, this set is in error!
?
color 0,7
? "Entry [";el$(flag+1);"] for satellite number";snr%;", [";
? elval$(1);"] is in ERROR."
color 7,0
? "The elements for this satellite have not been written to the output file."
? "Correct any Keyword/value errors in the ELEMENTS file and retry the update."
beep
print " ";
color 0,7
input "<ENTER> to continue...",junk$
color 7,0
?
setok:
if flag < 12 then skipwrite 'Do not write this disk record
'write this satellite's record to disk.
write# 2, elval$(1), val(elval$(2)), val(elval$(3)), val(elval$(4)),_
val(elval$(5)), val(elval$(6)), val(elval$(7)), val(elval$(8)),_
val(elval$(9)), val(elval$(10)), val(elval$(11)),_
val(elval$(12)), val(elval$(13)), val(elval$(14))
outrecords% = outrecords% + 1
skipwrite:
next snr%
CLOSE #1
CLOSE #2
?"Total number of satellites written to the ";outputfile$;" file =";outrecords%
?
'= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
'FINSERT.BAS
'870820-2
'This routine inserts frequency data from the file FREQS.ORB into records
'contained in KEPLER.ORB. File KEPLER.INT is created as an intermediate
'file, then erased.
DEFDBL a - z
print "The frequency data in FREQS.ORB will be inserted into the records"
print " contained in KEPLER.ORB."
print
open "FREQS.ORB" for INPUT as #1
j = 0
while not EOF(1)
input# 1, d$, d, d, d 'inputting just to count records
j = j + 1
wend
j = j - 1
close #1
dim DYNAMIC set$(j), catnr(j), freq1(j), freq2(j)
open "FREQS.ORB" for INPUT as #1 're-read to load dimensioned array
for j1 = 0 to j
input# 1, sat$(j1), catnr(j1), freq1(j1), freq2(j1)
next j1
print "FREQS.ORB contains";j + 1;"records for input.
close #1
'now open the KEPLER.ORB file and insert the FREQS.ORB data
open "KEPLER.ORB" for INPUT as #1
open "KEPLER.INT" for OUTPUT as #2
inserts = 0
while not eof(1)
input# 1, s01$, i01, d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, f01, f02
for j2 = 0 to j 'find match in array, if present
flag3 = 1 'if we exit with flag3 = 1, we matched
if i01 = catnr(j2) then EXIT FOR
flag3 = 0
next j2
if flag3 <> 1 then writerec: 'if flag3 <> 1, don't insert freq1 & 2
f01 = freq1(j2) 'flag3 = 1, so insert
f02 = freq2(j2)
inserts = inserts + 1
writerec:
write# 2, s01$, i01, d1, d2, d3, d4, d5, d6, d7, d8, d9, d10, f01, f02
wend
print inserts;"insertions completed."
print
print
close #1 'KEPLER.ORB
close #2 'KEPLER.INT
ERASE set$, catnr, freq1, freq2 'deallocate array
KILL "KEPLER.ORB"
NAME "KEPLER.INT" as "KEPLER.ORB"
print " "
print tab(26);
color 0,7
print "End of update...";
color 7,0
print
delay 1
RUN "orbs.exe"
'= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
sub BRACKET '870806-1
local t$, spos%
shared strpos%, endpos%, rawline$, el%
for spos% = strpos% to len(rawline$)
strpos% = spos% 'keep track of ptr1
s$ = mid$(rawline$,spos%,1) 'test next char of string
if asc(s$) > 42 then exit FOR 'found non-blank char w/ptr1
next spos%
for spos% = strpos% to len(rawline$)
endpos% = spos% 'keep track of ptr2
s$ = mid$(rawline$,spos%,1) 'test next char of string
if el% = 1 then endpos% = len(rawline$) 'Satellite name
if endpos% = len(rawline$) then endpos% = endpos% + 1
if asc(s$) = 32 or asc(s$) = 9 then exit FOR 'found blank/tab
next spos%
'At exit, STRPOS points to 1st char of bracketed entity,
' and ENDPOS points to 1st char following entity.
end SUB
end
'= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =