' Generates SelfOrthogonal Latin Diagonal Squares (9 x 9)
' Associated (Idempotent Squares)
' Tested with Office 365 under Windows 11
Sub SelfOrth9a()
Dim a(81), b(9), a1(9)
Dim b2(81), c2(81), a0(9, 9)
Dim s(32)
y = MsgBox("Locked", vbCritical, "Routine SelfOrth9a")
End
n2 = 0: n9 = 0: k1 = 1: k2 = 1
m1 = 1: m2 = 9: s1 = 36: Pr9 = 2 * s1 / 9
For i1 = 1 To 9: a1(i1) = i1 - 1: Next i1
Sheets("Klad1").Select
t1 = Timer
GoSub 1700 'Initialise diiagonal a()
' Row 1/9
For j80 = m1 To m2
a(80) = a1(j80)
If a(80) = a(81) Or a(80) = a(71) Then GoTo 800
a(2) = Pr9 - a(80)
If a(2) = a(1) Or a(2) = a(11) Then GoTo 20
For j79 = m1 To m2
a(79) = a1(j79)
If a(79) = a(81) Or a(79) = a(61) Then GoTo 790
If a(79) = a(80) Then GoTo 790
a(3) = Pr9 - a(79)
If a(3) = a(1) Or a(3) = a(21) Then GoTo 30
If a(3) = a(2) Then GoTo 30
For j78 = m1 To m2
a(78) = a1(j78)
If a(78) = a(81) Or a(78) = a(51) Then GoTo 780
If a(78) = a(80) Or a(78) = a(79) Then GoTo 780
a(4) = Pr9 - a(78)
If a(4) = a(1) Or a(4) = a(31) Then GoTo 40
If a(4) = a(2) Or a(4) = a(3) Then GoTo 40
For j77 = m1 To m2
a(77) = a1(j77)
If a(77) = a(81) Or a(77) = a(41) Then GoTo 770
If a(77) = a(80) Or a(77) = a(79) Or a(77) = a(78) Then GoTo 770
a(5) = Pr9 - a(77)
If a(5) = a(1) Or a(5) = a(41) Then GoTo 50
If a(5) = a(2) Or a(5) = a(3) Or a(5) = a(4) Then GoTo 50
For j76 = m1 To m2
a(76) = a1(j76)
If a(76) = a(81) Or a(76) = a(31) Then GoTo 760
If a(76) = a(80) Or a(76) = a(79) Or a(76) = a(78) Or a(76) = a(77) Then GoTo 760
If a(76) = a(4) Then GoTo 760
a(6) = Pr9 - a(76)
If a(6) = a(1) Or a(6) = a(51) Then GoTo 60
If a(6) = a(2) Or a(6) = a(3) Or a(6) = a(4) Or a(6) = a(5) Then GoTo 60
If a(6) = a(78) Then GoTo 60
For j75 = m1 To m2
a(75) = a1(j75)
If a(75) = a(81) Or a(75) = a(21) Then GoTo 750
If a(75) = a(80) Or a(75) = a(79) Or a(75) = a(78) Or a(75) = a(77) Or a(75) = a(76) Then GoTo 750
If a(75) = a(3) Then GoTo 750
a(7) = Pr9 - a(75)
If a(7) = a(1) Or a(7) = a(61) Then GoTo 70
If a(7) = a(2) Or a(7) = a(3) Or a(7) = a(4) Or a(7) = a(5) Or a(7) = a(6) Then GoTo 70
If a(7) = a(79) Then GoTo 70
For j74 = m1 To m2
a(74) = a1(j74)
If a(74) = a(81) Or a(74) = a(11) Then GoTo 740
If a(74) = a(80) Or a(74) = a(79) Or a(74) = a(78) Or a(74) = a(77) Or a(74) = a(76) Or a(74) = a(75) Then GoTo 740
If a(74) = a(2) Then GoTo 740
a(8) = Pr9 - a(74)
If a(8) = a(1) Or a(8) = a(71) Then GoTo 80
If a(8) = a(2) Or a(8) = a(3) Or a(8) = a(4) Or a(8) = a(5) Or a(8) = a(6) Or a(8) = a(7) Then GoTo 80
If a(8) = a(80) Then GoTo 80
a(73) = s1 - a(74) - a(75) - a(76) - a(77) - a(78) - a(79) - a(80) - a(81)
If a(73) < a1(m1) Or a(73) > a1(m2) Then GoTo 730
If a(73) = a(1) Then GoTo 730
If a(73) = a(41) Then GoTo 730
a(9) = Pr9 - a(73)
If a(9) = a(81) Then GoTo 90
' Column 1/9
For j72 = m1 To m2
a(72) = a1(j72)
If a(72) = a(81) Or a(72) = a(71) Then GoTo 720
If a(72) = a(9) Then GoTo 720
If a(72) = a(80) Then GoTo 720
a(10) = Pr9 - a(72)
If a(10) = a(1) Or a(10) = a(11) Then GoTo 100
If a(10) = a(73) Then GoTo 100
If a(10) = a(2) Then GoTo 100
For j63 = m1 To m2
a(63) = a1(j63)
If a(63) = a(81) Or a(63) = a(61) Then GoTo 630
If a(63) = a(9) Or a(63) = a(72) Then GoTo 630
If a(63) = a(79) Then GoTo 630
a(19) = Pr9 - a(63)
If a(19) = a(1) Or a(19) = a(21) Then GoTo 190
If a(19) = a(73) Or a(19) = a(10) Then GoTo 190
If a(19) = a(3) Then GoTo 190
For j54 = m1 To m2
a(54) = a1(j54)
If a(54) = a(81) Or a(54) = a(51) Then GoTo 540
If a(54) = a(9) Or a(54) = a(72) Or a(54) = a(63) Then GoTo 540
If a(54) = a(78) Then GoTo 540
a(28) = Pr9 - a(54)
If a(28) = a(1) Or a(28) = a(31) Then GoTo 280
If a(28) = a(73) Or a(28) = a(10) Or a(28) = a(19) Then GoTo 280
If a(28) = a(4) Then GoTo 280
For j45 = m1 To m2
a(45) = a1(j45)
If a(45) = a(81) Or a(45) = a(41) Then GoTo 450
If a(45) = a(9) Or a(45) = a(72) Or a(45) = a(63) Or a(45) = a(54) Then GoTo 450
If a(45) = a(77) Then GoTo 450
a(37) = Pr9 - a(45)
If a(37) = a(1) Or a(37) = a(41) Then GoTo 370
If a(37) = a(73) Or a(37) = a(10) Or a(37) = a(19) Or a(37) = a(28) Then GoTo 370
If a(37) = a(5) Then GoTo 370
For j36 = m1 To m2
a(36) = a1(j36)
If a(36) = a(81) Or a(36) = a(31) Then GoTo 360
If a(36) = a(9) Or a(36) = a(72) Or a(36) = a(63) Or a(36) = a(54) Or a(36) = a(45) Then GoTo 360
If a(36) = a(28) Then GoTo 360
If a(36) = a(76) Then GoTo 360
a(46) = Pr9 - a(36)
If a(46) = a(1) Or a(46) = a(51) Then GoTo 460
If a(46) = a(73) Or a(46) = a(10) Or a(46) = a(19) Or a(46) = a(28) Or a(46) = a(37) Then GoTo 460
If a(46) = a(54) Then GoTo 460
If a(46) = a(6) Then GoTo 460
For j27 = m1 To m2
a(27) = a1(j27)
If a(27) = a(81) Or a(27) = a(21) Then GoTo 270
If a(27) = a(9) Or a(27) = a(72) Or a(27) = a(63) Or a(27) = a(54) Or a(27) = a(45) Or a(27) = a(36) Then GoTo 270
If a(27) = a(19) Then GoTo 270
If a(27) = a(75) Then GoTo 270
a(55) = Pr9 - a(27)
If a(55) = a(1) Or a(55) = a(61) Then GoTo 550
If a(55) = a(73) Or a(55) = a(10) Or a(55) = a(19) Or a(55) = a(28) Or a(55) = a(37) Or a(55) = a(46) Then GoTo 550
If a(55) = a(63) Then GoTo 550
If a(55) = a(7) Then GoTo 550
a(18) = s1 - a(9) - a(27) - a(36) - a(45) - a(54) - a(63) - a(72) - a(81)
If a(18) < a1(m1) Or a(18) > a1(m2) Then GoTo 180
If a(18) = a(10) Or a(18) = a(11) Then GoTo 180
If a(18) = a(74) Then GoTo 180
a(64) = Pr9 - a(18)
If a(64) = a(71) Or a(64) = a(72) Then GoTo 640
If a(64) = a(8) Then GoTo 640
GoSub 1500: If fl1 = 0 Then GoTo 640 'Check Self Orthogonal
' Row 2/8
For j70 = m1 To m2
a(70) = a1(j70)
If a(70) = a(71) Or a(70) = a(61) Then GoTo 700
If a(70) = a(7) Or a(70) = a(79) Then GoTo 700
If a(70) = a(64) Or a(70) = a(72) Then GoTo 700
a(12) = Pr9 - a(70)
If a(12) = a(11) Or a(12) = a(21) Then GoTo 120
If a(12) = a(3) Or a(12) = a(75) Then GoTo 120
If a(12) = a(10) Or a(12) = a(18) Then GoTo 120
For j69 = m1 To m2
a(69) = a1(j69)
If a(69) = a(71) Or a(69) = a(51) Then GoTo 690
If a(69) = a(6) Or a(69) = a(78) Then GoTo 690
If a(69) = a(64) Or a(69) = a(72) Or a(69) = a(70) Then GoTo 690
a(13) = Pr9 - a(69)
If a(13) = a(11) Or a(13) = a(31) Then GoTo 130
If a(13) = a(4) Or a(13) = a(76) Then GoTo 130
If a(13) = a(10) Or a(13) = a(18) Or a(13) = a(12) Then GoTo 130
For j68 = m1 To m2
a(68) = a1(j68)
If a(68) = a(71) Or a(68) = a(41) Then GoTo 680
If a(68) = a(5) Or a(68) = a(77) Then GoTo 680
If a(68) = a(64) Or a(68) = a(72) Or a(68) = a(70) Or a(68) = a(69) Then GoTo 680
a(14) = Pr9 - a(68)
If a(14) = a(11) Or a(14) = a(41) Then GoTo 140
If a(14) = a(5) Or a(14) = a(77) Then GoTo 140
If a(14) = a(10) Or a(14) = a(18) Or a(14) = a(12) Or a(14) = a(13) Then GoTo 140
For j67 = m1 To m2
a(67) = a1(j67)
If a(67) = a(71) Or a(67) = a(31) Then GoTo 670
If a(67) = a(4) Or a(67) = a(76) Then GoTo 670
If a(67) = a(64) Or a(67) = a(72) Or a(67) = a(70) Or a(67) = a(69) Or a(67) = a(68) Then GoTo 670
If a(67) = a(13) Then GoTo 670
a(15) = Pr9 - a(67)
If a(15) = a(11) Or a(15) = a(51) Then GoTo 150
If a(15) = a(6) Or a(15) = a(78) Then GoTo 150
If a(15) = a(10) Or a(15) = a(18) Or a(15) = a(12) Or a(15) = a(13) Or a(15) = a(14) Then GoTo 150
If a(15) = a(69) Then GoTo 150
For j66 = m1 To m2
a(66) = a1(j66)
If a(66) = a(71) Or a(66) = a(21) Then GoTo 660
If a(66) = a(3) Or a(66) = a(75) Then GoTo 660
If a(66) = a(64) Or a(66) = a(72) Or a(66) = a(70) Or a(66) = a(69) Or a(66) = a(68) Or a(66) = a(67) Then GoTo 660
If a(66) = a(12) Then GoTo 660
a(16) = Pr9 - a(66)
If a(16) = a(11) Or a(16) = a(61) Then GoTo 160
If a(16) = a(7) Or a(16) = a(79) Then GoTo 160
If a(16) = a(10) Or a(16) = a(18) Or a(16) = a(12) Or a(16) = a(13) Or a(16) = a(14) Or a(16) = a(15) Then GoTo 160
If a(16) = a(70) Then GoTo 160
a(65) = s1 - a(64) - a(66) - a(67) - a(68) - a(69) - a(70) - a(71) - a(72)
If a(65) < a1(m1) Or a(65) > a1(m2) Then GoTo 650
If a(65) = a(11) Or a(65) = a(2) Or a(65) = a(74) Then GoTo 650
If a(65) = a(73) Or a(65) = a(41) Or a(65) = a(9) Then GoTo 650 'Diagonal
a(17) = Pr9 - a(65)
If a(17) = a(71) Or a(17) = a(8) Or a(17) = a(80) Then GoTo 170
If a(17) = a(73) Or a(17) = a(65) Or a(17) = a(41) Or a(17) = a(9) Then GoTo 170 'Diagonal
' Column 2/8
For j62 = m1 To m2
a(62) = a1(j62)
If a(62) = a(71) Or a(62) = a(61) Then GoTo 620
If a(62) = a(8) Or a(62) = a(80) Or a(62) = a(17) Then GoTo 620
If a(62) = a(55) Or a(62) = a(63) Then GoTo 620
If a(62) = a(70) Then GoTo 620
a(20) = Pr9 - a(62)
If a(20) = a(11) Or a(20) = a(21) Then GoTo 200
If a(20) = a(2) Or a(20) = a(74) Or a(20) = a(65) Then GoTo 200
If a(20) = a(19) Or a(20) = a(27) Then GoTo 200
If a(20) = a(12) Then GoTo 200
For j53 = m1 To m2
a(53) = a1(j53)
If a(53) = a(71) Or a(53) = a(51) Then GoTo 530
If a(53) = a(8) Or a(53) = a(80) Or a(53) = a(17) Or a(53) = a(62) Then GoTo 530
If a(53) = a(46) Or a(53) = a(54) Then GoTo 530
If a(53) = a(69) Then GoTo 530
a(29) = Pr9 - a(53)
If a(29) = a(11) Or a(29) = a(31) Then GoTo 290
If a(29) = a(2) Or a(29) = a(74) Or a(29) = a(65) Or a(29) = a(20) Then GoTo 290
If a(29) = a(28) Or a(29) = a(36) Then GoTo 290
If a(29) = a(13) Then GoTo 290
For j44 = m1 To m2
a(44) = a1(j44)
If a(44) = a(71) Or a(44) = a(41) Then GoTo 440
If a(44) = a(8) Or a(44) = a(80) Or a(44) = a(17) Or a(44) = a(62) Or a(44) = a(53) Then GoTo 440
If a(44) = a(37) Or a(44) = a(45) Then GoTo 440
If a(44) = a(68) Then GoTo 440
a(38) = Pr9 - a(44)
If a(38) = a(11) Or a(38) = a(41) Then GoTo 380
If a(38) = a(2) Or a(38) = a(74) Or a(38) = a(65) Or a(38) = a(20) Or a(38) = a(29) Then GoTo 380
If a(38) = a(37) Or a(38) = a(44) Then GoTo 380
If a(38) = a(14) Then GoTo 380
For j35 = m1 To m2
a(35) = a1(j35)
If a(35) = a(71) Or a(35) = a(31) Then GoTo 350
If a(35) = a(8) Or a(35) = a(80) Or a(35) = a(17) Or a(35) = a(62) Or a(35) = a(53) Or a(35) = a(44) Then GoTo 350
If a(35) = a(28) Or a(35) = a(29) Or a(35) = a(36) Then GoTo 350
If a(35) = a(67) Then GoTo 350
a(47) = Pr9 - a(35)
If a(47) = a(11) Or a(47) = a(51) Then GoTo 470
If a(47) = a(2) Or a(47) = a(74) Or a(47) = a(65) Or a(47) = a(20) Or a(47) = a(29) Or a(47) = a(38) Then GoTo 470
If a(47) = a(46) Or a(47) = a(54) Or a(47) = a(53) Then GoTo 470
If a(47) = a(15) Then GoTo 470
a(26) = s1 - a(8) - a(17) - a(35) - a(44) - a(53) - a(62) - a(71) - a(80)
If a(26) < a1(m1) Or a(26) > a1(m2) Then GoTo 260
If a(26) = a(19) Or a(26) = a(20) Or a(26) = a(21) Or a(26) = a(27) Then GoTo 260
If a(26) = a(66) Then GoTo 260
a(56) = Pr9 - a(26)
If a(56) = a(55) Or a(56) = a(61) Or a(56) = a(62) Or a(56) = a(63) Then GoTo 560
If a(56) = a(16) Then GoTo 560
GoSub 1500: If fl1 = 0 Then GoTo 560 'Check Self Orthogonal
' Row 3/7
For j60 = m1 To m2
a(60) = a1(j60)
If a(60) = a(61) Or a(60) = a(51) Then GoTo 600
If a(60) = a(6) Or a(60) = a(78) Or a(60) = a(15) Or a(60) = a(69) Then GoTo 600
If a(60) = a(55) Or a(60) = a(63) Or a(60) = a(56) Or a(60) = a(62) Then GoTo 600
a(22) = Pr9 - a(60)
If a(22) = a(21) Or a(22) = a(31) Then GoTo 220
If a(22) = a(4) Or a(22) = a(76) Or a(22) = a(13) Or a(22) = a(67) Then GoTo 220
If a(22) = a(19) Or a(22) = a(27) Or a(22) = a(20) Or a(22) = a(26) Then GoTo 220
For j59 = m1 To m2
a(59) = a1(j59)
If a(59) = a(61) Or a(59) = a(41) Then GoTo 590
If a(59) = a(5) Or a(59) = a(77) Or a(59) = a(14) Or a(59) = a(68) Then GoTo 590
If a(59) = a(55) Or a(59) = a(63) Or a(59) = a(56) Or a(59) = a(62) Or a(59) = a(60) Then GoTo 590
a(23) = Pr9 - a(59)
If a(23) = a(21) Or a(23) = a(41) Then GoTo 230
If a(23) = a(5) Or a(23) = a(77) Or a(23) = a(14) Or a(23) = a(68) Then GoTo 230
If a(23) = a(19) Or a(23) = a(27) Or a(23) = a(20) Or a(23) = a(26) Or a(23) = a(22) Then GoTo 230
For j58 = m1 To m2
a(58) = a1(j58)
If a(58) = a(61) Or a(58) = a(31) Then GoTo 580
If a(58) = a(4) Or a(58) = a(76) Or a(58) = a(13) Or a(58) = a(67) Or a(58) = a(22) Then GoTo 580
If a(58) = a(55) Or a(58) = a(63) Or a(58) = a(56) Or a(58) = a(62) Or a(58) = a(60) Or a(58) = a(59) Then GoTo 580
a(24) = Pr9 - a(58)
If a(24) = a(21) Or a(24) = a(51) Then GoTo 240
If a(24) = a(6) Or a(24) = a(78) Or a(24) = a(15) Or a(24) = a(69) Or a(24) = a(60) Then GoTo 240
If a(24) = a(19) Or a(24) = a(27) Or a(24) = a(20) Or a(24) = a(26) Or a(24) = a(22) Or a(24) = a(23) Then GoTo 240
a(57) = s1 - a(55) - a(56) - a(58) - a(59) - a(60) - a(61) - a(62) - a(63)
If a(57) < a1(m1) Or a(57) > a1(m2) Then GoTo 570
If a(57) = a(61) Or a(57) = a(21) Then GoTo 570
If a(57) = a(3) Or a(57) = a(75) Or a(57) = a(12) Or a(57) = a(66) Then GoTo 570
a(25) = Pr9 - a(57)
If a(25) = a(21) Or a(25) = a(61) Then GoTo 250
If a(25) = a(7) Or a(25) = a(79) Or a(25) = a(16) Or a(25) = a(70) Then GoTo 250
' Check Diagonal
b(1) = a(9): b(2) = a(17): b(3) = a(25): b(4) = a(41): b(5) = a(57): b(6) = a(65): b(7) = a(73):
n81 = 7: GoSub 1860: If fl1 = 0 Then GoTo 250
' Column 3/7
For j52 = m1 To m2
a(52) = a1(j52)
If a(52) = a(61) Or a(52) = a(51) Then GoTo 520
If a(52) = a(7) Or a(52) = a(79) Or a(52) = a(16) Or a(52) = a(70) Or a(52) = a(25) Then GoTo 520
If a(52) = a(46) Or a(52) = a(54) Or a(52) = a(47) Or a(52) = a(53) Then GoTo 520
If a(52) = a(60) Then GoTo 520
a(30) = Pr9 - a(52)
If a(30) = a(21) Or a(30) = a(31) Then GoTo 300
If a(30) = a(3) Or a(30) = a(75) Or a(30) = a(12) Or a(30) = a(66) Or a(30) = a(57) Then GoTo 300
If a(30) = a(28) Or a(30) = a(36) Or a(30) = a(29) Or a(30) = a(35) Then GoTo 300
If a(30) = a(22) Then GoTo 300
For j43 = m1 To m2
a(43) = a1(j43)
If a(43) = a(61) Or a(43) = a(41) Then GoTo 430
If a(43) = a(7) Or a(43) = a(79) Or a(43) = a(16) Or a(43) = a(70) Or a(43) = a(25) Or a(43) = a(52) Then GoTo 430
If a(43) = a(37) Or a(43) = a(45) Or a(43) = a(38) Or a(43) = a(44) Then GoTo 430
If a(43) = a(59) Then GoTo 430
a(39) = Pr9 - a(43)
If a(39) = a(21) Or a(39) = a(41) Then GoTo 390
If a(39) = a(3) Or a(39) = a(75) Or a(39) = a(12) Or a(39) = a(66) Or a(39) = a(57) Or a(39) = a(30) Then GoTo 390
If a(39) = a(37) Or a(39) = a(45) Or a(39) = a(38) Or a(39) = a(44) Then GoTo 390
If a(39) = a(23) Then GoTo 390
a(34) = s1 - a(7) - a(16) - a(25) - a(43) - a(52) - a(61) - a(70) - a(79)
If a(34) < a1(m1) Or a(34) > a1(m2) Then GoTo 340
b(1) = a(28): b(2) = a(29): b(3) = a(30): b(4) = a(31): b(5) = a(34): b(6) = a(35): b(7) = a(36):
n81 = 7: GoSub 1860: If fl1 = 0 Then GoTo 340
If a(34) = a(58) Then GoTo 340
a(48) = Pr9 - a(34)
b(1) = a(46): b(2) = a(47): b(3) = a(48): b(4) = a(51): b(5) = a(52): b(6) = a(53): b(7) = a(54):
n81 = 7: GoSub 1860: If fl1 = 0 Then GoTo 480
If a(48) = a(24) Then GoTo 480
GoSub 1500: If fl1 = 0 Then GoTo 480 'Check Self Orthogonal
For j49 = m1 To m2
a(49) = a1(j49)
a(33) = Pr9 - a(49)
b(1) = a(9): b(2) = a(17): b(3) = a(25): b(4) = a(33): b(5) = a(41): b(6) = a(49): b(7) = a(57): b(8) = a(65): b(9) = a(73):
n81 = 9: GoSub 1860: If fl1 = 0 Then GoTo 330
a(50) = s1 - a(46) - a(47) - a(48) - a(49) - a(51) - a(52) - a(53) - a(54)
a(32) = Pr9 - a(50)
a(40) = s1 - a(4) - a(13) - a(22) - a(31) - a(49) - a(58) - a(67) - a(76)
a(42) = Pr9 - a(40)
GoSub 1800: If fl1 = 0 Then GoTo 420 'Back Check
GoSub 1500: If fl1 = 0 Then GoTo 420 'Check Self Orthogonal
n9 = n9 + 1: GoSub 2645: ''End
''Cells(1, 1).Value = n9
Cells(1, 84).Value = a(80)
420 a(42) = 0
400 a(40) = 0
320 a(32) = 0
500 a(50) = 0
330 a(33) = 0
490 a(49) = 0
Next j49
480 a(48) = 0
340 a(34) = 0
390 a(39) = 0
430 a(43) = 0
Next j43
300 a(30) = 0
520 a(52) = 0
Next j52
250 a(25) = 0
570 a(57) = 0
240 a(24) = 0
580 a(58) = 0
Next j58
230 a(23) = 0
590 a(59) = 0
Next j59
220 a(22) = 0
600 a(60) = 0
Next j60
' ******************************
560 a(56) = 0
260 a(26) = 0
470 a(47) = 0
350 a(35) = 0
Next j35
380 a(38) = 0
440 a(44) = 0
Next j44
290 a(29) = 0
530 a(53) = 0
Next j53
200 a(20) = 0
620 a(62) = 0
Next j62
170 a(17) = 0
650 a(65) = 0
160 a(16) = 0
660 a(66) = 0
Next j66
150 a(15) = 0
670 a(67) = 0
Next j67
140 a(14) = 0
680 a(68) = 0
Next j68
130 a(13) = 0
690 a(69) = 0
Next j69
120 a(12) = 0
700 a(70) = 0
Next j70
' ******************************
640 a(64) = 0
180 a(18) = 0
550 a(55) = 0
270 a(27) = 0
Next j27
460 a(46) = 0
360 a(36) = 0
Next j36
370 a(37) = 0
450 a(45) = 0
Next j45
280 a(28) = 0
540 a(54) = 0
Next j54
190 a(19) = 0
630 a(63) = 0
Next j63
100 a(10) = 0
720 a(72) = 0
Next j72
90 a(9) = 0
730 a(73) = 0
80 a(8) = 0
740 a(74) = 0
Next j74
70 a(7) = 0
750 a(75) = 0
Next j75
60 a(6) = 0
760 a(76) = 0
Next j76
50 a(5) = 0
770 a(77) = 0
Next j77
40 a(4) = 0
780 a(78) = 0
Next j78
30 a(3) = 0
790 a(79) = 0
Next j79
20 a(2) = 0
800 a(80) = 0
Next j80
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine SelfOrth9a")
End
' Initialise diiagonal a()
1700 Erase a
i2 = -1
For i1 = 1 To 81 Step 10:
i2 = i2 + 1
a(i1) = i2
Next i1
Return
' Exclude solutions with identical numbers in rows, columns, diagonals, sub squares (9)
1800 fl1 = 1
' Rows
i1 = -8
For i0 = 1 To 9
i1 = i1 + 9
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): b(9) = a(i1 + 8)
n81 = 9: GoSub 1860: If fl1 = 0 Then Return
Next i0
' Columns
i1 = 0
For i0 = 1 To 9
i1 = i1 + 1
b(1) = a(i1): b(2) = a(i1 + 9): b(3) = a(i1 + 18): b(4) = a(i1 + 27): b(5) = a(i1 + 36)
b(6) = a(i1 + 45): b(7) = a(i1 + 54): b(8) = a(i1 + 63): b(9) = a(i1 + 72)
n81 = 9: GoSub 1860: If fl1 = 0 Then Return
Next i0
' Main Diagonals
b(1) = a(1): b(2) = a(11): b(3) = a(21): b(4) = a(31): b(5) = a(41): b(6) = a(51): b(7) = a(61): b(8) = a(71): b(9) = a(81):
n81 = 9: GoSub 1860: If fl1 = 0 Then Return
b(1) = a(9): b(2) = a(17): b(3) = a(25): b(4) = a(33): b(5) = a(41): b(6) = a(49): b(7) = a(57): b(8) = a(65): b(9) = a(73):
n81 = 9: GoSub 1860: If fl1 = 0 Then Return
Return
1860 fl1 = 1
For j1 = 1 To n81
b20 = b(j1)
For j2 = (1 + j1) To n81
If b20 = b(j2) Then fl1 = 0: Return
Next j2
Next j1
Return
' Print results (selected numbers)
2645 For i1 = 1 To 81
Cells(n9, i1).Value = a(i1)
Next i1
Cells(n9, 82).Value = n9
Cells(1, 83).Value = n9
Return
' Print results (squares)
2650 n2 = n2 + 1
If n2 = 5 Then
n2 = 1: k1 = k1 + 10: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 10
End If
'' Cells(k1, k2 + 1).Select
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = CStr(n9)
i3 = 0
For i1 = 1 To 9
For i2 = 1 To 9
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = a(i3)
Next i2
Next i1
Return
1500 fl1 = 1
' Transpose a()
i3 = 0: Erase a0
For i1 = 1 To 9
For i2 = 1 To 9
i3 = i3 + 1
a0(i1, i2) = a(i3)
Next i2
Next i1
i3 = 0:
For i1 = 1 To 9
For i2 = 1 To 9
i3 = i3 + 1
b2(i3) = a0(i2, i1)
Next i2
Next i1
' Calculate c2()
Erase c2
For i1 = 1 To 81
c2(i1) = 9 * a(i1) + b2(i1) + 1
Next i1
fl1 = 1: n20 = 0
For j1 = 1 To 81
a20 = c2(j1): If a20 = 1 Then GoTo 1510
For j2 = (1 + j1) To 81
If a20 = c2(j2) Then fl1 = 0: Return
Next j2
1510 Next j1
Return
End Sub
