John McKown's problem is a trivial one after the conversion of a YYYYMMDD date
into an integer elapsed-days-after-epoch-origin form.
The PL/I procedure below does this conversion and then calculates the
day-of-the week in the sequence 0, 1, 2, . . . , 6, from it. Omitting this
last step yieds the result that John needs.
This procedure also includes comments that explain the calendrical computations
involved.
The implementation of this scheme is straightforward in any statement-level
procedural language (even the HLASM macro language) except C, which botches the
definition of its equivalent of the PL/I BIF mod.
ymd2dow: procedure(yyyymmdd)
returns(signed binary fixed(7,0))
reorder ;
/* Given a licit ISO-standard descending Gregorian date in the
eight-character 'yyyymmdd' format, this function calculates and
returns as its value the serial number of the corresponding day
of the week in the sequence
0, Sunday 4, Thursday
1, Monday 5, Friday
2, Tuesday 6, Saturday
3, Wednesday
version 1, level 0, John Gilmore, 2003 September */
/* parameter */
declare yyyymmdd
character(8) nonassignable parameter ;
/* common template for CDICPMT_leap and CDICPMT_non_leap */
declare cdicpmt(0:12) based(tabp)
signed binary fixed(15,0) ;
/* Cumulative Days In Current, Preceding Months, leap year */
declare CDICPMT_leap(0:12) signed binary fixed(15,0)
static initial( 0, 31, 60, 91, 121, 152, 182,
213, 244, 274, 305, 335, 366) ;
/* Cumulative Days In Current, Preceding Months, non-leap year */
declare CDICPMT_non_leap(0:12) signed binary fixed(15,0)
static initial( 0, 31, 59, 90, 120, 151, 181,
212, 243, 273, 304, 334, 365) ;
/* builtins, named constants used */
declare (addr, binary, mod, substr)
builtin ;
declare (F0 value(0), F1 value(1), F4 value(4), F7 value(7),
F100 value(100), F365 value(365), F400 value(400),
F3600 value(3600), FGD_3600Feb28 value(1314564))
signed binary fixed(31,0) ;
/* LIFO scratch storage */
declare tabp /* -> cdicpmt for leap | non-leap year */
pointer,
(d, /* Gregorian-calendar day of month */
gd, /* Gregorian-day date value */
m, /* Gregorian-calendar month of year */
mm1, /* m - 1 */
y, /* Gregorian-calendar year */
ym1) /* y - 1 */
signed binary fixed(31,0),
dowsub /* returned: one of 0|1|2|3|4|5|6 */
signed binary fixed(7,0),
(after_3600Feb28, /* is date after 3600 February 28? */
leap_year) /* y a leap year? */
aligned bit ;
/* extract arithmetic year, month, day-of-month values */
y = binary(substr(yyyymmdd,1,4),31,0) ;
ym1 = y - F1 ;
m = binary(substr(yyyymmdd,5,2),31,0) ;
mm1 = m - F1 ;
d = binary(substr(yyyymmdd,7,2),31,0) ;
/* leap or non-leap year? set table pointer appropriately */
leap_year = (mod(y,F4) = F0)
& ((mod(y,F100) ^= F0) | ((mod(y,F400) = F0) & (y ^= F3600))) ;
if leap_year then tabp = addr(CDICPMT_leap) ;
else tabp = addr(CDICPMT_non_leap) ;
/* calculate corresponding Gregorian-day value, using the method
of inclusions and exclusions (A GD is the number of elapsed days
following the epoch origin of the Gregorian calendar, 0000 December
31.) */
gd = ym1 * F365 /* include 365 days for each preceding year */
+ ym1/F4 /* include one day for each preceding Julian
leap year */
- ym1/F100 /* exclude one day for each preceding centurial
year */
+ ym1/F400 /* reinclude one day for every 4th excluded
centurial year */
+ cdicpmt(mm1) /* include the days in the preceding months of
the current year */
+ d ; /* include the days in current month of the
current year */
/* correct for year-3600 anomaly. The year 3600 is a centurial one
and mod(3600,400) = 0. It should therefore be a Gregorian leap year,
but it is not to be one by fiat in order to sop up accumulated
precession. */
after_3600Feb28 = (gd > FGD_3600Feb28) ;
if after_3600Feb28 then gd -= F1 ;
/* calculate, return day-of-week subscript */
dowsub = mod(gd,F7) ;
return(dowsub) ;
end ymd2dow ;
John Gilmore Ashland, MA 01721-1817 USA
_________________________________________________________________
Windows Live™ SkyDrive: Get 25 GB of free online storage.
http://windowslive.com/online/skydrive?ocid=TXT_TAGLM_WL_skydrive_032009
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to [email protected] with the message: GET IBM-MAIN INFO
Search the archives at http://bama.ua.edu/archives/ibm-main.html
