' Generates (Associated) Magic Squares of order 7 based on Self Orthogonal Latin Squares
' Tested with Office 365 under Windows 10
Sub CnstrSqrs7a2()
Dim a(49), a1(49), b1(49), s(28)
n2 = 0: n9 = 0: k1 = 1: k2 = 1
s1 = 175
ShtNm1 = "Latin7A" 'WorkBook 'Associated7'
Sheets("Klad1").Select
y = MsgBox("Locked", vbCritical, "Routine CnstrCbs7a2")
End
n4 = 135168
t1 = Timer
For j1 = 2 To n4 + 1
GoSub 100 'Read Latin Square
'Construct Transposed
For j4 = 1 To 49
a(j4) = a1(j4) + 7 * b1(j4) + 1
Next j4
GoSub 300: If fl1 = 0 Then GoTo 10 'Check identical numbers
GoSub 200: If fl1 = 0 Then GoTo 10 'Check Properties
' n9 = n9 + 1: GoSub 600 'Print results (squares)
n9 = n9 + 1: Cells(1, 1).Value = n9 'Counting
10 Next j1
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine CnstrSqrs7a2")
End
' Read Latin Square a1 (line format)
' Construct Transposed b1 = T(a1)
100
For i1 = 1 To 49
a1(i1) = Sheets(ShtNm1).Cells(j1, i1).Value
Next i1
b1(1) = a1(1): b1(2) = a1(8): b1(3) = a1(15): b1(4) = a1(22): b1(5) = a1(29): b1(6) = a1(36): b1(7) = a1(43):
b1(8) = a1(2): b1(9) = a1(9): b1(10) = a1(16): b1(11) = a1(23): b1(12) = a1(30): b1(13) = a1(37): b1(14) = a1(44):
b1(15) = a1(3): b1(16) = a1(10): b1(17) = a1(17): b1(18) = a1(24): b1(19) = a1(31): b1(20) = a1(38): b1(21) = a1(45):
b1(22) = a1(4): b1(23) = a1(11): b1(24) = a1(18): b1(25) = a1(25): b1(26) = a1(32): b1(27) = a1(39): b1(28) = a1(46):
b1(29) = a1(5): b1(30) = a1(12): b1(31) = a1(19): b1(32) = a1(26): b1(33) = a1(33): b1(34) = a1(40): b1(35) = a1(47):
b1(36) = a1(6): b1(37) = a1(13): b1(38) = a1(20): b1(39) = a1(27): b1(40) = a1(34): b1(41) = a1(41): b1(42) = a1(48):
b1(43) = a1(7): b1(44) = a1(14): b1(45) = a1(21): b1(46) = a1(28): b1(47) = a1(35): b1(48) = a1(42): b1(49) = a1(49):
Return
' Check Properties
200 fl1 = 1
s(1) = a(1) + a(2) + a(3) + a(4) + a(5) + a(6) + a(7)
s1 = s(1): s2 = 2 * s1 / 7
s(2) = a(8) + a(9) + a(10) + a(11) + a(12) + a(13) + a(14)
s(3) = a(15) + a(16) + a(17) + a(18) + a(19) + a(20) + a(21)
s(4) = a(22) + a(23) + a(24) + a(25) + a(26) + a(27) + a(28)
s(5) = a(29) + a(30) + a(31) + a(32) + a(33) + a(34) + a(35)
s(6) = a(36) + a(37) + a(38) + a(39) + a(40) + a(41) + a(42)
s(7) = a(43) + a(44) + a(45) + a(46) + a(47) + a(48) + a(49)
s(8) = a(1) + a(8) + a(15) + a(22) + a(29) + a(36) + a(43)
s(9) = a(2) + a(9) + a(16) + a(23) + a(30) + a(37) + a(44)
s(10) = a(3) + a(10) + a(17) + a(24) + a(31) + a(38) + a(45)
s(11) = a(4) + a(11) + a(18) + a(25) + a(32) + a(39) + a(46)
s(12) = a(5) + a(12) + a(19) + a(26) + a(33) + a(40) + a(47)
s(13) = a(6) + a(13) + a(20) + a(27) + a(34) + a(41) + a(48)
s(14) = a(7) + a(14) + a(21) + a(28) + a(35) + a(42) + a(49)
s(15) = a(1) + a(9) + a(17) + a(25) + a(33) + a(41) + a(49)
s(16) = a(7) + a(13) + a(19) + a(25) + a(31) + a(37) + a(43)
' Check Simple Magic
For j20 = 1 To 16
If s(j20) <> s1 Then fl1 = 0: Return
Next j20
' Check Associated
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: Return
Next j20
''Return
' Pan Diagonals
s(17) = a(2) + a(10) + a(18) + a(26) + a(34) + a(42) + a(43)
s(18) = a(3) + a(11) + a(19) + a(27) + a(35) + a(36) + a(44)
s(19) = a(4) + a(12) + a(20) + a(28) + a(29) + a(37) + a(45)
s(20) = a(5) + a(13) + a(21) + a(22) + a(30) + a(38) + a(46)
s(21) = a(6) + a(14) + a(15) + a(23) + a(31) + a(39) + a(47)
s(22) = a(7) + a(8) + a(16) + a(24) + a(32) + a(40) + a(48)
s(23) = a(6) + a(12) + a(18) + a(24) + a(30) + a(36) + a(49)
s(24) = a(5) + a(11) + a(17) + a(23) + a(29) + a(42) + a(48)
s(25) = a(4) + a(10) + a(16) + a(22) + a(35) + a(41) + a(47)
s(26) = a(3) + a(9) + a(15) + a(28) + a(34) + a(40) + a(46)
s(27) = a(2) + a(8) + a(21) + a(27) + a(33) + a(39) + a(45)
s(28) = a(1) + a(14) + a(20) + a(26) + a(32) + a(38) + a(44)
' Check Pan Magic
For j20 = 17 To 28
If s(j20) <> s1 Then fl1 = 0: Return
Next j20
Return
' Check identical numbers
300 fl1 = 1
For i1 = 1 To 49
a20 = a(i1)
For i2 = (1 + i1) To 49
If a20 = a(i2) Then fl1 = 0: Return
Next i2
Next i1
Return
' Print results (selected numbers)
500 For i1 = 1 To 49
Cells(n9, i1).Value = a(i1)
Next i1
Return
' Print results (squares)
600 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 = j1
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
End Sub
