' Generates Most Perfect Magic Squares (Morris) of order 12, magic sum 870
' All Rows have Residuum Res12 = 72
' Tested with Office 365 under Windows 10
Sub MostPerf12()
Dim a(144), b(144), c(144)
Dim b12(12), Res12(26)
y = MsgBox("Locked", vbCritical, "Routine MostPerf12")
End
n2 = 0: n9 = 0: k1 = 1: k2 = 1
m1 = 1: m2 = 144: s1 = 870
r12 = 72
' Generate data
Sheets("Klad1").Select
m11 = 14: m12 = 107: m13 = 62: m14 = 95: m15 = 110: m16 = 11
t1 = Timer
For j144 = m11 To m2 ''14 To 14 'a(144)
If b(j144) = 0 Then b(j144) = j144: c(144) = j144 Else GoTo 1440
a(144) = j144
For j143 = m12 To m2 ''107 To 107 'a(143)
If b(j143) = 0 Then b(j143) = j143: c(143) = j143 Else GoTo 1430
a(143) = j143
For j142 = m13 To m2 ''62 To 62 'a(142)
If b(j142) = 0 Then b(j142) = j142: c(142) = j142 Else GoTo 1420
a(142) = j142
For j141 = m14 To m2 ''95 To 95 'a(141)
If b(j141) = 0 Then b(j141) = j141: c(141) = j141 Else GoTo 1410
a(141) = j141
For j140 = m15 To m2 ''110 To 110 'a(140)
If b(j140) = 0 Then b(j140) = j140: c(140) = j140 Else GoTo 1400
a(140) = j140
For j139 = m16 To m2 ''11 To 11 'a(139)
If b(j139) = 0 Then b(j139) = j139: c(139) = j139 Else GoTo 1390
a(139) = j139
jj = 139
a(138) = (435 - a(139) + a(140) - a(141) + a(142) - a(143) - 2 * a(144)) / 3
j = 138: GoSub 3000: If fl1 = 1 Then GoTo 1390
a(137) = 290 - a(138) - a(143) - a(144): j = 137: GoSub 3000: If fl1 = 1 Then GoTo 1390
a(136) = 290 - a(137) - a(142) - a(143): j = 136: GoSub 3000: If fl1 = 1 Then GoTo 1390
a(135) = 290 - a(136) - a(141) - a(142): j = 135: GoSub 3000: If fl1 = 1 Then GoTo 1390
a(134) = 290 - a(135) - a(140) - a(141): j = 134: GoSub 3000: If fl1 = 1 Then GoTo 1390
a(133) = 870 - a(134) - a(135) - a(136) - a(137) - a(138) - a(139) - a(140) - a(141) - a(142) - a(143) - a(144)
j = 133: GoSub 3000: If fl1 = 1 Then GoTo 1390
i10 = 12: GoSub 1500: If Res12(i10) <> r12 Then GoTo 1385
For j132 = m1 To m2 ''129 'a(132)
If b(j132) = 0 Then b(j132) = j132: c(132) = j132 Else GoTo 1320
a(132) = j132
jj = 132
a(131) = 290 - a(132) - a(143) - a(144): j = 131: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(130) = 290 - a(131) - a(142) - a(143): j = 130: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(129) = 290 - a(130) - a(141) - a(142): j = 129: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(128) = 290 - a(129) - a(140) - a(141): j = 128: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(127) = 290 - a(128) - a(139) - a(140): j = 127: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(126) = 290 - a(127) - a(138) - a(139): j = 126: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(125) = 290 - a(126) - a(137) - a(138): j = 125: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(124) = 290 - a(125) - a(136) - a(137): j = 124: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(123) = 290 - a(124) - a(135) - a(136): j = 123: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(122) = 290 - a(123) - a(134) - a(135): j = 122: GoSub 3000: If fl1 = 1 Then GoTo 1320
a(121) = 290 - a(122) - a(133) - a(134): j = 121: GoSub 3000: If fl1 = 1 Then GoTo 1320
i10 = 11: GoSub 1500: If Res12(i10) <> r12 Then GoTo 1315
For j120 = m1 To m2 ''18 'a(120)
If b(j120) = 0 Then b(j120) = j120: c(120) = j120 Else GoTo 1200
a(120) = j120
jj = 120
a(119) = 290 - a(120) - a(131) - a(132): j = 119: GoSub 3000: If fl1 = 1 Then GoTo 1200
a(118) = 290 - a(119) - a(130) - a(131): j = 118: GoSub 3000: If fl1 = 1 Then GoTo 1200
a(117) = 290 - a(118) - a(129) - a(130): j = 117: GoSub 3000: If fl1 = 1 Then GoTo 1200
a(116) = 290 - a(117) - a(128) - a(129): j = 116: GoSub 3000: If fl1 = 1 Then GoTo 1200
a(115) = 290 - a(116) - a(127) - a(128): j = 115: GoSub 3000: If fl1 = 1 Then GoTo 1200
a(114) = 290 - a(115) - a(126) - a(127): j = 114: GoSub 3000: If fl1 = 1 Then GoTo 1200
a(113) = 290 - a(114) - a(125) - a(126): j = 113: GoSub 3000: If fl1 = 1 Then GoTo 1200
a(112) = 290 - a(113) - a(124) - a(125): j = 112: GoSub 3000: If fl1 = 1 Then GoTo 1200
a(111) = 290 - a(112) - a(123) - a(124): j = 111: GoSub 3000: If fl1 = 1 Then GoTo 1200
a(110) = 290 - a(111) - a(122) - a(123): j = 110: GoSub 3000: If fl1 = 1 Then GoTo 1200
a(109) = 290 - a(110) - a(121) - a(122): j = 109: GoSub 3000: If fl1 = 1 Then GoTo 1200
i10 = 10: GoSub 1500: If Res12(i10) <> r12 Then GoTo 1195
For j108 = m1 To m2 ''128 'a(108)
If b(j108) = 0 Then b(j108) = j108: c(108) = j108 Else GoTo 1080
a(108) = j108
jj = 108
a(107) = 290 - a(108) - a(119) - a(120): j = 107: GoSub 3000: If fl1 = 1 Then GoTo 1080
a(106) = 290 - a(107) - a(118) - a(119): j = 106: GoSub 3000: If fl1 = 1 Then GoTo 1080
a(105) = 290 - a(106) - a(117) - a(118): j = 105: GoSub 3000: If fl1 = 1 Then GoTo 1080
a(104) = 290 - a(105) - a(116) - a(117): j = 104: GoSub 3000: If fl1 = 1 Then GoTo 1080
a(103) = 290 - a(104) - a(115) - a(116): j = 103: GoSub 3000: If fl1 = 1 Then GoTo 1080
a(102) = 290 - a(103) - a(114) - a(115): j = 102: GoSub 3000: If fl1 = 1 Then GoTo 1080
a(101) = 290 - a(102) - a(113) - a(114): j = 101: GoSub 3000: If fl1 = 1 Then GoTo 1080
a(100) = 290 - a(101) - a(112) - a(113): j = 100: GoSub 3000: If fl1 = 1 Then GoTo 1080
a(99) = 290 - a(100) - a(111) - a(112): j = 99: GoSub 3000: If fl1 = 1 Then GoTo 1080
a(98) = 290 - a(99) - a(110) - a(111): j = 98: GoSub 3000: If fl1 = 1 Then GoTo 1080
a(97) = 290 - a(98) - a(109) - a(110): j = 97: GoSub 3000: If fl1 = 1 Then GoTo 1080
i10 = 9: GoSub 1500: If Res12(i10) <> r12 Then GoTo 1075
For j96 = m1 To m2 ''22 'a(96)
If b(j96) = 0 Then b(j96) = j96: c(96) = j96 Else GoTo 960
a(96) = j96
jj = 96
a(95) = 290 - a(96) - a(107) - a(108): j = 95: GoSub 3000: If fl1 = 1 Then GoTo 960
a(94) = 290 - a(95) - a(106) - a(107): j = 94: GoSub 3000: If fl1 = 1 Then GoTo 960
a(93) = 290 - a(94) - a(105) - a(106): j = 93: GoSub 3000: If fl1 = 1 Then GoTo 960
a(92) = 290 - a(93) - a(104) - a(105): j = 92: GoSub 3000: If fl1 = 1 Then GoTo 960
a(91) = 290 - a(92) - a(103) - a(104): j = 91: GoSub 3000: If fl1 = 1 Then GoTo 960
a(90) = 290 - a(91) - a(102) - a(103): j = 90: GoSub 3000: If fl1 = 1 Then GoTo 960
a(89) = 290 - a(90) - a(101) - a(102): j = 89: GoSub 3000: If fl1 = 1 Then GoTo 960
a(88) = 290 - a(89) - a(100) - a(101): j = 88: GoSub 3000: If fl1 = 1 Then GoTo 960
a(87) = 290 - a(88) - a(99) - a(100): j = 87: GoSub 3000: If fl1 = 1 Then GoTo 960
a(86) = 290 - a(87) - a(98) - a(99): j = 86: GoSub 3000: If fl1 = 1 Then GoTo 960
a(85) = 290 - a(86) - a(97) - a(98): j = 85: GoSub 3000: If fl1 = 1 Then GoTo 960
i10 = 8: GoSub 1500: If Res12(i10) <> r12 Then GoTo 955
a(84) = 435 + a(96) - a(108) + a(120) - a(132) - a(139) + a(140) - a(141) + a(142) - a(143) - 4 * a(144)
j = 84: GoSub 3000: If fl1 = 1 Then GoTo 960
a(83) = 290 - a(84) - a(95) - a(96): j = 83: GoSub 3000: If fl1 = 1 Then GoTo 960
a(82) = 290 - a(83) - a(94) - a(95): j = 82: GoSub 3000: If fl1 = 1 Then GoTo 960
a(81) = 290 - a(82) - a(93) - a(94): j = 81: GoSub 3000: If fl1 = 1 Then GoTo 960
a(80) = 290 - a(81) - a(92) - a(93): j = 80: GoSub 3000: If fl1 = 1 Then GoTo 960
a(79) = 290 - a(80) - a(91) - a(92): j = 79: GoSub 3000: If fl1 = 1 Then GoTo 960
a(78) = 290 - a(79) - a(90) - a(91): j = 78: GoSub 3000: If fl1 = 1 Then GoTo 960
a(77) = 290 - a(78) - a(89) - a(90): j = 77: GoSub 3000: If fl1 = 1 Then GoTo 960
a(76) = 290 - a(77) - a(88) - a(89): j = 76: GoSub 3000: If fl1 = 1 Then GoTo 960
a(75) = 290 - a(76) - a(87) - a(88): j = 75: GoSub 3000: If fl1 = 1 Then GoTo 960
a(74) = 290 - a(75) - a(86) - a(87): j = 74: GoSub 3000: If fl1 = 1 Then GoTo 960
a(73) = 290 - a(74) - a(85) - a(86): j = 73: GoSub 3000: If fl1 = 1 Then GoTo 960
i10 = 7: GoSub 1500: If Res12(i10) <> r12 Then GoTo 955
a(72) = 145 - a(138): j = 72: GoSub 3000: If fl1 = 1 Then GoTo 960
a(71) = 145 - a(137): j = 71: GoSub 3000: If fl1 = 1 Then GoTo 960
a(70) = 145 - a(136): j = 70: GoSub 3000: If fl1 = 1 Then GoTo 960
a(69) = 145 - a(135): j = 69: GoSub 3000: If fl1 = 1 Then GoTo 960
a(68) = 145 - a(134): j = 68: GoSub 3000: If fl1 = 1 Then GoTo 960
a(67) = 145 - a(133): j = 67: GoSub 3000: If fl1 = 1 Then GoTo 960
a(66) = 145 - a(144): j = 66: GoSub 3000: If fl1 = 1 Then GoTo 960
a(65) = 145 - a(143): j = 65: GoSub 3000: If fl1 = 1 Then GoTo 960
a(64) = 145 - a(142): j = 64: GoSub 3000: If fl1 = 1 Then GoTo 960
a(63) = 145 - a(141): j = 63: GoSub 3000: If fl1 = 1 Then GoTo 960
a(62) = 145 - a(140): j = 62: GoSub 3000: If fl1 = 1 Then GoTo 960
a(61) = 145 - a(139): j = 61: GoSub 3000: If fl1 = 1 Then GoTo 960
a(60) = 145 - a(126): j = 60: GoSub 3000: If fl1 = 1 Then GoTo 960
a(59) = 145 - a(125): j = 59: GoSub 3000: If fl1 = 1 Then GoTo 960
a(58) = 145 - a(124): j = 58: GoSub 3000: If fl1 = 1 Then GoTo 960
a(57) = 145 - a(123): j = 57: GoSub 3000: If fl1 = 1 Then GoTo 960
a(56) = 145 - a(122): j = 56: GoSub 3000: If fl1 = 1 Then GoTo 960
a(55) = 145 - a(121): j = 55: GoSub 3000: If fl1 = 1 Then GoTo 960
a(54) = 145 - a(132): j = 54: GoSub 3000: If fl1 = 1 Then GoTo 960
a(53) = 145 - a(131): j = 53: GoSub 3000: If fl1 = 1 Then GoTo 960
a(52) = 145 - a(130): j = 52: GoSub 3000: If fl1 = 1 Then GoTo 960
a(51) = 145 - a(129): j = 51: GoSub 3000: If fl1 = 1 Then GoTo 960
a(50) = 145 - a(128): j = 50: GoSub 3000: If fl1 = 1 Then GoTo 960
a(49) = 145 - a(127): j = 49: GoSub 3000: If fl1 = 1 Then GoTo 960
a(48) = 145 - a(114): j = 48: GoSub 3000: If fl1 = 1 Then GoTo 960
a(47) = 145 - a(113): j = 47: GoSub 3000: If fl1 = 1 Then GoTo 960
a(46) = 145 - a(112): j = 46: GoSub 3000: If fl1 = 1 Then GoTo 960
a(45) = 145 - a(111): j = 45: GoSub 3000: If fl1 = 1 Then GoTo 960
a(44) = 145 - a(110): j = 44: GoSub 3000: If fl1 = 1 Then GoTo 960
a(43) = 145 - a(109): j = 43: GoSub 3000: If fl1 = 1 Then GoTo 960
a(42) = 145 - a(120): j = 42: GoSub 3000: If fl1 = 1 Then GoTo 960
a(41) = 145 - a(119): j = 41: GoSub 3000: If fl1 = 1 Then GoTo 960
a(40) = 145 - a(118): j = 40: GoSub 3000: If fl1 = 1 Then GoTo 960
a(39) = 145 - a(117): j = 39: GoSub 3000: If fl1 = 1 Then GoTo 960
a(38) = 145 - a(116): j = 38: GoSub 3000: If fl1 = 1 Then GoTo 960
a(37) = 145 - a(115): j = 37: GoSub 3000: If fl1 = 1 Then GoTo 960
a(36) = 145 - a(102): j = 36: GoSub 3000: If fl1 = 1 Then GoTo 960
a(35) = 145 - a(101): j = 35: GoSub 3000: If fl1 = 1 Then GoTo 960
a(34) = 145 - a(100): j = 34: GoSub 3000: If fl1 = 1 Then GoTo 960
a(33) = 145 - a(99): j = 33: GoSub 3000: If fl1 = 1 Then GoTo 960
a(32) = 145 - a(98): j = 32: GoSub 3000: If fl1 = 1 Then GoTo 960
a(31) = 145 - a(97): j = 31: GoSub 3000: If fl1 = 1 Then GoTo 960
a(30) = 145 - a(108): j = 30: GoSub 3000: If fl1 = 1 Then GoTo 960
a(29) = 145 - a(107): j = 29: GoSub 3000: If fl1 = 1 Then GoTo 960
a(28) = 145 - a(106): j = 28: GoSub 3000: If fl1 = 1 Then GoTo 960
a(27) = 145 - a(105): j = 27: GoSub 3000: If fl1 = 1 Then GoTo 960
a(26) = 145 - a(104): j = 26: GoSub 3000: If fl1 = 1 Then GoTo 960
a(25) = 145 - a(103): j = 25: GoSub 3000: If fl1 = 1 Then GoTo 960
a(24) = 145 - a(90): j = 24: GoSub 3000: If fl1 = 1 Then GoTo 960
a(23) = 145 - a(89): j = 23: GoSub 3000: If fl1 = 1 Then GoTo 960
a(22) = 145 - a(88): j = 22: GoSub 3000: If fl1 = 1 Then GoTo 960
a(21) = 145 - a(87): j = 21: GoSub 3000: If fl1 = 1 Then GoTo 960
a(20) = 145 - a(86): j = 20: GoSub 3000: If fl1 = 1 Then GoTo 960
a(19) = 145 - a(85): j = 19: GoSub 3000: If fl1 = 1 Then GoTo 960
a(18) = 145 - a(96): j = 18: GoSub 3000: If fl1 = 1 Then GoTo 960
a(17) = 145 - a(95): j = 17: GoSub 3000: If fl1 = 1 Then GoTo 960
a(16) = 145 - a(94): j = 16: GoSub 3000: If fl1 = 1 Then GoTo 960
a(15) = 145 - a(93): j = 15: GoSub 3000: If fl1 = 1 Then GoTo 960
a(14) = 145 - a(92): j = 14: GoSub 3000: If fl1 = 1 Then GoTo 960
a(13) = 145 - a(91): j = 13: GoSub 3000: If fl1 = 1 Then GoTo 960
a(12) = 145 - a(78): j = 12: GoSub 3000: If fl1 = 1 Then GoTo 960
a(11) = 145 - a(77): j = 11: GoSub 3000: If fl1 = 1 Then GoTo 960
a(10) = 145 - a(76): j = 10: GoSub 3000: If fl1 = 1 Then GoTo 960
a(9) = 145 - a(75): j = 9: GoSub 3000: If fl1 = 1 Then GoTo 960
a(8) = 145 - a(74): j = 8: GoSub 3000: If fl1 = 1 Then GoTo 960
a(7) = 145 - a(73): j = 7: GoSub 3000: If fl1 = 1 Then GoTo 960
a(6) = 145 - a(84): j = 6: GoSub 3000: If fl1 = 1 Then GoTo 960
a(5) = 145 - a(83): j = 5: GoSub 3000: If fl1 = 1 Then GoTo 960
a(4) = 145 - a(82): j = 4: GoSub 3000: If fl1 = 1 Then GoTo 960
a(3) = 145 - a(81): j = 3: GoSub 3000: If fl1 = 1 Then GoTo 960
a(2) = 145 - a(80): j = 2: GoSub 3000: If fl1 = 1 Then GoTo 960
a(1) = 145 - a(79): j = 1: GoSub 3000: If fl1 = 1 Then GoTo 960
For i10 = 1 To 12
GoSub 1500: If Res12(i10) <> r12 Then GoTo 955
Next i10
n9 = n9 + 1
'' GoSub 2650 'Print results (squares)
GoSub 2645 'Print results (selected numbers)
If n9 = 196 Then End
955 jj = 96: GoSub 3050 'Reset b() and c()
960 Next j96
1075 jj = 108: GoSub 3050 'Reset b() and c()
1080 Next j108
1195 jj = 120: GoSub 3050 'Reset b() and c()
1200 Next j120
1315 jj = 132: GoSub 3050 'Reset b() and c()
1320 Next j132
1385 jj = 139: GoSub 3050 'Reset b() and c()
1390 Next j139
m16 = 1
1395 b(c(140)) = 0: c(140) = 0
1400 Next j140
m15 = 1
1405 b(c(141)) = 0: c(141) = 0
1410 Next j141
m14 = 1
1415 b(c(142)) = 0: c(142) = 0
1420 Next j142
m13 = 1
b(c(143)) = 0: c(143) = 0
1430 Next j143
m12 = 2
b(c(144)) = 0: c(144) = 0
1440 Next j144
m11 = 1
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine MostPerf12")
End
' Print results (selected numbers)
2645 ''Cells(n9, 138).Select
For i1 = 1 To 144
Cells(n9, i1).Value = a(i1)
Next i1
Cells(n9, 145).Value = n9
Cells(1, 146).Value = n9
Return
' Print results (squares)
2650 n2 = n2 + 1
If n2 = 3 Then
n2 = 1: k1 = k1 + 13: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 13
End If
Cells(k1, k2 + 1).Value = n9
i3 = 0
For i1 = 1 To 12
For i2 = 1 To 12
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = a(i3)
Next i2
Next i1
Return
' Exclude identical solutions and solutions out of range
3000 fl1 = 0
If a(j) <= 0 Or a(j) > 144 Or CInt(a(j)) <> a(j) Then fl1 = 1: GoTo 3010
If b(a(j)) = 0 Then b(a(j)) = a(j): c(j) = a(j) Else fl1 = 1
3010 If fl1 = 1 Then 'Reset b() and c()
For i = j + 1 To jj
b(c(i)) = 0: c(i) = 0
Next i
End If
Return
' Reset b() and c() after completion loop
3050 For i = j To jj
b(c(i)) = 0: c(i) = 0
Next i
Return
' determine Resudu lin i10
1500
Select Case i10
' Rows
Case 1 To 12:
For i1 = 1 To 12: b12(i1) = a((i10 - 1) * 12 + i1): Next i1
GoSub 1550
' Columns
Case 13 To 24:
For i1 = 1 To 12: b12(i1) = a((i10 - 12) + (i1 - 1) * 12): Next i1
GoSub 1550
' Diagonals
Case 25:
For i1 = 1 To 12: b12(i1) = a(i1 + (i1 - 1) * 12): Next i1
GoSub 1550
Case 26:
For i1 = 1 To 12: b12(i1) = a(12 - i1 + 1 + (i1 - 1) * 12): Next i1
GoSub 1550
End Select
Return
1550
For i2 = 1 To 11
For i1 = i2 To 12
If b12(i2) < b12(i1) Then
x = b12(i1)
b12(i1) = b12(i2)
b12(i2) = x
End If
Next i1
Next i2
Res12(i10) = b12(1) - b12(2) + b12(3) - b12(4) + b12(5) - b12(6) + b12(7) - b12(8) + b12(9) - b12(10) + b12(11) - b12(12)
Return
End Sub
