       IDENTIFICATION DIVISION.
       PROGRAM-ID. Y2KATOG.
       AUTHOR. JAY MOSELEY.
       DATE-WRITTEN. DECEMBER, 1997.
       DATE-COMPILED.
      *                                                               *
      *   YY   YY   222   KK   KK    A   TTTTTTTT  OOOOO   GGGGG      *
      *   YY   YY  2   2  KK  KK    AAA     TT    OO   OO GG   GG     *
      *   YY   YY      2  KK KK    AA AA    TT    OO   OO GG   GG     *
      *    YY YY       2  KKKK    AA   AA   TT    OO   OO GG          *
      *     YYY     222   KKKK    AA   AA   TT    OO   OO GG  GGG     *
      *     YY     2      KK KK   AAAAAAA   TT    OO   OO GG   GG     *
      *     YY     2      KK  KK  AA   AA   TT    OO   OO GG   GG     *
      *     YY     22222  KK   KK AA   AA   TT     OOOOO   GGGGG      *
      *                                                               *
      *************************************************************** *
      * THIS SUBROUTINE REBUILDS THE GREGORIAN DATE (MMDDYYYY) FOR    *
      * GIVEN ASTRONOMICAL NUMBER                                     *
      *                                                               *
      *  VALID ASTRONOMICAL NUMBERS FOR THIS ROUTINE ARE 2305814+     *
      *  THROUGH 2962884+ (INCLUSIVE)                                 *
      *                                                               *
      *  THREE FIELDS ARE PASSED AS PARAMETERS TO THE ROUTINE:        *
      *  1)  A 7 BYTE FIELD CONTAINING THE ASTRONOMICAL NUMBER        *
      *      (IN ZONED-DECIMAL FORMAT) TO BE PROCESSED,               *
      *  2)  A 1 BYTE ZONED-DECIMAL RETURN CODE, AND                  *
      *  3)  AN 8 BYTE FIELD WHICH WILL RECEIVE THE OUTPUT DATE       *
      *      (IN ZONED-DECIMAL FORMAT).                               *
      *  THE ROUTINE WILL NOT ALTER THE ASTRONOMICAL NUMBER PASSED    *
      *  TO IT.                                                       *
      *                                                               *
      *  SUGGESTED CALLING SYNTAX FOR COBOL CALLERS:                  *
      *                                                               *
      *       01  ATOG-PARAMETERS.                                    *
      *           02  ANUM PIC 9(7) VALUE +2451544.                   *
      *           02  RC   PIC 9(1) VALUE 0.                          *
      *           02  DATE PIC 9(8) VALUE 0.                          *
      *       CALL 'Y2KATOG' USING ATOG-PARAMETERS.                   *
      *                                                               *
      *  THE POSSIBLE VALUES FOR THE RETURN CODE FIELD ARE:           *
      *                                                               *
      *  0 INDICATES SUCCESSFUL EXECUTION OF THE ROUTINE.             *
      *                                                               *
      *  2 INDICATES INVALID DATA WAS FOUND IN THE ANUM FIELD.        *
      *  INVALID DATA ARE DETERMINED IF THE FIELD'S LOW ORDER BYTE'S  *
      *  ZONE CONTAINS AN INVALID SIGN, (NOT ONE OF X'C', X'D', 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 ANUM SPECIFIED WAS NOT IN       *
      *  THE RANGE SPECIFIED IN 1 (ABOVE).                            *
      *                                                               *
      *  UPON SUCCESSFUL EXECUTION, THE GREGORIAN DATE TO WHICH       *
      *  THE ASTRONOMICAL NUMBER CORRESPONDS WILL BE PLACED IN        *
      *  THE 3RD PARAMETER FIELD (DATE).  IF THE RETURN CODE IS       *
      *  A NON-ZERO VALUE (UNSUCCESSFUL EXECUTION), THE DATE          *
      *  FIELD WILL CONTAINS 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 'Y2KATOG STORAGE BEGINS->'.

      * ************************************************************* *
      * THESE ARE PROGRAM CONTROL SWITCHES AND WORK FIELDS.           *
      * ************************************************************* *
       01  PROGRAM-CONTROL-FIELDS.
           02  WORK-A                  PIC S9(15) COMP-3.
           02  WORK-B                  PIC S9(15) COMP-3.
           02  WORK-C                  PIC S9(15) COMP-3.
           02  WORK-D                  PIC S9(15) COMP-3.

       01  FILLER                      PIC X(24)
           VALUE '<-Y2KATOG 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  ATOG-PARAMETERS.
           02  ATOGP-ANUM              PIC S9(7).
           02  ATOGP-RETURN-CODE       PIC 9(1).
           02  ATOGP-DATE-G.
                03  ATOGP-DATE-G-M     PIC 9(2).
                03  ATOGP-DATE-G-D     PIC 9(2).
                03  ATOGP-DATE-G-Y     PIC 9(4).

      /
       PROCEDURE DIVISION USING ATOG-PARAMETERS.

       0000-MAIN SECTION.
       0050-INITIALIZE.
           MOVE ZERO TO ATOGP-RETURN-CODE, ATOGP-DATE-G.

       0075-VALIDATE-INPUT-DATA.
           IF ATOGP-ANUM IS NOT NUMERIC
               MOVE 2 TO ATOGP-RETURN-CODE
               GOBACK.

           IF ATOGP-ANUM < 2305814
           OR ATOGP-ANUM > 2962884
               MOVE 4 TO ATOGP-RETURN-CODE
               GOBACK.

       0100-COMPUTE-DATE.
           MULTIPLY ATOGP-ANUM BY 4 GIVING WORK-A.
           SUBTRACT 6884477 FROM WORK-A.
           DIVIDE WORK-A BY 146097 GIVING WORK-B REMAINDER WORK-C.
           MULTIPLY WORK-B BY 100 GIVING WORK-B.
           DIVIDE WORK-C BY 4 GIVING WORK-C.
           MULTIPLY WORK-C BY 4 GIVING WORK-A.
           ADD 3 TO WORK-A.
           DIVIDE WORK-A BY 1461 GIVING WORK-A REMAINDER WORK-D.
           ADD WORK-A TO WORK-B.
           DIVIDE WORK-D BY 4 GIVING WORK-C.
           ADD 1 TO WORK-C.
           MULTIPLY WORK-C BY 5 GIVING WORK-A.
           SUBTRACT 3 FROM WORK-A.
           DIVIDE WORK-A BY 153 GIVING WORK-A REMAINDER WORK-C.
           ADD 1 TO WORK-A.
           DIVIDE WORK-C BY 5 GIVING WORK-C.
           ADD 1 TO WORK-C.

           MOVE WORK-A TO ATOGP-DATE-G-M.
           IF WORK-A LESS THAN 11
               ADD 2 TO ATOGP-DATE-G-M
           ELSE
               SUBTRACT 10 FROM ATOGP-DATE-G-M.

           MOVE WORK-C TO ATOGP-DATE-G-D.

           DIVIDE WORK-A BY 11 GIVING WORK-A.
           ADD WORK-A TO WORK-B.
           MOVE WORK-B TO ATOGP-DATE-G-Y.

           GOBACK.

       END PROGRAM Y2KATOG.
