' Generates SelfOrthogonal Latin Diagonal Squares (8 x 8)
' Associated (Idempotent Squares)
' Tested with Office 365 under Windows 11
Sub SelfOrth8a()
Dim a(64), b(8), a1(8)
Dim b2(64), c(64), a0(8, 8)
y = MsgBox("Locked", vbCritical, "Routine SelfOrth8a")
End
n2 = 0: n9 = 0: k1 = 1: k2 = 1
m1 = 1: m2 = 8: s1 = 28: Pr8 = s1 / 4
For i1 = 1 To 8: a1(i1) = i1 - 1: Next i1
Sheets("Klad1").Select
t1 = Timer
For j64 = 8 To 8 ''m1 To m2 'a(64) 8 To 8
a(64) = a1(j64)
a(1) = Pr8 - a(64)
For j63 = m1 To m2 'a(63)
a(63) = a1(j63)
If a(63) = a(64) Then GoTo 630
a(2) = Pr8 - a(63)
For j62 = m1 To m2 'a(62)
a(62) = a1(j62)
If a(62) = a(63) Or a(62) = a(64) Then GoTo 620
a(3) = Pr8 - a(62)
For j61 = m1 To m2 'a(61)
a(61) = a1(j61)
If a(61) = a(62) Or a(61) = a(63) Or a(61) = a(64) Then GoTo 610
a(4) = Pr8 - a(61)
For j60 = m1 To m2 'a(60)
a(60) = a1(j60)
If a(60) = a(61) Or a(60) = a(62) Or a(60) = a(63) Or a(60) = a(64) Then GoTo 600
If a(60) = a(4) Then GoTo 600
a(5) = Pr8 - a(60)
If a(5) = a(61) Then GoTo 600
For j59 = m1 To m2 'a(59)
a(59) = a1(j59)
If a(59) = a(60) Or a(59) = a(61) Or a(59) = a(62) Or a(59) = a(63) Or a(59) = a(64) Then GoTo 590
If a(59) = a(3) Then GoTo 590
a(6) = Pr8 - a(59)
If a(6) = a(62) Then GoTo 590
For j58 = m1 To m2 'a(58)
a(58) = a1(j58)
If a(58) = a(59) Or a(58) = a(60) Or a(58) = a(61) Or a(58) = a(62) Or a(58) = a(63) Or a(58) = a(64) Then GoTo 580
If a(58) = a(2) Then GoTo 580
a(7) = Pr8 - a(58)
If a(7) = a(63) Then GoTo 580
a(57) = s1 - a(58) - a(59) - a(60) - a(61) - a(62) - a(63) - a(64)
If a(57) < a1(m1) Or a(57) > a1(m2) Then GoTo 580
If a(57) = a(1) Then GoTo 580
a(8) = Pr8 - a(57)
If a(8) = a(64) Then GoTo 580
For j56 = m1 To m2 'a(56)
a(56) = a1(j56)
If a(56) = a(64) Or a(56) = a(8) Then GoTo 560
a(9) = Pr8 - a(56)
If a(9) = a(1) Or a(9) = a(57) Then GoTo 560
For j55 = 7 To 7 ''m1 To m2 'a(55)7 To 7
a(55) = a1(j55)
If a(55) = a(56) Then GoTo 550
If a(55) = a(63) Or a(55) = a(7) Then GoTo 550
If a(55) = a(64) Or a(55) = a(1) Then GoTo 550 'Diagonal 1
a(10) = Pr8 - a(55)
If a(10) = a(2) Or a(10) = a(58) Then GoTo 550
If a(10) = a(1) Or a(10) = a(55) Or a(10) = a(64) Then GoTo 550 'Diagonal 1
For j54 = m1 To m2 'a(54)
a(54) = a1(j54)
If a(54) = a(55) Or a(54) = a(56) Then GoTo 540
If a(54) = a(62) Or a(54) = a(6) Then GoTo 540
a(11) = Pr8 - a(54)
If a(11) = a(3) Or a(11) = a(59) Then GoTo 540
For j53 = m1 To m2 'a(53)
a(53) = a1(j53)
If a(53) = a(54) Or a(53) = a(55) Or a(53) = a(56) Then GoTo 530
If a(53) = a(61) Or a(53) = a(5) Then GoTo 530
a(12) = Pr8 - a(53)
If a(12) = a(4) Or a(12) = a(60) Then GoTo 530
For j52 = m1 To m2 'a(52)
a(52) = a1(j52)
If a(52) = a(53) Or a(52) = a(54) Or a(52) = a(55) Or a(52) = a(56) Then GoTo 520
If a(52) = a(4) Or a(52) = a(12) Or a(52) = a(60) Then GoTo 520
a(13) = Pr8 - a(52)
If a(13) = a(5) Or a(13) = a(53) Or a(13) = a(61) Then GoTo 520
For j51 = m1 To m2 'a(51)
a(51) = a1(j51)
If a(51) = a(52) Or a(51) = a(53) Or a(51) = a(54) Or a(51) = a(55) Or a(51) = a(56) Then GoTo 510
If a(51) = a(3) Or a(51) = a(11) Or a(51) = a(59) Then GoTo 510
a(14) = Pr8 - a(51)
If a(14) = a(6) Or a(14) = a(54) Or a(14) = a(62) Then GoTo 510
For j50 = m1 To m2 'a(50)
a(50) = a1(j50)
If a(50) = a(51) Or a(50) = a(52) Or a(50) = a(53) Or a(50) = a(54) Or a(50) = a(55) Or a(50) = a(56) Then GoTo 500
If a(50) = a(2) Or a(50) = a(10) Or a(50) = a(58) Then GoTo 500
If a(50) = a(8) Or a(50) = a(57) Then GoTo 500 'Diagonal 2
a(15) = Pr8 - a(50)
If a(15) = a(7) Or a(15) = a(55) Or a(15) = a(63) Then GoTo 500
If a(15) = a(8) Or a(15) = a(50) Or a(15) = a(57) Then GoTo 500 'Diagonal 2
a(49) = s1 - a(50) - a(51) - a(52) - a(53) - a(54) - a(55) - a(56)
If a(49) < a1(m1) Or a(49) > a1(m2) Then GoTo 500
If a(49) = a(1) Or a(49) = a(9) Or a(49) = a(57) Then GoTo 500
a(16) = Pr8 - a(49)
If a(16) = a(8) Or a(16) = a(56) Or a(16) = a(64) Then GoTo 500
For j48 = m1 To m2 'a(48)
a(48) = a1(j48)
If a(48) = a(64) Or a(48) = a(8) Or a(48) = a(56) Or a(48) = a(16) Then GoTo 480
a(17) = Pr8 - a(48)
If a(17) = a(1) Or a(17) = a(57) Or a(17) = a(9) Or a(17) = a(49) Then GoTo 480
For j47 = m1 To m2 'a(47)
a(47) = a1(j47)
If a(47) = a(48) Then GoTo 470
If a(47) = a(63) Or a(47) = a(7) Or a(47) = a(55) Or a(47) = a(15) Then GoTo 470
a(18) = Pr8 - a(47)
If a(18) = a(2) Or a(18) = a(58) Or a(18) = a(10) Or a(18) = a(50) Then GoTo 470
For j46 = 6 To 6 ''m1 To m2 'a(46) 6 To 6 ''
a(46) = a1(j46)
If a(46) = a(47) Or a(46) = a(48) Then GoTo 460
If a(46) = a(62) Or a(46) = a(6) Or a(46) = a(54) Or a(46) = a(14) Then GoTo 460
If a(46) = a(64) Or a(46) = a(1) Or a(46) = a(55) Or a(46) = a(10) Then GoTo 460 'Diagonal 1
a(19) = Pr8 - a(46)
If a(19) = a(3) Or a(19) = a(59) Or a(19) = a(11) Or a(19) = a(51) Then GoTo 460
If a(19) = a(1) Or a(19) = a(10) Or a(19) = a(46) Or a(19) = a(55) Or a(19) = a(64) Then GoTo 460 'Diagonal 1
For j45 = m1 To m2 'a(45)
a(45) = a1(j45)
If a(45) = a(46) Or a(45) = a(47) Or a(45) = a(48) Then GoTo 450
If a(45) = a(61) Or a(45) = a(5) Or a(45) = a(53) Or a(45) = a(13) Then GoTo 450
a(20) = Pr8 - a(45)
If a(20) = a(4) Or a(20) = a(60) Or a(20) = a(12) Or a(20) = a(52) Then GoTo 450
For j44 = m1 To m2 'a(44)
a(44) = a1(j44)
If a(44) = a(45) Or a(44) = a(46) Or a(44) = a(47) Or a(44) = a(48) Then GoTo 440
If a(44) = a(4) Or a(44) = a(12) Or a(44) = a(60) Or a(44) = a(20) Or a(44) = a(52) Then GoTo 440
a(21) = Pr8 - a(44)
If a(21) = a(5) Or a(21) = a(53) Or a(21) = a(61) Or a(21) = a(13) Or a(21) = a(45) Then GoTo 440
For j43 = m1 To m2 'a(43)
a(43) = a1(j43)
If a(43) = a(44) Or a(43) = a(45) Or a(43) = a(46) Or a(43) = a(47) Or a(43) = a(48) Then GoTo 430
If a(43) = a(3) Or a(43) = a(11) Or a(43) = a(59) Or a(43) = a(19) Or a(43) = a(51) Then GoTo 430
If a(43) = a(8) Or a(43) = a(57) Or a(43) = a(15) Or a(43) = a(50) Then GoTo 430 'Diagonal 2
a(22) = Pr8 - a(43)
If a(22) = a(6) Or a(22) = a(54) Or a(22) = a(62) Or a(22) = a(14) Or a(22) = a(46) Then GoTo 430
If a(22) = a(8) Or a(22) = a(50) Or a(22) = a(57) Or a(22) = a(15) Or a(22) = a(43) Then GoTo 430 'Diagonal 2
For j42 = m1 To m2 'a(42)
a(42) = a1(j42)
If a(42) = a(43) Or a(42) = a(44) Or a(42) = a(45) Or a(42) = a(46) Or a(42) = a(47) Or a(42) = a(48) Then GoTo 420
If a(42) = a(2) Or a(42) = a(10) Or a(42) = a(58) Or a(42) = a(18) Or a(42) = a(50) Then GoTo 420
a(23) = Pr8 - a(42)
If a(23) = a(7) Or a(23) = a(55) Or a(23) = a(63) Or a(23) = a(15) Or a(23) = a(47) Then GoTo 420
a(41) = s1 - a(42) - a(43) - a(44) - a(45) - a(46) - a(47) - a(48)
If a(41) < a1(m1) Or a(41) > a1(m2) Then GoTo 420
If a(41) = a(1) Or a(41) = a(9) Or a(41) = a(57) Or a(41) = a(17) Or a(41) = a(49) Then GoTo 420
a(24) = Pr8 - a(41)
If a(24) = a(8) Or a(24) = a(56) Or a(24) = a(64) Or a(24) = a(16) Or a(24) = a(48) Then GoTo 420
For j40 = m1 To m2 'a(40)
a(40) = a1(j40)
If a(40) = a(64) Or a(40) = a(8) Or a(40) = a(56) Or a(40) = a(16) Or a(40) = a(48) Or a(40) = a(24) Then GoTo 400
a(25) = Pr8 - a(40)
If a(25) = a(1) Or a(25) = a(57) Or a(25) = a(9) Or a(25) = a(49) Or a(25) = a(17) Or a(25) = a(41) Then GoTo 400
For j39 = m1 To m2 'a(39)
a(39) = a1(j39)
If a(39) = a(40) Then GoTo 390
If a(39) = a(63) Or a(39) = a(7) Or a(39) = a(55) Or a(39) = a(15) Or a(39) = a(47) Or a(39) = a(23) Then GoTo 390
a(26) = Pr8 - a(39)
If a(26) = a(2) Or a(26) = a(58) Or a(26) = a(10) Or a(26) = a(50) Or a(26) = a(18) Or a(26) = a(42) Then GoTo 390
For j38 = m1 To m2 'a(38)
a(38) = a1(j38)
If a(38) = a(39) Or a(38) = a(40) Then GoTo 380
If a(38) = a(62) Or a(38) = a(6) Or a(38) = a(54) Or a(38) = a(14) Or a(38) = a(46) Or a(38) = a(22) Then GoTo 380
a(27) = Pr8 - a(38)
If a(27) = a(3) Or a(27) = a(59) Or a(27) = a(11) Or a(27) = a(51) Or a(27) = a(19) Or a(27) = a(43) Then GoTo 380
a(37) = -a(38) - a(39) - a(40) - a(45) - a(46) - a(47) - a(48) + a(49) + a(50) + a(51) + a(52) + a(57) + a(58) + a(59) + a(60)
If a(37) < a1(m1) Or a(37) > a1(m2) Then GoTo 380
If a(37) = a(38) Or a(37) = a(39) Or a(37) = a(40) Then GoTo 380
If a(37) = a(61) Or a(37) = a(5) Or a(37) = a(53) Or a(37) = a(13) Or a(37) = a(45) Or a(37) = a(21) Then GoTo 380
If a(37) <> 4 Then GoTo 380 'Option for Idempotent Squares
a(28) = Pr8 - a(37)
If a(28) = a(4) Or a(28) = a(60) Or a(28) = a(12) Or a(28) = a(52) Or a(28) = a(20) Or a(28) = a(44) Then GoTo 380
If a(28) = a(1) Or a(28) = a(10) Or a(28) = a(19) Or a(28) = a(37) Or a(28) = a(46) Or a(28) = a(55) Or a(28) = a(64) Then GoTo 380
a(36) = a(37) - a(44) + a(45) - a(52) + a(53) - a(60) + a(61)
If a(36) < a1(m1) Or a(36) > a1(m2) Then GoTo 380
If a(36) = a(37) Or a(36) = a(38) Or a(36) = a(39) Or a(36) = a(40) Then GoTo 380
If a(36) = a(60) Or a(36) = a(4) Or a(36) = a(52) Or a(36) = a(12) Or a(36) = a(44) Or a(36) = a(20) Or a(36) = a(28) Then GoTo 380
a(29) = Pr8 - a(36)
If a(29) = a(5) Or a(29) = a(61) Or a(29) = a(13) Or a(29) = a(53) Or a(29) = a(21) Or a(29) = a(45) Or a(29) = a(37) Then GoTo 380
If a(29) = a(8) Or a(29) = a(15) Or a(29) = a(22) Or a(29) = a(36) Or a(29) = a(43) Or a(29) = a(50) Or a(29) = a(57) Then GoTo 380
a(35) = a(38) - a(43) + a(46) - a(51) + a(54) - a(59) + a(62)
If a(35) < a1(m1) Or a(35) > a1(m2) Then GoTo 380
If a(35) = a(36) Or a(35) = a(37) Or a(35) = a(38) Or a(35) = a(39) Or a(35) = a(40) Then GoTo 380
If a(35) = a(59) Or a(35) = a(3) Or a(35) = a(51) Or a(35) = a(11) Or a(35) = a(43) Or a(35) = a(19) Or a(35) = a(27) Then GoTo 380
a(30) = Pr8 - a(35)
If a(30) = a(6) Or a(30) = a(62) Or a(30) = a(14) Or a(30) = a(54) Or a(30) = a(22) Or a(30) = a(46) Or a(30) = a(38) Then GoTo 380
a(34) = a(39) - a(42) + a(47) - a(50) + a(55) - a(58) + a(63)
If a(34) < a1(m1) Or a(34) > a1(m2) Then GoTo 380
If a(34) = a(35) Or a(34) = a(36) Or a(34) = a(37) Or a(34) = a(38) Or a(34) = a(39) Or a(34) = a(40) Then GoTo 380
If a(34) = a(58) Or a(34) = a(2) Or a(34) = a(50) Or a(34) = a(10) Or a(34) = a(42) Or a(34) = a(18) Or a(34) = a(26) Then GoTo 380
a(31) = Pr8 - a(34)
If a(31) = a(7) Or a(31) = a(63) Or a(31) = a(15) Or a(31) = a(55) Or a(31) = a(23) Or a(31) = a(47) Or a(31) = a(39) Then GoTo 380
a(33) = s1 - a(34) - a(35) - a(36) - a(37) - a(38) - a(39) - a(40)
If a(33) < a1(m1) Or a(33) > a1(m2) Then GoTo 380
a(32) = Pr8 - a(33)
GoSub 1800: If fl1 = 0 Then GoTo 5 'Check Latin Rpws, Columns and Diagonals
GoSub 1500: If fl1 = 0 Then GoTo 5 'Check Self Orthogonal
n9 = n9 + 1: ''GoSub 2650: End
Cells(1, 1).Value = n9
Cells(2, 1).Value = a(64)
5
380 Next j38
390 Next j39
400 Next j40
420 Next j42
430 Next j43
440 Next j44
450 Next j45
460 Next j46
470 Next j47
480 Next j48
500 Next j50
510 Next j51
520 Next j52
530 Next j53
540 Next j54
550 Next j55
560 Next j56
580 Next j58
590 Next j59
600 Next j60
610 Next j61
620 Next j62
630 Next j63
640 Next j64
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine SelfOrth8a")
End
' Exclude solutions with identical numbers in rows, columns, diagonals
1800
' Rows
i1 = -7
For i0 = 1 To 8
i1 = i1 + 8
b(1) = a(i1): b(2) = a(i1 + 1): b(3) = a(i1 + 2): b(4) = a(i1 + 3):
b(5) = a(i1 + 4): b(6) = a(i1 + 5): b(7) = a(i1 + 6): b(8) = a(i1 + 7)
GoSub 1860: If fl1 = 0 Then Return
Next i0
' Columns
i1 = 0
For i0 = 1 To 8
i1 = i1 + 1
b(1) = a(i1): b(2) = a(i1 + 8): b(3) = a(i1 + 16): b(4) = a(i1 + 24):
b(5) = a(i1 + 32): b(6) = a(i1 + 40): b(7) = a(i1 + 48): b(8) = a(i1 + 56)
GoSub 1860: If fl1 = 0 Then Return
Next i0
' Main Diagonals
b(1) = a(1): b(2) = a(10): b(3) = a(19): b(4) = a(28): b(5) = a(37): b(6) = a(46): b(7) = a(55): b(8) = a(64)
GoSub 1860: If fl1 = 0 Then Return
b(1) = a(8): b(2) = a(15): b(3) = a(22): b(4) = a(29): b(5) = a(36): b(6) = a(43): b(7) = a(50): b(8) = a(57)
GoSub 1860: If fl1 = 0 Then Return
Return
' Check identical numbers
1860 fl1 = 1
For j10 = 1 To 8
b20 = b(j10)
For j20 = (1 + j10) To 8
If b20 = b(j20) Then fl1 = 0: Return
Next j20
Next j10
Return
' Print results (selected numbers)
2645 For i1 = 1 To 64
Cells(n9, i1).Value = a(i1)
Next i1
Cells(n9, 65).Value = n9
Cells(1, 66).Value = n9
Return
' Print results (squares)
2650 n2 = n2 + 1
If n2 = 5 Then
n2 = 1: k1 = k1 + 9: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 9
End If
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = n9
i3 = 0
For i1 = 1 To 8
For i2 = 1 To 8
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = a(i3)
Next i2
Next i1
Return
' Check Self Orthogonal
1500 fl1 = 1
' Transpose a()
i3 = 0: Erase a0
For i1 = 1 To 8
For i2 = 1 To 8
i3 = i3 + 1
a0(i1, i2) = a(i3)
Next i2
Next i1
i3 = 0:
For i1 = 1 To 8
For i2 = 1 To 8
i3 = i3 + 1
b2(i3) = a0(i2, i1)
Next i2
Next i1
' Calculate c()
Erase c
For i1 = 1 To 64
c(i1) = 8 * a(i1) + b2(i1) + 1
Next i1
fl1 = 1: n20 = 0
For j1 = 1 To 64
a20 = c(j1):
For j2 = (1 + j1) To 64
If a20 = c(j2) Then fl1 = 0: Return
Next j2
1510 Next j1
Return
End Sub
