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