Sudoku, Fortran - rextester

Sudoku

! BY IAN WALKER 2018
      INTEGER D,N,M,Z,X,P,R,BC,SC,BV,SV
      INTEGER FLOORV
      CHARACTER A(27)
      DIMENSION D(9,9,10)
!      OPEN(UNIT=7,FILE="SUDDATA.TXT")
!      OPEN(UNIT=8,FILE="SUDOUT.TXT")

!      J=ROW, K=COL, L=POSS

DO J=1,9
         DO K=1,9
            DO Z=1,10
              D(J,K,Z) =0
            END DO
         END DO
      END DO
      D(1,4,10)=8
      D(1,8,10)=4
      D(1,9,10)=9
      D(2,3,10)=4
      D(3,1,10)=5
      D(3,2,10)=2
      D(3,6,10)=4
      D(3,7,10)=8
      D(4,5,10)=2
      D(4,7,10)=4
      D(5,4,10)=1
      D(5,5,10)=5
      D(5,8,10)=6
      D(6,1,10)=6
      D(6,5,10)=4
      D(6,9,10)=8
      D(7,1,10)=3
      D(7,2,10)=8
      D(7,3,10)=2
      D(7,6,10)=9
      D(7,7,10)=1
      D(8,7,10)=3
      D(9,2,10)=1
      D(9,3,10)=6
      D(9,4,10)=7
      D(9,5,10)=3
      
      DO J=1,27
       A(J)=' '
      END DO     
!      DO J=1,9
!         READ(2,4) (D(J,K,10),K=1,9)
!         WRITE(*,*) (D(J,K,10),K=1,9)
!    4    FORMAT(9I4)
!      END DO

DO J=1,9
         WRITE(8,7) (D(J,K,10),K=1,9)
    7    FORMAT(9I4)
      END DO

!FOR EACH ELEMENT THAT IS NON ZERO

DO 101 N=1,9
      DO 100 M=1,9
      Z=D(N,M,10)
!     Z IS THE VALUE OF THE NUMBER IN THE BOX
      IF (Z .EQ. 0) THEN 
        GOTO 100
      ENDIF
      DO 20 P=1,9
         D(N,P,Z)= -1
         D(P,M,Z)= -1
   20 CONTINUE
! Use floorv function to find the lowest cell number for the big cell, 1 4 or 7
         DO 31 R=FLOORV(N),FLOORV(N)+2
            DO 30 P=FLOORV(M),FLOORV(M)+2
                D(R,P,Z)=-1
   30       CONTINUE
   31    CONTINUE
  100 CONTINUE
  101 CONTINUE

!PRINTING OF THE SUDOKU GRID
      WRITE(*,*)"     1   2   3    4   5   6    7   8   9"
      WRITE(*,*)"  ++===+===+===++===+===+===++===+===+===++"
      DO 126 J=1,27
      DO 6 N=1,27
          A(N)=' '
    6 CONTINUE
      DO 106 P=1,27
! BC = BIG CELL COUNT (1-9) HORIZONTAL
! SC = SMALL CELL COUNT (1-3) HORIZONTAL
! BV = BIG CELL COUNT (1-9) VERTICAL
! SV = SMALL CELL COUNT (1-3) VERTICAL
      BC=(P+2)/3
      SC=MOD(P-1,3)+1
      BV=(J+2)/3
      SV=MOD(J-1,3)+1
!      WRITE(8,201)J,BC,SC,BV,SV
!  201 FORMAT(5I4) 
      
        IF (D(BV,BC,10).NE.0) THEN
          A(P)=' '
          IF (SV.EQ.2) THEN
             IF(SC.EQ.1) THEN
               A(P)='('
             ELSEIF (SC.EQ.2) THEN
               WRITE(A(P),104) D(BV,BC,10)
             ELSEIF (SC.EQ.3) THEN
               A(P)=')'
             ENDIF
          ENDIF
          GOTO 106
        ENDIF 
          IF (D(BV,BC,SC+3*(SV-1)).EQ.0) THEN 
            WRITE(A(P),104)SC+3*(SV-1)
          ENDIF
  104     FORMAT (I1)
  106 CONTINUE
      WRITE(*,*)'  ||',A(1),A(2),A(3),'|',A(4),A(5),A(6),'|',A(7),A(8)&
     ,A(9),'||',A(10),A(11),A(12),'|',A(13),A(14),A(15),'|',A(16),A(17)&
     ,A(18),'||',A(19),A(20),A(21),'|',A(22),A(23),A(24),'|',A(25)&
     ,A(26),A(27),'||'
     IF (MOD(J,9).EQ.0) WRITE(*,*)"  ++===+===+===++===+===+===++===+===+===++"
     IF ((MOD(J,9).NE.0) .AND. (MOD(J,3).EQ.0)) WRITE(*,*)"  ++---+---+---++---+---+---++---+---+---++"
  
  126 CONTINUE

!      DO 200 N=1,9
!      DO 200 M=1,9
!      DO 200 Z=1,9
!      WRITE (8,110) N,M,Z,D(N,M,Z)
!  110 FORMAT(4I5)
!  200 CONTINUE
            
      END

INTEGER FUNCTION FLOORV(X)
      INTEGER X
      FLOORV=4
      IF(X.LT.4) FLOORV=1
      IF(X.GT.6) FLOORV=7
      RETURN
      END


run \| edit \| history \| help	0