vhammang24
Programmer
can anyone improve on this sudoku solver.
MODULE utils
IMPLICIT NONE
CONTAINS
SUBROUTINE read_puzzle(known)
! Read in the puzzle grid from puzzle.dat.
! Gives array with known numbers.
IMPLICIT NONE
INTEGER, INTENT(out) :: known(9,9)
INTEGER :: i,j,k,ierr
CHARACTER(1) :: char_array(9,9)
CHARACTER(80) :: char80
OPEN(unit=8,file='puzzle.dat',status='old',iostat=ierr)
IF(ierr/=0)THEN
WRITE(*,*)'Cannot open puzzle.dat.'
STOP
ENDIF
known(1:9,1:9)=0
DO i=1,9
read(8,'(a)')char80
char80=adjustl(char80)
READ(char80,'(9a)',iostat=ierr)char_array(i,1:9)
IF(ierr/=0)THEN
WRITE(*,*)'Problem reading data from puzzle.dat.'
STOP
ENDIF ! ierr
DO j=1,9
DO k=1,9
IF(CHAR(48+k)==char_array(i,j))THEN
known(i,j)=k
EXIT
ENDIF ! Number read in.
ENDDO ! k
ENDDO ! j
ENDDO ! i
CLOSE(8)
END SUBROUTINE read_puzzle
SUBROUTINE write_puzzle(io,margin,known)
! Write out puzzle grid (known numbers) to unit io. The grid is indented
! by margin spaces.
IMPLICIT NONE
INTEGER,INTENT(in) :: io,known(9,9),margin
INTEGER :: i,j,ierr
CHARACTER(1) :: char_array(9,9)
CHARACTER(20) :: fmtstring
DO i=1,9
DO j=1,9
char_array(i,j)=CHAR(48+known(i,j))
ENDDO ! j
ENDDO ! i
if(margin>0)then
fmtstring='('//trim(i2s(margin))//'x,9a)'
else
fmtstring='(9a)'
endif ! margin>0
DO i=1,9
WRITE(io,trim(fmtstring),iostat=ierr)char_array(i,1:9)
IF(ierr/=0)THEN
WRITE(*,*)'Problem writing out puzzle data.'
STOP
ENDIF ! ierr
ENDDO ! i
END SUBROUTINE write_puzzle
SUBROUTINE check_known(known)
! Check that there aren't any contradictions in the array of "known"
! numbers. This would indicate either an impossible (self-contradictory)
! puzzle, or a bug in the code.
IMPLICIT NONE
INTEGER,INTENT(in) :: known(9,9)
INTEGER :: i,j,k,i1,j1,i2,j2,i3,j3,i4,j4,i5,j5,k1,k2
! Check rows don't contradict...
DO i=1,9
DO j=1,8
IF(known(i,j)>0)THEN
DO k=j+1,9
IF(known(i,j)==known(i,k))THEN
WRITE(*,*)'Problem with puzzle:'
WRITE(*,*)'Element ('//TRIM(i2s(i))//','//TRIM(i2s(j)) &
&//') is '//TRIM(i2s(known(i,j)))//'.'
WRITE(*,*)'Element ('//TRIM(i2s(i))//','//TRIM(i2s(k)) &
&//') is '//TRIM(i2s(known(i,k)))//'.'
STOP
ENDIF ! known(i,j)=known(i,k)
ENDDO ! k
ENDIF ! known(i,j)>0
ENDDO ! j
ENDDO ! i
! Check columns don't contradict...
DO i=1,9
DO j=1,8
IF(known(j,i)>0)THEN
DO k=j+1,9
IF(known(j,i)==known(k,i))THEN
WRITE(*,*)'Problem with puzzle:'
WRITE(*,*)'Element ('//TRIM(i2s(j))//','//TRIM(i2s(i)) &
&//') is '//TRIM(i2s(known(j,i)))//'.'
WRITE(*,*)'Element ('//TRIM(i2s(k))//','//TRIM(i2s(i)) &
&//') is '//TRIM(i2s(known(k,i)))//'.'
STOP
ENDIF ! known(j,i)=known(k,i)
ENDDO ! k
ENDIF ! known(j,i)>0
ENDDO ! j
ENDDO ! i
! Check squares don't contradict.
DO j1=1,3
DO j2=1,3
j4=3*(j1-1)+j2
DO i1=1,3
DO i2=1,3
i4=3*(i1-1)+i2
k1=known(i4,j4)
IF(k1>0)THEN
DO j3=1,3
j5=3*(j1-1)+j3
DO i3=1,3
IF(i2/=i3.OR.j2/=j3)THEN
i5=3*(i1-1)+i3
k2=known(i5,j5)
IF(k1==k2)THEN
WRITE(*,*)'Problem with puzzle:'
WRITE(*,*)'Element ('//TRIM(i2s(i4))//',' &
&//TRIM(i2s(j4))//') is '//TRIM(i2s(k1)) &
&//'.'
WRITE(*,*)'Element ('//TRIM(i2s(i5))//',' &
&//TRIM(i2s(j5))//') is '//TRIM(i2s(k2)) &
&//'.'
STOP
ENDIF ! k1=k2
ENDIF ! i2/=i3 or j1/=j3
ENDDO ! i3
ENDDO !j3
ENDIF ! k1>0
ENDDO ! i2
ENDDO ! i1
ENDDO ! j2
ENDDO ! j1
END SUBROUTINE check_known
SUBROUTINE update_possible(known,possible,contradiction)
! This subroutine take the array of known and possible numbers and applies
! the rules each number occurs only once in each row and column and
! square, in order to determine the array of possibilities for each
! element. If there is just one possibility then the known array is
! updated. If a contradiction is found then the updating is halted
! and the subroutine returns with contradiction=T.
! We continue updating in this fashion until the known array ceases to
! change.
IMPLICIT NONE
INTEGER,INTENT(inout) :: known(9,9)
LOGICAL,INTENT(inout) :: possible(9,9,9)
LOGICAL,INTENT(out) :: contradiction
INTEGER :: i,j,k,i1,j1,i2,j2,no_poss
LOGICAL :: changed
contradiction=.FALSE.
DO
changed=.FALSE.
! Make sure that everything that is "known" is reflected in the
! "possible" array.
DO i=1,9
DO j=1,9
k=known(i,j)
IF(k>0)THEN
IF(.NOT.possible(k,i,j))THEN
contradiction=.TRUE.
RETURN
ENDIF
possible(k,1:9,j)=.FALSE.
possible(k,i,1:9)=.FALSE.
possible(1:9,i,j)=.FALSE.
possible(k,i,j)=.TRUE.
ENDIF ! known
ENDDO ! j
ENDDO ! i
! Take each known number and update the array of possible numbers
! by eliminating the known number from the list of possibilities
! for each element in the row and column containing that square.
DO i1=1,3
DO j1=1,3
DO i=1,3
DO j=1,3
k=known(3*(i1-1)+i,3*(j1-1)+j)
IF(k>0)THEN
DO i2=1,3
DO j2=1,3
possible(k,3*(i1-1)+i2,3*(j1-1)+j2)=.FALSE.
ENDDO ! j2
ENDDO ! i2
possible(1:9,3*(i1-1)+i,3*(j1-1)+j)=.FALSE.
possible(k,3*(i1-1)+i,3*(j1-1)+j)=.TRUE.
ENDIF ! known
ENDDO ! j
ENDDO ! i
ENDDO ! j1
ENDDO ! i1
! Count up the number of possibilities for each element. If there is
! just one possibility then we have a new "known" number. If there
! are zero then we have a contradiction.
DO i=1,9
DO j=1,9
no_poss=0
DO k=1,9
IF(possible(k,i,j))no_poss=no_poss+1
ENDDO ! k
IF(no_poss==1)THEN
DO k=1,9
IF(possible(k,i,j))THEN
IF(known(i,j)==0)THEN
changed=.TRUE.
ELSEIF(known(i,j)/=k)THEN
contradiction=.TRUE.
RETURN
ENDIF ! xxx
known(i,j)=k
EXIT
ENDIF ! possible(k,i,j)
ENDDO ! k
ELSEIF(no_poss==0)THEN
contradiction=.TRUE.
RETURN
ENDIF ! no_poss=1
ENDDO ! j
ENDDO ! i
IF(.NOT.changed)EXIT
ENDDO ! Loop until done
END SUBROUTINE update_possible
RECURSIVE SUBROUTINE guess_unknown(known,possible,works)
! This subroutine looks for the first unknown element, chooses the first
! possible number for that element (in a trial known & possible array),
! the updates the possible elements of the trial arrays. If there is a
! contradiction, the value tried is removed from the actual list of
! possibilities. If there is not then the subroutine is called recursively
! with the trial arrays, so that further guesses are made. If this leads
! to the puzzle being completed, the subroutine exits with works=.true.;
! otherwise, works=.false., and the guess is rejected, allowing the
! possible array to be updated.
IMPLICIT NONE
INTEGER,INTENT(inout) :: known(9,9)
LOGICAL,INTENT(inout) :: possible(9,9,9)
LOGICAL,INTENT(out) :: works
INTEGER :: i,j,k,known_trial(9,9)
LOGICAL :: possible_trial(9,9,9),contradiction
works=.TRUE.
DO i=1,9
DO j=1,9
IF(known(i,j)==0)THEN
DO k=1,9
IF(possible(k,i,j))THEN
known_trial=known
possible_trial=possible
known_trial(i,j)=k
CALL update_possible(known_trial,possible_trial, &
&contradiction)
IF(contradiction)THEN
possible(k,i,j)=.FALSE.
ELSE
CALL guess_unknown(known_trial,possible_trial,works)
IF(works)THEN
known=known_trial
possible=possible_trial
RETURN
ELSE
possible(k,i,j)=.FALSE.
ENDIF ! works
ENDIF ! contradiction
ENDIF ! possible
ENDDO ! k
works=.FALSE.
RETURN
ENDIF ! unknown(i,j)
ENDDO ! j
ENDDO ! i
END SUBROUTINE guess_unknown
CHARACTER(20) FUNCTION i2s
! Convert integers to left-justified strings that can be printed in the
! middle of a sentence without introducing large amounts of white space.
! (Thanks to Mike Towler.)
INTEGER,INTENT(in) :: n
INTEGER :: i,j
CHARACTER :: tmp,sign
IF(n==0)THEN
i2s='0' ; RETURN
ENDIF
sign=' ' ; IF(n<0)sign='-'
DO i=1,LEN(i2s)
i2s(i:i)=' '
ENDDO ! i
i=ABS
DO j=1,LEN(i2s)
IF(i==0)EXIT
i2s(j:j)=ACHAR(ICHAR('0')+MOD(i,10))
i=i/10
ENDDO ! j
i=1 ; j=LEN_TRIM(i2s)
DO
IF(i>=j)EXIT
tmp=i2s(j:j)
i2s(j:j)=i2s(i:i)
i2s(i:i)=tmp
i=i+1
j=j-1
ENDDO
i2s=TRIM(sign)//i2s
END FUNCTION i2s
END MODULE utils
PROGRAM sudoku_solver
! Main program starts here.
USE utils
IMPLICIT NONE
INTEGER :: known(9,9)
LOGICAL :: possible(9,9,9),contradiction,works
WRITE(*,*)
WRITE(*,*)'O---------------O'
WRITE(*,*)'| Sudoku solver |'
WRITE(*,*)'O---------------O'
WRITE(*,*)
! Read in the initial configuration.
CALL read_puzzle(known)
possible=.TRUE.
WRITE(*,*)'Puzzle grid as supplied in puzzle.dat:'
WRITE(*,*)
CALL write_puzzle(6,4,known)
WRITE(*,*)
! Check for contradictions.
CALL check_known(known)
! Apply the straightforward rules.
CALL update_possible(known,possible,contradiction)
IF(contradiction)THEN
WRITE(*,*)'Puzzle is self-contradictory.'
STOP
ENDIF ! contradiction
! Check for contradictions.
CALL check_known(known)
IF(ANY(known==0))THEN
WRITE(*,*)'Guesswork required...'
! Guess the unknown elements.
CALL guess_unknown(known,possible,works)
IF(.NOT.works)THEN
WRITE(*,*)'Puzzle is self-contradictory.'
STOP
ENDIF ! not works
! Check for contradictions.
CALL check_known(known)
ELSE
WRITE(*,*)'Puzzle can be complete by straightforward application of the &
&exclusion rules'
WRITE(*,*)'for rows, columns and squares.'
ENDIF ! Guesswork needed
WRITE(*,*)
WRITE(*,*)'Completed puzzle is:'
WRITE(*,*)
CALL write_puzzle(6,4,known)
WRITE(*,*)
WRITE(*,*)'Program finished.'
WRITE(*,*)
END PROGRAM sudoku_solver
MODULE utils
IMPLICIT NONE
CONTAINS
SUBROUTINE read_puzzle(known)
! Read in the puzzle grid from puzzle.dat.
! Gives array with known numbers.
IMPLICIT NONE
INTEGER, INTENT(out) :: known(9,9)
INTEGER :: i,j,k,ierr
CHARACTER(1) :: char_array(9,9)
CHARACTER(80) :: char80
OPEN(unit=8,file='puzzle.dat',status='old',iostat=ierr)
IF(ierr/=0)THEN
WRITE(*,*)'Cannot open puzzle.dat.'
STOP
ENDIF
known(1:9,1:9)=0
DO i=1,9
read(8,'(a)')char80
char80=adjustl(char80)
READ(char80,'(9a)',iostat=ierr)char_array(i,1:9)
IF(ierr/=0)THEN
WRITE(*,*)'Problem reading data from puzzle.dat.'
STOP
ENDIF ! ierr
DO j=1,9
DO k=1,9
IF(CHAR(48+k)==char_array(i,j))THEN
known(i,j)=k
EXIT
ENDIF ! Number read in.
ENDDO ! k
ENDDO ! j
ENDDO ! i
CLOSE(8)
END SUBROUTINE read_puzzle
SUBROUTINE write_puzzle(io,margin,known)
! Write out puzzle grid (known numbers) to unit io. The grid is indented
! by margin spaces.
IMPLICIT NONE
INTEGER,INTENT(in) :: io,known(9,9),margin
INTEGER :: i,j,ierr
CHARACTER(1) :: char_array(9,9)
CHARACTER(20) :: fmtstring
DO i=1,9
DO j=1,9
char_array(i,j)=CHAR(48+known(i,j))
ENDDO ! j
ENDDO ! i
if(margin>0)then
fmtstring='('//trim(i2s(margin))//'x,9a)'
else
fmtstring='(9a)'
endif ! margin>0
DO i=1,9
WRITE(io,trim(fmtstring),iostat=ierr)char_array(i,1:9)
IF(ierr/=0)THEN
WRITE(*,*)'Problem writing out puzzle data.'
STOP
ENDIF ! ierr
ENDDO ! i
END SUBROUTINE write_puzzle
SUBROUTINE check_known(known)
! Check that there aren't any contradictions in the array of "known"
! numbers. This would indicate either an impossible (self-contradictory)
! puzzle, or a bug in the code.
IMPLICIT NONE
INTEGER,INTENT(in) :: known(9,9)
INTEGER :: i,j,k,i1,j1,i2,j2,i3,j3,i4,j4,i5,j5,k1,k2
! Check rows don't contradict...
DO i=1,9
DO j=1,8
IF(known(i,j)>0)THEN
DO k=j+1,9
IF(known(i,j)==known(i,k))THEN
WRITE(*,*)'Problem with puzzle:'
WRITE(*,*)'Element ('//TRIM(i2s(i))//','//TRIM(i2s(j)) &
&//') is '//TRIM(i2s(known(i,j)))//'.'
WRITE(*,*)'Element ('//TRIM(i2s(i))//','//TRIM(i2s(k)) &
&//') is '//TRIM(i2s(known(i,k)))//'.'
STOP
ENDIF ! known(i,j)=known(i,k)
ENDDO ! k
ENDIF ! known(i,j)>0
ENDDO ! j
ENDDO ! i
! Check columns don't contradict...
DO i=1,9
DO j=1,8
IF(known(j,i)>0)THEN
DO k=j+1,9
IF(known(j,i)==known(k,i))THEN
WRITE(*,*)'Problem with puzzle:'
WRITE(*,*)'Element ('//TRIM(i2s(j))//','//TRIM(i2s(i)) &
&//') is '//TRIM(i2s(known(j,i)))//'.'
WRITE(*,*)'Element ('//TRIM(i2s(k))//','//TRIM(i2s(i)) &
&//') is '//TRIM(i2s(known(k,i)))//'.'
STOP
ENDIF ! known(j,i)=known(k,i)
ENDDO ! k
ENDIF ! known(j,i)>0
ENDDO ! j
ENDDO ! i
! Check squares don't contradict.
DO j1=1,3
DO j2=1,3
j4=3*(j1-1)+j2
DO i1=1,3
DO i2=1,3
i4=3*(i1-1)+i2
k1=known(i4,j4)
IF(k1>0)THEN
DO j3=1,3
j5=3*(j1-1)+j3
DO i3=1,3
IF(i2/=i3.OR.j2/=j3)THEN
i5=3*(i1-1)+i3
k2=known(i5,j5)
IF(k1==k2)THEN
WRITE(*,*)'Problem with puzzle:'
WRITE(*,*)'Element ('//TRIM(i2s(i4))//',' &
&//TRIM(i2s(j4))//') is '//TRIM(i2s(k1)) &
&//'.'
WRITE(*,*)'Element ('//TRIM(i2s(i5))//',' &
&//TRIM(i2s(j5))//') is '//TRIM(i2s(k2)) &
&//'.'
STOP
ENDIF ! k1=k2
ENDIF ! i2/=i3 or j1/=j3
ENDDO ! i3
ENDDO !j3
ENDIF ! k1>0
ENDDO ! i2
ENDDO ! i1
ENDDO ! j2
ENDDO ! j1
END SUBROUTINE check_known
SUBROUTINE update_possible(known,possible,contradiction)
! This subroutine take the array of known and possible numbers and applies
! the rules each number occurs only once in each row and column and
! square, in order to determine the array of possibilities for each
! element. If there is just one possibility then the known array is
! updated. If a contradiction is found then the updating is halted
! and the subroutine returns with contradiction=T.
! We continue updating in this fashion until the known array ceases to
! change.
IMPLICIT NONE
INTEGER,INTENT(inout) :: known(9,9)
LOGICAL,INTENT(inout) :: possible(9,9,9)
LOGICAL,INTENT(out) :: contradiction
INTEGER :: i,j,k,i1,j1,i2,j2,no_poss
LOGICAL :: changed
contradiction=.FALSE.
DO
changed=.FALSE.
! Make sure that everything that is "known" is reflected in the
! "possible" array.
DO i=1,9
DO j=1,9
k=known(i,j)
IF(k>0)THEN
IF(.NOT.possible(k,i,j))THEN
contradiction=.TRUE.
RETURN
ENDIF
possible(k,1:9,j)=.FALSE.
possible(k,i,1:9)=.FALSE.
possible(1:9,i,j)=.FALSE.
possible(k,i,j)=.TRUE.
ENDIF ! known
ENDDO ! j
ENDDO ! i
! Take each known number and update the array of possible numbers
! by eliminating the known number from the list of possibilities
! for each element in the row and column containing that square.
DO i1=1,3
DO j1=1,3
DO i=1,3
DO j=1,3
k=known(3*(i1-1)+i,3*(j1-1)+j)
IF(k>0)THEN
DO i2=1,3
DO j2=1,3
possible(k,3*(i1-1)+i2,3*(j1-1)+j2)=.FALSE.
ENDDO ! j2
ENDDO ! i2
possible(1:9,3*(i1-1)+i,3*(j1-1)+j)=.FALSE.
possible(k,3*(i1-1)+i,3*(j1-1)+j)=.TRUE.
ENDIF ! known
ENDDO ! j
ENDDO ! i
ENDDO ! j1
ENDDO ! i1
! Count up the number of possibilities for each element. If there is
! just one possibility then we have a new "known" number. If there
! are zero then we have a contradiction.
DO i=1,9
DO j=1,9
no_poss=0
DO k=1,9
IF(possible(k,i,j))no_poss=no_poss+1
ENDDO ! k
IF(no_poss==1)THEN
DO k=1,9
IF(possible(k,i,j))THEN
IF(known(i,j)==0)THEN
changed=.TRUE.
ELSEIF(known(i,j)/=k)THEN
contradiction=.TRUE.
RETURN
ENDIF ! xxx
known(i,j)=k
EXIT
ENDIF ! possible(k,i,j)
ENDDO ! k
ELSEIF(no_poss==0)THEN
contradiction=.TRUE.
RETURN
ENDIF ! no_poss=1
ENDDO ! j
ENDDO ! i
IF(.NOT.changed)EXIT
ENDDO ! Loop until done
END SUBROUTINE update_possible
RECURSIVE SUBROUTINE guess_unknown(known,possible,works)
! This subroutine looks for the first unknown element, chooses the first
! possible number for that element (in a trial known & possible array),
! the updates the possible elements of the trial arrays. If there is a
! contradiction, the value tried is removed from the actual list of
! possibilities. If there is not then the subroutine is called recursively
! with the trial arrays, so that further guesses are made. If this leads
! to the puzzle being completed, the subroutine exits with works=.true.;
! otherwise, works=.false., and the guess is rejected, allowing the
! possible array to be updated.
IMPLICIT NONE
INTEGER,INTENT(inout) :: known(9,9)
LOGICAL,INTENT(inout) :: possible(9,9,9)
LOGICAL,INTENT(out) :: works
INTEGER :: i,j,k,known_trial(9,9)
LOGICAL :: possible_trial(9,9,9),contradiction
works=.TRUE.
DO i=1,9
DO j=1,9
IF(known(i,j)==0)THEN
DO k=1,9
IF(possible(k,i,j))THEN
known_trial=known
possible_trial=possible
known_trial(i,j)=k
CALL update_possible(known_trial,possible_trial, &
&contradiction)
IF(contradiction)THEN
possible(k,i,j)=.FALSE.
ELSE
CALL guess_unknown(known_trial,possible_trial,works)
IF(works)THEN
known=known_trial
possible=possible_trial
RETURN
ELSE
possible(k,i,j)=.FALSE.
ENDIF ! works
ENDIF ! contradiction
ENDIF ! possible
ENDDO ! k
works=.FALSE.
RETURN
ENDIF ! unknown(i,j)
ENDDO ! j
ENDDO ! i
END SUBROUTINE guess_unknown
CHARACTER(20) FUNCTION i2s
! Convert integers to left-justified strings that can be printed in the
! middle of a sentence without introducing large amounts of white space.
! (Thanks to Mike Towler.)
INTEGER,INTENT(in) :: n
INTEGER :: i,j
CHARACTER :: tmp,sign
IF(n==0)THEN
i2s='0' ; RETURN
ENDIF
sign=' ' ; IF(n<0)sign='-'
DO i=1,LEN(i2s)
i2s(i:i)=' '
ENDDO ! i
i=ABS
DO j=1,LEN(i2s)
IF(i==0)EXIT
i2s(j:j)=ACHAR(ICHAR('0')+MOD(i,10))
i=i/10
ENDDO ! j
i=1 ; j=LEN_TRIM(i2s)
DO
IF(i>=j)EXIT
tmp=i2s(j:j)
i2s(j:j)=i2s(i:i)
i2s(i:i)=tmp
i=i+1
j=j-1
ENDDO
i2s=TRIM(sign)//i2s
END FUNCTION i2s
END MODULE utils
PROGRAM sudoku_solver
! Main program starts here.
USE utils
IMPLICIT NONE
INTEGER :: known(9,9)
LOGICAL :: possible(9,9,9),contradiction,works
WRITE(*,*)
WRITE(*,*)'O---------------O'
WRITE(*,*)'| Sudoku solver |'
WRITE(*,*)'O---------------O'
WRITE(*,*)
! Read in the initial configuration.
CALL read_puzzle(known)
possible=.TRUE.
WRITE(*,*)'Puzzle grid as supplied in puzzle.dat:'
WRITE(*,*)
CALL write_puzzle(6,4,known)
WRITE(*,*)
! Check for contradictions.
CALL check_known(known)
! Apply the straightforward rules.
CALL update_possible(known,possible,contradiction)
IF(contradiction)THEN
WRITE(*,*)'Puzzle is self-contradictory.'
STOP
ENDIF ! contradiction
! Check for contradictions.
CALL check_known(known)
IF(ANY(known==0))THEN
WRITE(*,*)'Guesswork required...'
! Guess the unknown elements.
CALL guess_unknown(known,possible,works)
IF(.NOT.works)THEN
WRITE(*,*)'Puzzle is self-contradictory.'
STOP
ENDIF ! not works
! Check for contradictions.
CALL check_known(known)
ELSE
WRITE(*,*)'Puzzle can be complete by straightforward application of the &
&exclusion rules'
WRITE(*,*)'for rows, columns and squares.'
ENDIF ! Guesswork needed
WRITE(*,*)
WRITE(*,*)'Completed puzzle is:'
WRITE(*,*)
CALL write_puzzle(6,4,known)
WRITE(*,*)
WRITE(*,*)'Program finished.'
WRITE(*,*)
END PROGRAM sudoku_solver