Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations derfloh on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

useful easter algorithm

Status
Not open for further replies.
Crox

Crox

Programmer
Joined
Apr 3, 2000
Messages
895
Location
NL
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:

Code: 
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

 
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?

Code: 
           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
           .

 
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 &quot;typewriter&quot; was reinvented there?

Code: 
           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
           .
 
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.

Code: 
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.
 
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!
 
To calculate from easter to some other days:

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


 
Status
Not open for further replies.

Similar threads

Crox
  • Locked
  • Question Question
COBFD was a very usefull program. Perhaps we can create one ourself in GNU COBOL? 😁
Replies
14
Views
1K
Crox
Crox
RICHINMINN
  • Locked
  • Question Question
Algorithm to convert CCYYMM to number 1 - 18
Replies
6
Views
357
webrabbit
webrabbit
RICHINMINN
  • Locked
  • Question Question
Algorithm for calculating business-day aging??
Replies
4
Views
367
jmanj
jmanj
webrabbit
  • Locked
  • Question Question
Square root algorithm
Replies
10
Views
498
Glenn9999
Glenn9999
kfmason
  • Locked
  • Helpful tip Helpful tip
Easter Day Calculation
Replies
1
Views
244
Crox
Crox

Part and Inventory Search

Sponsor

Back
Top