       IDENTIFICATION DIVISION.
       PROGRAM-ID. Y2KESTR.
       AUTHOR. JAY MOSELEY.
       DATE-WRITTEN. NOVEMBER, 1998.
       DATE-COMPILED.
      *                                                               *
      *   YY   YY   222   KK   KK EEEEEE   SSSSS TTTTTTTT RRRRRR      *
      *   YY   YY  2   2  KK  KK  EE      SS   SS   TT    RR   RR     *
      *   YY   YY      2  KK KK   EE      SS        TT    RR   RR     *
      *    YY YY       2  KKKK    EEEE     SSSSS    TT    RR   RR     *
      *     YYY     222   KKKK    EE           SS   TT    RRRRRR      *
      *     YY     2      KK KK   EE      SS   SS   TT    RR RR       *
      *     YY     2      KK  KK  EE      SS   SS   TT    RR  RR      *
      *     YY     22222  KK   KK EEEEEEE  SSSSS    TT    RR   RR     *
      *                                                               *
      *************************************************************** *
      *    THIS SUBROUTINE DETERMINES THE DATE ON WHICH EASTER FALLS  *
      *    FOR A GIVEN YEAR                                           *
      *                                                               *
      *    1.  VALID INPUT YEARS FOR THIS ROUTINE ARE THE YEARS 1601  *
      *        THROUGH 3399 A. D. (INCLUSIVE)                         *
      *                                                               *
      *    2.  THREE FIELDS ARE PASSED AS PARAMETERS TO THE ROUTINE:  *
      *        1)  A 4 BYTE FIELD CONTAINING THE YEAR TO BE PROCESSED *
      *            (IN ZONED-DECIMAL FORMAT),                         *
      *        2)  A 1 BYTE ZONED-DECIMAL RETURN CODE, AND            *
      *        3)  AN 8 BYTE FIELD WHICH WILL RECEIVE THE GREGORIAN   *
      *            DATE ON WHICH EASTER FALLS (IN ZONED-DECIMAL       *
      *            FORMAT).                                           *
      *        THE ROUTINE WILL NOT ALTER THE YEAR PASSED TO IT.      *
      *                                                               *
      *        SUGGESTED CALLING SYNTAX FOR COBOL CALLERS:            *
      *                                                               *
      *             01  ESTR-PARAMETERS.                              *
      *                 02  YEAR   PIC 9(4) VALUE 1997.               *
      *                 02  RC     PIC 9(1) VALUE 0.                  *
      *                 02  EASTER PIC 9(8) VALUE 0.                  *
      *             CALL 'Y2KESTR' USING ESTR-PARAMETERS.             *
      *                                                               *
      *    3.  THE POSSIBLE VALUES FOR THE RETURN CODE FIELD ARE:     *
      *                                                               *
      *        0 INDICATES SUCCESSFUL EXECUTION OF THE ROUTINE.       *
      *                                                               *
      *        2 INDICATES INVALID DATA WAS FOUND IN THE YEAR FIELD.  *
      *        INVALID DATA ARE DETERMINED IF THE FIELD'S LOW ORDER   *
      *        BYTE'S ZONE CONTAINS AN INVALID SIGN, (NOT ONE OF      *
      *        X'C', X'A', X'E', OR X'F'), OR IF THE PRECEDING BYTES' *
      *        ZONES ARE OTHER THAN X'F', OR IF ANY BYTE'S LOW ORDER  *
      *        NIBBLE CONTAINS A VALUE GREATER THAN X'9'.             *
      *                                                               *
      *        4 INDICATES THE VALUE OF THE YEAR SPECIFIED WAS NOT IN *
      *        THE RANGE SPECIFIED IN 1 (ABOVE).                      *
      *                                                               *
      *    4.  UPON SUCCESSFUL EXECUTION, THE GREGORIAN DATE          *
      *        (MMDDYYYY) ON WHICH EASTER FALLS FOR THE GIVEN YEAR    *
      *        WILL BE PLACED IN THE 3RD PARAMETER FIELD.  IF THE     *
      *        RETURN CODE IS A NON-ZERO VALUE (UNSUCCESSFUL          *
      *        EXECUTION), THE OUTPUT DATE FIELD WILL CONTAIN ZEROS.  *
      *                                                               *
      *---------------------------------------------------------------*
      *                                                               *
      * 18 Sep 2017 - Change from INITIAL to LOCAL-STORAGE            *
      *               This change has no affect on program execution. *
      *               It was made to accomodate a bug in GnuCOBOL 2.2 *
      *               which will be fixed, but the change makes sense *
      *               from a logical viewpoint, so thus is justified. *
      *                                                               *
      *************************************************************** *
      /
       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.

       LOCAL-STORAGE SECTION.

       01  FILLER                      PIC X(24)
           VALUE 'Y2KESTR STORAGE BEGINS->'.

      * ************************************************************* *
      * THESE ARE PROGRAM CONTROL SWITCHES AND WORK FIELDS.           *
      * ************************************************************* *
       01  PROGRAM-CONTROL-FIELDS      COMP-3.
           02  CENTURY                 PIC S9(3).
           02  WORK                    PIC S9(9).
           02  TEMP1                   PIC S9(5).
           02  TEMP2                   PIC S9(5).
           02  NON-LEAP-CENTESMALS     PIC S9(3).
           02  METONIC                 PIC S9(3).
           02  METONIC-CORRECTION      PIC S9(3).
           02  DAY-MODIFIER            PIC S9(5).
           02  EPACT                   PIC S9(3).
           02  DAY-WORK                PIC S9(3).
           02  EASTER-MONTH            PIC 9(02).
           02  EASTER-DAY              PIC 9(02).

       01  FILLER                      PIC X(24)
           VALUE '<-Y2KESTR STORAGE ENDS'.

       LINKAGE SECTION.

      * ************************************************************* *
      * THESE ARE THE FIELDS USED TO RECEIVE INPUT DATA FROM THE      *
      * CALLER AND PASS RESULT FIELDS BACK TO THE CALLER.             *
      * ************************************************************* *
       01  ESTR-PARAMETERS.
           02  ESTRP-YEAR              PIC 9(04).
           02  ESTRP-RC                PIC X(01).
           02  ESTRP-DATEG.
               03  ESTRP-DATEG-MM      PIC 9(2).
               03  ESTRP-DATEG-DD      PIC 9(2).
               03  ESTRP-DATEG-YYYY    PIC 9(4).
      /
       PROCEDURE DIVISION USING ESTR-PARAMETERS.

       0000-MAIN SECTION.
       0025-INITIALIZE.
           MOVE ZERO TO ESTRP-RC, ESTRP-DATEG.

           IF ESTRP-YEAR IS NOT NUMERIC
               MOVE '2' TO ESTRP-RC
           ELSE
               IF ESTRP-YEAR LESS THAN 1601
               OR ESTRP-YEAR GREATER THAN 3399
                   MOVE '4' TO ESTRP-RC
               ELSE
                   PERFORM 0100-COMPUTE-EASTER
               END-IF
           END-IF.

           GOBACK.

       0100-COMPUTE-EASTER.

      * ************************************************************* *
      * COMPUTE CENTURY NUMBER.                                       *
      * ************************************************************* *
           COMPUTE CENTURY = FUNCTION INTEGER(ESTRP-YEAR / 100).
           ADD 1 TO CENTURY.

      * ************************************************************* *
      * COMPUTE NON-LEAP YEAR CENTESMALS.                             *
      * ************************************************************* *
           COMPUTE WORK = ESTRP-YEAR - 1600.
           COMPUTE WORK = FUNCTION INTEGER(WORK / 400).
           COMPUTE TEMP1 = WORK * 3.
           COMPUTE WORK = ESTRP-YEAR - 1600.
           COMPUTE WORK = FUNCTION MOD(WORK, 400).
           COMPUTE TEMP2 = FUNCTION INTEGER(WORK / 100).
           COMPUTE NON-LEAP-CENTESMALS = TEMP1 + TEMP2.

      * ************************************************************* *
      * COMPUTE YEAR'S POSITION IN THE METONIC CYCLE.                 *
      * ************************************************************* *
           COMPUTE METONIC = FUNCTION MOD(ESTRP-YEAR, 19).
           ADD 1 TO METONIC.

      * ************************************************************* *
      * COMPUTE CORRECTION FOR THE METONIC CYCLE.                     *
      * ************************************************************* *
           COMPUTE WORK = (CENTURY * 8) + 5.
           COMPUTE METONIC-CORRECTION = FUNCTION INTEGER(WORK / 25).
           SUBTRACT 5 FROM METONIC-CORRECTION.
           SUBTRACT NON-LEAP-CENTESMALS FROM METONIC-CORRECTION.

      * ************************************************************* *
      * COMPUTE DAY COUNT MODIFIER.                                   *
      * ************************************************************* *
           COMPUTE WORK = ESTRP-YEAR * 5.
           COMPUTE DAY-MODIFIER = FUNCTION INTEGER(WORK / 4).
           SUBTRACT NON-LEAP-CENTESMALS FROM DAY-MODIFIER.
           SUBTRACT 10 FROM DAY-MODIFIER.

      * ************************************************************* *
      * COMPUTE THE EPACT.                                            *
      * ************************************************************* *
           COMPUTE WORK = (METONIC * 11) + 20 + METONIC-CORRECTION.
           COMPUTE EPACT = FUNCTION MOD(WORK, 30).
           IF EPACT EQUAL 25
               IF METONIC GREATER THAN 11
                   ADD 1 TO EPACT
               END-IF
           END-IF.
           IF EPACT EQUAL 24
               ADD 1 TO EPACT
           END-IF.

      * ************************************************************* *
      * COMPUTE MODIFIED DAY VALUE.                                   *
      * ************************************************************* *
           COMPUTE DAY-WORK = 44 - EPACT.
           IF DAY-WORK LESS THAN 21
               ADD 30 TO DAY-WORK
           END-IF.
           COMPUTE TEMP1 = DAY-WORK + 7.
           COMPUTE TEMP2 = DAY-WORK + DAY-MODIFIER.
           COMPUTE TEMP2 = FUNCTION MOD(TEMP2, 7).
           COMPUTE DAY-WORK = TEMP1 - TEMP2.

      * ************************************************************* *
      * ASSEMBLE COMPLETED EASTER DATE.                               *
      * ************************************************************* *
           IF DAY-WORK IS < 31 OR = 31
               MOVE 03 TO ESTRP-DATEG-MM
               MOVE DAY-WORK TO ESTRP-DATEG-DD
           ELSE
               MOVE 04 TO ESTRP-DATEG-MM
               SUBTRACT 31 FROM DAY-WORK GIVING ESTRP-DATEG-DD
           END-IF.
           MOVE ESTRP-YEAR TO ESTRP-DATEG-YYYY.

       END PROGRAM Y2KESTR.
