' Generates Self Orthogonal Latin (Diagonal) Squares of order 7
' Pan Magic, Integers 0 thru 6
' Tested with Office 365 under Windows 11
Sub SelfOrth7b()
Dim a(49), b(49), s(24)
Dim a2(49), b2(49), c(49)
Dim a0(7, 7)
y = MsgBox("Locked", vbCritical, "Routine SelfOrth7b")
End
n2 = 0: n9 = 0: k1 = 1: k2 = 1
m1 = 1: m2 = 7: s1 = 21: s2 = 6
' Generate data
Sheets("Klad1").Select
t1 = Timer
For j49 = m1 To m2 'a(49)
a(49) = j49 - 1
For j48 = m1 To m2 'a(48)
a(48) = j48 - 1
If a(48) = a(49) Then GoTo 480
For j47 = m1 To m2 'a(47)
a(47) = j47 - 1
If a(47) = a(48) Or a(47) = a(49) Then GoTo 470
For j46 = m1 To m2 'a(46)
a(46) = j46 - 1
If a(46) = a(47) Or a(46) = a(48) Or a(46) = a(49) Then GoTo 460
For j45 = m1 To m2 'a(45)
a(45) = j45 - 1
If a(45) = a(46) Or a(45) = a(47) Or a(45) = a(48) Or a(45) = a(49) Then GoTo 450
For j44 = m1 To m2 'a(44)
a(44) = j44 - 1
If a(44) = a(45) Or a(44) = a(46) Or a(44) = a(47) Or a(44) = a(48) Or a(44) = a(49) Then GoTo 440
a(43) = s1 - a(44) - a(45) - a(46) - a(47) - a(48) - a(49)
If a(43) < 0 Or a(43) > 6 Then GoTo 440
For j42 = m1 To m2 'a(42)
a(42) = j42 - 1
If a(42) = a(49) Then GoTo 420
If a(42) = a(48) Or a(42) = a(43) Then GoTo 420
For j41 = m1 To m2 'a(41)
a(41) = j41 - 1
If a(41) = a(42) Then GoTo 410
If a(41) = a(48) Then GoTo 410
If a(41) = a(49) Then GoTo 410
If a(41) = a(49) Or a(41) = a(47) Then GoTo 410
For j40 = m1 To m2 'a(40)
a(40) = j40 - 1
If a(40) = a(41) Or a(40) = a(42) Then GoTo 400
If a(40) = a(47) Then GoTo 400
If a(40) = a(48) Or a(40) = a(46) Then GoTo 400
For j39 = m1 To m2 'a(39)
a(39) = j39 - 1
If a(39) = a(40) Or a(39) = a(41) Or a(39) = a(42) Then GoTo 390
If a(39) = a(46) Then GoTo 390
If a(39) = a(47) Or a(39) = a(45) Then GoTo 390
For j38 = m1 To m2 'a(38)
a(38) = j38 - 1
If a(38) = a(39) Or a(38) = a(40) Or a(38) = a(41) Or a(38) = a(42) Then GoTo 380
If a(38) = a(45) Then GoTo 380
If a(38) = a(46) Or a(38) = a(44) Then GoTo 380
For j37 = m1 To m2 'a(37)
a(37) = j37 - 1
If a(37) = a(38) Or a(37) = a(39) Or a(37) = a(40) Or a(37) = a(41) Or a(37) = a(42) Then GoTo 370
If a(37) = a(44) Or a(37) = a(43) Then GoTo 370
If a(37) = a(45) Or a(37) = a(43) Then GoTo 370
a(36) = s1 - a(37) - a(38) - a(39) - a(40) - a(41) - a(42)
If a(36) < 0 Or a(36) > 6 Then GoTo 370
If a(36) = a(43) Then GoTo 370
If a(36) = a(44) Or a(36) = a(49) Then GoTo 370
For j35 = m1 To m2 'a(35)
a(35) = j35 - 1
If a(35) = a(49) Or a(35) = a(42) Then GoTo 350
If a(35) = a(41) Or a(35) = a(47) Or a(35) = a(36) Or a(35) = a(44) Then GoTo 350
For j34 = m1 To m2 'a(34)
a(34) = j34 - 1
If a(34) = a(35) Then GoTo 340
If a(34) = a(48) Or a(34) = a(41) Then GoTo 340
If a(34) = a(40) Or a(34) = a(46) Or a(34) = a(42) Or a(34) = a(43) Then GoTo 340
For j33 = m1 To m2 'a(33)
a(33) = j33 - 1
If a(33) = a(34) Or a(33) = a(35) Then GoTo 330
If a(33) = a(47) Or a(33) = a(40) Then GoTo 330
If a(33) = a(49) Or a(33) = a(41) Then GoTo 330
If a(33) = a(39) Or a(33) = a(45) Or a(33) = a(41) Or a(33) = a(49) Then GoTo 330
For j32 = m1 To m2 'a(32)
a(32) = j32 - 1
If a(32) = a(33) Or a(32) = a(34) Or a(32) = a(35) Then GoTo 320
If a(32) = a(46) Or a(32) = a(39) Then GoTo 320
If a(32) = a(38) Or a(32) = a(44) Or a(32) = a(40) Or a(32) = a(48) Then GoTo 320
For j31 = m1 To m2 'a(31)
a(31) = j31 - 1
If a(31) = a(32) Or a(31) = a(33) Or a(31) = a(34) Or a(31) = a(35) Then GoTo 310
If a(31) = a(45) Or a(31) = a(38) Then GoTo 310
If a(31) = a(43) Or a(31) = a(37) Then GoTo 310
If a(31) = a(37) Or a(31) = a(43) Or a(31) = a(39) Or a(31) = a(47) Then GoTo 310
For j30 = m1 To m2 'a(30)
a(30) = j30 - 1
If a(30) = a(31) Or a(30) = a(32) Or a(30) = a(33) Or a(30) = a(34) Or a(30) = a(35) Then GoTo 300
If a(30) = a(44) Or a(30) = a(37) Then GoTo 300
If a(30) = a(36) Or a(30) = a(49) Or a(30) = a(38) Or a(30) = a(46) Then GoTo 300
a(29) = s1 - a(30) - a(31) - a(32) - a(33) - a(34) - a(35)
If a(29) < 0 Or a(29) > 6 Then GoTo 300
If a(29) = a(43) Or a(29) = a(36) Then GoTo 300
If a(29) = a(42) Or a(29) = a(48) Or a(29) = a(37) Or a(29) = a(45) Then GoTo 300
For j28 = m1 To m2 'a(28)
a(28) = j28 - 1
If a(28) = a(49) Or a(28) = a(42) Or a(28) = a(35) Then GoTo 280
For j27 = m1 To m2 'a(27)
a(27) = j27 - 1
If a(27) = a(48) Or a(27) = a(41) Or a(27) = a(34) Then GoTo 270
If a(27) = a(28) Then GoTo 270
For j26 = m1 To m2 'a(26)
a(26) = j26 - 1
If a(26) = a(47) Or a(26) = a(40) Or a(26) = a(33) Then GoTo 260
If a(26) = a(27) Or a(26) = a(28) Then GoTo 260
a(20) = s1 - a(26) - a(27) - a(28) + a(30) + a(31) - a(34) - a(40) - a(41) - a(42) - a(48)
If a(20) < 0 Or a(20) > 6 Then GoTo 260
a(13) = -s1 + a(26) + a(27) + a(28) - a(30) - a(31) + a(33) + a(34) + a(35) - a(37) +
- a(38) + a(40) + a(41) + a(42) + a(47) + a(48) + a(49)
If a(13) < 0 Or a(13) > 6 Then GoTo 260
For j25 = m1 To m2 'a(25)
a(25) = j25 - 1
If a(25) = a(46) Or a(25) = a(39) Or a(25) = a(32) Then GoTo 250
If a(25) = a(26) Or a(25) = a(27) Or a(25) = a(28) Then GoTo 250
If a(25) = a(33) Or a(25) = a(41) Or a(25) = a(49) Then GoTo 250
If a(25) = a(31) Or a(25) = a(37) Or a(25) = a(43) Then GoTo 250
a(19) = 2 * s1 - a(25) - a(26) - a(27) - a(31) - a(32) - 2 * a(33) - a(34) - a(35) +
- a(39) - a(40) - a(41) - a(47)
If a(19) < 0 Or a(19) > 6 Then GoTo 250
a(16) = a(25) + a(26) + a(27) + a(28) - a(30) + a(33) + a(34) - a(36) - a(37) - a(38) - a(44)
If a(16) < 0 Or a(16) > 6 Then GoTo 250
a(12) = a(25) + a(26) + a(27) - a(29) - a(30) + a(32) + a(33) + a(34) - 2 * a(36) +
- 2 * a(37) - a(38) - a(42) + a(46) + a(47) + a(48)
If a(12) < 0 Or a(12) > 6 Then GoTo 250
a(9) = 3 * s1 - a(25) - a(26) - a(27) - a(28) - a(32) - 2 * a(33) - 2 * a(34) +
- a(35) - a(39) - 2 * a(40) - 2 * a(41) - a(42) - a(46) - a(47) - a(48) - a(49)
If a(9) < 0 Or a(9) > 6 Then GoTo 250
For j24 = m1 To m2 'a(24)
a(24) = j24 - 1
If a(24) = a(45) Or a(24) = a(38) Or a(24) = a(31) Then GoTo 240
If a(24) = a(25) Or a(24) = a(26) Or a(24) = a(27) Or a(24) = a(28) Then GoTo 240
a(18) = s1 - a(24) - a(25) - a(26) + a(29) - a(32) + a(35) - a(38) - a(39) - a(40) - a(46)
If a(18) < 0 Or a(18) > 6 Then GoTo 240
a(15) = -s1 + a(24) + a(25) + a(26) + a(27) - a(29) + a(32) + a(33) + a(38) + a(39) +
+ a(40) + a(41) - a(43)
If a(15) < 0 Or a(15) > 6 Then GoTo 240
a(11) = -s1 + a(24) + a(25) + a(26) - a(29) + a(31) + a(32) + a(33) - a(35) - a(36) + a(38) +
+ a(39) + a(40) - a(42) + a(45) + a(46) + a(47)
If a(11) < 0 Or a(11) > 6 Then GoTo 240
a(8) = 2 * s1 - a(24) - a(25) - a(26) - a(27) - a(31) - 2 * a(32) - 2 * a(33) +
- a(34) - a(38) - 2 * a(39) - 2 * a(40) - a(41) + a(43) + a(44) + a(49)
If a(8) < 0 Or a(8) > 6 Then GoTo 240
For j23 = m1 To m2 'a(23)
a(23) = j23 - 1
If a(23) = a(44) Or a(23) = a(37) Or a(23) = a(30) Then GoTo 230
If a(23) = a(24) Or a(23) = a(25) Or a(23) = a(26) Or a(23) = a(27) Or a(23) = a(28) Then GoTo 230
a(22) = s1 - a(23) - a(24) - a(25) - a(26) - a(27) - a(28)
If a(22) < 0 Or a(22) > 6 Then GoTo 230
If a(22) = a(43) Or a(22) = a(36) Or a(22) = a(29) Then GoTo 230
a(21) = s1 - a(22) - a(27) - a(28) + a(31) + a(32) - a(35) - a(36) - a(41) - a(42) - a(49)
If a(21) < 0 Or a(21) > 6 Then GoTo 230
a(17) = s1 - a(23) - a(24) - a(25) - a(31) + a(34) + a(35) - a(37) - a(38) - a(39) - a(45)
If a(17) < 0 Or a(17) > 6 Then GoTo 230
a(14) = 3 * s1 - a(23) - a(24) - a(25) - a(26) - a(30) - 2 * a(31) - 2 * a(32) +
- a(33) - a(37) - 2 * a(38) - 2 * a(39) - a(40) - a(44) - a(45) - a(46) - a(47)
If a(14) < 0 Or a(14) > 6 Then GoTo 230
a(10) = -s1 + a(23) + a(24) + a(25) + a(30) + a(31) + a(32) - a(34) - a(35) +
+ a(37) + a(38) + a(39) - a(41) - a(42) + a(44) + a(45) + a(46)
If a(10) < 0 Or a(10) > 6 Then GoTo 230
a(7) = s1 - a(14) - a(21) - a(28) - a(35) - a(42) - a(49): If a(7) < 0 Or a(7) > 6 Then GoTo 230
a(6) = s1 - a(13) - a(20) - a(27) - a(34) - a(41) - a(48): If a(6) < 0 Or a(6) > 6 Then GoTo 230
a(5) = s1 - a(12) - a(19) - a(26) - a(33) - a(40) - a(47): If a(5) < 0 Or a(5) > 6 Then GoTo 230
a(4) = s1 - a(11) - a(18) - a(25) - a(32) - a(39) - a(46): If a(4) < 0 Or a(4) > 6 Then GoTo 230
a(3) = s1 - a(10) - a(17) - a(24) - a(31) - a(38) - a(45): If a(3) < 0 Or a(3) > 6 Then GoTo 230
a(2) = s1 - a(9) - a(16) - a(23) - a(30) - a(37) - a(44): If a(2) < 0 Or a(2) > 6 Then GoTo 230
a(1) = s1 - a(8) - a(15) - a(22) - a(29) - a(36) - a(43): If a(1) < 0 Or a(1) > 6 Then GoTo 230
GoSub 800: If fl1 = 0 Then GoTo 230
' Check Self Orthogonal
Erase a2
For i1 = 1 To 49: a2(i1) = a(i1): Next i1
GoSub 1500: If fl1 = 0 Then GoTo 5
' Check Associated 'Option
' GoSub 900: If fl1 = 0 Then GoTo 5
n9 = n9 + 1
' GoSub 2650 'Print results (squares)
' GoSub 2645 'Print results (selected numbers
Cells(1, 1).Value = n9 'Counting
5
230 Next j23
240 Next j24
250 Next j25
260 Next j26
270 Next j27
280 Next j28
300 Next j30
310 Next j31
320 Next j32
330 Next j33
340 Next j34
350 Next j35
370 Next j37
380 Next j38
390 Next j39
400 Next j40
410 Next j41
420 Next j42
440 Next j44
450 Next j45
460 Next j46
470 Next j47
480 Next j48
490 Next j49
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine SelfOrth7b")
End
' Print results (selected numbers)
2645 For i1 = 1 To 49
Cells(n9, i1).Value = a(i1)
Next i1
Return
' Print results (squares)
2650 n2 = n2 + 1
If n2 = 5 Then
n2 = 1: k1 = k1 + 8: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 8
End If
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = n9
i3 = 0
For i1 = 1 To 7
For i2 = 1 To 7
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = a(i3)
Next i2
Next i1
Return
' Exclude solutions with identical numbers in rows, columns, diagonals
800 fl1 = 1
' Rows
i1 = -6
For i0 = 1 To 7
i1 = i1 + 7
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)
GoSub 860: If fl1 = 0 Then Return
Next i0
' Columns
i1 = 0
For i0 = 1 To 7
i1 = i1 + 1
b(1) = a(i1): b(2) = a(i1 + 7): b(3) = a(i1 + 14): b(4) = a(i1 + 21):
b(5) = a(i1 + 28): b(6) = a(i1 + 35): b(7) = a(i1 + 42)
GoSub 860: If fl1 = 0 Then Return
Next i0
' Pan Diagonals
b(1) = a(1): b(2) = a(9): b(3) = a(17): b(4) = a(25): b(5) = a(33): b(6) = a(41): b(7) = a(49):
GoSub 860: If fl1 = 0 Then Return
b(1) = a(2): b(2) = a(10): b(3) = a(18): b(4) = a(26): b(5) = a(34): b(6) = a(42): b(7) = a(43):
GoSub 860: If fl1 = 0 Then Return
b(1) = a(3): b(2) = a(11): b(3) = a(19): b(4) = a(27): b(5) = a(35): b(6) = a(36): b(7) = a(44):
GoSub 860: If fl1 = 0 Then Return
b(1) = a(4): b(2) = a(12): b(3) = a(20): b(4) = a(28): b(5) = a(29): b(6) = a(37): b(7) = a(45):
GoSub 860: If fl1 = 0 Then Return
b(1) = a(5): b(2) = a(13): b(3) = a(21): b(4) = a(22): b(5) = a(30): b(6) = a(38): b(7) = a(46):
GoSub 860: If fl1 = 0 Then Return
b(1) = a(6): b(2) = a(14): b(3) = a(15): b(4) = a(23): b(5) = a(31): b(6) = a(39): b(7) = a(47):
GoSub 860: If fl1 = 0 Then Return
b(1) = a(7): b(2) = a(8): b(3) = a(16): b(4) = a(24): b(5) = a(32): b(6) = a(40): b(7) = a(48):
GoSub 860: If fl1 = 0 Then Return
b(1) = a(43): b(2) = a(37): b(3) = a(31): b(4) = a(25): b(5) = a(19): b(6) = a(13): b(7) = a(7):
GoSub 860: If fl1 = 0 Then Return
b(1) = a(44): b(2) = a(38): b(3) = a(32): b(4) = a(26): b(5) = a(20): b(6) = a(14): b(7) = a(1):
GoSub 860: If fl1 = 0 Then Return
b(1) = a(45): b(2) = a(39): b(3) = a(33): b(4) = a(27): b(5) = a(21): b(6) = a(8): b(7) = a(2):
GoSub 860: If fl1 = 0 Then Return
b(1) = a(46): b(2) = a(40): b(3) = a(34): b(4) = a(28): b(5) = a(15): b(6) = a(9): b(7) = a(3):
GoSub 860: If fl1 = 0 Then Return
b(1) = a(47): b(2) = a(41): b(3) = a(35): b(4) = a(22): b(5) = a(16): b(6) = a(10): b(7) = a(4):
GoSub 860: If fl1 = 0 Then Return
b(1) = a(48): b(2) = a(42): b(3) = a(29): b(4) = a(23): b(5) = a(17): b(6) = a(11): b(7) = a(5):
GoSub 860: If fl1 = 0 Then Return
b(1) = a(49): b(2) = a(36): b(3) = a(30): b(4) = a(24): b(5) = a(18): b(6) = a(12): b(7) = a(6):
GoSub 860: If fl1 = 0 Then Return
Return
860 fl1 = 1
For j1 = 1 To 7
b20 = b(j1)
For j2 = (1 + j1) To 7
If b20 = b(j2) Then fl1 = 0: Return
Next j2
Next j1
Return
' Check Associated
900 fl1 = 1
s(1) = a(1) + a(49): s(2) = a(2) + a(48): s(3) = a(3) + a(47): s(4) = a(4) + a(46)
s(5) = a(5) + a(45): s(6) = a(6) + a(44): s(7) = a(7) + a(43): s(8) = a(8) + a(42)
s(9) = a(9) + a(41): s(10) = a(10) + a(40): s(11) = a(11) + a(39): s(12) = a(12) + a(38)
s(13) = a(13) + a(37): s(14) = a(14) + a(36): s(15) = a(15) + a(35): s(16) = a(16) + a(34)
s(17) = a(17) + a(33): s(18) = a(18) + a(32): s(19) = a(19) + a(31): s(20) = a(20) + a(30)
s(21) = a(21) + a(29): s(22) = a(22) + a(28): s(23) = a(23) + a(27): s(24) = a(24) + a(26)
For j20 = 1 To 24
If s(j20) <> s2 Then fl1 = 0: Exit For
Next j20
Return
1500 fl1 = 1
' Transpose a2()
i3 = 0: Erase a0
For i1 = 1 To 7
For i2 = 1 To 7
i3 = i3 + 1
a0(i1, i2) = a2(i3)
Next i2
Next i1
i3 = 0:
For i1 = 1 To 7
For i2 = 1 To 7
i3 = i3 + 1
b2(i3) = a0(i2, i1)
Next i2
Next i1
' Calculate c()
Erase c
For i1 = 1 To 49
c(i1) = 7 * a2(i1) + b2(i1) + 1
Next i1
fl1 = 1: n20 = 0
For j1 = 1 To 49
a20 = c(j1):
For j2 = (1 + j1) To 49
If a20 = c(j2) Then fl1 = 0: Return
Next j2
1510 Next j1
Return
End Sub
