home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Phoenix CD 2.0
/
Phoenix_CD.cdr
/
02a
/
orbsrc14.zip
/
DATESUBS.BAS
next >
Wrap
BASIC Source File
|
1987-08-17
|
3KB
|
118 lines
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'
' T U R B O D A T E S U B S
'870816-4 Ron Dunbar, W0PN
'* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
'- - - - Dates subroutine - - - - - - - - - - - - -
' INPUT: YEAR = Year (e.g. 83 for 1983)
' MON = Month
' DAY = Day of month
'
'OUTPUT: ADNR = elapsed days since 1978.0
' ADNR11 = elapsed days from 1978.0 to 1/1/YEAR
' DOW = day of week (0 - 6 with Sunday = 0)
' DOW$ = string containing day of the week (i.e. " Monday")
' DOY = day of the current year
' DT$ = string containing MM/DD/YY with 1 leading space
' GMST# = Greenwich Mean Sideral Time in days at 00:00 UT
' JULIAN = Julian date (YYDOY)
' STR# = Sideral Time Rate
'- - - - - - - - - - - - - - - - -
$static
dimarry:
DIM dowtbl$(7)
dowtbl$(0) ="Sunday" :dowtbl$(1) ="Monday"
dowtbl$(2) ="Tuesday" :dowtbl$(3) ="Wednesday"
dowtbl$(4) ="Thursday" :dowtbl$(5) ="Friday"
dowtbl$(6) ="Saturday"
dimflag = 1 'indicate initialization complete
return
'- - - Actual date subroutine - - -
'
datecalc:
if dimflag <> 1 then gosub dimarry 'dim array 1st time thru only
day = fix(day)
mon = fix(mon)
year= fix(year)
DX# = fix((YEAR-1)*365.25)
ADNR = fix(DAY)
YEAR = fix(YEAR)
MON = fix(MON)
IF MON > 2 THEN
ADNR = fix((MON+1)*30.6)+fix(YEAR*365.25)+ADNR-28553
ELSE
ADNR = fix((MON + 13) * 30.6) + DX#+ADNR - 28553
end if
dow = fix(adnr MOD 7)
IF dow < 0 THEN dow = 0
dow$ = dowtbl$(dow)
DT$ = STR$(MON) + "/"
wk9$ = STR$(DAY)+"/" :DT$ = DT$+RIGHT$(wk9$,LEN(wk9$)-1)
wk9$ = STR$(YEAR) :DT$ = DT$+RIGHT$(wk9$,LEN(wk9$)-1)
DOY = fix(ADNR - DX# + 28125)
ADNR11 = ADNR - DOY + 1
JULIAN = (YEAR * 1000) + ADNR - ADNR11 + 1
AGMST = ADNR11 - 1 'Jan 0.0, YEAR
GMST# = AGMST * 0.0027379093# + AGMST *_
AGMST * 8.05975e-16 +.278586056#
GMST# = GMST# - fix(GMST#)
STR# = 1.00273790931# + 1.61195D-15 * ADNR
RETURN
'- - - Inverse date subroutine - - -
'
' INPUT: ADNR = Elapsed days since 1978.0
'OUTPUT: YEAR, MONth, DAY
'
'First, calc year = YEAR, month = MON
adnr:
adnr1# = fix(adnr)
adnr = fix(adnr1#)
YEAR = fix((ADNR + 731) / 365.25) + 76
julad:
MON = ((ADNR + 28553 - fix(YEAR * 365.25)) / 30.61) - 1
IF MON > 2.1 OR (MON > 2.06 AND YEAR/4 = fix(YEAR/4)) THEN
MON = fix(MON)
ELSE
MON = 1
end if
'- - - now get day of month
TEMP = ADNR
DAY = 1
GOSUB datecalc
DAY = TEMP - ADNR + 1
'- - - now recalculate everything and exit
GOSUB datecalc
RETURN
'- - - This is the JULIAN entry point - - -
julian:
julian1# = fix(julian)
julian = fix(julian1#)
YEAR = fix(JULIAN / 1000)
DOY = fix(JULIAN - (YEAR * 1000))
ADNR = 429 + ((YEAR-1) * 365) + fix((YEAR-1)/4) - 28553 + fix(DOY) - 1
GOSUB julad 'go get the rest of the stuff
RETURN
'- - - - - - - - - - - - - - - - - - - - - -
'