subroutine aptsudu (achars, acell, adup, nrowd, ncold, nerr)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTSUDU
c
c call aptsudu (achars, acell, adup, nrowd, ncold, nerr)
c
c Version: aptsudu Updated 2006 March 13 13:30.
c aptsudu Originated 2006 March 13 13:30.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: To test a 9 x 9 Sudoku grid for invalid or duplicate characters
c in a row, column or 3 x 3 box.
c
c Input: achars, acell.
c
c Output: adup, nerr.
c
c Glossary:
c
c acell Input Array acell(nrow,ncol). If not achars(0), the
c character assigned to the cell located at row nrow,
c column ncol of the 9 x 9 Sudoku grid.
c
c achars Input A set of 10 unique characters. Each acell must be
c one of these characters. Character achars(0) is
c used for an unassigned cell, and is normally blank.
c
c adup Output A duplicated character, in row nrowd, column ncold.
c There may be other duplicated characters.
c
c nerr Output Error flag. No error if zero.
c 1 if any initially specified character is not an
c array achars.
c 3 if a character used more than once in same row.
c 4 if a character used more than once in same column.
c 5 if a character used more than once in same box.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc########
ccend.
implicit none
c.... Arguments.
integer nerr ! Error flag, 0, 1, 3, 4 or 5.
character*1 achars(0:9) ! Characters used in Sudoku grid.
character*1 acell(9,9) ! Character assiged to a cell.
character*1 adup ! Duplicated character.
c.... Local variables.
integer ichar ! Index in array achars.
integer nbox ! Box index, 1 to 9.
integer ncol ! Column index, 1 to 9.
integer ncolbeg ! Column index at start of box, 1 to 9.
integer ncold ! Column index of duplicate char, 1 to 9.
integer ncolend ! Column index at end of box, 1 to 9.
integer ncolx ! Column index, 1 to 9.
integer nrow ! Row index, 1 to 9.
integer nrowbeg ! Row index at start of box, 1 to 9.
integer nrowd ! Row index of duplicate char, 1 to 9.
integer nrowend ! Row index at end of box, 1 to 9.
integer nrowx ! Row index, 1 to 9.
character*1 acells(9,9) ! Character assiged to a cell.
cbugc***DEBUG begins.
cbug 9001 format (/ 'aptsudu looking for duplicate characters in a',
cbug & ' 9 x 9 Sudoku grid.' )
cbug
cbug 9002 format (/ 'Assigned characters:' /
cbug & ' |'23('-'),'|' /
cbug & ' |',3(1x,a1),' |',3(1x,a1),' |',3(1x,a1),' |' /
cbug & ' |',3(1x,a1),' |',3(1x,a1),' |',3(1x,a1),' |' /
cbug & ' |',3(1x,a1),' |',3(1x,a1),' |',3(1x,a1),' |' /
cbug & ' |',23('-'),'|' /
cbug & ' |',3(1x,a1),' |',3(1x,a1),' |',3(1x,a1),' |' /
cbug & ' |',3(1x,a1),' |',3(1x,a1),' |',3(1x,a1),' |' /
cbug & ' |',3(1x,a1),' |',3(1x,a1),' |',3(1x,a1),' |' /
cbug & ' |',23('-'),'|' /
cbug & ' |',3(1x,a1),' |',3(1x,a1),' |',3(1x,a1),' |' /
cbug & ' |',3(1x,a1),' |',3(1x,a1),' |',3(1x,a1),' |' /
cbug & ' |',3(1x,a1),' |',3(1x,a1),' |',3(1x,a1),' |' /
cbug & ' |',23('-'),'|' // )
cbug
cbug write ( 3, 9001)
cbug write ( 3, 9002) ((acell(nrow,ncol), ncol = 1, 9), nrow = 1, 9)
cbugc***DEBUG ends.
c.... See if assigned characters are in array achars.
nerr = 0
do 110 nrow = 1, 9
do 105 ncol = 1, 9
if (acell(nrow,ncol) .eq. achars(0)) go to 105
do ichar = 1, 9
if (acell(nrow,ncol) .eq. achars(ichar)) go to 105
enddo
nerr = 1
adup = acell(nrow,ncol)
nrowd = nrow
ncold = ncol
cbugcbugc***DEBUG begins.
cbugcbug 9110 format ('Invalid character',1x,a1,' in row',i2,
cbugcbug & ', column',i2,'.')
cbugcbug write ( 3, 9110) acell(nrow,ncol), nrow, ncol
cbugcbugc***DEBUG ends.
105 continue
110 continue
if (nerr .ne. 0) go to 210
c.... Test for duplicate characters in same row.
do 130 nrow = 1, 9
do 125 ncol = 1, 8
if (acell(nrow,ncol) .eq. achars(0)) go to 125
do 120 ncolx = ncol + 1, 9
if (acell(nrow,ncol) .eq. acell(nrow,ncolx)) then
nerr = 3
adup = acell(nrow,ncol)
nrowd = nrow
ncold = ncol
cbugcbugc***DEBUG begins.
cbugcbug 9120 format ('Duplicate character',1x,a1,' in same row',i2,
cbugcbug & ', columns',i2,' and',i2,'.')
cbugcbug write ( 3, 9120) acell(nrow,ncol), nrow, ncol, ncolx
cbugcbugc***DEBUG ends.
endif
120 continue
125 continue
130 continue
if (nerr .ne. 0) go to 210
c.... Test for duplicate characters in same column.
do 150 ncol = 1, 9
do 145 nrow = 1, 8
if (acell(nrow,ncol) .eq. achars(0)) go to 145
do 140 nrowx = nrow + 1, 9
if (acell(nrow,ncol) .eq. acell(nrowx,ncol)) then
nerr = 4
adup = acell(nrow,ncol)
nrowd = nrow
ncold = ncol
cbugcbugc***DEBUG begins.
cbugcbug 9140 format ('Duplicate character',1x,a1,' in same col',i2,
cbugcbug & ', rows',i2,' and',i2,'.')
cbugcbug write ( 3, 9140) acell(nrow,ncol), ncol, nrow, nrowx
cbugcbugc***DEBUG ends.
endif
140 continue
145 continue
150 continue
if (nerr .ne. 0) go to 210
c.... Test for duplicate characters in same box.
do 190 nbox = 1, 9
nrowbeg = 1 + 3 * ((nbox - 1) / 3)
nrowend = nrowbeg + 2
ncolbeg = 1 + 3 * mod (nbox - 1, 3)
ncolend = ncolbeg + 2
do 180 nrow = nrowbeg, nrowend
do 175 ncol = ncolbeg, ncolend
if (acell(nrow,ncol) .eq. achars(0)) go to 175
do 170 nrowx= nrowbeg, nrowend
do 165 ncolx = ncolbeg, ncolend
if (acell(nrowx,ncolx) .eq. achars(0)) go to 165
if ((nrow .ge. nrowx) .and.
& (ncol .ge. ncolx)) go to 165
if (acell(nrow,ncol) .eq. acell(nrowx,ncolx)) then
nerr = 5
adup = acell(nrow,ncol)
nrowd = nrow
ncold = ncol
cbugcbugc***DEBUG begins.
cbugcbug 9170 format ('Duplicate character',1x,a1,' in same box, row',i2,
cbugcbug & ', column',i2,' and row',i2,', column',i2,'.')
cbugcbug write ( 3, 9170) acell(nrow,ncol), nrow, ncol, nrowx, ncolx
cbugcbugc***DEBUG ends.
endif
165 continue
170 continue
175 continue
180 continue
190 continue
c=======================================================================********
210 continue
cbugc***DEBUG begins.
cbug 9903 format (/ 'aptsudu tested for character duplicates.',
cbug & ' nerr =',i2,'.')
cbug 9904 format ('Duplicate character',1x,a1,' in row',i2,', col',i2,'.')
cbug write ( 3, 9903) nerr
cbug if (nerr .ne. 0) then
cbug write ( 3, 9904) adup, nrowd, ncold
cbug endif
cbugc***DEBUG ends.
return
c.... End of subroutine aptsudu. (+1 line.)
end
UCRL-WEB-209832