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