useful easter algorithm

[Crox]

Hi,

In the Y2k time, there was an algorithm explained how to calculate the dates it is easter.

Here it is, enjoy!

I hope you all will contribute to 'useful algorithms'.

Regards,

Crox

This method is from 1876 Butcher's Ecclesiastical Calendar to calculate easter sunday:

DIVIDE                 BY       QUOTIENT         REMAINDER

YEAR x                  19           -             a
YEAR x                 100           b             c
b                        4           d             e
b + 8                   25           f             -
b - f + 1                3           g             -
19a + b - d - g + 15    30           -             h
c                        4           i             k
32 + 2e + 2i - h - k     7           -             l
a + 11h + 22l          451           m             -
h + l - 7m + 114        31           n             p

n = month: 1 = january ...
p + 1 = day of the month of easter sunday

 

[slade]

Hi Crox,

Thanx for the algorithm (did you know that Al Gore invented this too?).

Here's one I had to write for a telecom firm's billing system. It calculates the Daylight Saving Time window for any year. I wonder how many times this old "typewriter" was reinvented there?

Jack.

P.S. I don't know why the code - /code tags don't work for this code, but does for others. Any ideas?

           05  WS-DAYS-TO-OCT31           PIC S9(08) COMP VALUE +304.
           05  WS-BIT-BUCKET              PIC S9(02) COMP.
           05  WS-DAY-OF-WEEK             PIC S9(01) COMP.
               88  1ST-SUN-IN-APR                    VALUE +1 +8.
               88  LAST-SUN-IN-OCT                   VALUE +1 -6.
           05  WS-LEAP-YR-IND             PIC  X(01).
               88  ITS-A-LEAP-YR                     VALUE 'L'.
               88  ITS-NOT-A-LEAP-YR                 VALUE 'N'.

           05  WS-REMAINDERS.
               10  WR-REMAINDER-4         PIC S9(01) COMP.
               88  DIVISIBLE-BY-4                    VALUE +0.
               10  WR-REMAINDER-100       PIC S9(02) COMP.
               88  DIVISIBLE-BY-100                  VALUE +0.
               10  WR-REMAINDER-400       PIC S9(03) COMP.
               88  DIVISIBLE-BY-400                  VALUE +0.

           05  WS-DST-START-LONG.
               10  WDS-CCYY.
               20  WDS-CC                     PIC 9(02) VALUE 19.
               20  WDS-YY                     PIC 9(02).
               10  WDS-CCYY-NUM REDEFINES
                   WDS-CCYY                             PIC S9(04).
               10  WDS-MM                     PIC 9(02) VALUE 04.
               10  WDS-DD                     PIC 9(02) VALUE 01.
               10  WDS-TIME                   PIC 9(06) VALUE 055959.
           05  FILLER      REDEFINES
               WS-DST-START-LONG.
               10  FILLER                               PIC XX.
               10  WS-DST-START                         PIC X(12).
           05  WS-DST-END-LONG.
               10  WDE-CCYY.
               20  WDE-CC                     PIC 9(02) VALUE 19.
               20  WDE-YY                     PIC 9(02).
               10  WDE-CCYY-NUM REDEFINES
                   WDE-CCYY                             PIC S9(04).
               10  WDE-MM                     PIC 9(02) VALUE 10.
               10  WDE-DD                     PIC 9(02) VALUE 31.
               10  WDE-TIME                   PIC 9(06) VALUE 070000.
           05  FILLER      REDEFINES
               WS-DST-END-LONG.
               10  FILLER                               PIC XX.
               10  WS-DST-END                           PIC X(12).
           05  WS-WORK-DATE.
               10  WS-MONTH                   PIC XX      VALUE SPACES.
               10  FILLER                     PIC X       VALUE '/'.
               10  WS-DAY                     PIC XX      VALUE SPACES.
               10  FILLER                     PIC X       VALUE '/'.
               10  WS-YEAR                    PIC XX      VALUE SPACES.
           05  WS-IT-DATE.
               10  WS-YY                      PIC S99     VALUE 0.
               10  WS-MM                      PIC S99     VALUE 0.
               10  WS-DD                      PIC S99     VALUE 0.
1     /
      *===============================================================
      *==================    END OF MOMTH TABLE    ===================
      *===============================================================
      *    NOTE: THIS IS A GENERALIZED TABLE TO BE USED FOR DATE     *
      *          MANIPULATION. EACH ENTRY CONTAINS THE NAME OF THE   *
      *          MONTH AND THE NUMBER OF DAYS IN EACH MONTH AND ITS  *
      *          IMMEDIATE NEIGHBORS. THE JAN-PREV-EOM FIELD CON-    *
      *          TAINS THE NUMBER OF DAYS IN THE PREVIOUS DECEMBER.  *
      *          THE DEC-NEXT-EOM FIELD CONTAINS THE NUMBER OF DAYS  *
      *          IN THE NEXT JANUARY.                                *
      *
      *          IN LEAP YEARS THE USER MUST INCREMENT THE FOLLOWING *
      *          FIELDS BY ONE:                                      *
      *                         JAN-NEXT-EOM-VAL                     *
      *                         FEB-EOM-VAL                          *
      *                         MAR-PREV-EOM-VAL                     *
      *===============================================================

       01  END-OF-MONTH-VALUES.
      *========================
           05  JAN-VALUES.
               10  JAN-NAME                PIC X(009) VALUE
               'JANUARY'.
               10  JAN-EOM-VAL             PIC 9(002) VALUE 31.
               10  JAN-PREV-EOM-VAL        PIC 9(002) VALUE 31.
               10  JAN-NEXT-EOM-VAL        PIC 9(002) VALUE 28.
           05  FEB-VALUES.
               10  FEB-NAME                PIC X(009) VALUE
               'FEBRUARY'.
               10  FEB-EOM-VAL             PIC 9(002) VALUE 28.
               10  FEB-PREV-EOM-VAL        PIC 9(002) VALUE 31.
               10  FEB-NEXT-EOM-VAL        PIC 9(002) VALUE 31.
           05  MAR-VALUES.
               10  MAR-NAME                PIC X(009) VALUE
               'MARCH'.
               10  MAR-EOM-VAL             PIC 9(002) VALUE 31.
               10  MAR-PREV-EOM-VAL        PIC 9(002) VALUE 28.
               10  MAR-NEXT-EOM-VAL        PIC 9(002) VALUE 30.
           05  APR-VALUES.
               10  APR-NAME                PIC X(009) VALUE
               'APRIL'.
               10  APR-EOM-VAL             PIC 9(002) VALUE 30.
               10  APR-PREV-EOM-VAL        PIC 9(002) VALUE 31.
               10  APR-NEXT-EOM-VAL        PIC 9(002) VALUE 31.
           05  MAY-VALUES.
               10  MAY-NAME                PIC X(009) VALUE
               'MAY'.
               10  MAY-EOM-VAL             PIC 9(002) VALUE 31.
               10  MAY-PREV-EOM-VAL        PIC 9(002) VALUE 30.
               10  MAY-NEXT-EOM-VAL        PIC 9(002) VALUE 30.
           05  JUN-VALUES.
               10  JUN-NAME                PIC X(009) VALUE
               'JUNE'.
               10  JUN-EOM-VAL             PIC 9(002) VALUE 30.
               10  JUN-PREV-EOM-VAL        PIC 9(002) VALUE 31.
               10  JUN-NEXT-EOM-VAL        PIC 9(002) VALUE 31.
           05  JUL-VALUES.
               10  JUL-NAME                PIC X(009) VALUE
               'JULY'.
               10  JUL-EOM-VAL             PIC 9(002) VALUE 31.
               10  JUL-PREV-EOM-VAL        PIC 9(002) VALUE 30.
               10  JUL-NEXT-EOM-VAL        PIC 9(002) VALUE 31.
           05  AUG-VALUES.
               10  AUG-NAME                PIC X(009) VALUE
               'AUGUST'.
               10  AUG-EOM-VAL             PIC 9(002) VALUE 31.
               10  AUG-PREV-EOM-VAL        PIC 9(002) VALUE 31.
               10  AUG-NEXT-EOM-VAL        PIC 9(002) VALUE 30.
           05  SEP-VALUES.
               10  SEP-NAME                PIC X(009) VALUE
               'SEPTEMBER'.
               10  SEP-EOM-VAL             PIC 9(002) VALUE 30.
               10  SEP-PREV-EOM-VAL        PIC 9(002) VALUE 31.
               10  SEP-NEXT-EOM-VAL        PIC 9(002) VALUE 31.
           05  OCT-VALUES.
               10  OCT-NAME                PIC X(009) VALUE
               'OCTOBER'.
               10  OCT-EOM-VAL             PIC 9(002) VALUE 31.
               10  OCT-PREV-EOM-VAL        PIC 9(002) VALUE 30.
               10  OCT-NEXT-EOM-VAL        PIC 9(002) VALUE 30.
           05  NOV-VALUES.
               10  NOV-NAME                PIC X(009) VALUE
               'NOVEMBER'.
               10  NOV-EOM-VAL             PIC 9(002) VALUE 30.
               10  NOV-PREV-EOM-VAL        PIC 9(002) VALUE 31.
               10  NOV-NEXT-EOM-VAL        PIC 9(002) VALUE 31.
           05  DEC-VALUES.
               10  DEC-NAME                PIC X(009) VALUE
               'DECEMBER'.
               10  DEC-EOM-VAL             PIC 9(002) VALUE 31.
               10  DEC-PREV-EOM-VAL        PIC 9(002) VALUE 30.
               10  DEC-NEXT-EOM-VAL        PIC 9(002) VALUE 31.

       01  EOM-TABLE REDEFINES
           END-OF-MONTH-VALUES.
           05  ET-MONTHLY-ENTRY     OCCURS 012  TIMES.
               10  ET-MONTH-NAME           PIC X(009).
               10  ET-EOM                  PIC 9(002).
               10  ET-PREV-EOM             PIC 9(002).
               10  ET-NEXT-EOM             PIC 9(002).

      /*****************************************************************
       1010-CALC-DST-DATES.
      ******************************************************************
      *    THIS ROUTINE CALCULATES THE BEGIN AND END DAYLIGHT SAV-
      *    INGS TIME DATES FOR THE SUBJECT YEAR. THE YEAR IS IN THE FORM
      *    YYMMDD AND WINDOWING IS USED TO ASSIGN THE CENTURY(WDS-CC).
      *    THE WINDOW LIMIT IS 90. BEGIN & END DATES ARE DEFINED AS THE
      *    1ST SUNDAY (AT 2 A.M., EST) IN APRIL AND THE LAST SUNDAY IN
      *    OCTOBER, RESPECTIVELY. THE PROBLEM IS APPROACHED BY DE-
      *    TERMINING THE DAY OF WEEK FOR APRIL 1 AND OCTOBER 31, THEN
      *    DIVIDING BY 7 AND
      *    ADDING(FOR APRIL) OR SUBTRACTING(FOR OCT) THE APPROPRIATE
      *    NUMBER OF DAYS UNTIL THE REMAINDER (WS-DAY-OF-WEEK)
      *    REACHES A 'SUNDAY' VALUE. (SEE THE TABLE BELOW).
      *
      * NOTE!!!!
      *    THIS ROUTINE WON'T WORK BEYOND FEB 28 2100. THE CALC FOR
      *    WS-NUM-OF-LEAP-YRS WAS SIMPLIFIED. TO CORRECT IT DIVIDE
      *    WDS-CCYY-NUM BY 100 AND SUB RESULT FROM WS-NUM-OF-LEAP-YRS
      *    THEN DIVIDE WDS-CCYY-NUM BY 400 AND ADD RESULT TO
      *    WS-NUM-OF-LEAP-YRS. THEN REDO THE TABLE BELOW.
      ******************************************************************
      *
      *           -6  -> SUN    <=======
      *           -5  -> MON
      *           -4  -> TUE
      *           -3  -> WED
      *           -2  -> THU
      *           -1  -> FRI
      *            0  -> SAT
      *           +1  -> SUN    <=======
      *           +2  -> MON
      *           +3  -> TUE
      *           +4  -> WED
      *           +5  -> THU
      *           +6  -> FRI
      *           +7  -> SAT
      *           +8  -> SUN    <=======
      *
      ******************************************************************
      *  DETERMINE  CENTURY FOR DAYLIGHT SAVINGS START/END DATES
      ******************************************************************
           MOVE    STD-B1-MESSAGE-DATE  TO  WS-IT-DATE
           MOVE    WS-YY                TO  WDS-YY
           IF      WDS-YY                <  90
           ADD       +1                 TO  WDS-CC
           END-IF
           MOVE    WDS-CCYY             TO  WDE-CCYY
      ******************************************************************
      *  DETERMINE IF ITS A LEAP YEAR
      ******************************************************************
           SET     ITS-NOT-A-LEAP-YR    TO  TRUE
           DIVIDE  WDS-CCYY-NUM         BY  +4
           GIVING  WS-BIT-BUCKET
           REMAINDER WS-REMAINDER-4

           DIVIDE  WDS-CCYY-NUM         BY  +100
           GIVING  WS-BIT-BUCKET
           REMAINDER WS-REMAINDER-100

           DIVIDE  WDS-CCYY-NUM         BY  +400
           GIVING  WS-BIT-BUCKET
           REMAINDER WS-REMAINDER-400

           IF DIVISIBLE-BY-400
              OR
              (DIVISIBLE-BY-4 AND NOT DIVISIBLE-BY-100)
              SET ITS-A-LEAP-YR    TO TRUE
           END-IF
      ******************************************************************
      *  IF LEAP YR ADJUST YTD AND CALENDAR BY ONE.
      ******************************************************************
           IF      ITS-A-LEAP-YR
           ADD          +1              TO  WS-DAYS-TO-APR1
                                            WS-DAYS-TO-OCT31
                                            ET-NEXT-EOM(1)
                                            ET-EOM(2)
                                            ET-PREV-EOM(3)
           END-IF
      ******************************************************************
      *        COMPUTE THE TOTAL # OF DAYS TO APR 1 OF THE SUBJECT YEAR
      ******************************************************************
           COMPUTE WS-NUM-OF-LEAP-YRS = (WDS-CCYY-NUM - 1) / +4
           COMPUTE WS-TOT-DAYS = WS-NUM-OF-LEAP-YRS
                               + ((WDS-CCYY-NUM - 1) * +365)
                               +   WS-DAYS-TO-APR1
      ******************************************************************
      *        COMPUTE DAY OF WEEK FOR APRIL 1ST (SEE TABLE ABOVE)
      ******************************************************************
           DIVIDE  WS-TOT-DAYS BY  +7
           GIVING  WS-TOT-DAYS
           REMAINDER WS-DAY-OF-WEEK
      ******************************************************************
      *        THEN ...
      ******************************************************************
           PERFORM 1020-ADD-DAYS
           UNTIL   1ST-SUN-IN-APR
      ******************************************************************
      *        COMPUTE THE TOTAL # OF DAYS TO OCT 31 OF THE SUBJECT YEAR
      ******************************************************************
           COMPUTE WS-TOT-DAYS = WS-NUM-OF-LEAP-YRS
                               + ((WDE-CCYY-NUM - 1) * 365)
                               +   WS-DAYS-TO-OCT31
      ******************************************************************
      *        COMPUTE DAY OF WEEK FOR OCT 31ST (SEE TABLE ABOVE)
      ******************************************************************
           DIVIDE  WS-TOT-DAYS BY  +7
           GIVING  WS-TOT-DAYS
           REMAINDER WS-DAY-OF-WEEK
      ******************************************************************
      *        THEN ...
      ******************************************************************
           PERFORM 1040-SUB-DAYS
           UNTIL   LAST-SUN-IN-OCT
           .
      ******************************************************************
       1020-ADD-DAYS.

           ADD      +1       TO  WDS-DD
                                 WS-DAY-OF-WEEK
           .
      ******************************************************************
       1040-SUB-DAYS.

           SUBTRACT +1      FROM WDE-DD
                                 WS-DAY-OF-WEEK
           .

 

[slade]

Hi Crox,

Thanx for the algorithm (did you know that Al Gore invented this too?).
Here's one I had to write for a telecom firm's billing system. I wonder how many times this old "typewriter" was reinvented there?

           05  WS-DAYS-TO-OCT31           PIC S9(08) COMP VALUE +304.
           05  WS-BIT-BUCKET              PIC S9(02) COMP.
           05  WS-DAY-OF-WEEK             PIC S9(01) COMP.
               88  1ST-SUN-IN-APR                    VALUE +1 +8.
               88  LAST-SUN-IN-OCT                   VALUE +1 -6.
           05  WS-LEAP-YR-IND             PIC  X(01).
               88  ITS-A-LEAP-YR                     VALUE 'L'.
               88  ITS-NOT-A-LEAP-YR                 VALUE 'N'.

           05  WS-REMAINDERS.
               10  WR-REMAINDER-4         PIC S9(01) COMP.
               88  DIVISIBLE-BY-4                    VALUE +0.
               10  WR-REMAINDER-100       PIC S9(02) COMP.
               88  DIVISIBLE-BY-100                  VALUE +0.
               10  WR-REMAINDER-400       PIC S9(03) COMP.
               88  DIVISIBLE-BY-400                  VALUE +0.

           05  WS-DST-START-LONG.
               10  WDS-CCYY.
               20  WDS-CC                     PIC 9(02) VALUE 19.
               20  WDS-YY                     PIC 9(02).
               10  WDS-CCYY-NUM REDEFINES
                   WDS-CCYY                             PIC S9(04).
               10  WDS-MM                     PIC 9(02) VALUE 04.
               10  WDS-DD                     PIC 9(02) VALUE 01.
               10  WDS-TIME                   PIC 9(06) VALUE 055959.
           05  FILLER      REDEFINES
               WS-DST-START-LONG.
               10  FILLER                               PIC XX.
               10  WS-DST-START                         PIC X(12).
           05  WS-DST-END-LONG.
               10  WDE-CCYY.
               20  WDE-CC                     PIC 9(02) VALUE 19.
               20  WDE-YY                     PIC 9(02).
               10  WDE-CCYY-NUM REDEFINES
                   WDE-CCYY                             PIC S9(04).
               10  WDE-MM                     PIC 9(02) VALUE 10.
               10  WDE-DD                     PIC 9(02) VALUE 31.
               10  WDE-TIME                   PIC 9(06) VALUE 070000.
           05  FILLER      REDEFINES
               WS-DST-END-LONG.
               10  FILLER                               PIC XX.
               10  WS-DST-END                           PIC X(12).
           05  WS-WORK-DATE.
               10  WS-MONTH                   PIC XX      VALUE SPACES.
               10  FILLER                     PIC X       VALUE '/'.
               10  WS-DAY                     PIC XX      VALUE SPACES.
               10  FILLER                     PIC X       VALUE '/'.
               10  WS-YEAR                    PIC XX      VALUE SPACES.
           05  WS-IT-DATE.
               10  WS-YY                      PIC S99     VALUE 0.
               10  WS-MM                      PIC S99     VALUE 0.
               10  WS-DD                      PIC S99     VALUE 0.
1     /
      *===============================================================
      *==================    END OF MOMTH TABLE    ===================
      *===============================================================
      *    NOTE: THIS IS A GENERALIZED TABLE TO BE USED FOR DATE     *
      *          MANIPULATION. EACH ENTRY CONTAINS THE NAME OF THE   *
      *          MONTH AND THE NUMBER OF DAYS IN EACH MONTH AND ITS  *
      *          IMMEDIATE NEIGHBORS. THE JAN-PREV-EOM FIELD CON-    *
      *          TAINS THE NUMBER OF DAYS IN THE PREVIOUS DECEMBER.  *
      *          THE DEC-NEXT-EOM FIELD CONTAINS THE NUMBER OF DAYS  *
      *          IN THE NEXT JANUARY.                                *
      *
      *          IN LEAP YEARS THE USER MUST INCREMENT THE FOLLOWING *
      *          FIELDS BY ONE:                                      *
      *                         JAN-NEXT-EOM-VAL                     *
      *                         FEB-EOM-VAL                          *
      *                         MAR-PREV-EOM-VAL                     *
      *===============================================================

       01  END-OF-MONTH-VALUES.
      *========================
           05  JAN-VALUES.
               10  JAN-NAME                PIC X(009) VALUE
               'JANUARY'.
               10  JAN-EOM-VAL             PIC 9(002) VALUE 31.
               10  JAN-PREV-EOM-VAL        PIC 9(002) VALUE 31.
               10  JAN-NEXT-EOM-VAL        PIC 9(002) VALUE 28.
           05  FEB-VALUES.
               10  FEB-NAME                PIC X(009) VALUE
               'FEBRUARY'.
               10  FEB-EOM-VAL             PIC 9(002) VALUE 28.
               10  FEB-PREV-EOM-VAL        PIC 9(002) VALUE 31.
               10  FEB-NEXT-EOM-VAL        PIC 9(002) VALUE 31.
           05  MAR-VALUES.
               10  MAR-NAME                PIC X(009) VALUE
               'MARCH'.
               10  MAR-EOM-VAL             PIC 9(002) VALUE 31.
               10  MAR-PREV-EOM-VAL        PIC 9(002) VALUE 28.
               10  MAR-NEXT-EOM-VAL        PIC 9(002) VALUE 30.
           05  APR-VALUES.
               10  APR-NAME                PIC X(009) VALUE
               'APRIL'.
               10  APR-EOM-VAL             PIC 9(002) VALUE 30.
               10  APR-PREV-EOM-VAL        PIC 9(002) VALUE 31.
               10  APR-NEXT-EOM-VAL        PIC 9(002) VALUE 31.
           05  MAY-VALUES.
               10  MAY-NAME                PIC X(009) VALUE
               'MAY'.
               10  MAY-EOM-VAL             PIC 9(002) VALUE 31.
               10  MAY-PREV-EOM-VAL        PIC 9(002) VALUE 30.
               10  MAY-NEXT-EOM-VAL        PIC 9(002) VALUE 30.
           05  JUN-VALUES.
               10  JUN-NAME                PIC X(009) VALUE
               'JUNE'.
               10  JUN-EOM-VAL             PIC 9(002) VALUE 30.
               10  JUN-PREV-EOM-VAL        PIC 9(002) VALUE 31.
               10  JUN-NEXT-EOM-VAL        PIC 9(002) VALUE 31.
           05  JUL-VALUES.
               10  JUL-NAME                PIC X(009) VALUE
               'JULY'.
               10  JUL-EOM-VAL             PIC 9(002) VALUE 31.
               10  JUL-PREV-EOM-VAL        PIC 9(002) VALUE 30.
               10  JUL-NEXT-EOM-VAL        PIC 9(002) VALUE 31.
           05  AUG-VALUES.
               10  AUG-NAME                PIC X(009) VALUE
               'AUGUST'.
               10  AUG-EOM-VAL             PIC 9(002) VALUE 31.
               10  AUG-PREV-EOM-VAL        PIC 9(002) VALUE 31.
               10  AUG-NEXT-EOM-VAL        PIC 9(002) VALUE 30.
           05  SEP-VALUES.
               10  SEP-NAME                PIC X(009) VALUE
               'SEPTEMBER'.
               10  SEP-EOM-VAL             PIC 9(002) VALUE 30.
               10  SEP-PREV-EOM-VAL        PIC 9(002) VALUE 31.
               10  SEP-NEXT-EOM-VAL        PIC 9(002) VALUE 31.
           05  OCT-VALUES.
               10  OCT-NAME                PIC X(009) VALUE
               'OCTOBER'.
               10  OCT-EOM-VAL             PIC 9(002) VALUE 31.
               10  OCT-PREV-EOM-VAL        PIC 9(002) VALUE 30.
               10  OCT-NEXT-EOM-VAL        PIC 9(002) VALUE 30.
           05  NOV-VALUES.
               10  NOV-NAME                PIC X(009) VALUE
               'NOVEMBER'.
               10  NOV-EOM-VAL             PIC 9(002) VALUE 30.
               10  NOV-PREV-EOM-VAL        PIC 9(002) VALUE 31.
               10  NOV-NEXT-EOM-VAL        PIC 9(002) VALUE 31.
           05  DEC-VALUES.
               10  DEC-NAME                PIC X(009) VALUE
               'DECEMBER'.
               10  DEC-EOM-VAL             PIC 9(002) VALUE 31.
               10  DEC-PREV-EOM-VAL        PIC 9(002) VALUE 30.
               10  DEC-NEXT-EOM-VAL        PIC 9(002) VALUE 31.

       01  EOM-TABLE REDEFINES
           END-OF-MONTH-VALUES.
           05  ET-MONTHLY-ENTRY     OCCURS 012  TIMES.
               10  ET-MONTH-NAME           PIC X(009).
               10  ET-EOM                  PIC 9(002).
               10  ET-PREV-EOM             PIC 9(002).
               10  ET-NEXT-EOM             PIC 9(002).

      /*****************************************************************
       1010-CALC-DST-DATES.
      ******************************************************************
      *    THIS ROUTINE CALCULATES THE BEGIN AND END DAYLIGHT SAV-
      *    INGS TIME DATES FOR THE SUBJECT YEAR. THE YEAR IS IN THE FORM
      *    YYMMDD AND WINDOWING IS USED TO ASSIGN THE CENTURY(WDS-CC).
      *    THE WINDOW LIMIT IS 90. BEGIN & END DATES ARE DEFINED AS THE
      *    1ST SUNDAY (AT 2 A.M., EST) IN APRIL AND THE LAST SUNDAY IN
      *    OCTOBER, RESPECTIVELY. THE PROBLEM IS APPROACHED BY DE-
      *    TERMINING THE DAY OF WEEK FOR APRIL 1 AND OCTOBER 31, THEN
      *    DIVIDING BY 7 AND
      *    ADDING(FOR APRIL) OR SUBTRACTING(FOR OCT) THE APPROPRIATE
      *    NUMBER OF DAYS UNTIL THE REMAINDER (WS-DAY-OF-WEEK)
      *    REACHES A 'SUNDAY' VALUE. (SEE THE TABLE BELOW).
      *
      * NOTE!!!!
      *    THIS ROUTINE WON'T WORK BEYOND FEB 28 2100. THE CALC FOR
      *    WS-NUM-OF-LEAP-YRS WAS SIMPLIFIED. TO CORRECT IT DIVIDE
      *    WDS-CCYY-NUM BY 100 AND SUB RESULT FROM WS-NUM-OF-LEAP-YRS
      *    THEN DIVIDE WDS-CCYY-NUM BY 400 AND ADD RESULT TO
      *    WS-NUM-OF-LEAP-YRS. THEN REDO THE TABLE BELOW.
      ******************************************************************
      *
      *           -6  -> SUN    <=======
      *           -5  -> MON
      *           -4  -> TUE
      *           -3  -> WED
      *           -2  -> THU
      *           -1  -> FRI
      *            0  -> SAT
      *           +1  -> SUN    <=======
      *           +2  -> MON
      *           +3  -> TUE
      *           +4  -> WED
      *           +5  -> THU
      *           +6  -> FRI
      *           +7  -> SAT
      *           +8  -> SUN    <=======
      *
      ******************************************************************
      *  DETERMINE  CENTURY FOR DAYLIGHT SAVINGS START/END DATES
      ******************************************************************
           MOVE    STD-B1-MESSAGE-DATE  TO  WS-IT-DATE
           MOVE    WS-YY                TO  WDS-YY
           IF      WDS-YY                <  90
           ADD       +1                 TO  WDS-CC
           END-IF
           MOVE    WDS-CCYY             TO  WDE-CCYY
      ******************************************************************
      *  DETERMINE IF ITS A LEAP YEAR
      ******************************************************************
           SET     ITS-NOT-A-LEAP-YR    TO  TRUE
           DIVIDE  WDS-CCYY-NUM         BY  +4
           GIVING  WS-BIT-BUCKET
           REMAINDER WS-REMAINDER-4

           DIVIDE  WDS-CCYY-NUM         BY  +100
           GIVING  WS-BIT-BUCKET
           REMAINDER WS-REMAINDER-100

           DIVIDE  WDS-CCYY-NUM         BY  +400
           GIVING  WS-BIT-BUCKET
           REMAINDER WS-REMAINDER-400

           IF DIVISIBLE-BY-400
              OR
              (DIVISIBLE-BY-4 AND NOT DIVISIBLE-BY-100)
              SET ITS-A-LEAP-YR    TO TRUE
           END-IF
      ******************************************************************
      *  IF LEAP YR ADJUST YTD AND CALENDAR BY ONE.
      ******************************************************************
           IF      ITS-A-LEAP-YR
           ADD          +1              TO  WS-DAYS-TO-APR1
                                            WS-DAYS-TO-OCT31
                                            ET-NEXT-EOM(1)
                                            ET-EOM(2)
                                            ET-PREV-EOM(3)
           END-IF
      ******************************************************************
      *        COMPUTE THE TOTAL # OF DAYS TO APR 1 OF THE SUBJECT YEAR
      ******************************************************************
           COMPUTE WS-NUM-OF-LEAP-YRS = (WDS-CCYY-NUM - 1) / +4
           COMPUTE WS-TOT-DAYS = WS-NUM-OF-LEAP-YRS
                               + ((WDS-CCYY-NUM - 1) * +365)
                               +   WS-DAYS-TO-APR1
      ******************************************************************
      *        COMPUTE DAY OF WEEK FOR APRIL 1ST (SEE TABLE ABOVE)
      ******************************************************************
           DIVIDE  WS-TOT-DAYS BY  +7
           GIVING  WS-TOT-DAYS
           REMAINDER WS-DAY-OF-WEEK
      ******************************************************************
      *        THEN ...
      ******************************************************************
           PERFORM 1020-ADD-DAYS
           UNTIL   1ST-SUN-IN-APR
      ******************************************************************
      *        COMPUTE THE TOTAL # OF DAYS TO OCT 31 OF THE SUBJECT YEAR
      ******************************************************************
           COMPUTE WS-TOT-DAYS = WS-NUM-OF-LEAP-YRS
                               + ((WDE-CCYY-NUM - 1) * 365)
                               +   WS-DAYS-TO-OCT31
      ******************************************************************
      *        COMPUTE DAY OF WEEK FOR OCT 31ST (SEE TABLE ABOVE)
      ******************************************************************
           DIVIDE  WS-TOT-DAYS BY  +7
           GIVING  WS-TOT-DAYS
           REMAINDER WS-DAY-OF-WEEK
      ******************************************************************
      *        THEN ...
      ******************************************************************
           PERFORM 1040-SUB-DAYS
           UNTIL   LAST-SUN-IN-OCT
           .
      ******************************************************************
       1020-ADD-DAYS.

           ADD      +1       TO  WDS-DD
                                 WS-DAY-OF-WEEK
           .
      ******************************************************************
       1040-SUB-DAYS.

           SUBTRACT +1      FROM WDE-DD
                                 WS-DAY-OF-WEEK
           .

 

[Crox]

Thanks Slade, that is nice.

That is why I want a algoritm forum and also an up- and download place for sources....

Here is my try to implement the algorithm. The program does displays because I don't count this out again in my date routine. Instead I have a very small table, giving the difference in days compared to yyyy-03-21. It takes only one byte a year and there is nothing to count.

Implementing the algorithm in CA-REALIA, I can redirect the displays into a file with the >

Regards,

Crox

ps. I have also sometimes trouble to use that code-thing.

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. EASTER.
000300 ENVIRONMENT DIVISION.
000400 CONFIGURATION SECTION.
000500 SOURCE-COMPUTER. IBM-PC.
000600 OBJECT-COMPUTER. IBM-PC.
000700 SPECIAL-NAMES.
000800     DECIMAL-POINT IS COMMA.
000900 INPUT-OUTPUT SECTION.
001000 FILE-CONTROL.
001100 DATA DIVISION.
001200 WORKING-STORAGE SECTION.
001300 01  HULPVELDEN.
001400     05  DUMMY                     PIC S9(4) COMP-5.
001500     05  WORK                      PIC S9(4) COMP-5.
001600     05  X                         PIC S9(4) COMP-5.
001700     05  A                         PIC S9(4) COMP-5.
001800     05  B                         PIC S9(4) COMP-5.
001900     05  C                         PIC S9(4) COMP-5.
002000     05  D                         PIC S9(4) COMP-5.
002100     05  E                         PIC S9(4) COMP-5.
002200     05  F                         PIC S9(4) COMP-5.
002300     05  G                         PIC S9(4) COMP-5.
002400     05  H                         PIC S9(4) COMP-5.
002500     05  I                         PIC S9(4) COMP-5.
002600     05  J                         PIC S9(4) COMP-5.
002700     05  K                         PIC S9(4) COMP-5.
002800     05  L                         PIC S9(4) COMP-5.
002900     05  M                         PIC S9(4) COMP-5.
003000     05  N                         PIC S9(4) COMP-5.
003100     05  O                         PIC S9(4) COMP-5.
003200     05  P                         PIC S9(4) COMP-5.
003300     05  EASTERDAY.
003400         07  EASTER-DAY            PIC Z9.
003500         07  FILLER                PIC X VALUE '-'.
003600         07  EASTER-MONTH          PIC 99.
003700 PROCEDURE DIVISION.
003800 0001.
003900     PERFORM VARYING X FROM 1582 BY +1 UNTIL X > 4000
004000        PERFORM COMPUTE-EASTERN
004100     END-PERFORM.
004200     STOP RUN.
004300 COMPUTE-EASTERN SECTION.
004400     DIVIDE X BY  19 GIVING DUMMY REMAINDER A.
004500     DIVIDE X BY 100 GIVING B     REMAINDER C.
004600     DIVIDE B BY   4 GIVING D     REMAINDER E.
004700     ADD B 8 GIVING WORK.
004800     DIVIDE WORK BY 25 GIVING F.
004900     ADD B 1 GIVING WORK.
005000     SUBTRACT F FROM WORK.
005100     DIVIDE WORK BY 3 GIVING G.
005200     COMPUTE WORK = 19 * A + B - D - G + 15.
005300     DIVIDE WORK BY 30 GIVING DUMMY REMAINDER H.
005400     DIVIDE C BY 4 GIVING I REMAINDER K.
005500     COMPUTE WORK = 32 + 2 * E + 2 * I - H - K.
005600     DIVIDE WORK BY 7 GIVING DUMMY REMAINDER L.
005700     COMPUTE M = (A + 11 * H + 22 * L) / 451.
005800     COMPUTE WORK = H + L - 7 * M + 114.
005900     DIVIDE WORK BY 31 GIVING N REMAINDER P.
006000     ADD +1 TO P.
006100     MOVE N TO EASTER-MONTH.
006200     MOVE P TO EASTER-DAY.
006300     DISPLAY 'YEAR: ' X SPACE SPACE WITH NO ADVANCING.
006400     EXHIBIT NAMED EASTERDAY.

 

[Thane]

There is also a very clean version of this with detailed explanation in my book Sams Teach Yourself COBOL in 24 hours - In the date handling chapter!

 

[Crox]

To calculate from easter to some other days:

+1 --> 2nd easter day
+38 --> Ascension day
+10 --> Whit Sunday
+1 --> Whit Monday