Sudoku in Cobol


I was recently (2007) bitten by the Sudoku bug, and as a computer programmer I was immediately intrigued by the idea of writing a program to solve Sudoku puzzles.

I have been a Mainframe IBM Cobol programmer for 25 years, and so it was only natural for me to write the program in the language I knew best - Cobol!

I wanted to have the fun of figuring it out all on my own, and so I didn't "pollute" my thinking by consulting Sudoku-solving algorithms on the Net. I did, however, consult a friend who is a Sudoku whiz and asked him about some of the strategies he employed. Based on what I could figure out on my own, and enhanced with some insights from my friend, I came up with a program that has successfully and (powered by a mainframe number-cruncher) instantaneously solved every puzzle I have given it.

I then started reading about Sudoku algorithms and strategies on the Net to see what others had come up with. I found that there are a lot more solving strategies than I had imagined, but I was also pleased to see that most of the main ones were the same ones that I had "invented" in my program.

But I was also surprised to see that no one out there has yet published a Sudoku solver written in Cobol. Is mine the first one??

So, for whatever it's worth, here is my Cobol Sudoku Solver.


Terminology

I employ the following terminology for the Cobol Sudoku Solver.

The matrix consists of 81 cells, numbered from 1 through 81, beginning from the top left corner (cell #1) and sweeping from left to right, working downwards row by row, until reaching the bottom right corner (cell #81).

The matrix has three types of groups: rows, columns, and squares.


Running the Cobol Sudoku Solver

The Cobol Sudoku Solver inputs a card file of nine lines containing the puzzle to be solved. Empty cells are input as zero.

Example:

  //CARDFILE DD *
  004320600 
  070006000 
  002580030 
  060000000 
  091030850 
  000000010 
  020049500 
  000200060 
  008063100 
  /*

The Cobol Sudoku Solver prints a sysout listing of the steps involved in solving the puzzle, followed by a matrix depicting the solution. Following that is a dump of the internal array used in storing the puzzle's solution, and that is followed by a display of iteration counts for the routines called. If any error is encountered in the process, an error routine dumps all pertinent working-storage areas.

The sysout for the above input is displayed as follows:

  N9000 M1130-S 00020 1 
  N9000 M1130-S 00076 7 
  B3900 B3130-S 00019 6 
  B3900 B3120-V 00057 6 
  B9907 B4100 COL 06 24 00 00033 00007 
  B9907 B4100 COL 06 24 00 00042 00007 
  B9907 B4100 COL 06 24 00 00051 00007 
  B9907 B4100 ROW 13 14 00 00010 00009 
  B9907 B4100 ROW 13 14 00 00012 00009 
  B9907 B4100 ROW 13 14 00 00016 00009 
  B9907 B4100 ROW 13 14 00 00017 00009 
  B9907 B4100 ROW 13 14 00 00018 00009 
  B9907 B4100 ROW 68 69 00 00064 00005 
  B9907 B4100 ROW 68 69 00 00065 00005 
  B9907 B4100 ROW 68 69 00 00066 00005 
  B9907 B4200 SQR 25 27 00 00008 00009 
  B9907 B4200 SQR 25 27 00 00009 00009 
  B9905 SQR 09 18 5 1 09 00007 
  B9905 SQR 09 18 5 1 09 00008 
  B9905 SQR 09 18 5 1 18 00002 
  B9905 SQR 09 18 5 1 18 00004 
  B9905 SQR 09 18 5 1 18 00008 
  B3900 B3110-H 00001 9 
  B3900 B3120-V 00066 9 
  B1140-V 00008 00062 00007 00008 00017 00008 
  B1140-V 00008 00062 00007 00008 00035 00007 
  B3900 B3110-H 00010 8 
  B3900 B3130-S 00008 8 
  B3900 B3120-V 00062 7 
  N9000 M1110-H 00002 5 
  N9000 M1110-H 00009 1 
  N9000 M1130-S 00012 3 
  N9000 M1120-V 00018 5 
  N9000 M1120-V 00074 4 
  N9000 M1110-H 00006 7 
  N9000 M1120-V 00024 4 
  N9000 M1120-V 00042 2 
  N9000 M1120-V 00065 3 
  N9000 M1110-H 00070 4 
  N9000 M1110-H 00072 8
  N9000 M1110-H 00073 5
  N9000 M1120-V 00016 2
  N9000 M1110-H 00017 4
  N9000 M1120-V 00047 8
  N9000 M1110-H 00051 5
  N9000 M1130-S 00055 1
  N9000 M1110-H 00058 8
  N9000 M1110-H 00063 3
  N9000 M1120-V 00064 7
  N9000 M1120-V 00069 1
  N9000 M1120-V 00033 8
  N9000 M1120-V 00037 4
  N9000 M1110-H 00040 6
  N9000 M1110-H 00045 7
  N9000 M1110-H 00048 7
  N9000 M1110-H 00050 9
  N9000 M1110-H 00052 3
  N9000 M1110-H 00068 5
  N9000 M1120-V 00014 1
  N9000 M1120-V 00027 9 
  N9000 M1120-V 00030 5 
  N9000 M1120-V 00032 7 
  N9000 M1120-V 00034 9 
  N9000 M1110-H 00035 2 
  N9000 M1110-H 00036 4 
  N9000 M1110-H 00046 2 
  N9000 M1110-H 00049 4 
  N9000 M1110-H 00054 6 
  N9000 M1120-V 00080 9 
  N9000 M1110-H 00081 2 
  N9000 M1110-H 00013 9 
  N9000 M1110-H 00025 7 
  N9000 M1110-H 00028 3 
  N9000 M1110-H 00031 1 
  9 5 4 3 2 7 6 8 1 
  8 7 3 9 1 6 2 4 5 
  6 1 2 5 8 4 7 3 9 
  3 6 5 1 7 8 9 2 4 
  4 9 1 6 3 2 8 5 7 
  2 8 7 4 9 5 3 1 6 
  1 2 6 8 4 9 5 7 3 
  7 3 9 2 5 1 4 6 8 
  5 4 8 7 6 3 1 9 2 
  00001 00000000919 
  00002 00005000015 
  00003 00040000014 
  00004 00300000013 
  00005 02000000012 
  00006 00000070017 
  00007 00000600016 
  00008 00000008018 
  00009 10000000011 
  00010 00000008018 
  00011 00000070017 
  00012 00300000013 
  00013 00000000919 
  00014 10000000011 
  00015 00000600016 
  00016 02000000012 
  00017 00040000014
  00018 00005000015
  00019 00000600016
  00020 10000000011
  00021 02000000012
  00022 00005000015
  00023 00000008018
  00024 00040000014
  00025 00000070017
  00026 00300000013
  00027 00000000919
  00028 00300000013
  00029 00000600016
  00030 00005000015
  00031 10000000011
  00032 00000070017
  00033 00000008018
  00034 00000000919
  00035 02000000012
  00036 00040000014
  00037 00040000014
  00038 00000000919
  00039 10000000011
  00040 00000600016
  00041 00300000013
  00042 02000000012
  00043 00000008018
  00044 00005000015
  00045 00000070017
  00046 02000000012
  00047 00000008018
  00048 00000070017
  00049 00040000014
  00050 00000000919
  00051 00005000015
  00052 00300000013
  00053 10000000011
  00054 00000600016
  00055 10000000011
  00056 02000000012
  00057 00000600016 
  00058 00000008018 
  00059 00040000014 
  00060 00000000919 
  00061 00005000015 
  00062 00000070017 
  00063 00300000013 
  00064 00000070017 
  00065 00300000013 
  00066 00000000919 
  00067 02000000012 
  00068 00005000015 
  00069 10000000011 
  00070 00040000014 
  00071 00000600016 
  00072 00000008018 
  00073 00005000015 
  00074 00040000014 
  00075 00000008018 
  00076 00000070017 
  00077 00000600016 
  00078 00300000013 
  00079 10000000011 
  00080 00000000919 
  00081 02000000012 
  A0000-CTR = 0000000001 
  B0000-CTR = 0000000016 
  B1000-CTR = 0000000002 
  B1100-CTR = 0000000089 
  B1110-CTR = 0000000108 
  B1120-CTR = 0000000000 
  B1130-CTR = 0000000108 
  B1140-CTR = 0000000009 
  B1150-CTR = 0000000099 
  B1160-CTR = 0000000000 
  B3000-CTR = 0000000005 
  B3100-CTR = 0000000045 
  B3110-CTR = 0000000405 
  B3120-CTR = 0000000405 
  B3130-CTR = 0000000405 
  B3900-CTR = 0000000007
  B4000-CTR = 0000000001
  B4100-CTR = 0000000009
  B4200-CTR = 0000000009
  B4300-CTR = 0000000009
  B4400-CTR = 0000000009
  B6000-CTR = 0000000000
  B6100-CTR = 0000000000
  B6200-CTR = 0000000000
  B9901-CTR = 0000000243
  B9903-CTR = 0000000486
  B9905-CTR = 0000000002
  B9906-CTR = 0000000243
  B9907-CTR = 0000000032
  B9910-CTR = 0000000000
  B9912-CTR = 0000000000
  B9913-CTR = 0000000000
  B9914-CTR = 0000000000
  B9915-CTR = 0000000000
  B9916-CTR = 0000000000
  B9917-CTR = 0000000000
  B9918-CTR = 0000000000
  B9919-CTR = 0000000000
  B9920-CTR = 0000000000
  B9921-CTR = 0000000000
  B9922-CTR = 0000000000
  C0000-CTR = 0000000000
  C1000-CTR = 0000000000
  C2000-CTR = 0000000000
  C3000-CTR = 0000000000
  J0000-CTR = 0000000009
  M1000-CTR = 0000000016
  M1100-CTR = 0000001296
  M1110-CTR = 0000011664
  M1120-CTR = 0000011664
  M1130-CTR = 0000011664
  N9000-CTR = 0000000047

Interpreting the Sysout

The Cobol Sudoku Solver solves the puzzle by iterative sweeps through the Sudoku matrix, finding possibilities in each cell to eliminate, until all cells have been reduced to only one possibility.

After the initial sweep through the matrix to eliminate possibilities based on the given values, it begins working through a series of solving algorithms, beginning with the simplest and working up to the more complex.

Whenever the matrix is updated with the elimination of a possibility, the matrix is checked for complete solution of the puzzle. If the puzzle is solved, the program displays the solution and terminates. If the puzzle is not yet solved, it drops back down to the simplest algorithm and starts all over again.

If the program works through all solving algorithms and does not detect any updates (i.e., no possibilities are eliminated), then it switches over to "probe" mode. This is a hit-and-miss algorithm that makes guesses starting with the first cell with the least number of remaining possibilities, trying out each possibility until a contradiction is found (in which case this possibility is eliminated, and the program starts all over again from the beginning), or the puzzle is solved (in which case the program displays the solution and terminates). A "test" counter has been inserted to allow a maximum of ten guesses before "giving up".

In testing out a sampling of some Sudoku puzzles that are supposedly the most difficult to solve, I have found that the "probe" method easily finds the solution, well before exhausting the allocated ten attempts. I have not yet found a proper Sudoku puzzle that requires more than ten attempts at the "probe" method.

The "probe" mode is, in a manner of speaking, "cheating." I have inserted this routine only as a last resort, after all of the basic solving algorithms have been exhausted. I now realize, of course, that there are many more algorithms that can be applied for solving more difficult puzzles, but I have found that the routines that I have coded are more than sufficient for solving any "normal" Sudoku puzzle, without having to resort to this "guessing" method. (I might also add that I have been too lazy to code up any additional routines!)

The tiers of solving algorithms employed by the Cobol Sudoku Solver are as follows:

1. Final Value. If the value A is the only remaining value possible for cell X, then the value for cell X is A.

2. Single. If within any given group, the value A only occurs in cell X, then the value for cell X is A.

3. Isolated Twins. If within a group, cells X and Y both only have possibilities A and B, then no other cell within the group may have values A or B.

4. Group Exclusion. If within a square, possibility A can only occur in cells (two or three) that fall within the same row or the same column, then possibility A cannot occur in any other cells in that same row or column in other squares.
Also:
If within a row or column, possibility A only occurs in cells (two or three) that fall within the same square, then possibility A cannot occur in cells outside of this row or column within this same square.

5. Hidden Twins. If within a group, possibilities A and B can only occur in cells X or Y, then cells X and Y cannot contain any possibilities other than A or B.

6. Hidden Triplets. If within a group, possibilities A, B, and C can only occur in cells X, Y, Z, then cells X, Y, and Z cannot contain any possibilities other than A, B, and C.

7. Isolated Triplets. If within a group, cells X, Y, and Z only contain possibilities A, B, and C, then no other cell within the group may have values A, B, or C.

The sysout displays each step involved in solving the puzzle, each line of sysout representing the discovery of the final value of a single cell, or the elimination of a possibility in a single cell. The first value displayed is a "tag" that tells which action was taken, and the values following the "tag" explain what occured in which cell.

Here is a "tag" legend for interpreting each line of sysout that precedes the final solution of the matrix:

N9000 (Solving algorithm: Final Value)
Display:
1. N9000
2. Which routine coming from
3. Cell being updated
4. Final value found

B3900 (Solving algorithm: Single)
Display:
1. B3900
2. Group (H for row, V for column, or S for square)
3. Cell being updated
4. Value

B1120-H, B1140-V, B1160-S (Solving algorithm: Isolated Twins)
Display:
1. B1120-H (row), B1140-V (column), B1160-S (square)
2. First twin cell
3. Second twin cell
4. First twin value
5. Second twin value
6. Cell being updated
7. Value being eliminated

B9907 / B4100 (Solving algorithm: Group Exclusion within a square)
Display:
1. B9907
2. B4100
3. ROW or COL
4. Cell 1
5. Cell 2
6. Cell 3 (zero if no cell 3)
7. Cell being updated
8. Value being eliminated

B9907 / B4200 (Solving algorithm: Group Exclusion within a row or column)
1. B4907
2. B4200
3. SQR
4. Cell 1
5. Cell 2
6. Cell 3 (zero if no cell 3)
7. Cell being updated
8. Value being eliminated

B9905 (Solving algorithm: Hidden Twins)
Display:
1. B9905
2. Group type (SQR, ROW, or COL)
3. Cell 1
4. Cell 2
5. Value 1
6. Value 2
7. Cell being updated (either Cell 1 or Cell 2)
8. Value being eliminated

B9915 (Solving algorithm: Hidden Triplets)
Display:
1. B9915
2. Group type (SQR, ROW, or COL)
3. Cell 1
4. Cell 2
5. Cell 3
6. Value 1
7. Value 2
8. Value 3
9. Cell being updated
10. Value being eliminated

B9921 (Solving algorithm: Isolated Triplets)
Display:
1. B9921
2. Group type (SQR, ROW, or COL)
3. Cell 1
4. Cell 2
5. Cell 3
6. Value 1
7. Value 2
8. Value 3
9. Cell being updated
10. Value being eliminated

To illustrate with the above puzzle, here is an explanation of the first six lines of sysout:

N9000 M1130-S 00020 1
1 is the only remaining value for cell 20. This was discovered in section M1130-S.

N9000 M1130-S 00076 7
7 is the only remaining value for cell 76. This was discovered in section M1130-S.

B3900 B3130-S 00019 6
Cell 19 is the only cell with value 6 in the square that contains cell 19.

B3900 B3120-V 00057 6
Cell 57 is the only cell with value 6 in the column that contains cell 57.

B9907 B4100 COL 06 24 00 00033 00007
The value 7 only occurs in cells 6 and 24 for the square that contains cells 6 and 24. Therefore the value 7 was eliminated from cell 33 because it lies in the same column.

B9907 B4100 COL 06 24 00 00042 00007
The value 7 only occurs in cells 6 and 24 for the square that contains cells 6 and 24. Therefore the value 7 was eliminated from cell 42 because it lies in the same column.


Cobol Source

Here is the source for the Cobol Sudoku Solver:

       IDENTIFICATION                  DIVISION.
      *--------------                  ---------
       PROGRAM-ID.                     SUDOKU.
       AUTHOR.                         BILL PRICE.
      *REMARKS.

       ENVIRONMENT                     DIVISION.
      *-----------                     ---------

       CONFIGURATION                   SECTION.
      *-------------                   --------

       SOURCE-COMPUTER.                IBM.

       OBJECT-COMPUTER.                IBM.

       INPUT-OUTPUT                    SECTION.
      *------------                    --------

       FILE-CONTROL.

           SELECT CARD-FILE
               ASSIGN TO CARDFILE.

       DATA                            DIVISION.
      *----                            ---------

       FILE                            SECTION.
      *----                            --------

       FD  CARD-FILE
           LABEL RECORDS ARE OMITTED
           RECORD CONTAINS 80 CHARACTERS
           RECORDING MODE IS F
           DATA RECORD IS CARD-RECORD.
       01  CARD-RECORD                 PIC X(80).

           EJECT
      ****************************************************************
      *
      *            WORKING STORAGE SECTION
      *
      ****************************************************************

       WORKING-STORAGE     SECTION.
       77  FILLER                      PIC X(32)         VALUE
                            '**SUDOKU WORKING-STORAGE BEGIN**'.

       01  WORK-VALUES.
           05  SUB1                    PIC 9(04)  COMP VALUE ZERO.
           05  SUB2                    PIC 9(04)  COMP VALUE ZERO.
           05  SUB3                    PIC 9(04)  COMP VALUE ZERO.
           05  SUB4                    PIC 9(04)  COMP VALUE ZERO.
           05  SUB5                    PIC 9(04)  COMP VALUE ZERO.
           05  SUB6                    PIC 9(04)  COMP VALUE ZERO.
           05  SUB7                    PIC 9(04)  COMP VALUE ZERO.
           05  SUB8                    PIC 9(04)  COMP VALUE ZERO.
           05  SUB9                    PIC 9(04)  COMP VALUE ZERO.
           05  SUB10                   PIC 9(04)  COMP VALUE ZERO.
           05  SUB11                   PIC 9(04)  COMP VALUE ZERO.
           05  SUB12                   PIC 9(04)  COMP VALUE ZERO.
           05  SUB13                   PIC 9(04)  COMP VALUE ZERO.
           05  SUB14                   PIC 9(04)  COMP VALUE ZERO.
           05  SUB15                   PIC 9(04)  COMP VALUE ZERO.
           05  SUB16                   PIC 9(04)  COMP VALUE ZERO.
           05  SUB17                   PIC 9(04)  COMP VALUE ZERO.
           05  SUB20                   PIC 9(04)  COMP VALUE ZERO.
           05  SUB21                   PIC 9(04)  COMP VALUE ZERO.
           05  SUB22                   PIC 9(04)  COMP VALUE ZERO.
           05  SUB30                   PIC 9(04)  COMP VALUE ZERO.
           05  SUB31                   PIC 9(04)  COMP VALUE ZERO.
           05  SUB32                   PIC 9(04)  COMP VALUE ZERO.
           05  SUB33                   PIC 9(04)  COMP VALUE ZERO.
           05  SUB34                   PIC 9(04)  COMP VALUE ZERO.
           05  SUB35                   PIC 9(04)  COMP VALUE ZERO.
           05  SUB36                   PIC 9(04)  COMP VALUE ZERO.
           05  SUB37                   PIC 9(04)  COMP VALUE ZERO.
           05  SUBA                    PIC 9(04)  COMP VALUE ZERO.
           05  SUBM                    PIC 9(04)  COMP VALUE ZERO.
           05  SUBH                    PIC 9(04)  COMP VALUE ZERO.
           05  SUBS                    PIC 9(04)  COMP VALUE ZERO.
           05  SUBV                    PIC 9(04)  COMP VALUE ZERO.
           05  SUBX                    PIC 9(04)  COMP VALUE ZERO.
           05  SUBY                    PIC 9(04)  COMP VALUE ZERO.
           05  SUB-A                   PIC 9(04)  COMP VALUE ZERO.
           05  SUB-B                   PIC 9(04)  COMP VALUE ZERO.
           05  SUB-C                   PIC 9(04)  COMP VALUE ZERO.
           05  AB-SUB                  PIC 9(04)  COMP VALUE ZERO.

       01  COUNTERS-W81.
           05  CARD-CTR-W81            PIC 9(04)  COMP VALUE ZERO.
           05  QUOTIENT-W81            PIC 9(04)  COMP VALUE ZERO.
           05  REM-W81                 PIC 9(04)  COMP VALUE ZERO.
           05  MATCH-W81               PIC 9(04)  COMP VALUE ZERO.
           05  A-W81                   PIC 9(04)  COMP VALUE ZERO.
           05  B-W81                   PIC 9(04)  COMP VALUE ZERO.
           05  AB-W81                  PIC 9(04)  COMP VALUE ZERO.
           05  SINGLE-W81              PIC 9(04)  COMP VALUE ZERO.
           05  MAX-ARRAY-C             PIC 9(04)  COMP VALUE ZERO.
TEST       05  TEST-W81                PIC 9(04)  COMP VALUE ZERO.
           05  A0000-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B0000-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B1000-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B1100-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B1110-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B1120-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B1130-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B1140-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B1150-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B1160-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B3000-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B3100-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B3110-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B3120-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B3130-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B3900-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B4000-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B4100-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B4200-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B4300-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B4400-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B6000-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B6100-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B6200-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B9901-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B9903-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B9905-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B9906-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B9907-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B9910-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B9911-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B9912-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B9913-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B9914-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B9915-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B9916-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B9917-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B9918-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B9919-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B9920-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B9921-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  B9922-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  C0000-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  C1000-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  C2000-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  C3000-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  J0000-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  M1000-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  M1100-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  M1110-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  M1120-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  M1130-CTR               PIC 9(08)  COMP VALUE ZERO.
           05  N9000-CTR               PIC 9(08)  COMP VALUE ZERO.

       01  SWITCHES-W82.
           05  CHANGED-W82             PIC X(01)  VALUE SPACES.
           05  CONTRA-W82              PIC X(01)  VALUE SPACES.
           05  FOUND-W82               PIC X(01)  VALUE SPACES.
           05  INPUT-EOF-W82           PIC X(01)  VALUE SPACES.
           05  INPUT-ERR-W82           PIC X(01)  VALUE SPACES.
           05  PROBE-W82               PIC X(01)  VALUE SPACES.
           05  STARTOVER-W82           PIC X(01)  VALUE SPACES.
           05  DONE-W82                PIC X(01)  VALUE SPACES.

       01  WORK-AREAS-W700.
           05  SOURCE-W700             PIC X(10)  VALUE SPACES.
           05  CELL-1-W700             PIC 9(02)  VALUE ZERO.
           05  CELL-2-W700             PIC 9(02)  VALUE ZERO.
           05  CELL-3-W700             PIC 9(02)  VALUE ZERO.
           05  POSS-1-W700             PIC 9(01)  VALUE ZERO.
           05  POSS-2-W700             PIC 9(01)  VALUE ZERO.
           05  POSS-3-W700             PIC 9(01)  VALUE ZERO.
           05  ROW-W700                PIC 9(02)  VALUE ZERO.
           05  COL-W700                PIC 9(02)  VALUE ZERO.
           05  SQR-W700                PIC 9(02)  VALUE ZERO.
           05  WAGON-W700.
               10  WAGON-CNT-W700      PIC 9(01)  VALUE ZERO.
               10  WAGON-RIDER-W700    OCCURS 9   PIC 9(02).
           05  PTS-W700.
               10  PT1-W700            PIC 9(02)  VALUE ZERO.
               10  PT2-W700            PIC 9(02)  VALUE ZERO.
               10  PT3-W700            PIC 9(02)  VALUE ZERO.
           05  DISPLAY-W700.
               10  DISPLAY-X           OCCURS 9.
                   15  DISPLAY-SPC     PIC X(01).
                   15  DISPLAY-VAL     PIC 9(01).
           05  B9903-TYPE              PIC X(03)  VALUE SPACES.
           05  B9906-TYPE              PIC X(05)  VALUE SPACES.
           05  B9907-TYPE              PIC X(03)  VALUE SPACES.
           05  B9916-TYPE              PIC X(03)  VALUE SPACES.

       01  WORK-TABLES.
           05  ARRAY-A.
               10  ARRAY-A-ELEMENT     OCCURS 81.
                   15  ARRAY-A-VAL     PIC 9(01) OCCURS 11.
           05  ARRAY-B-VALUES.
               10  FILLER              PIC X(06) VALUE
                   '010101'.
               10  FILLER              PIC X(06) VALUE
                   '010201'.
               10  FILLER              PIC X(06) VALUE
                   '010301'.
               10  FILLER              PIC X(06) VALUE
                   '010404'.
               10  FILLER              PIC X(06) VALUE
                   '010504'.
               10  FILLER              PIC X(06) VALUE
                   '010604'.
               10  FILLER              PIC X(06) VALUE
                   '010707'.
               10  FILLER              PIC X(06) VALUE
                   '010807'.
               10  FILLER              PIC X(06) VALUE
                   '010907'.
               10  FILLER              PIC X(06) VALUE
                   '100101'.
               10  FILLER              PIC X(06) VALUE
                   '100201'.
               10  FILLER              PIC X(06) VALUE
                   '100301'.
               10  FILLER              PIC X(06) VALUE
                   '100404'.
               10  FILLER              PIC X(06) VALUE
                   '100504'.
               10  FILLER              PIC X(06) VALUE
                   '100604'.
               10  FILLER              PIC X(06) VALUE
                   '100707'.
               10  FILLER              PIC X(06) VALUE
                   '100807'.
               10  FILLER              PIC X(06) VALUE
                   '100907'.
               10  FILLER              PIC X(06) VALUE
                   '190101'.
               10  FILLER              PIC X(06) VALUE
                   '190201'.
               10  FILLER              PIC X(06) VALUE
                   '190301'.
               10  FILLER              PIC X(06) VALUE
                   '190404'.
               10  FILLER              PIC X(06) VALUE
                   '190504'.
               10  FILLER              PIC X(06) VALUE
                   '190604'.
               10  FILLER              PIC X(06) VALUE
                   '190707'.
               10  FILLER              PIC X(06) VALUE
                   '190807'.
               10  FILLER              PIC X(06) VALUE
                   '190907'.
               10  FILLER              PIC X(06) VALUE
                   '280128'.
               10  FILLER              PIC X(06) VALUE
                   '280228'.
               10  FILLER              PIC X(06) VALUE
                   '280328'.
               10  FILLER              PIC X(06) VALUE
                   '280431'.
               10  FILLER              PIC X(06) VALUE
                   '280531'.
               10  FILLER              PIC X(06) VALUE
                   '280631'.
               10  FILLER              PIC X(06) VALUE
                   '280734'.
               10  FILLER              PIC X(06) VALUE
                   '280834'.
               10  FILLER              PIC X(06) VALUE
                   '280934'.
               10  FILLER              PIC X(06) VALUE
                   '370128'.
               10  FILLER              PIC X(06) VALUE
                   '370228'.
               10  FILLER              PIC X(06) VALUE
                   '370328'.
               10  FILLER              PIC X(06) VALUE
                   '370431'.
               10  FILLER              PIC X(06) VALUE
                   '370531'.
               10  FILLER              PIC X(06) VALUE
                   '370631'.
               10  FILLER              PIC X(06) VALUE
                   '370734'.
               10  FILLER              PIC X(06) VALUE
                   '370834'.
               10  FILLER              PIC X(06) VALUE
                   '370934'.
               10  FILLER              PIC X(06) VALUE
                   '460128'.
               10  FILLER              PIC X(06) VALUE
                   '460228'.
               10  FILLER              PIC X(06) VALUE
                   '460328'.
               10  FILLER              PIC X(06) VALUE
                   '460431'.
               10  FILLER              PIC X(06) VALUE
                   '460531'.
               10  FILLER              PIC X(06) VALUE
                   '460631'.
               10  FILLER              PIC X(06) VALUE
                   '460734'.
               10  FILLER              PIC X(06) VALUE
                   '460834'.
               10  FILLER              PIC X(06) VALUE
                   '460934'.
               10  FILLER              PIC X(06) VALUE
                   '550155'.
               10  FILLER              PIC X(06) VALUE
                   '550255'.
               10  FILLER              PIC X(06) VALUE
                   '550355'.
               10  FILLER              PIC X(06) VALUE
                   '550458'.
               10  FILLER              PIC X(06) VALUE
                   '550558'.
               10  FILLER              PIC X(06) VALUE
                   '550658'.
               10  FILLER              PIC X(06) VALUE
                   '550761'.
               10  FILLER              PIC X(06) VALUE
                   '550861'.
               10  FILLER              PIC X(06) VALUE
                   '550961'.
               10  FILLER              PIC X(06) VALUE
                   '640155'.
               10  FILLER              PIC X(06) VALUE
                   '640255'.
               10  FILLER              PIC X(06) VALUE
                   '640355'.
               10  FILLER              PIC X(06) VALUE
                   '640458'.
               10  FILLER              PIC X(06) VALUE
                   '640558'.
               10  FILLER              PIC X(06) VALUE
                   '640658'.
               10  FILLER              PIC X(06) VALUE
                   '640761'.
               10  FILLER              PIC X(06) VALUE
                   '640861'.
               10  FILLER              PIC X(06) VALUE
                   '640961'.
               10  FILLER              PIC X(06) VALUE
                   '730155'.
               10  FILLER              PIC X(06) VALUE
                   '730255'.
               10  FILLER              PIC X(06) VALUE
                   '730355'.
               10  FILLER              PIC X(06) VALUE
                   '730458'.
               10  FILLER              PIC X(06) VALUE
                   '730558'.
               10  FILLER              PIC X(06) VALUE
                   '730658'.
               10  FILLER              PIC X(06) VALUE
                   '730761'.
               10  FILLER              PIC X(06) VALUE
                   '730861'.
               10  FILLER              PIC X(06) VALUE
                   '730961'.
           05  ARRAY-B REDEFINES ARRAY-B-VALUES.
               10  ARRAY-B-ELEMENT     OCCURS 81.
                   15  ARRAY-B-H       PIC 9(02).
                   15  ARRAY-B-V       PIC 9(02).
                   15  ARRAY-B-S       PIC 9(02).
           05  ARRAY-C.
               10  ARRAY-C-ELEMENT     OCCURS 81.
                   15  ARRAY-C-NUM     PIC 9(02).
                   15  ARRAY-C-POSS    PIC 9(01).
           05  ARRAY-D-VALUES.
               10  FILLER              PIC X(06) VALUE
                   '010101'.
               10  FILLER              PIC X(06) VALUE
                   '100204'.
               10  FILLER              PIC X(06) VALUE
                   '190307'.
               10  FILLER              PIC X(06) VALUE
                   '280428'.
               10  FILLER              PIC X(06) VALUE
                   '370531'.
               10  FILLER              PIC X(06) VALUE
                   '460634'.
               10  FILLER              PIC X(06) VALUE
                   '550755'.
               10  FILLER              PIC X(06) VALUE
                   '640858'.
               10  FILLER              PIC X(06) VALUE
                   '730961'.
           05  ARRAY-D REDEFINES ARRAY-D-VALUES.
               10  ARRAY-D-ELEMENT     OCCURS 9.
                   15  ARRAY-D-H       PIC 9(02).
                   15  ARRAY-D-V       PIC 9(02).
                   15  ARRAY-D-S       PIC 9(02).
           05  ARRAY-E.
               10  ARRAY-E-POSS        OCCURS 9.
                   15  ARRAY-E-CNT     PIC 9(01).
                   15  ARRAY-E-CELL    OCCURS 9    PIC 9(02).
           05  ARRAY-H                 PIC X(891)  VALUE SPACES.

       01  WS-CARD.
           05  WS-CARD-VAL   OCCURS 9  PIC 9(01).
           05  FILLER                  PIC X(71)   VALUE SPACES.

       01  FILLER                  PIC X(32)             VALUE
                            '**SUDOKU WORKING-STORAGE END ***'.
      /
       PROCEDURE                       DIVISION.
      *---------                       ---------
       A-MAINLINE                      SECTION.
      *----------                      --------
       A-START.

           PERFORM V0000-INITIALIZATION.

           PERFORM X1000-OPEN.

           PERFORM S1000-PROCESS-INPUT.

           IF INPUT-ERR-W82 = '1'
               DISPLAY 'E001 INPUT ERROR'
               PERFORM Z999-ABEND.

           MOVE '1'                    TO CHANGED-W82.
           MOVE SPACES                 TO CONTRA-W82.

           MOVE SPACES                 TO DONE-W82.
           PERFORM A0000-ITERATIONS
               UNTIL (CHANGED-W82    = SPACES
                      AND CONTRA-W82 = SPACES)
                  OR  DONE-W82 = '1'.

           PERFORM P0000-DISPLAY.

           PERFORM X2000-CLOSE.

           GOBACK.

       A0000-ITERATIONS                SECTION.
      *----------------                --------

           ADD 1 TO A0000-CTR.

           MOVE '1'                    TO CHANGED-W82.
           PERFORM B0000-SWEEPS
               UNTIL CHANGED-W82 NOT = '1'

           IF DONE-W82 NOT = '1'
               PERFORM C0000-PROBES.

TEST***    MOVE '1' TO DONE-W82.
TEST       ADD 1 TO TEST-W81.
TEST       IF TEST-W81 > 10
TEST           MOVE '1' TO DONE-W82.

       A0000-EXIT.
           EXIT.

       B0000-SWEEPS                    SECTION.
      *------------                    --------

           ADD 1 TO B0000-CTR.

           MOVE SPACES                 TO CHANGED-W82.

           PERFORM M1000-BASIC-SWEEP.
           IF CONTRA-W82 = '1'
               IF PROBE-W82 = '1'
                   GO TO B0000-EXIT
               ELSE
                   DISPLAY 'E002 SETUP ERROR'
                   PERFORM Z999-ABEND
               END-IF
           ELSE
               IF CHANGED-W82 = '1'
                   GO TO B0000-EXIT
               ELSE
                   MOVE '1'            TO DONE-W82
                   PERFORM J0000-CHECK-DONE
                   IF DONE-W82 = '1'
                       GO TO B0000-EXIT
                   END-IF
               END-IF
           END-IF.

           PERFORM B3000-SINGLE.

           IF CHANGED-W82 = '1'
               GO TO B0000-EXIT
           ELSE
               MOVE '1'                TO DONE-W82
               PERFORM J0000-CHECK-DONE
               IF DONE-W82 = '1'
                   GO TO B0000-EXIT
               END-IF
           END-IF.

           PERFORM B1000-COMB2.

           IF  PROBE-W82 = '1'
           AND CONTRA-W82 = '1'
               GO TO B0000-EXIT.

           IF CHANGED-W82 = '1'
               GO TO B0000-EXIT
           ELSE
               MOVE '1'                TO DONE-W82
               PERFORM J0000-CHECK-DONE
               IF DONE-W82 = '1'
                   GO TO B0000-EXIT
               END-IF
           END-IF.

           PERFORM B4000-CHECKS.

           IF  PROBE-W82 = '1'
           AND CONTRA-W82 = '1'
               GO TO B0000-EXIT.

           IF CHANGED-W82 = '1'
               GO TO B0000-EXIT
           ELSE
               MOVE '1'                TO DONE-W82
               PERFORM J0000-CHECK-DONE
               IF DONE-W82 = '1'
                   GO TO B0000-EXIT
               END-IF
           END-IF.

           PERFORM B6000-COMB3.
           IF  PROBE-W82 = '1'
           AND CONTRA-W82 = '1'
               GO TO B0000-EXIT.

           IF CHANGED-W82 = '1'
               GO TO B0000-EXIT
           ELSE
               MOVE '1'                TO DONE-W82
               PERFORM J0000-CHECK-DONE
               IF DONE-W82 = '1'
                   GO TO B0000-EXIT
               END-IF
           END-IF.

       B0000-EXIT.
           EXIT.

       B1000-COMB2                     SECTION.
      *-----------                     --------

           ADD 1 TO B1000-CTR.

           PERFORM B1100-SWEEP VARYING SUB1 FROM 1 BY 1
                 UNTIL SUB1 > 81
                 OR CHANGED-W82 = '1'
                 OR CONTRA-W82 = '1'.

       B1000-EXIT.
           EXIT.

       B1100-SWEEP                     SECTION.
      *-----------                     --------

           ADD 1 TO B1100-CTR.

           IF ARRAY-A-VAL (SUB1, 10) NOT = 2
               GO TO B1100-EXIT.

           MOVE ZERO                   TO A-W81
                                          B-W81.

           PERFORM VARYING SUB2 FROM 1 BY 1
                 UNTIL SUB2 > 9
               IF ARRAY-A-VAL (SUB1, SUB2) > 0
                   IF A-W81 = 0
                       MOVE ARRAY-A-VAL (SUB1, SUB2)
                                       TO A-W81
                   ELSE
                       MOVE ARRAY-A-VAL (SUB1, SUB2)
                                       TO B-W81
                   END-IF
               END-IF
           END-PERFORM.

           IF A-W81 = 0
           OR B-W81 = 0
               IF PROBE-W82 = '1'
                   MOVE '1'            TO CONTRA-W82
                   GO TO B1100-EXIT
               ELSE
                   DISPLAY 'E003'
                   PERFORM Z999-ABEND
               END-IF
           END-IF.

           MOVE ZERO                   TO AB-W81
                                          AB-SUB.
           PERFORM B1110-H-1ST-PASS
               VARYING SUB2 FROM 1 BY 1
                   UNTIL SUB2 > 9
                     OR  CONTRA-W82 = '1'.

           IF CONTRA-W82 = '1'
               GO TO B1100-EXIT.

           IF AB-W81 > ZERO
               PERFORM B1120-H-2ND-PASS
                   VARYING SUB2 FROM 1 BY 1
                       UNTIL SUB2 > 9
               IF CHANGED-W82 = '1'
               OR CONTRA-W82  = '1'
                   GO TO B1100-EXIT
               END-IF
           END-IF.

           MOVE ZERO                   TO AB-W81
                                          AB-SUB.
           PERFORM B1130-V-1ST-PASS
               VARYING SUB2 FROM 1 BY 1
                   UNTIL SUB2 > 9
                     OR  CONTRA-W82 = '1'.

           IF CONTRA-W82 = '1'
               GO TO B1100-EXIT.

           IF AB-W81 > ZERO
               PERFORM B1140-V-2ND-PASS
                   VARYING SUB2 FROM 1 BY 1
                       UNTIL SUB2 > 9
               IF CHANGED-W82 = '1'
               OR CONTRA-W82  = '1'
                   GO TO B1100-EXIT
               END-IF
           END-IF.

           MOVE ZERO                   TO AB-W81
                                          AB-SUB.
           PERFORM B1150-S-1ST-PASS
               VARYING SUB2 FROM 1 BY 1
                   UNTIL SUB2 > 9
                     OR  CONTRA-W82 = '1'.

           IF CONTRA-W82 = '1'
               GO TO B1100-EXIT.

           IF AB-W81 > ZERO
               PERFORM B1160-S-2ND-PASS
                   VARYING SUB2 FROM 1 BY 1
                       UNTIL SUB2 > 9
               IF CHANGED-W82 = '1'
               OR CONTRA-W82  = '1'
                   GO TO B1100-EXIT
               END-IF
           END-IF.

       B1100-EXIT.
           EXIT.

       B1110-H-1ST-PASS                SECTION.
      *----------------                --------

           ADD 1 TO B1110-CTR.

           COMPUTE SUBX = ARRAY-B-H (SUB1) + SUB2 - 1.

           IF SUBX = SUB1
               GO TO B1110-EXIT.

           IF  ARRAY-A-VAL (SUBX, 10) NOT = 2
               GO TO B1110-EXIT.

           IF ARRAY-A-ELEMENT (SUB1) = ARRAY-A-ELEMENT (SUBX)
               IF AB-W81 < 1
                   ADD 1 TO AB-W81
                   MOVE SUBX           TO AB-SUB
               ELSE
                   IF PROBE-W82 = '1'
                       MOVE '1'        TO CONTRA-W82
                   ELSE
                       DISPLAY 'E004'
                       PERFORM Z999-ABEND
                   END-IF
               END-IF
           END-IF.

       B1110-EXIT.
           EXIT.

       B1120-H-2ND-PASS                SECTION.
      *----------------                --------

           ADD 1 TO B1120-CTR.

           COMPUTE SUBX = ARRAY-B-H (SUB1) + SUB2 - 1.

           IF SUBX = SUB1
           OR SUBX = AB-SUB
           OR ARRAY-A-VAL (SUBX, 10) = 1
               GO TO B1120-EXIT.

           PERFORM VARYING SUB3 FROM 1 BY 1
                 UNTIL SUB3 > 9
                   OR  CONTRA-W82 = '1'
               IF  ARRAY-A-VAL (SUBX, SUB3) = A-W81
                   MOVE ZERO           TO ARRAY-A-VAL (SUBX, SUB3)
                   DISPLAY 'B1120-H ' SUB1 SPACE AB-SUB SPACE A-W81
                       SPACE B-W81 SPACE SUBX SPACE A-W81
                   SUBTRACT 1 FROM ARRAY-A-VAL (SUBX, 10)
                   IF ARRAY-A-VAL (SUBX, 10) = ZERO
                       IF PROBE-W82 = '1'
                           MOVE '1'    TO CONTRA-W82
                       ELSE
                           DISPLAY 'E005'
                           PERFORM Z999-ABEND
                       END-IF
                   END-IF
                   IF ARRAY-A-VAL (SUBX, 10) = 1
                       MOVE 'B1120-H'  TO SOURCE-W700
                       MOVE SUBX       TO SUBM
                       PERFORM N9000-11
                   END-IF
                   MOVE '1'            TO CHANGED-W82
               END-IF
               IF  ARRAY-A-VAL (SUBX, SUB3) = B-W81
                   MOVE ZERO           TO ARRAY-A-VAL (SUBX, SUB3)
                   DISPLAY 'B1120-H ' SUB1 SPACE AB-SUB SPACE A-W81
                       SPACE B-W81 SPACE SUBX SPACE B-W81
                   SUBTRACT 1 FROM ARRAY-A-VAL (SUBX, 10)
                   IF ARRAY-A-VAL (SUBX, 10) = ZERO
                       IF PROBE-W82 = '1'
                           MOVE '1' TO CONTRA-W82
                       ELSE
                           DISPLAY 'E006'
                           PERFORM Z999-ABEND
                       END-IF
                   END-IF
                   IF ARRAY-A-VAL (SUBX, 10) = 1
                       MOVE 'B1120-H'  TO SOURCE-W700
                       MOVE SUBX       TO SUBM
                       PERFORM N9000-11
                   END-IF
                   MOVE '1'            TO CHANGED-W82
               END-IF
           END-PERFORM.

       B1120-EXIT.
           EXIT.

       B1130-V-1ST-PASS                SECTION.
      *----------------                --------

           ADD 1 TO B1130-CTR.

           COMPUTE SUBX = ARRAY-B-V (SUB1) + (9 * SUB2) - 9.

           IF SUBX = SUB1
               GO TO B1130-EXIT.

           IF  ARRAY-A-VAL (SUBX, 10) NOT = 2
               GO TO B1130-EXIT.

           IF ARRAY-A-ELEMENT (SUB1) = ARRAY-A-ELEMENT (SUBX)
               IF AB-W81 < 1
                   ADD 1 TO AB-W81
                   MOVE SUBX           TO AB-SUB
               ELSE
                   IF PROBE-W82 = '1'
                       MOVE '1'        TO CONTRA-W82
                   ELSE
                       DISPLAY 'E007'
                       PERFORM Z999-ABEND
                   END-IF
               END-IF
           END-IF.

       B1130-EXIT.
           EXIT.

       B1140-V-2ND-PASS                SECTION.
      *----------------                --------

           ADD 1 TO B1140-CTR.

           COMPUTE SUBX = ARRAY-B-V (SUB1) + (9 * SUB2) - 9.

           IF SUBX = SUB1
           OR SUBX = AB-SUB
           OR ARRAY-A-VAL (SUBX, 10) = 1
               GO TO B1140-EXIT.

           PERFORM VARYING SUB3 FROM 1 BY 1
                 UNTIL SUB3 > 9
                   OR  CONTRA-W82 = '1'
               IF  ARRAY-A-VAL (SUBX, SUB3) = A-W81
                   MOVE ZERO           TO ARRAY-A-VAL (SUBX, SUB3)
                   DISPLAY 'B1140-V ' SUB1 SPACE AB-SUB SPACE A-W81
                       SPACE B-W81 SPACE SUBX SPACE A-W81
                   SUBTRACT 1 FROM ARRAY-A-VAL (SUBX, 10)
                   IF ARRAY-A-VAL (SUBX, 10) = ZERO
                       IF PROBE-W82 = '1'
                           MOVE '1'    TO CONTRA-W82
                       ELSE
                           DISPLAY 'E008'
                           PERFORM Z999-ABEND
                       END-IF
                   END-IF
                   IF ARRAY-A-VAL (SUBX, 10) = 1
                       MOVE 'B1140-V'  TO SOURCE-W700
                       MOVE SUBX       TO SUBM
                       PERFORM N9000-11
                   END-IF
                   MOVE '1'            TO CHANGED-W82
               END-IF
               IF  ARRAY-A-VAL (SUBX, SUB3) = B-W81
                   MOVE ZERO           TO ARRAY-A-VAL (SUBX, SUB3)
                   DISPLAY 'B1140-V ' SUB1 SPACE AB-SUB SPACE A-W81
                       SPACE B-W81 SPACE SUBX SPACE B-W81
                   SUBTRACT 1 FROM ARRAY-A-VAL (SUBX, 10)
                   IF ARRAY-A-VAL (SUBX, 10) = ZERO
                       IF PROBE-W82 = '1'
                           MOVE '1'    TO CONTRA-W82
                       ELSE
                           DISPLAY 'E009'
                           PERFORM Z999-ABEND
                       END-IF
                   END-IF
                   IF ARRAY-A-VAL (SUBX, 10) = 1
                       MOVE 'B1140-V'  TO SOURCE-W700
                       MOVE SUBX       TO SUBM
                       PERFORM N9000-11
                   END-IF
                   MOVE '1'            TO CHANGED-W82
               END-IF
           END-PERFORM.

       B1140-EXIT.
           EXIT.

       B1150-S-1ST-PASS                SECTION.
      *----------------                --------

           ADD 1 TO B1150-CTR.

           SUBTRACT 1 FROM SUB2 GIVING SUB6.
           DIVIDE SUB6 BY 3 GIVING QUOTIENT-W81 REMAINDER REM-W81.
           COMPUTE SUBX =
                   ARRAY-B-S (SUB1) + 9 * QUOTIENT-W81 + REM-W81.

           IF SUBX = SUB1
               GO TO B1150-EXIT.

           IF  ARRAY-A-VAL (SUBX, 10) NOT = 2
               GO TO B1150-EXIT.

           IF ARRAY-A-ELEMENT (SUB1) = ARRAY-A-ELEMENT (SUBX)
               IF AB-W81 < 1
                   ADD 1 TO AB-W81
                   MOVE SUBX           TO AB-SUB
               ELSE
                   IF PROBE-W82 = '1'
                       MOVE '1'        TO CONTRA-W82
                   ELSE
                       DISPLAY 'E010'
                       PERFORM Z999-ABEND
                   END-IF
               END-IF
           END-IF.

       B1150-EXIT.
           EXIT.

       B1160-S-2ND-PASS                SECTION.
      *----------------                --------

           ADD 1 TO B1160-CTR.

           SUBTRACT 1 FROM SUB2 GIVING SUB6.
           DIVIDE SUB6 BY 3 GIVING QUOTIENT-W81 REMAINDER REM-W81.
           COMPUTE SUBX =
                   ARRAY-B-S (SUB1) + 9 * QUOTIENT-W81 + REM-W81.

           IF SUBX = SUB1
           OR SUBX = AB-SUB
           OR ARRAY-A-VAL (SUBX, 10) = 1
               GO TO B1160-EXIT.

           PERFORM VARYING SUB3 FROM 1 BY 1
                 UNTIL SUB3 > 9
                   OR  CONTRA-W82 = '1'
               IF  ARRAY-A-VAL (SUBX, SUB3) = A-W81
                   MOVE ZERO           TO ARRAY-A-VAL (SUBX, SUB3)
                   DISPLAY 'B1160-S ' SUB1 SPACE AB-SUB SPACE A-W81
                       SPACE B-W81 SPACE SUBX SPACE A-W81
                   SUBTRACT 1 FROM ARRAY-A-VAL (SUBX, 10)
                   IF ARRAY-A-VAL (SUBX, 10) = ZERO
                       IF PROBE-W82 = '1'
                           MOVE '1'    TO CONTRA-W82
                       ELSE
                           DISPLAY 'E011'
                           PERFORM Z999-ABEND
                       END-IF
                   END-IF
                   IF ARRAY-A-VAL (SUBX, 10) = 1
                       MOVE 'B1160-S'  TO SOURCE-W700
                       MOVE SUBX       TO SUBM
                       PERFORM N9000-11
                   END-IF
                   MOVE '1'            TO CHANGED-W82
               END-IF
               IF  ARRAY-A-VAL (SUBX, SUB3) = B-W81
                   MOVE ZERO           TO ARRAY-A-VAL (SUBX, SUB3)
                   DISPLAY 'B1160-S ' SUB1 SPACE AB-SUB SPACE A-W81
                       SPACE B-W81 SPACE SUBX SPACE B-W81
                   SUBTRACT 1 FROM ARRAY-A-VAL (SUBX, 10)
                   IF ARRAY-A-VAL (SUBX, 10) = ZERO
                       IF PROBE-W82 = '1'
                           MOVE '1'    TO CONTRA-W82
                       ELSE
                           DISPLAY 'E012'
                           PERFORM Z999-ABEND
                       END-IF
                   END-IF
                   IF ARRAY-A-VAL (SUBX, 10) = 1
                       MOVE 'B1160-S'  TO SOURCE-W700
                       MOVE SUBX       TO SUBM
                       PERFORM N9000-11
                   END-IF
                   MOVE '1'            TO CHANGED-W82
               END-IF
           END-PERFORM.

       B1160-EXIT.
           EXIT.

       B3000-SINGLE                    SECTION.
      *------------                    --------

           ADD 1 TO B3000-CTR.

           PERFORM B3100-SWEEP VARYING SUB15 FROM 1 BY 1
                 UNTIL SUB15 > 9.

       B3000-EXIT.
           EXIT.

       B3100-SWEEP                     SECTION.
      *-----------                     --------

           ADD 1 TO B3100-CTR.

           PERFORM B3110-H-SINGLE
               VARYING SUB16 FROM 1 BY 1
                   UNTIL SUB16 > 9.

           PERFORM B3120-V-SINGLE
               VARYING SUB16 FROM 1 BY 1
                   UNTIL SUB16 > 9.

           PERFORM B3130-S-SINGLE
               VARYING SUB16 FROM 1 BY 1
                   UNTIL SUB16 > 9.

       B3100-EXIT.
           EXIT.

       B3110-H-SINGLE                  SECTION.
      *--------------                  --------

           ADD 1 TO B3110-CTR.

           MOVE ZERO                   TO SINGLE-W81.

           PERFORM VARYING SUB2 FROM 1 BY 1
                 UNTIL SUB2 > 9
               COMPUTE SUBX = ARRAY-D-H (SUB15) + SUB2 - 1
               IF ARRAY-A-VAL (SUBX, SUB16) = SUB16
                   ADD 1               TO SINGLE-W81
                   MOVE SUBX           TO SUBY
               END-IF
           END-PERFORM.

           IF  SINGLE-W81 = 1
           AND ARRAY-A-VAL (SUBY, 10) NOT = 1
               MOVE 'B3110-H'          TO SOURCE-W700
               PERFORM B3900-SAVE-SINGLE
           END-IF.

       B3110-EXIT.
           EXIT.

       B3120-V-SINGLE                  SECTION.
      *--------------                  --------

           ADD 1 TO B3120-CTR.

           MOVE ZERO                   TO SINGLE-W81.

           PERFORM VARYING SUB2 FROM 1 BY 1
                 UNTIL SUB2 > 9
               COMPUTE SUBX = ARRAY-D-V (SUB15) + (9 * SUB2) - 9
               IF ARRAY-A-VAL (SUBX, SUB16) = SUB16
                   ADD 1               TO SINGLE-W81
                   MOVE SUBX           TO SUBY
               END-IF
           END-PERFORM.

           IF  SINGLE-W81 = 1
           AND ARRAY-A-VAL (SUBY, 10) NOT = 1
               MOVE 'B3120-V'          TO SOURCE-W700
               PERFORM B3900-SAVE-SINGLE
           END-IF.

       B3120-EXIT.
           EXIT.

       B3130-S-SINGLE                  SECTION.
      *--------------                  --------

           ADD 1 TO B3130-CTR.

           MOVE ZERO                   TO SINGLE-W81.

           PERFORM VARYING SUB2 FROM 1 BY 1
                 UNTIL SUB2 > 9
               SUBTRACT 1 FROM SUB2 GIVING SUB6
               DIVIDE SUB6 BY 3 GIVING QUOTIENT-W81 REMAINDER REM-W81
               COMPUTE SUBX =
                   ARRAY-D-S (SUB15) + 9 * QUOTIENT-W81 + REM-W81
               IF ARRAY-A-VAL (SUBX, SUB16) = SUB16
                   ADD 1               TO SINGLE-W81
                   MOVE SUBX           TO SUBY
               END-IF
           END-PERFORM.

           IF  SINGLE-W81 = 1
           AND ARRAY-A-VAL (SUBY, 10) NOT = 1
               MOVE 'B3130-S'          TO SOURCE-W700
               PERFORM B3900-SAVE-SINGLE
           END-IF.

       B3130-EXIT.
           EXIT.

       B3900-SAVE-SINGLE               SECTION.
      *-----------------               --------

           ADD 1 TO B3900-CTR.

           MOVE ALL '0'                TO ARRAY-A-ELEMENT (SUBY).
           MOVE 1                      TO ARRAY-A-VAL (SUBY, 10).
           MOVE SUB16                  TO ARRAY-A-VAL (SUBY, SUB16)
                                          ARRAY-A-VAL (SUBY, 11).
           MOVE '1'                    TO CHANGED-W82.
           DISPLAY 'B3900 ' SOURCE-W700 SPACE SUBY SPACE
               ARRAY-A-VAL (SUBY, 11).

       B3900-EXIT.
           EXIT.

       B4000-CHECKS                    SECTION.
      *------------                    --------

           ADD 1 TO B4000-CTR.

           PERFORM B4100-CHECK1
               VARYING SUB30 FROM 1 BY 1
                   UNTIL SUB30 > 9.

           IF PROBE-W82 = '1'
           AND CONTRA-W82 = '1'
               GO TO B4000-EXIT.

           PERFORM B4200-CHECK2
               VARYING SUB30 FROM 1 BY 1
                   UNTIL SUB30 > 9.

           IF PROBE-W82 = '1'
           AND CONTRA-W82 = '1'
               GO TO B4000-EXIT.

           PERFORM B4300-CHECK3
               VARYING SUB30 FROM 1 BY 1
                   UNTIL SUB30 > 9.

           IF PROBE-W82 = '1'
           AND CONTRA-W82 = '1'
               GO TO B4000-EXIT.

           PERFORM B4400-CHECK4
               VARYING SUB30 FROM 1 BY 1
                   UNTIL SUB30 > 9.

       B4000-EXIT.
           EXIT.

       B4100-CHECK1                    SECTION.
      *------------                    --------

           ADD 1 TO B4100-CTR.

           MOVE ALL '0'                TO ARRAY-E.

           MOVE 'SQR'                  TO B9903-TYPE.
           PERFORM B9903-TALLY
               VARYING SUB2 FROM 1 BY 1
                   UNTIL SUB2 > 9.

           MOVE 'B4100'                TO B9906-TYPE.
           PERFORM B9906-CHECK-TALLY
               VARYING SUB31 FROM 1 BY 1
                   UNTIL SUB31 > 9.

       B4100-EXIT.
           EXIT.

       B4200-CHECK2                    SECTION.
      *------------                    --------

           ADD 1 TO B4200-CTR.

           MOVE ALL '0'                TO ARRAY-E.

           MOVE 'ROW'                  TO B9903-TYPE.
           PERFORM B9903-TALLY
               VARYING SUB2 FROM 1 BY 1
                   UNTIL SUB2 > 9.

           MOVE 'B4200'                TO B9906-TYPE.
           PERFORM B9906-CHECK-TALLY
               VARYING SUB31 FROM 1 BY 1
                   UNTIL SUB31 > 9.

           IF  PROBE-W82 = '1'
           AND CONTRA-W82 = '1'
               GO TO B4200-EXIT.

           MOVE ALL '0'                TO ARRAY-E.

           MOVE 'COL'                  TO B9903-TYPE.
           PERFORM B9903-TALLY
               VARYING SUB2 FROM 1 BY 1
                   UNTIL SUB2 > 9.

           MOVE 'B4200'                TO B9906-TYPE.
           PERFORM B9906-CHECK-TALLY
               VARYING SUB31 FROM 1 BY 1
                   UNTIL SUB31 > 9.

       B4200-EXIT.
           EXIT.

       B4300-CHECK3                    SECTION.
      *------------                    --------

           ADD 1 TO B4300-CTR.

           MOVE ALL '0'                TO ARRAY-E.

           MOVE 'SQR'                  TO B9903-TYPE.
           PERFORM B9903-TALLY
               VARYING SUB2 FROM 1 BY 1
                   UNTIL SUB2 > 9.

           PERFORM B9901-CHECK-TALLY
               VARYING SUB31 FROM 1 BY 1
                   UNTIL SUB31 > 9.

       B4300-EXIT.
           EXIT.

       B4400-CHECK4                    SECTION.
      *------------                    --------

           ADD 1 TO B4400-CTR.

           MOVE ALL '0'                TO ARRAY-E.

           MOVE 'ROW'                  TO B9903-TYPE.
           PERFORM B9903-TALLY
               VARYING SUB2 FROM 1 BY 1
                   UNTIL SUB2 > 9.

           PERFORM B9901-CHECK-TALLY
               VARYING SUB31 FROM 1 BY 1
                   UNTIL SUB31 > 9.

           IF  PROBE-W82 = '1'
           AND CONTRA-W82 = '1'
               GO TO B4400-EXIT.

           MOVE ALL '0'                TO ARRAY-E.

           MOVE 'COL'                  TO B9903-TYPE.
           PERFORM B9903-TALLY
               VARYING SUB2 FROM 1 BY 1
                   UNTIL SUB2 > 9.

           PERFORM B9901-CHECK-TALLY
               VARYING SUB31 FROM 1 BY 1
                   UNTIL SUB31 > 9.

       B4400-EXIT.
           EXIT.

       B6000-COMB3                     SECTION.
      *------------                    --------

           ADD 1 TO B6000-CTR.

           PERFORM B6100-COMB3
               VARYING SUB30 FROM 1 BY 1
                   UNTIL SUB30 > 9
                   OR CHANGED-W82 = '1'
                   OR CONTRA-W82 = '1'.

           IF CHANGED-W82 = '1'
           OR CONTRA-W82 = '1'
               GO TO B6000-EXIT.

           PERFORM B6200-COMB3
               VARYING SUB30 FROM 1 BY 1
                   UNTIL SUB30 > 9
                   OR CHANGED-W82 = '1'
                   OR CONTRA-W82 = '1'.

       B6000-EXIT.
           EXIT.

       B6100-COMB3                     SECTION.
      *------------                    --------

           ADD 1 TO B6100-CTR.

           MOVE ALL '0'                TO ARRAY-E.

           MOVE 'ROW'                  TO B9903-TYPE.
           PERFORM B9903-TALLY
               VARYING SUB2 FROM 1 BY 1
                   UNTIL SUB2 > 9.

           PERFORM B9910-CHECK-TALLY
               VARYING SUB31 FROM 1 BY 1
                   UNTIL SUB31 > 9.

           IF CHANGED-W82 = '1'
               GO TO B6100-EXIT.

           IF  PROBE-W82 = '1'
           AND CONTRA-W82 = '1'
               GO TO B6100-EXIT.

           MOVE ALL '0'                TO ARRAY-E.

           MOVE 'COL'                  TO B9903-TYPE.
           PERFORM B9903-TALLY
               VARYING SUB2 FROM 1 BY 1
                   UNTIL SUB2 > 9.

           PERFORM B9910-CHECK-TALLY
               VARYING SUB31 FROM 1 BY 1
                   UNTIL SUB31 > 9.

           IF CHANGED-W82 = '1'
               GO TO B6100-EXIT.

           IF  PROBE-W82 = '1'
           AND CONTRA-W82 = '1'
               GO TO B6100-EXIT.

           MOVE ALL '0'                TO ARRAY-E.

           MOVE 'SQR'                  TO B9903-TYPE.
           PERFORM B9903-TALLY
               VARYING SUB2 FROM 1 BY 1
                   UNTIL SUB2 > 9.

           PERFORM B9910-CHECK-TALLY
               VARYING SUB31 FROM 1 BY 1
                   UNTIL SUB31 > 9.

       B6100-EXIT.
           EXIT.

       B6200-COMB3                     SECTION.
      *-----------                     --------

           ADD 1 TO B6200-CTR.

           MOVE 'ROW'                  TO B9916-TYPE.
           PERFORM B9916-CHECK-ARRAY
               VARYING SUB31 FROM 1 BY 1
                   UNTIL SUB31 > 9.

           IF CHANGED-W82 = '1'
               GO TO B6200-EXIT.

           IF  PROBE-W82 = '1'
           AND CONTRA-W82 = '1'
               GO TO B6200-EXIT.

           MOVE 'COL'                  TO B9916-TYPE.
           PERFORM B9916-CHECK-ARRAY
               VARYING SUB31 FROM 1 BY 1
                   UNTIL SUB31 > 9.

           IF CHANGED-W82 = '1'
               GO TO B6200-EXIT.

           IF  PROBE-W82 = '1'
           AND CONTRA-W82 = '1'
               GO TO B6200-EXIT.

           MOVE 'SQR'                  TO B9916-TYPE.
           PERFORM B9916-CHECK-ARRAY
               VARYING SUB31 FROM 1 BY 1
                   UNTIL SUB31 > 9.

       B6200-EXIT.
           EXIT.

       B9901-CHECK-TALLY               SECTION.
      *-----------------               --------

           ADD 1 TO B9901-CTR.

           IF  ARRAY-E-CNT (SUB31) NOT = 2
               GO TO B9901-EXIT.

           MOVE ZERO                   TO CELL-1-W700
                                          CELL-2-W700
                                          POSS-1-W700
                                          POSS-2-W700
                                          MATCH-W81.
           PERFORM VARYING SUB35 FROM 1 BY 1
                 UNTIL SUB35 > 9
               IF  ARRAY-E-POSS (SUB31) = ARRAY-E-POSS (SUB35)
               AND SUB31 > SUB35
                   IF MATCH-W81 > ZERO
                       IF PROBE-W82 = '1'
                           MOVE '1'            TO CONTRA-W82
                           MOVE 10             TO SUB35
                       ELSE
                           DISPLAY 'E026'
                           PERFORM Z999-ABEND
                       END-IF
                   ELSE
                       ADD 1 TO MATCH-W81
                       MOVE ARRAY-E-CELL (SUB31, 1)
                                       TO CELL-1-W700
                       MOVE ARRAY-E-CELL (SUB31, 2)
                                       TO CELL-2-W700
                       MOVE SUB31      TO POSS-1-W700
                       MOVE SUB35      TO POSS-2-W700
                       PERFORM B9905-ELIMINATE-POSS
                   END-IF
               END-IF
           END-PERFORM.

       B9901-EXIT.
           EXIT.

       B9903-TALLY                     SECTION.
      *-----------                     --------

           ADD 1 TO B9903-CTR.

           IF B9903-TYPE = 'ROW'
               COMPUTE SUBX = ARRAY-D-H (SUB30) + SUB2 - 1
           ELSE
               IF B9903-TYPE = 'COL'
                   COMPUTE SUBX = ARRAY-D-V (SUB30) + (9 * SUB2) - 9
               ELSE
                   SUBTRACT 1 FROM SUB2 GIVING SUB6
                   DIVIDE SUB6 BY 3
                       GIVING QUOTIENT-W81 REMAINDER REM-W81
                   COMPUTE SUBX =
                       ARRAY-D-S (SUB30) + 9 * QUOTIENT-W81 + REM-W81
               END-IF
           END-IF.

           PERFORM VARYING SUB31 FROM 1 BY 1
                 UNTIL SUB31 > 9
               IF ARRAY-A-VAL (SUBX, SUB31) = SUB31
                   ADD 1 TO ARRAY-E-CNT (SUB31)
                   MOVE ARRAY-E-CNT (SUB31)
                                       TO SUB32
                   MOVE SUBX           TO ARRAY-E-CELL (SUB31, SUB32)
               END-IF
           END-PERFORM.

       B9903-EXIT.
           EXIT.

       B9905-ELIMINATE-POSS            SECTION.
      *--------------------            --------

           ADD 1 TO B9905-CTR.

           PERFORM VARYING SUB36 FROM 1 BY 1
                 UNTIL SUB36 > 9
               IF  ARRAY-A-VAL (CELL-1-W700, SUB36) NOT = POSS-1-W700
               AND ARRAY-A-VAL (CELL-1-W700, SUB36) NOT = POSS-2-W700
               AND ARRAY-A-VAL (CELL-1-W700, SUB36) NOT = ZERO
                   MOVE ZERO           TO ARRAY-A-VAL
                                            (CELL-1-W700, SUB36)
                   DISPLAY 'B9905 ' B9903-TYPE SPACE CELL-1-W700
                       SPACE CELL-2-W700 SPACE POSS-1-W700 SPACE
                       POSS-2-W700 SPACE CELL-1-W700 SPACE SUB36
                   SUBTRACT 1 FROM ARRAY-A-VAL (CELL-1-W700, 10)
                   IF ARRAY-A-VAL (CELL-1-W700, 10) = ZERO
                       IF PROBE-W82 = '1'
                           MOVE '1'            TO CONTRA-W82
                           MOVE 10             TO SUB36
                       ELSE
                           DISPLAY 'E027'
                           PERFORM Z999-ABEND
                       END-IF
                   ELSE
                       MOVE '1'        TO CHANGED-W82
                       IF ARRAY-A-VAL (CELL-1-W700, 10) = 1
                           MOVE 'B9905'
                                       TO SOURCE-W700
                           MOVE CELL-1-W700
                                       TO SUBM
                           PERFORM N9000-11
                       END-IF
                   END-IF
               END-IF
           END-PERFORM.

           IF  PROBE-W82 = '1'
           AND CONTRA-W82 = '1'
               GO TO B9905-EXIT.

           PERFORM VARYING SUB36 FROM 1 BY 1
                 UNTIL SUB36 > 9
               IF  ARRAY-A-VAL (CELL-2-W700, SUB36) NOT = POSS-1-W700
               AND ARRAY-A-VAL (CELL-2-W700, SUB36) NOT = POSS-2-W700
               AND ARRAY-A-VAL (CELL-2-W700, SUB36) NOT = ZERO
                   MOVE ZERO           TO ARRAY-A-VAL
                                            (CELL-2-W700, SUB36)
                   DISPLAY 'B9905 ' B9903-TYPE SPACE CELL-1-W700
                       SPACE CELL-2-W700 SPACE POSS-1-W700 SPACE
                       POSS-2-W700 SPACE CELL-2-W700 SPACE SUB36
                   SUBTRACT 1 FROM ARRAY-A-VAL (CELL-2-W700, 10)
                   IF ARRAY-A-VAL (CELL-2-W700, 10) = ZERO
                       IF PROBE-W82 = '1'
                           MOVE '1'            TO CONTRA-W82
                           MOVE 10             TO SUB36
                       ELSE
                           DISPLAY 'E028'
                           PERFORM Z999-ABEND
                       END-IF
                   ELSE
                       MOVE '1'        TO CHANGED-W82
                       IF ARRAY-A-VAL (CELL-2-W700, 10) = 1
                           MOVE 'B9905'
                                       TO SOURCE-W700
                           MOVE CELL-2-W700
                                       TO SUBM
                           PERFORM N9000-11
                       END-IF
                   END-IF
               END-IF
           END-PERFORM.

       B9905-EXIT.
           EXIT.

       B9906-CHECK-TALLY               SECTION.
      *-----------------               --------

           ADD 1 TO B9906-CTR.

           IF  ARRAY-E-CNT (SUB31) NOT = 2
           AND ARRAY-E-CNT (SUB31) NOT = 3
               GO TO B9906-EXIT.

           MOVE ARRAY-E-CELL (SUB31, 1)
                                       TO CELL-1-W700.
           MOVE ARRAY-E-CELL (SUB31, 2)
                                       TO CELL-2-W700.
           IF ARRAY-E-CNT (SUB31) = 3
               MOVE ARRAY-E-CELL (SUB31, 3)
                                       TO CELL-3-W700
           ELSE
               MOVE ZERO               TO CELL-3-W700.

           IF B9906-TYPE = 'B4200'
               GO TO B9906-SQR.

           MOVE SPACE                  TO FOUND-W82.

           IF CELL-3-W700 = ZERO
               IF ARRAY-B-H (CELL-1-W700) = ARRAY-B-H (CELL-2-W700)
                   MOVE '1'            TO FOUND-W82
               END-IF
           ELSE
               IF  ARRAY-B-H (CELL-1-W700) = ARRAY-B-H (CELL-2-W700)
               AND ARRAY-B-H (CELL-1-W700) = ARRAY-B-H (CELL-3-W700)
                   MOVE '1'            TO FOUND-W82
               END-IF
           END-IF.

           IF FOUND-W82 = '1'
               MOVE 'ROW'              TO B9907-TYPE
               PERFORM B9907-ELIMINATE
               GO TO B9906-EXIT.

           IF  PROBE-W82 = '1'
           AND CONTRA-W82 = '1'
               GO TO B9906-EXIT.

           IF CELL-3-W700 = ZERO
               IF ARRAY-B-V (CELL-1-W700) = ARRAY-B-V (CELL-2-W700)
                   MOVE '1'            TO FOUND-W82
               END-IF
           ELSE
               IF  ARRAY-B-V (CELL-1-W700) = ARRAY-B-V (CELL-2-W700)
               AND ARRAY-B-V (CELL-1-W700) = ARRAY-B-V (CELL-3-W700)
                   MOVE '1'            TO FOUND-W82
               END-IF
           END-IF.

           IF FOUND-W82 = '1'
               MOVE 'COL'              TO B9907-TYPE
               PERFORM B9907-ELIMINATE.

           GO TO B9906-EXIT.

       B9906-SQR.

           MOVE SPACE                  TO FOUND-W82.

           IF CELL-3-W700 = ZERO
               IF ARRAY-B-S (CELL-1-W700) = ARRAY-B-S (CELL-2-W700)
                   MOVE '1'            TO FOUND-W82
               END-IF
           ELSE
               IF  ARRAY-B-S (CELL-1-W700) = ARRAY-B-S (CELL-2-W700)
               AND ARRAY-B-S (CELL-1-W700) = ARRAY-B-S (CELL-3-W700)
                   MOVE '1'            TO FOUND-W82
               END-IF
           END-IF.

           IF FOUND-W82 = '1'
               MOVE 'SQR'              TO B9907-TYPE
               PERFORM B9907-ELIMINATE.

       B9906-EXIT.
           EXIT.

       B9907-ELIMINATE                 SECTION.
      *---------------                 --------

           ADD 1 TO B9907-CTR.

           IF B9907-TYPE = 'ROW'
               MOVE ARRAY-B-H (CELL-1-W700)
                                       TO ROW-W700
           ELSE
               IF B9907-TYPE = 'COL'
                   MOVE ARRAY-B-V (CELL-1-W700)
                                       TO COL-W700
               ELSE
                   IF B9907-TYPE = 'SQR'
                       MOVE ARRAY-B-S (CELL-1-W700)
                                       TO SQR-W700
                   END-IF
               END-IF
           END-IF.

           PERFORM VARYING SUB33 FROM 1 BY 1
                 UNTIL SUB33 > 9
               IF B9907-TYPE = 'ROW'
                   COMPUTE SUB34 = ROW-W700 + SUB33 - 1
               ELSE
                   IF B9907-TYPE = 'COL'
                       COMPUTE SUB34 = COL-W700 + (9 * SUB33) - 9
                   ELSE
                       IF B9907-TYPE = 'SQR'
                           SUBTRACT 1 FROM SUB33 GIVING SUB6
                           DIVIDE SUB6 BY 3
                               GIVING QUOTIENT-W81 REMAINDER REM-W81
                           COMPUTE SUB34 =
                               SQR-W700 + 9 * QUOTIENT-W81 + REM-W81
                       END-IF
                   END-IF
               END-IF
               IF  SUB34 NOT = CELL-1-W700
               AND SUB34 NOT = CELL-2-W700
               AND SUB34 NOT = CELL-3-W700
                   IF ARRAY-A-VAL (SUB34, SUB31) NOT = ZERO
                       MOVE ZERO       TO ARRAY-A-VAL (SUB34, SUB31)
                       DISPLAY 'B9907 ' B9906-TYPE SPACE B9907-TYPE
                           SPACE CELL-1-W700 SPACE CELL-2-W700 SPACE
                           CELL-3-W700 SPACE SUB34 SPACE SUB31
                       SUBTRACT 1 FROM ARRAY-A-VAL (SUB34, 10)
                       IF ARRAY-A-VAL (SUB34, 10) = 0
                           IF PROBE-W82 = '1'
                               MOVE '1'
                                       TO CONTRA-W82
                           ELSE
                               DISPLAY 'E029'
                               PERFORM Z999-ABEND
                           END-IF
                       ELSE
                           MOVE '1'    TO CHANGED-W82
                           IF ARRAY-A-VAL (SUB34, 10) = 1
                               MOVE 'B9907'
                                       TO SOURCE-W700
                               MOVE SUB34
                                       TO SUBM
                               PERFORM N9000-11
                           END-IF
                       END-IF
                   END-IF
               END-IF
           END-PERFORM.

       B9907-EXIT.
           EXIT.

       B9910-CHECK-TALLY               SECTION.
      *-----------------               --------

           ADD 1 TO B9910-CTR.

           IF  ARRAY-E-CNT (SUB31) NOT = 2 AND NOT = 3
               GO TO B9910-EXIT.

           MOVE ALL '0'                TO WAGON-W700
                                          PTS-W700.
           MOVE SUB31                  TO PT1-W700.

           MOVE ARRAY-E-CELL (SUB31, 1)
                                       TO WAGON-RIDER-W700 (1).
           MOVE ARRAY-E-CELL (SUB31, 2)
                                       TO WAGON-RIDER-W700 (2).
           IF  ARRAY-E-CNT (SUB31) = 3
               MOVE ARRAY-E-CELL (SUB31, 3)
                                       TO WAGON-RIDER-W700 (3)
               MOVE 3                  TO WAGON-CNT-W700
           ELSE
               MOVE 2                  TO WAGON-CNT-W700
           END-IF.

           PERFORM VARYING SUB35 FROM 1 BY 1
                 UNTIL SUB35 > 9
               IF  (ARRAY-E-CNT (SUB35) = 2 OR 3)
               AND  SUB31 NOT = SUB35
                   IF  WAGON-CNT-W700 = 2
                   AND ARRAY-E-CNT (SUB35) = 2
                       PERFORM B9911-2-2
                   ELSE
                       IF  WAGON-CNT-W700 = 2
                       AND ARRAY-E-CNT (SUB35) = 3
                           PERFORM B9912-2-3
                       ELSE
                           IF  WAGON-CNT-W700 = 3
                           AND ARRAY-E-CNT (SUB35) = 2
                               PERFORM B9913-3-2
                           ELSE
                               IF  WAGON-CNT-W700 = 3
                               AND ARRAY-E-CNT (SUB35) = 3
                                   PERFORM B9914-3-3
                               END-IF
                           END-IF
                       END-IF
                   END-IF
               END-IF
           END-PERFORM.

           IF  WAGON-CNT-W700 = 3
           AND PT2-W700 > ZERO
           AND PT3-W700 > ZERO
               MOVE WAGON-RIDER-W700 (1)
                                       TO CELL-1-W700
               MOVE WAGON-RIDER-W700 (2)
                                       TO CELL-2-W700
               MOVE WAGON-RIDER-W700 (3)
                                       TO CELL-3-W700
               MOVE PT1-W700           TO POSS-1-W700
               MOVE PT2-W700           TO POSS-2-W700
               MOVE PT3-W700           TO POSS-3-W700
               PERFORM B9915-ELIMINATE-POSS
               IF CHANGED-W82 = '1'
                   MOVE 10             TO SUB31
               END-IF
           END-IF.

       B9910-EXIT.
           EXIT.

       B9911-2-2                       SECTION.
      *---------                       --------

           ADD 1 TO B9911-CTR.

           IF  WAGON-RIDER-W700 (1) NOT = ARRAY-E-CELL (SUB35, 1)
           AND WAGON-RIDER-W700 (2) NOT = ARRAY-E-CELL (SUB35, 1)
           AND WAGON-RIDER-W700 (1) NOT = ARRAY-E-CELL (SUB35, 2)
           AND WAGON-RIDER-W700 (2) NOT = ARRAY-E-CELL (SUB35, 2)
               GO TO B9911-EXIT.

           IF  (WAGON-RIDER-W700 (1) = ARRAY-E-CELL (SUB35, 1)
           OR   WAGON-RIDER-W700 (2) = ARRAY-E-CELL (SUB35, 1))
           AND (WAGON-RIDER-W700 (1) = ARRAY-E-CELL (SUB35, 2)
           OR   WAGON-RIDER-W700 (2) = ARRAY-E-CELL (SUB35, 2))
               IF PT2-W700 = ZERO
                   MOVE SUB35          TO PT2-W700
               ELSE
                   IF PT3-W700 > ZERO
                       MOVE 10         TO SUB35
                       MOVE ALL '0'    TO WAGON-W700
                                          PTS-W700
                       GO TO B9911-EXIT
                   ELSE
                       MOVE SUB35      TO PT3-W700
                   END-IF
               END-IF
               GO TO B9911-EXIT
           END-IF.

           IF PT2-W700 = ZERO
               MOVE SUB35              TO PT2-W700
           ELSE
               IF PT3-W700 > ZERO
                   MOVE 10             TO SUB35
                   MOVE ALL '0'        TO WAGON-W700
                                          PTS-W700
                   GO TO B9911-EXIT
               ELSE
                   MOVE SUB35          TO PT3-W700
               END-IF
           END-IF.
           IF  ARRAY-E-CELL (SUB35, 1) NOT = WAGON-RIDER-W700 (1)
           AND ARRAY-E-CELL (SUB35, 1) NOT = WAGON-RIDER-W700 (2)
               MOVE ARRAY-E-CELL (SUB35, 1)
                                       TO WAGON-RIDER-W700 (3)
           ELSE
               MOVE ARRAY-E-CELL (SUB35, 2)
                                       TO WAGON-RIDER-W700 (3)
           END-IF.
           ADD 1 TO WAGON-CNT-W700.

       B9911-EXIT.
           EXIT.

       B9912-2-3                       SECTION.
      *---------                       --------

           ADD 1 TO B9912-CTR.

           IF  WAGON-RIDER-W700 (1) NOT = ARRAY-E-CELL (SUB35, 1)
           AND WAGON-RIDER-W700 (1) NOT = ARRAY-E-CELL (SUB35, 2)
           AND WAGON-RIDER-W700 (1) NOT = ARRAY-E-CELL (SUB35, 3)
           AND WAGON-RIDER-W700 (2) NOT = ARRAY-E-CELL (SUB35, 1)
           AND WAGON-RIDER-W700 (2) NOT = ARRAY-E-CELL (SUB35, 2)
           AND WAGON-RIDER-W700 (2) NOT = ARRAY-E-CELL (SUB35, 3)
               GO TO B9912-EXIT.

           IF  (WAGON-RIDER-W700 (1) = ARRAY-E-CELL (SUB35, 1)
           OR   WAGON-RIDER-W700 (1) = ARRAY-E-CELL (SUB35, 2)
           OR   WAGON-RIDER-W700 (1) = ARRAY-E-CELL (SUB35, 3))
           AND (WAGON-RIDER-W700 (2) = ARRAY-E-CELL (SUB35, 1)
           OR   WAGON-RIDER-W700 (2) = ARRAY-E-CELL (SUB35, 2)
           OR   WAGON-RIDER-W700 (2) = ARRAY-E-CELL (SUB35, 3))
               IF PT2-W700 = ZERO
                   MOVE SUB35          TO PT2-W700
               ELSE
                   IF PT3-W700 > ZERO
                       MOVE 10         TO SUB35
                       MOVE ALL '0'    TO WAGON-W700
                                          PTS-W700
                       GO TO B9912-EXIT
                   ELSE
                       MOVE SUB35      TO PT3-W700
                   END-IF
               END-IF
               MOVE ARRAY-E-CELL (SUB35, 1)
                                       TO  WAGON-RIDER-W700 (1)
               MOVE ARRAY-E-CELL (SUB35, 2)
                                       TO  WAGON-RIDER-W700 (2)
               MOVE ARRAY-E-CELL (SUB35, 3)
                                       TO  WAGON-RIDER-W700 (3)
               MOVE 3                  TO  WAGON-CNT-W700
               GO TO B9912-EXIT
           END-IF.

           MOVE 10                     TO SUB35.
           MOVE ALL '0'                TO WAGON-W700
                                          PTS-W700.

       B9912-EXIT.
           EXIT.

       B9913-3-2                       SECTION.
      *---------                       --------

           ADD 1 TO B9913-CTR.

           IF  WAGON-RIDER-W700 (1) NOT = ARRAY-E-CELL (SUB35, 1)
           AND WAGON-RIDER-W700 (1) NOT = ARRAY-E-CELL (SUB35, 2)
           AND WAGON-RIDER-W700 (2) NOT = ARRAY-E-CELL (SUB35, 1)
           AND WAGON-RIDER-W700 (2) NOT = ARRAY-E-CELL (SUB35, 2)
           AND WAGON-RIDER-W700 (3) NOT = ARRAY-E-CELL (SUB35, 1)
           AND WAGON-RIDER-W700 (3) NOT = ARRAY-E-CELL (SUB35, 2)
               GO TO B9913-EXIT.

           IF  (WAGON-RIDER-W700 (1) = ARRAY-E-CELL (SUB35, 1)
           OR   WAGON-RIDER-W700 (2) = ARRAY-E-CELL (SUB35, 1)
           OR   WAGON-RIDER-W700 (3) = ARRAY-E-CELL (SUB35, 1))
           AND (WAGON-RIDER-W700 (1) = ARRAY-E-CELL (SUB35, 2)
           OR   WAGON-RIDER-W700 (2) = ARRAY-E-CELL (SUB35, 2)
           OR   WAGON-RIDER-W700 (3) = ARRAY-E-CELL (SUB35, 2))
               IF PT2-W700 = ZERO
                   MOVE SUB35          TO PT2-W700
               ELSE
                   IF PT3-W700 > ZERO
                       MOVE 10         TO SUB35
                       MOVE ALL '0'    TO WAGON-W700
                                          PTS-W700
                       GO TO B9913-EXIT
                   ELSE
                       MOVE SUB35      TO PT3-W700
                   END-IF
               END-IF
               GO TO B9913-EXIT
           END-IF.

           MOVE 10                     TO SUB35.
           MOVE ALL '0'                TO WAGON-W700
                                          PTS-W700.

       B9913-EXIT.
           EXIT.

       B9914-3-3                       SECTION.
      *---------                       --------

           ADD 1 TO B9914-CTR.

           IF  WAGON-RIDER-W700 (1) NOT = ARRAY-E-CELL (SUB35, 1)
           AND WAGON-RIDER-W700 (1) NOT = ARRAY-E-CELL (SUB35, 2)
           AND WAGON-RIDER-W700 (1) NOT = ARRAY-E-CELL (SUB35, 3)
           AND WAGON-RIDER-W700 (2) NOT = ARRAY-E-CELL (SUB35, 1)
           AND WAGON-RIDER-W700 (2) NOT = ARRAY-E-CELL (SUB35, 2)
           AND WAGON-RIDER-W700 (2) NOT = ARRAY-E-CELL (SUB35, 3)
           AND WAGON-RIDER-W700 (3) NOT = ARRAY-E-CELL (SUB35, 1)
           AND WAGON-RIDER-W700 (3) NOT = ARRAY-E-CELL (SUB35, 2)
           AND WAGON-RIDER-W700 (3) NOT = ARRAY-E-CELL (SUB35, 3)
               GO TO B9914-EXIT.

           IF  (WAGON-RIDER-W700 (1) = ARRAY-E-CELL (SUB35, 1)
           OR   WAGON-RIDER-W700 (2) = ARRAY-E-CELL (SUB35, 1)
           OR   WAGON-RIDER-W700 (3) = ARRAY-E-CELL (SUB35, 1))
           AND (WAGON-RIDER-W700 (1) = ARRAY-E-CELL (SUB35, 2)
           OR   WAGON-RIDER-W700 (2) = ARRAY-E-CELL (SUB35, 2)
           OR   WAGON-RIDER-W700 (3) = ARRAY-E-CELL (SUB35, 2))
           AND (WAGON-RIDER-W700 (1) = ARRAY-E-CELL (SUB35, 3)
           OR   WAGON-RIDER-W700 (2) = ARRAY-E-CELL (SUB35, 3)
           OR   WAGON-RIDER-W700 (3) = ARRAY-E-CELL (SUB35, 3))
               IF PT2-W700 = ZERO
                   MOVE SUB35          TO PT2-W700
               ELSE
                   IF PT3-W700 > ZERO
                       MOVE 10         TO SUB35
                       MOVE ALL '0'    TO WAGON-W700
                                          PTS-W700
                       GO TO B9914-EXIT
                   ELSE
                       MOVE SUB35      TO PT3-W700
                   END-IF
               END-IF
               GO TO B9914-EXIT

           MOVE 10                     TO SUB35.
           MOVE ALL '0'                TO WAGON-W700
                                          PTS-W700.

       B9914-EXIT.
           EXIT.

       B9915-ELIMINATE-POSS            SECTION.
      *--------------------            --------

           ADD 1 TO B9915-CTR.

           PERFORM VARYING SUB36 FROM 1 BY 1
                 UNTIL SUB36 > 9
               IF  ARRAY-A-VAL (CELL-1-W700, SUB36) NOT = ZERO
               AND ARRAY-A-VAL (CELL-1-W700, SUB36) NOT = POSS-1-W700
               AND ARRAY-A-VAL (CELL-1-W700, SUB36) NOT = POSS-2-W700
               AND ARRAY-A-VAL (CELL-1-W700, SUB36) NOT = POSS-3-W700
                   MOVE ZERO           TO ARRAY-A-VAL
                                            (CELL-1-W700, SUB36)
                   DISPLAY 'B9915 ' B9903-TYPE SPACE CELL-1-W700 SPACE
                       CELL-2-W700 SPACE CELL-3-W700 SPACE POSS-1-W700
                       SPACE POSS-2-W700 SPACE POSS-3-W700 SPACE
                       CELL-1-W700 SPACE SUB36
                   SUBTRACT 1 FROM ARRAY-A-VAL (CELL-1-W700, 10)
                   IF ARRAY-A-VAL (CELL-1-W700, 10) = ZERO
                       IF PROBE-W82 = '1'
                           MOVE '1'            TO CONTRA-W82
                           MOVE 10             TO SUB36
                       ELSE
                           DISPLAY 'E033'
                           PERFORM Z999-ABEND
                       END-IF
                   ELSE
                       MOVE '1'        TO CHANGED-W82
                       IF ARRAY-A-VAL (CELL-1-W700, 10) = 1
                           MOVE 'B9915'
                                       TO SOURCE-W700
                           MOVE CELL-1-W700
                                       TO SUBM
                           PERFORM N9000-11
                       END-IF
                   END-IF
               END-IF
           END-PERFORM.

           IF  PROBE-W82 = '1'
           AND CONTRA-W82 = '1'
               GO TO B9915-EXIT.

           PERFORM VARYING SUB36 FROM 1 BY 1
                 UNTIL SUB36 > 9
               IF  ARRAY-A-VAL (CELL-2-W700, SUB36) NOT = ZERO
               AND ARRAY-A-VAL (CELL-2-W700, SUB36) NOT = POSS-1-W700
               AND ARRAY-A-VAL (CELL-2-W700, SUB36) NOT = POSS-2-W700
               AND ARRAY-A-VAL (CELL-2-W700, SUB36) NOT = POSS-3-W700
                   MOVE ZERO           TO ARRAY-A-VAL
                                            (CELL-2-W700, SUB36)
                   DISPLAY 'B9915 ' B9903-TYPE SPACE CELL-1-W700 SPACE
                       CELL-2-W700 SPACE CELL-3-W700 SPACE POSS-1-W700
                       SPACE POSS-2-W700 SPACE POSS-3-W700 SPACE
                       CELL-2-W700 SPACE SUB36
                   SUBTRACT 1 FROM ARRAY-A-VAL (CELL-2-W700, 10)
                   IF ARRAY-A-VAL (CELL-2-W700, 10) = ZERO
                       IF PROBE-W82 = '1'
                           MOVE '1'            TO CONTRA-W82
                           MOVE 10             TO SUB36
                       ELSE
                           DISPLAY 'E034'
                           PERFORM Z999-ABEND
                       END-IF
                   ELSE
                       MOVE '1'        TO CHANGED-W82
                       IF ARRAY-A-VAL (CELL-2-W700, 10) = 1
                           MOVE 'B9915'
                                       TO SOURCE-W700
                           MOVE CELL-2-W700
                                       TO SUBM
                           PERFORM N9000-11
                       END-IF
                   END-IF
               END-IF
           END-PERFORM.

           IF  PROBE-W82 = '1'
           AND CONTRA-W82 = '1'
               GO TO B9915-EXIT.

           PERFORM VARYING SUB36 FROM 1 BY 1
                 UNTIL SUB36 > 9
               IF  ARRAY-A-VAL (CELL-3-W700, SUB36) NOT = ZERO
               AND ARRAY-A-VAL (CELL-3-W700, SUB36) NOT = POSS-1-W700
               AND ARRAY-A-VAL (CELL-3-W700, SUB36) NOT = POSS-2-W700
               AND ARRAY-A-VAL (CELL-3-W700, SUB36) NOT = POSS-3-W700
                   MOVE ZERO           TO ARRAY-A-VAL
                                            (CELL-3-W700, SUB36)
                   DISPLAY 'B9915 ' B9903-TYPE SPACE CELL-1-W700 SPACE
                       CELL-2-W700 SPACE CELL-3-W700 SPACE POSS-1-W700
                       SPACE POSS-2-W700 SPACE POSS-3-W700 SPACE
                       CELL-3-W700 SPACE SUB36
                   SUBTRACT 1 FROM ARRAY-A-VAL (CELL-3-W700, 10)
                   IF ARRAY-A-VAL (CELL-3-W700, 10) = ZERO
                       IF PROBE-W82 = '1'
                           MOVE '1'            TO CONTRA-W82
                           MOVE 10             TO SUB36
                       ELSE
                           DISPLAY 'E035'
                           PERFORM Z999-ABEND
                       END-IF
                   ELSE
                       MOVE '1'        TO CHANGED-W82
                       IF ARRAY-A-VAL (CELL-3-W700, 10) = 1
                           MOVE 'B9915'
                                       TO SOURCE-W700
                           MOVE CELL-3-W700
                                       TO SUBM
                           PERFORM N9000-11
                       END-IF
                   END-IF
               END-IF
           END-PERFORM.

       B9915-EXIT.
           EXIT.

       B9916-CHECK-ARRAY               SECTION.
      *-----------------               --------

           ADD 1 TO B9916-CTR.

           IF B9916-TYPE = 'ROW'
               COMPUTE SUBX = ARRAY-D-H (SUB30) + SUB31 - 1
           ELSE
               IF B9916-TYPE = 'COL'
                   COMPUTE SUBX = ARRAY-D-V (SUB30) + (9 * SUB31) - 9
               ELSE
                   SUBTRACT 1 FROM SUB31 GIVING SUB6
                   DIVIDE SUB6 BY 3
                       GIVING QUOTIENT-W81 REMAINDER REM-W81
                   COMPUTE SUBX =
                       ARRAY-D-S (SUB30) + 9 * QUOTIENT-W81 + REM-W81
               END-IF
           END-IF.

           IF  ARRAY-A-VAL (SUBX, 10) NOT = 2 AND NOT = 3
               GO TO B9916-EXIT.

           MOVE ALL '0'                TO WAGON-W700
                                          PTS-W700.
           MOVE SUBX                   TO PT1-W700.

           PERFORM VARYING SUB35 FROM 1 BY 1
                 UNTIL SUB35 > 9
               IF ARRAY-A-VAL (SUBX, SUB35) > 0
                   ADD 1               TO WAGON-CNT-W700
                   MOVE ARRAY-A-VAL (SUBX, SUB35)
                                       TO WAGON-RIDER-W700
                                            (WAGON-CNT-W700)
               END-IF
           END-PERFORM.

           IF WAGON-CNT-W700 NOT = 2 AND NOT = 3
               DISPLAY 'E036'
               PERFORM Z999-ABEND
           END-IF.

           PERFORM VARYING SUB35 FROM 1 BY 1
                 UNTIL SUB35 > 9
               IF B9916-TYPE = 'ROW'
                   COMPUTE SUBY = ARRAY-D-H (SUB30) + SUB35 - 1
               ELSE
                   IF B9916-TYPE = 'COL'
                       COMPUTE SUBY =
                                  ARRAY-D-V (SUB30) + (9 * SUB35) - 9
                   ELSE
                       SUBTRACT 1 FROM SUB35 GIVING SUB6
                       DIVIDE SUB6 BY 3
                           GIVING QUOTIENT-W81 REMAINDER REM-W81
                       COMPUTE SUBY =
                          ARRAY-D-S (SUB30) + 9 * QUOTIENT-W81 + REM-W81
                   END-IF
               END-IF
               IF  (ARRAY-A-VAL (SUBY, 10) = 2 OR 3)
               AND  SUBX NOT = SUBY
                   MOVE ZERO           TO SUB-A
                                          SUB-B
                                          SUB-C
                   PERFORM B9922-FIND-SUB23
                   IF  WAGON-CNT-W700 = 2
                   AND ARRAY-A-VAL (SUBY, 10) = 2
                       PERFORM B9917-2-2
                   ELSE
                       IF  WAGON-CNT-W700 = 2
                       AND ARRAY-A-VAL (SUBY, 10) = 3
                           PERFORM B9918-2-3
                       ELSE
                           IF  WAGON-CNT-W700 = 3
                           AND ARRAY-A-VAL (SUBY, 10) = 2
                               PERFORM B9919-3-2
                           ELSE
                               IF  WAGON-CNT-W700 = 3
                               AND ARRAY-A-VAL (SUBY, 10) = 3
                                   PERFORM B9920-3-3
                               END-IF
                           END-IF
                       END-IF
                   END-IF
               END-IF
           END-PERFORM.

           IF  WAGON-CNT-W700 = 3
           AND PT2-W700 > ZERO
           AND PT3-W700 > ZERO
               MOVE WAGON-RIDER-W700 (1)
                                       TO POSS-1-W700
               MOVE WAGON-RIDER-W700 (2)
                                       TO POSS-2-W700
               MOVE WAGON-RIDER-W700 (3)
                                       TO POSS-3-W700
               MOVE PT1-W700           TO CELL-1-W700
               MOVE PT2-W700           TO CELL-2-W700
               MOVE PT3-W700           TO CELL-3-W700
               PERFORM B9921-ELIMINATE-POSS
                   VARYING SUB36 FROM 1 BY 1
                       UNTIL SUB36 > 9
               IF CHANGED-W82 = '1'
                   MOVE 10             TO SUB31
               END-IF
               IF  PROBE-W82  = '1'
               AND CONTRA-W82 = '1'
                   MOVE 10             TO SUB31
               END-IF
           END-IF.

       B9916-EXIT.
           EXIT.

       B9917-2-2                       SECTION.
      *---------                       --------

           ADD 1 TO B9917-CTR.

           IF  WAGON-RIDER-W700 (1) NOT = ARRAY-A-VAL (SUBY, SUB-A)
           AND WAGON-RIDER-W700 (2) NOT = ARRAY-A-VAL (SUBY, SUB-A)
           AND WAGON-RIDER-W700 (1) NOT = ARRAY-A-VAL (SUBY, SUB-B)
           AND WAGON-RIDER-W700 (2) NOT = ARRAY-A-VAL (SUBY, SUB-B)
               GO TO B9917-EXIT.

           IF  (WAGON-RIDER-W700 (1) = ARRAY-A-VAL (SUBY, SUB-A)
           OR   WAGON-RIDER-W700 (2) = ARRAY-A-VAL (SUBY, SUB-A))
           AND (WAGON-RIDER-W700 (1) = ARRAY-A-VAL (SUBY, SUB-B)
           OR   WAGON-RIDER-W700 (2) = ARRAY-A-VAL (SUBY, SUB-B))
               IF PT2-W700 = ZERO
                   MOVE SUBY           TO PT2-W700
               ELSE
                   IF PT3-W700 > ZERO
                       MOVE 10         TO SUB35
                       MOVE ALL '0'    TO WAGON-W700
                                          PTS-W700
                       GO TO B9917-EXIT
                   ELSE
                       MOVE SUBY       TO PT3-W700
                   END-IF
               END-IF
               GO TO B9917-EXIT
           END-IF.

           IF PT2-W700 = ZERO
               MOVE SUBY               TO PT2-W700
           ELSE
               IF PT3-W700 > ZERO
                   MOVE 10             TO SUB35
                   MOVE ALL '0'        TO WAGON-W700
                                          PTS-W700
                   GO TO B9917-EXIT
               ELSE
                   MOVE SUBY           TO PT3-W700
               END-IF
           END-IF.
           IF  ARRAY-A-VAL (SUBY, SUB-A) NOT = WAGON-RIDER-W700 (1)
           AND ARRAY-A-VAL (SUBY, SUB-A) NOT = WAGON-RIDER-W700 (2)
               MOVE ARRAY-A-VAL (SUBY, SUB-A)
                                       TO WAGON-RIDER-W700 (3)
           ELSE
               MOVE ARRAY-A-VAL (SUBY, SUB-B)
                                       TO WAGON-RIDER-W700 (3)
           END-IF.
           ADD 1 TO WAGON-CNT-W700.

       B9917-EXIT.
           EXIT.

       B9918-2-3                       SECTION.
      *---------                       --------

           ADD 1 TO B9918-CTR.

           IF  WAGON-RIDER-W700 (1) NOT = ARRAY-A-VAL (SUBY, SUB-A)
           AND WAGON-RIDER-W700 (1) NOT = ARRAY-A-VAL (SUBY, SUB-B)
           AND WAGON-RIDER-W700 (1) NOT = ARRAY-A-VAL (SUBY, SUB-C)
           AND WAGON-RIDER-W700 (2) NOT = ARRAY-A-VAL (SUBY, SUB-A)
           AND WAGON-RIDER-W700 (2) NOT = ARRAY-A-VAL (SUBY, SUB-B)
           AND WAGON-RIDER-W700 (2) NOT = ARRAY-A-VAL (SUBY, SUB-C)
               GO TO B9918-EXIT.

           IF  (WAGON-RIDER-W700 (1) = ARRAY-A-VAL (SUBY, SUB-A)
           OR   WAGON-RIDER-W700 (1) = ARRAY-A-VAL (SUBY, SUB-B)
           OR   WAGON-RIDER-W700 (1) = ARRAY-A-VAL (SUBY, SUB-C))
           AND (WAGON-RIDER-W700 (2) = ARRAY-A-VAL (SUBY, SUB-A)
           OR   WAGON-RIDER-W700 (2) = ARRAY-A-VAL (SUBY, SUB-B)
           OR   WAGON-RIDER-W700 (2) = ARRAY-A-VAL (SUBY, SUB-C))
               IF PT2-W700 = ZERO
                   MOVE SUBY           TO PT2-W700
               ELSE
                   IF PT3-W700 > ZERO
                       MOVE 10         TO SUB35
                       MOVE ALL '0'    TO WAGON-W700
                                          PTS-W700
                       GO TO B9918-EXIT
                   ELSE
                       MOVE SUBY       TO PT3-W700
                   END-IF
               END-IF
               MOVE ARRAY-A-VAL (SUBY, SUB-A)
                                       TO  WAGON-RIDER-W700 (1)
               MOVE ARRAY-A-VAL (SUBY, SUB-B)
                                       TO  WAGON-RIDER-W700 (2)
               MOVE ARRAY-A-VAL (SUBY, SUB-C)
                                       TO  WAGON-RIDER-W700 (3)
               MOVE 3                  TO  WAGON-CNT-W700
               GO TO B9918-EXIT
           END-IF.

           MOVE 10                     TO SUB35.
           MOVE ALL '0'                TO WAGON-W700
                                          PTS-W700.

       B9918-EXIT.
           EXIT.

       B9919-3-2                       SECTION.
      *---------                       --------

           ADD 1 TO B9919-CTR.

           IF  WAGON-RIDER-W700 (1) NOT = ARRAY-A-VAL (SUBY, SUB-A)
           AND WAGON-RIDER-W700 (1) NOT = ARRAY-A-VAL (SUBY, SUB-B)
           AND WAGON-RIDER-W700 (2) NOT = ARRAY-A-VAL (SUBY, SUB-A)
           AND WAGON-RIDER-W700 (2) NOT = ARRAY-A-VAL (SUBY, SUB-B)
           AND WAGON-RIDER-W700 (3) NOT = ARRAY-A-VAL (SUBY, SUB-A)
           AND WAGON-RIDER-W700 (3) NOT = ARRAY-A-VAL (SUBY, SUB-B)
               GO TO B9919-EXIT.

           IF  (WAGON-RIDER-W700 (1) = ARRAY-A-VAL (SUBY, SUB-A)
           OR   WAGON-RIDER-W700 (2) = ARRAY-A-VAL (SUBY, SUB-A)
           OR   WAGON-RIDER-W700 (3) = ARRAY-A-VAL (SUBY, SUB-A))
           AND (WAGON-RIDER-W700 (1) = ARRAY-A-VAL (SUBY, SUB-B)
           OR   WAGON-RIDER-W700 (2) = ARRAY-A-VAL (SUBY, SUB-B)
           OR   WAGON-RIDER-W700 (3) = ARRAY-A-VAL (SUBY, SUB-B))
               IF PT2-W700 = ZERO
                   MOVE SUBY           TO PT2-W700
               ELSE
                   IF PT3-W700 > ZERO
                       MOVE 10         TO SUB35
                       MOVE ALL '0'    TO WAGON-W700
                                          PTS-W700
                       GO TO B9919-EXIT
                   ELSE
                       MOVE SUBY       TO PT3-W700
                   END-IF
               END-IF
               GO TO B9919-EXIT
           END-IF.

           MOVE 10                     TO SUB35.
           MOVE ALL '0'                TO WAGON-W700
                                          PTS-W700.

       B9919-EXIT.
           EXIT.

       B9920-3-3                       SECTION.
      *---------                       --------

           ADD 1 TO B9920-CTR.

           IF  WAGON-RIDER-W700 (1) NOT = ARRAY-A-VAL (SUBY, SUB-A)
           AND WAGON-RIDER-W700 (1) NOT = ARRAY-A-VAL (SUBY, SUB-B)
           AND WAGON-RIDER-W700 (1) NOT = ARRAY-A-VAL (SUBY, SUB-C)
           AND WAGON-RIDER-W700 (2) NOT = ARRAY-A-VAL (SUBY, SUB-A)
           AND WAGON-RIDER-W700 (2) NOT = ARRAY-A-VAL (SUBY, SUB-B)
           AND WAGON-RIDER-W700 (2) NOT = ARRAY-A-VAL (SUBY, SUB-C)
           AND WAGON-RIDER-W700 (3) NOT = ARRAY-A-VAL (SUBY, SUB-A)
           AND WAGON-RIDER-W700 (3) NOT = ARRAY-A-VAL (SUBY, SUB-B)
           AND WAGON-RIDER-W700 (3) NOT = ARRAY-A-VAL (SUBY, SUB-C)
               GO TO B9920-EXIT.

           IF  (WAGON-RIDER-W700 (1) = ARRAY-A-VAL (SUBY, SUB-A)
           OR   WAGON-RIDER-W700 (2) = ARRAY-A-VAL (SUBY, SUB-A)
           OR   WAGON-RIDER-W700 (3) = ARRAY-A-VAL (SUBY, SUB-A))
           AND (WAGON-RIDER-W700 (1) = ARRAY-A-VAL (SUBY, SUB-B)
           OR   WAGON-RIDER-W700 (2) = ARRAY-A-VAL (SUBY, SUB-B)
           OR   WAGON-RIDER-W700 (3) = ARRAY-A-VAL (SUBY, SUB-B))
           AND (WAGON-RIDER-W700 (1) = ARRAY-A-VAL (SUBY, SUB-C)
           OR   WAGON-RIDER-W700 (2) = ARRAY-A-VAL (SUBY, SUB-C)
           OR   WAGON-RIDER-W700 (3) = ARRAY-A-VAL (SUBY, SUB-C))
               IF PT2-W700 = ZERO
                   MOVE SUBY           TO PT2-W700
               ELSE
                   IF PT3-W700 > ZERO
                       MOVE 10         TO SUB35
                       MOVE ALL '0'    TO WAGON-W700
                                          PTS-W700
                       GO TO B9920-EXIT
                   ELSE
                       MOVE SUBY       TO PT3-W700
                   END-IF
               END-IF
               GO TO B9920-EXIT

           MOVE 10                     TO SUB35.
           MOVE ALL '0'                TO WAGON-W700
                                          PTS-W700.

       B9920-EXIT.
           EXIT.

       B9921-ELIMINATE-POSS            SECTION.
      *--------------------            --------

           ADD 1 TO B9921-CTR.

           IF B9916-TYPE = 'ROW'
               COMPUTE SUBX = ARRAY-D-H (SUB30) + SUB36 - 1
           ELSE
               IF B9916-TYPE = 'COL'
                  COMPUTE SUBX =
                              ARRAY-D-V (SUB30) + (9 * SUB36) - 9
               ELSE
                   SUBTRACT 1 FROM SUB36 GIVING SUB6
                   DIVIDE SUB6 BY 3
                       GIVING QUOTIENT-W81 REMAINDER REM-W81
                   COMPUTE SUBX =
                      ARRAY-D-S (SUB30) + 9 * QUOTIENT-W81 + REM-W81
               END-IF
           END-IF.

           IF  SUBX = CELL-1-W700
           OR  SUBX = CELL-2-W700
           OR  SUBX = CELL-3-W700
               GO TO B9921-EXIT
           END-IF.

           IF ARRAY-A-VAL (SUBX, POSS-1-W700) > 0
               MOVE ZERO               TO ARRAY-A-VAL
                                          (SUBX, POSS-1-W700)
               DISPLAY 'B9921 ' B9916-TYPE SPACE CELL-1-W700 SPACE
                   CELL-2-W700 SPACE CELL-3-W700 SPACE POSS-1-W700 SPACE
                   POSS-2-W700 SPACE POSS-3-W700 SPACE SUBX SPACE
                   POSS-1-W700
               SUBTRACT 1 FROM ARRAY-A-VAL (SUBX, 10)
               IF ARRAY-A-VAL (SUBX, 10) = ZERO
                   IF PROBE-W82 = '1'
                       MOVE '1'        TO CONTRA-W82
                       MOVE 10         TO SUB36
                   ELSE
                       DISPLAY 'E037'
                       PERFORM Z999-ABEND
                   END-IF
               ELSE
                   MOVE '1'            TO CHANGED-W82
                   IF ARRAY-A-VAL (SUBX, 10) = 1
                       MOVE 'B9921'    TO SOURCE-W700
                       MOVE SUBX       TO SUBM
                       PERFORM N9000-11
                   END-IF
               END-IF
           END-IF.

           IF  PROBE-W82 = '1'
           AND CONTRA-W82 = '1'
               GO TO B9921-EXIT.

           IF ARRAY-A-VAL (SUBX, POSS-2-W700) > 0
               MOVE ZERO               TO ARRAY-A-VAL
                                          (SUBX, POSS-2-W700)
               DISPLAY 'B9921 ' B9916-TYPE SPACE CELL-1-W700 SPACE
                   CELL-2-W700 SPACE CELL-3-W700 SPACE POSS-1-W700 SPACE
                   POSS-2-W700 SPACE POSS-3-W700 SPACE SUBX SPACE
                   POSS-2-W700
               SUBTRACT 1 FROM ARRAY-A-VAL (SUBX, 10)
               IF ARRAY-A-VAL (SUBX, 10) = ZERO
                   IF PROBE-W82 = '1'
                       MOVE '1'        TO CONTRA-W82
                       MOVE 10         TO SUB36
                   ELSE
                       DISPLAY 'E038'
                       PERFORM Z999-ABEND
                   END-IF
               ELSE
                   MOVE '1'            TO CHANGED-W82
                   IF ARRAY-A-VAL (SUBX, 10) = 1
                       MOVE 'B9921'    TO SOURCE-W700
                       MOVE SUBX       TO SUBM
                       PERFORM N9000-11
                   END-IF
               END-IF
           END-IF.

           IF  PROBE-W82 = '1'
           AND CONTRA-W82 = '1'
               GO TO B9921-EXIT.

           IF ARRAY-A-VAL (SUBX, POSS-3-W700) > 0
               MOVE ZERO               TO ARRAY-A-VAL
                                          (SUBX, POSS-3-W700)
               DISPLAY 'B9921 ' B9916-TYPE SPACE CELL-1-W700 SPACE
                   CELL-2-W700 SPACE CELL-3-W700 SPACE POSS-1-W700 SPACE
                   POSS-2-W700 SPACE POSS-3-W700 SPACE SUBX SPACE
                   POSS-3-W700
               SUBTRACT 1 FROM ARRAY-A-VAL (SUBX, 10)
               IF ARRAY-A-VAL (SUBX, 10) = ZERO
                   IF PROBE-W82 = '1'
                       MOVE '1'        TO CONTRA-W82
                       MOVE 10         TO SUB36
                   ELSE
                       DISPLAY 'E039'
                       PERFORM Z999-ABEND
                   END-IF
               ELSE
                   MOVE '1'            TO CHANGED-W82
                   IF ARRAY-A-VAL (SUBX, 10) = 1
                       MOVE 'B9921'    TO SOURCE-W700
                       MOVE SUBX       TO SUBM
                       PERFORM N9000-11
                   END-IF
               END-IF
           END-IF.

           IF  PROBE-W82 = '1'
           AND CONTRA-W82 = '1'
               GO TO B9921-EXIT.

       B9921-EXIT.
           EXIT.

       B9922-FIND-SUB23                SECTION.
      *----------------                --------

           ADD 1 TO B9922-CTR.

           PERFORM VARYING SUB37 FROM 1 BY 1
                 UNTIL SUB37 > 9
               IF ARRAY-A-VAL (SUBY, SUB37) > 0
                   IF SUB-A = 0
                       MOVE SUB37      TO SUB-A
                   ELSE
                       IF SUB-B = 0
                           MOVE SUB37  TO SUB-B
                       ELSE
                           MOVE SUB37  TO SUB-C
                       END-IF
                   END-IF
               END-IF
           END-PERFORM.

       B9922-EXIT.
           EXIT.

       C0000-PROBES                    SECTION.
      *------------                    --------

           ADD 1 TO C0000-CTR.
           DISPLAY 'C0000 ' C0000-CTR.

           MOVE '1'                    TO PROBE-W82.

           MOVE ZERO                   TO SUB10.
           PERFORM C1000-OPENS
               VARYING SUB8 FROM 2 BY 1
                   UNTIL SUB8 > 9.

           MOVE SPACES                 TO CONTRA-W82
                                          STARTOVER-W82.
           MOVE SUB10                  TO MAX-ARRAY-C.
           PERFORM C2000-PROBE
                 VARYING SUB10 FROM 1 BY 1
                   UNTIL SUB10 > MAX-ARRAY-C
                     OR  CONTRA-W82 = '1'
                     OR  STARTOVER-W82 = '1'
                     OR  DONE-W82 = '1'.

           MOVE SPACES                 TO PROBE-W82.

       C0000-EXIT.
           EXIT.

       C1000-OPENS                     SECTION.
      *-----------                     --------

           ADD 1 TO C1000-CTR.

           PERFORM VARYING SUB9 FROM 1 BY 1
                 UNTIL SUB9 > 81
               IF ARRAY-A-VAL (SUB9, 10) = SUB8
                   ADD 1 TO SUB10
                   MOVE SUB9           TO ARRAY-C-NUM  (SUB10)
                   MOVE SUB8           TO ARRAY-C-POSS (SUB10)
               END-IF
           END-PERFORM.

       C1000-EXIT.
           EXIT.

       C2000-PROBE                     SECTION.
      *-----------                     --------

           ADD 1 TO C2000-CTR.

           MOVE ARRAY-C-NUM (SUB10)    TO SUB11.
           PERFORM VARYING SUB12 FROM 1 BY 1
                 UNTIL SUB12 > 9
                   OR  CONTRA-W82 = '1'
                   OR  STARTOVER-W82 = '1'
                   OR  DONE-W82 = '1'
               IF ARRAY-A-VAL (SUB11, SUB12) > ZERO
                   MOVE ARRAY-A-VAL (SUB11, SUB12)
                                       TO SUB13
                   MOVE ARRAY-A        TO ARRAY-H
                   MOVE ALL '0'        TO ARRAY-A-ELEMENT (SUB11)
                   MOVE 1              TO ARRAY-A-VAL (SUB11, 10)
                   MOVE SUB13          TO ARRAY-A-VAL (SUB11, 11)
                                          ARRAY-A-VAL (SUB11, SUB13)
                   PERFORM C3000-PROBE
                   IF DONE-W82 NOT = '1'
                       MOVE ARRAY-H    TO ARRAY-A
                       IF CONTRA-W82 = '1'
                           MOVE ZERO   TO ARRAY-A-VAL (SUB11, SUB13)
                           SUBTRACT 1 FROM ARRAY-A-VAL (SUB11, 10)
                           IF ARRAY-A-VAL (SUB11, 10) = 0
                               DISPLAY 'E040'
                               PERFORM Z999-ABEND
                           END-IF
                           IF ARRAY-A-VAL (SUB11, 10) = 1
                               MOVE 'C2000'
                                       TO SOURCE-W700
                               MOVE SUB11
                                       TO SUBM
                               PERFORM N9000-11
                           END-IF
                           MOVE '1'    TO STARTOVER-W82
                       END-IF
                   END-IF
               END-IF
           END-PERFORM.

       C2000-EXIT.
           EXIT.

       C3000-PROBE                     SECTION.
      *-----------                     --------

           ADD 1 TO C3000-CTR.
           DISPLAY 'C3000 ' C3000-CTR SPACE SUB11 SPACE SUB13.

           MOVE SPACES                 TO CONTRA-W82.
           MOVE '1'                    TO CHANGED-W82.
           PERFORM B0000-SWEEPS
               UNTIL CHANGED-W82 NOT = '1'
                 OR  CONTRA-W82 = '1'
                 OR  DONE-W82 = '1'.

       C3000-EXIT.
           EXIT.

       J0000-CHECK-DONE                SECTION.
      *----------------                --------

           ADD 1 TO J0000-CTR.

           PERFORM VARYING SUB7 FROM 1 BY 1
                 UNTIL SUB7 > 81
               IF ARRAY-A-VAL (SUB7, 11) = ZERO
                   MOVE SPACES         TO DONE-W82
                   MOVE 81             TO SUB7
               END-IF
           END-PERFORM.

       J0000-EXIT.
           EXIT.

       M1000-BASIC-SWEEP               SECTION.
      *-----------------               --------

           ADD 1 TO M1000-CTR.

           MOVE SPACES                 TO CONTRA-W82.
           PERFORM M1100-SWEEP
                 VARYING SUB1 FROM 1 BY 1
                   UNTIL SUB1 > 81
                     OR  CONTRA-W82 = '1'.

       M1000-EXIT.
           EXIT.

       M1100-SWEEP                     SECTION.
      *-----------                     --------

           ADD 1 TO M1100-CTR.

           PERFORM M1110-H
               VARYING SUB2 FROM 1 BY 1
                   UNTIL SUB2 > 9
                     OR  CONTRA-W82 = '1'.

           PERFORM M1120-V
               VARYING SUB2 FROM 1 BY 1
                   UNTIL SUB2 > 9
                     OR  CONTRA-W82 = '1'.

           PERFORM M1130-S
               VARYING SUB2 FROM 1 BY 1
                   UNTIL SUB2 > 9
                     OR  CONTRA-W82 = '1'.

       M1100-EXIT.
           EXIT.

       M1110-H                         SECTION.
      *-------                         --------

           ADD 1 TO M1110-CTR.

           COMPUTE SUBH = ARRAY-B-H (SUB1) + SUB2 - 1.

           IF SUBH = SUB1
               GO TO M1110-EXIT.

           IF ARRAY-A-VAL (SUBH, 10) NOT = 1
               GO TO M1110-EXIT.

           IF ARRAY-A-VAL (SUB1, 10) = 1
               IF ARRAY-A-VAL (SUB1, 11) = ARRAY-A-VAL (SUBH, 11)
                   MOVE '1'            TO CONTRA-W82
               END-IF
               GO TO M1110-EXIT
           END-IF.

           MOVE ARRAY-A-VAL (SUBH, 11) TO SUB3.
           IF ARRAY-A-VAL (SUB1, SUB3) > ZERO
               MOVE '1'                TO CHANGED-W82
               MOVE ZERO               TO ARRAY-A-VAL (SUB1, SUB3)
               SUBTRACT 1 FROM ARRAY-A-VAL (SUB1, 10)
               IF ARRAY-A-VAL (SUB1, 10) = ZERO
                   IF PROBE-W82 = '1'
                       MOVE '1'        TO CONTRA-W82
                   ELSE
                       DISPLAY 'E041'
                       PERFORM Z999-ABEND
                   END-IF
               END-IF
               IF ARRAY-A-VAL (SUB1, 10) = 1
                   MOVE 'M1110-H'      TO SOURCE-W700
                   MOVE SUB1           TO SUBM
                   PERFORM N9000-11
               END-IF
           END-IF.

       M1110-EXIT.
           EXIT.

       M1120-V                         SECTION.
      *-------                         --------

           ADD 1 TO M1120-CTR.

           COMPUTE SUBV = ARRAY-B-V (SUB1) + (9 * SUB2) - 9.

           IF SUBV = SUB1
               GO TO M1120-EXIT.

           IF ARRAY-A-VAL (SUBV, 10) NOT = 1
               GO TO M1120-EXIT.

           IF ARRAY-A-VAL (SUB1, 10) = 1
               IF ARRAY-A-VAL (SUB1, 11) = ARRAY-A-VAL (SUBV, 11)
                   MOVE '1'            TO CONTRA-W82
               END-IF
               GO TO M1120-EXIT
           END-IF.

           MOVE ARRAY-A-VAL (SUBV, 11) TO SUB3.
           IF ARRAY-A-VAL (SUB1, SUB3) > ZERO
               MOVE '1'                TO CHANGED-W82
               MOVE ZERO               TO ARRAY-A-VAL (SUB1, SUB3)
               SUBTRACT 1 FROM ARRAY-A-VAL (SUB1, 10)
               IF ARRAY-A-VAL (SUB1, 10) = ZERO
                   IF PROBE-W82 = '1'
                       MOVE '1'        TO CONTRA-W82
                   ELSE
                       DISPLAY 'E042'
                       PERFORM Z999-ABEND
                   END-IF
               END-IF
               IF ARRAY-A-VAL (SUB1, 10) = 1
                   MOVE 'M1120-V'      TO SOURCE-W700
                   MOVE SUB1           TO SUBM
                   PERFORM N9000-11
               END-IF
           END-IF.

       M1120-EXIT.
           EXIT.

       M1130-S                         SECTION.
      *-------                         --------

           ADD 1 TO M1130-CTR.

           SUBTRACT 1 FROM SUB2 GIVING SUB6.
           DIVIDE SUB6 BY 3 GIVING QUOTIENT-W81 REMAINDER REM-W81.
           COMPUTE SUBS =
                   ARRAY-B-S (SUB1) + 9 * QUOTIENT-W81 + REM-W81.

           IF SUBS = SUB1
               GO TO M1130-EXIT.

           IF ARRAY-A-VAL (SUBS, 10) NOT = 1
               GO TO M1130-EXIT.

           IF ARRAY-A-VAL (SUB1, 10) = 1
               IF ARRAY-A-VAL (SUB1, 11) = ARRAY-A-VAL (SUBS, 11)
                   MOVE '1'            TO CONTRA-W82
               END-IF
               GO TO M1130-EXIT
           END-IF.

           MOVE ARRAY-A-VAL (SUBS, 11) TO SUB3.
           IF ARRAY-A-VAL (SUB1, SUB3) > ZERO
               MOVE '1'                TO CHANGED-W82
               MOVE ZERO               TO ARRAY-A-VAL (SUB1, SUB3)
               SUBTRACT 1 FROM ARRAY-A-VAL (SUB1, 10)
               IF ARRAY-A-VAL (SUB1, 10) = ZERO
                   IF PROBE-W82 = '1'
                       MOVE '1'        TO CONTRA-W82
                   ELSE
                       DISPLAY 'E043'
                       PERFORM Z999-ABEND
                   END-IF
               END-IF
               IF ARRAY-A-VAL (SUB1, 10) = 1
                   MOVE 'M1130-S'      TO SOURCE-W700
                   MOVE SUB1           TO SUBM
                   PERFORM N9000-11
               END-IF
           END-IF.

       M1130-EXIT.
           EXIT.

       N9000-11                        SECTION.
      *--------                        --------

           ADD 1 TO N9000-CTR.

           MOVE SPACES                 TO FOUND-W82.

           PERFORM VARYING SUB4 FROM 1 BY 1
                 UNTIL SUB4 > 9
                   OR  FOUND-W82 = '1'
               IF ARRAY-A-VAL (SUBM, SUB4) > 0
                   MOVE ARRAY-A-VAL (SUBM, SUB4) TO
                        ARRAY-A-VAL (SUBM, 11)
                   MOVE '1'            TO FOUND-W82
               END-IF
           END-PERFORM.

           IF FOUND-W82 NOT = '1'
               DISPLAY 'E044'
               PERFORM Z999-ABEND
           END-IF.

           DISPLAY 'N9000 ' SOURCE-W700 SPACE SUBM SPACE
               ARRAY-A-VAL (SUBM, 11).

       N9000-EXIT.
           EXIT.

       P0000-DISPLAY                   SECTION.
      *-------------                   --------

           MOVE ZERO                   TO SUB22.
           MOVE SPACES                 TO DISPLAY-W700.

           PERFORM VARYING SUB14 FROM 1 BY 1
                 UNTIL SUB14 > 81
               ADD 1 TO SUB22
               MOVE SPACE              TO DISPLAY-SPC (SUB22)
               MOVE ARRAY-A-VAL (SUB14, 11)
                                       TO DISPLAY-VAL (SUB22)
               IF SUB22 = 9
                   DISPLAY DISPLAY-W700
                   MOVE ZERO           TO SUB22
                   MOVE SPACES         TO DISPLAY-W700
               END-IF
           END-PERFORM.

           PERFORM VARYING SUB14 FROM 1 BY 1
                 UNTIL SUB14 > 81
               DISPLAY SUB14 SPACE ARRAY-A-ELEMENT (SUB14)
           END-PERFORM.

           DISPLAY 'A0000-CTR = ' A0000-CTR.
           DISPLAY 'B0000-CTR = ' B0000-CTR.
           DISPLAY 'B1000-CTR = ' B1000-CTR.
           DISPLAY 'B1100-CTR = ' B1100-CTR.
           DISPLAY 'B1110-CTR = ' B1110-CTR.
           DISPLAY 'B1120-CTR = ' B1120-CTR.
           DISPLAY 'B1130-CTR = ' B1130-CTR.
           DISPLAY 'B1140-CTR = ' B1140-CTR.
           DISPLAY 'B1150-CTR = ' B1150-CTR.
           DISPLAY 'B1160-CTR = ' B1160-CTR.
           DISPLAY 'B3000-CTR = ' B3000-CTR.
           DISPLAY 'B3100-CTR = ' B3100-CTR.
           DISPLAY 'B3110-CTR = ' B3110-CTR.
           DISPLAY 'B3120-CTR = ' B3120-CTR.
           DISPLAY 'B3130-CTR = ' B3130-CTR.
           DISPLAY 'B3900-CTR = ' B3900-CTR.
           DISPLAY 'B4000-CTR = ' B4000-CTR.
           DISPLAY 'B4100-CTR = ' B4100-CTR.
           DISPLAY 'B4200-CTR = ' B4200-CTR.
           DISPLAY 'B4300-CTR = ' B4300-CTR.
           DISPLAY 'B4400-CTR = ' B4400-CTR.
           DISPLAY 'B6000-CTR = ' B6000-CTR.
           DISPLAY 'B6100-CTR = ' B6100-CTR.
           DISPLAY 'B6200-CTR = ' B6200-CTR.
           DISPLAY 'B9901-CTR = ' B9901-CTR.
           DISPLAY 'B9903-CTR = ' B9903-CTR.
           DISPLAY 'B9905-CTR = ' B9905-CTR.
           DISPLAY 'B9906-CTR = ' B9906-CTR.
           DISPLAY 'B9907-CTR = ' B9907-CTR.
           DISPLAY 'B9910-CTR = ' B9910-CTR.
           DISPLAY 'B9912-CTR = ' B9912-CTR.
           DISPLAY 'B9913-CTR = ' B9913-CTR.
           DISPLAY 'B9914-CTR = ' B9914-CTR.
           DISPLAY 'B9915-CTR = ' B9915-CTR.
           DISPLAY 'B9916-CTR = ' B9916-CTR.
           DISPLAY 'B9917-CTR = ' B9917-CTR.
           DISPLAY 'B9918-CTR = ' B9918-CTR.
           DISPLAY 'B9919-CTR = ' B9919-CTR.
           DISPLAY 'B9920-CTR = ' B9920-CTR.
           DISPLAY 'B9921-CTR = ' B9921-CTR.
           DISPLAY 'B9922-CTR = ' B9922-CTR.
           DISPLAY 'C0000-CTR = ' C0000-CTR.
           DISPLAY 'C1000-CTR = ' C1000-CTR.
           DISPLAY 'C2000-CTR = ' C2000-CTR.
           DISPLAY 'C3000-CTR = ' C3000-CTR.
           DISPLAY 'J0000-CTR = ' J0000-CTR.
           DISPLAY 'M1000-CTR = ' M1000-CTR.
           DISPLAY 'M1100-CTR = ' M1100-CTR.
           DISPLAY 'M1110-CTR = ' M1110-CTR.
           DISPLAY 'M1120-CTR = ' M1120-CTR.
           DISPLAY 'M1130-CTR = ' M1130-CTR.
           DISPLAY 'N9000-CTR = ' N9000-CTR.

       P0000-EXIT.
           EXIT.

       S1000-PROCESS-INPUT             SECTION.
      *-------------------             --------

           PERFORM VARYING SUB20 FROM 1 BY 1
                 UNTIL SUB20 > 9
                   OR INPUT-EOF-W82 = '1'
                   OR INPUT-ERR-W82 = '1'
               PERFORM S1100-READ-INPUT
               IF INPUT-EOF-W82 = '1'
                   MOVE '1' TO INPUT-ERR-W82
               ELSE
                   PERFORM S1200-INPUT-9
               END-IF
           END-PERFORM.

       S1000-EXIT.
           EXIT.

       S1100-READ-INPUT                SECTION.
      *----------------                --------

           READ CARD-FILE INTO WS-CARD
               AT END
                   MOVE '1' TO INPUT-EOF-W82.

       S1100-EXIT.
           EXIT.

       S1200-INPUT-9                   SECTION.
      *-------------                   --------

           PERFORM VARYING SUB21 FROM 1 BY 1
                 UNTIL SUB21 > 9
               ADD 1 TO SUBA
               IF WS-CARD-VAL (SUB21) NOT NUMERIC
                   MOVE '1'            TO INPUT-ERR-W82
               ELSE
                   IF WS-CARD-VAL (SUB21) > 0
                       MOVE ALL '0'    TO ARRAY-A-ELEMENT (SUBA)
                       MOVE 1          TO ARRAY-A-VAL (SUBA, 10)
                       MOVE WS-CARD-VAL (SUB21)
                                       TO ARRAY-A-VAL (SUBA, 11)
                       MOVE ARRAY-A-VAL (SUBA, 11)
                                       TO SUB5
                       MOVE SUB5       TO ARRAY-A-VAL (SUBA, SUB5)
                   END-IF
               END-IF
           END-PERFORM.

       S1200-EXIT.
           EXIT.

       V0000-INITIALIZATION            SECTION.
      *--------------------            --------

           PERFORM VARYING SUB1 FROM 1 BY 1
                 UNTIL SUB1 > 81
               MOVE '12345678990'      TO ARRAY-A-ELEMENT (SUB1)
           END-PERFORM.

           MOVE ALL '0'                TO ARRAY-C.

       X1000-OPEN                      SECTION.
      *----------                      --------

           OPEN INPUT CARD-FILE.

       X2000-CLOSE                     SECTION.
      *-----------                     --------

           CLOSE CARD-FILE.

       Z999-ABEND                      SECTION.
      *----------                      --------

           DISPLAY 'ABEND'.
           PERFORM P0000-DISPLAY.
           DISPLAY 'SUB1          = ' SUB1.
           DISPLAY 'SUB2          = ' SUB2.
           DISPLAY 'SUB3          = ' SUB3.
           DISPLAY 'SUB4          = ' SUB4.
           DISPLAY 'SUB5          = ' SUB5.
           DISPLAY 'SUB6          = ' SUB6.
           DISPLAY 'SUB7          = ' SUB7.
           DISPLAY 'SUB8          = ' SUB8.
           DISPLAY 'SUB9          = ' SUB9.
           DISPLAY 'SUB10         = ' SUB10.
           DISPLAY 'SUB11         = ' SUB11.
           DISPLAY 'SUB12         = ' SUB12.
           DISPLAY 'SUB13         = ' SUB13.
           DISPLAY 'SUB14         = ' SUB14.
           DISPLAY 'SUB15         = ' SUB15.
           DISPLAY 'SUB16         = ' SUB16.
           DISPLAY 'SUB20         = ' SUB20.
           DISPLAY 'SUB21         = ' SUB21.
           DISPLAY 'SUB22         = ' SUB22.
           DISPLAY 'SUB30         = ' SUB30.
           DISPLAY 'SUB31         = ' SUB31.
           DISPLAY 'SUB32         = ' SUB32.
           DISPLAY 'SUB33         = ' SUB33.
           DISPLAY 'SUB34         = ' SUB34.
           DISPLAY 'SUB35         = ' SUB35.
           DISPLAY 'SUB36         = ' SUB36.
           DISPLAY 'SUB37         = ' SUB37.
           DISPLAY 'SUBA          = ' SUBA.
           DISPLAY 'SUBM          = ' SUBM.
           DISPLAY 'SUBH          = ' SUBH.
           DISPLAY 'SUBS          = ' SUBS.
           DISPLAY 'SUBV          = ' SUBV.
           DISPLAY 'SUBX          = ' SUBX.
           DISPLAY 'SUBY          = ' SUBY.
           DISPLAY 'SUB-A         = ' SUB-A.
           DISPLAY 'SUB-B         = ' SUB-B.
           DISPLAY 'SUB-C         = ' SUB-C.
           DISPLAY 'AB-SUB        = ' AB-SUB.
           DISPLAY 'CARD-CTR-W81  = ' CARD-CTR-W81.
           DISPLAY 'QUOTIENT-W81  = ' QUOTIENT-W81.
           DISPLAY 'REM-W81       = ' REM-W81.
           DISPLAY 'MATCH-W81     = ' MATCH-W81.
           DISPLAY 'SINGLE-W81    = ' SINGLE-W81.
           DISPLAY 'A-W81         = ' A-W81.
           DISPLAY 'B-W81         = ' B-W81.
           DISPLAY 'AB-W81        = ' AB-W81.
TEST       DISPLAY 'TEST-W81      = ' TEST-W81.
           DISPLAY 'MAX-ARRAY-C   = ' MAX-ARRAY-C.
           DISPLAY 'CHANGED-W82   = ' CHANGED-W82.
           DISPLAY 'CONTRA-W82    = ' CONTRA-W82.
           DISPLAY 'FOUND-W82     = ' FOUND-W82.
           DISPLAY 'INPUT-EOF-W82 = ' INPUT-EOF-W82.
           DISPLAY 'INPUT-ERR-W82 = ' INPUT-ERR-W82.
           DISPLAY 'PROBE-W82     = ' PROBE-W82.
           DISPLAY 'STARTOVER-W82 = ' STARTOVER-W82.
           DISPLAY 'DONE-W82      = ' DONE-W82.
           DISPLAY 'SOURCE-W700   = ' SOURCE-W700.
           DISPLAY 'CELL-1-W700   = ' CELL-1-W700.
           DISPLAY 'CELL-2-W700   = ' CELL-2-W700.
           DISPLAY 'CELL-3-W700   = ' CELL-3-W700.
           DISPLAY 'POSS-1-W700   = ' POSS-1-W700.
           DISPLAY 'POSS-2-W700   = ' POSS-2-W700.
           DISPLAY 'POSS-3-W700   = ' POSS-3-W700.
           DISPLAY 'ROW-W700      = ' ROW-W700.
           DISPLAY 'COL-W700      = ' COL-W700.
           DISPLAY 'SQR-W700      = ' SQR-W700.
           DISPLAY 'B9903-TYPE    = ' B9903-TYPE.
           DISPLAY 'B9906-TYPE    = ' B9906-TYPE.
           DISPLAY 'B9907-TYPE    = ' B9907-TYPE.
           DISPLAY 'B9916-TYPE    = ' B9916-TYPE.
           DISPLAY 'PT1-W700      = ' PT1-W700.
           DISPLAY 'PT2-W700      = ' PT2-W700.
           DISPLAY 'PT3-W700      = ' PT3-W700.
           DISPLAY 'WAGON-CNT-W700= ' WAGON-CNT-W700.

           DISPLAY 'ARRAY-C:'.

           PERFORM VARYING SUB17 FROM 1 BY 1
                 UNTIL SUB17 > 81
                   OR  ARRAY-C-NUM (SUB17) = ZERO
               DISPLAY ARRAY-C-NUM (SUB17) SPACE
                       ARRAY-C-POSS (SUB17)
           END-PERFORM.

           DISPLAY 'ARRAY-E:'.

           PERFORM VARYING SUB17 FROM 1 BY 1
                 UNTIL SUB17 > 9
               DISPLAY ARRAY-E-POSS (SUB17)
           END-PERFORM.

           DISPLAY 'WAGON-RIDER-W700:'.

           PERFORM VARYING SUB17 FROM 1 BY 1
                 UNTIL SUB17 > 9
               DISPLAY WAGON-RIDER-W700 (SUB17)
           END-PERFORM.

           GOBACK.


Dimensions, ch.1 | Dimensions, ch.2 | Dimensions, ch.3 | Dimensions, ch.4 | Dimensions, ch.5 | Hypercube formula | Decimals of Primes | Visual Definition of Primes | Calculator Trick | Decimal Equivalents of Fractions | Mental Calendar Trick | Kaleidodigit | Math | Home Page


Copyright 2007 by Bill Price