' Generates Semi-Latin Squares of order 12
' Most Perfect Pan Magic Squares
' Tested with Office 365 under Windows 10
Sub CompLat12c()
Dim a(144), b(12)
y = MsgBox("Locked", vbCritical, "Routine CompLat12c")
End
n2 = 0: n9 = 0
m1 = 0: m2 = 11: s1 = 66
k1 = 1: k2 = 1
Pr12 = 11
' Generate data
Sheets("Klad1").Select
t1 = Timer
For j144 = m1 To m2 'a(144)
a(144) = j144
For j143 = m1 To m2 'a(143)
a(143) = j143
For j142 = m1 To m2 'a(142)
a(142) = j142
For j141 = m1 To m2 'a(141)
a(141) = j141
For j140 = m1 To m2 'a(140)
a(140) = j140
For j139 = m1 To m2 'a(139)
a(139) = j139
a(138) = (3 * Pr12 - a(139) + a(140) - a(141) + a(142) - a(143) - 2 * a(144)) / 3
If a(138) < 0 Or a(138) > 11 Or CInt(a(138)) <> a(138) Then GoTo 1390
a(137) = 2 * Pr12 - a(138) - a(143) - a(144): If a(137) < 0 Or a(137) > 11 Then GoTo 1390
a(136) = 2 * Pr12 - a(137) - a(142) - a(143): If a(136) < 0 Or a(136) > 11 Then GoTo 1390
a(135) = 2 * Pr12 - a(136) - a(141) - a(142): If a(135) < 0 Or a(135) > 11 Then GoTo 1390
a(134) = 2 * Pr12 - a(135) - a(140) - a(141): If a(134) < 0 Or a(134) > 11 Then GoTo 1390
a(133) = s1 - a(134) - a(135) - a(136) - a(137) - a(138) - a(139) - a(140) - a(141) - a(142) - a(143) - a(144)
If a(133) < 0 Or a(133) > 11 Then GoTo 1390
' Check Row 1
For i1 = 133 To 144
b(i1 - 132) = a(i1)
Next i1
GoSub 1800: If fl1 = 0 Then GoTo 1390
For j132 = m1 To m2 'a(132)
a(132) = j132
a(131) = 2 * Pr12 - a(132) - a(143) - a(144): If a(131) < 0 Or a(131) > 11 Then GoTo 1320
a(130) = 2 * Pr12 - a(131) - a(142) - a(143): If a(130) < 0 Or a(130) > 11 Then GoTo 1320
a(129) = 2 * Pr12 - a(130) - a(141) - a(142): If a(129) < 0 Or a(129) > 11 Then GoTo 1320
a(128) = 2 * Pr12 - a(129) - a(140) - a(141): If a(128) < 0 Or a(128) > 11 Then GoTo 1320
a(127) = 2 * Pr12 - a(128) - a(139) - a(140): If a(127) < 0 Or a(127) > 11 Then GoTo 1320
a(126) = 2 * Pr12 - a(127) - a(138) - a(139): If a(126) < 0 Or a(126) > 11 Then GoTo 1320
a(125) = 2 * Pr12 - a(126) - a(137) - a(138): If a(125) < 0 Or a(125) > 11 Then GoTo 1320
a(124) = 2 * Pr12 - a(125) - a(136) - a(137): If a(124) < 0 Or a(124) > 11 Then GoTo 1320
a(123) = 2 * Pr12 - a(124) - a(135) - a(136): If a(123) < 0 Or a(123) > 11 Then GoTo 1320
a(122) = 2 * Pr12 - a(123) - a(134) - a(135): If a(122) < 0 Or a(122) > 11 Then GoTo 1320
a(121) = 2 * Pr12 - a(122) - a(133) - a(134): If a(121) < 0 Or a(121) > 11 Then GoTo 1320
' Check Row 2
For i1 = 121 To 132
b(i1 - 120) = a(i1)
Next i1
GoSub 1800: If fl1 = 0 Then GoTo 1320
For j120 = m1 To m2 'a(120)
a(120) = j120
a(119) = 2 * Pr12 - a(120) - a(131) - a(132): If a(119) < 0 Or a(119) > 11 Then GoTo 1200
a(118) = 2 * Pr12 - a(119) - a(130) - a(131): If a(118) < 0 Or a(118) > 11 Then GoTo 1200
a(117) = 2 * Pr12 - a(118) - a(129) - a(130): If a(117) < 0 Or a(117) > 11 Then GoTo 1200
a(116) = 2 * Pr12 - a(117) - a(128) - a(129): If a(116) < 0 Or a(116) > 11 Then GoTo 1200
a(115) = 2 * Pr12 - a(116) - a(127) - a(128): If a(115) < 0 Or a(115) > 11 Then GoTo 1200
a(114) = 2 * Pr12 - a(115) - a(126) - a(127): If a(114) < 0 Or a(114) > 11 Then GoTo 1200
a(113) = 2 * Pr12 - a(114) - a(125) - a(126): If a(113) < 0 Or a(113) > 11 Then GoTo 1200
a(112) = 2 * Pr12 - a(113) - a(124) - a(125): If a(112) < 0 Or a(112) > 11 Then GoTo 1200
a(111) = 2 * Pr12 - a(112) - a(123) - a(124): If a(111) < 0 Or a(111) > 11 Then GoTo 1200
a(110) = 2 * Pr12 - a(111) - a(122) - a(123): If a(110) < 0 Or a(110) > 11 Then GoTo 1200
a(109) = 2 * Pr12 - a(110) - a(121) - a(122): If a(109) < 0 Or a(109) > 11 Then GoTo 1200
' Check Row 3
For i1 = 109 To 120
b(i1 - 108) = a(i1)
Next i1
GoSub 1800: If fl1 = 0 Then GoTo 1200
For j108 = m1 To m2 'a(108)
a(108) = j108
a(107) = 2 * Pr12 - a(108) - a(119) - a(120): If a(107) < 0 Or a(107) > 11 Then GoTo 1080
a(106) = 2 * Pr12 - a(107) - a(118) - a(119): If a(106) < 0 Or a(106) > 11 Then GoTo 1080
a(105) = 2 * Pr12 - a(106) - a(117) - a(118): If a(105) < 0 Or a(105) > 11 Then GoTo 1080
a(104) = 2 * Pr12 - a(105) - a(116) - a(117): If a(104) < 0 Or a(104) > 11 Then GoTo 1080
a(103) = 2 * Pr12 - a(104) - a(115) - a(116): If a(103) < 0 Or a(103) > 11 Then GoTo 1080
a(102) = 2 * Pr12 - a(103) - a(114) - a(115): If a(102) < 0 Or a(102) > 11 Then GoTo 1080
a(101) = 2 * Pr12 - a(102) - a(113) - a(114): If a(101) < 0 Or a(101) > 11 Then GoTo 1080
a(100) = 2 * Pr12 - a(101) - a(112) - a(113): If a(100) < 0 Or a(100) > 11 Then GoTo 1080
a(99) = 2 * Pr12 - a(100) - a(111) - a(112): If a(99) < 0 Or a(99) > 11 Then GoTo 1080
a(98) = 2 * Pr12 - a(99) - a(110) - a(111): If a(98) < 0 Or a(98) > 11 Then GoTo 1080
a(97) = 2 * Pr12 - a(98) - a(109) - a(110): If a(97) < 0 Or a(97) > 11 Then GoTo 1080
' Check Row 4
For i1 = 97 To 108
b(i1 - 96) = a(i1)
Next i1
GoSub 1800: If fl1 = 0 Then GoTo 1080
For j96 = m1 To m2 'a(96)
a(96) = j96
a(95) = 2 * Pr12 - a(96) - a(107) - a(108): If a(95) < 0 Or a(95) > 11 Then GoTo 960
a(94) = 2 * Pr12 - a(95) - a(106) - a(107): If a(94) < 0 Or a(94) > 11 Then GoTo 960
a(93) = 2 * Pr12 - a(94) - a(105) - a(106): If a(93) < 0 Or a(93) > 11 Then GoTo 960
a(92) = 2 * Pr12 - a(93) - a(104) - a(105): If a(92) < 0 Or a(92) > 11 Then GoTo 960
a(91) = 2 * Pr12 - a(92) - a(103) - a(104): If a(91) < 0 Or a(91) > 11 Then GoTo 960
a(90) = 2 * Pr12 - a(91) - a(102) - a(103): If a(90) < 0 Or a(90) > 11 Then GoTo 960
a(89) = 2 * Pr12 - a(90) - a(101) - a(102): If a(89) < 0 Or a(89) > 11 Then GoTo 960
a(88) = 2 * Pr12 - a(89) - a(100) - a(101): If a(88) < 0 Or a(88) > 11 Then GoTo 960
a(87) = 2 * Pr12 - a(88) - a(99) - a(100): If a(87) < 0 Or a(87) > 11 Then GoTo 960
a(86) = 2 * Pr12 - a(87) - a(98) - a(99): If a(86) < 0 Or a(86) > 11 Then GoTo 960
a(85) = 2 * Pr12 - a(86) - a(97) - a(98): If a(85) < 0 Or a(85) > 11 Then GoTo 960
' Check Row 5
For i1 = 85 To 96
b(i1 - 84) = a(i1)
Next i1
GoSub 1800: If fl1 = 0 Then GoTo 960
a(84) = 3 * Pr12 + a(96) - a(108) + a(120) - a(132) - a(139) + a(140) - a(141) + a(142) - a(143) - 4 * a(144)
If a(84) < 0 Or a(84) > 11 Then GoTo 960
a(83) = 2 * Pr12 - a(84) - a(95) - a(96): If a(83) < 0 Or a(83) > 11 Then GoTo 960
a(82) = 2 * Pr12 - a(83) - a(94) - a(95): If a(82) < 0 Or a(82) > 11 Then GoTo 960
a(81) = 2 * Pr12 - a(82) - a(93) - a(94): If a(81) < 0 Or a(81) > 11 Then GoTo 960
a(80) = 2 * Pr12 - a(81) - a(92) - a(93): If a(80) < 0 Or a(80) > 11 Then GoTo 960
a(79) = 2 * Pr12 - a(80) - a(91) - a(92): If a(79) < 0 Or a(79) > 11 Then GoTo 960
a(78) = 2 * Pr12 - a(79) - a(90) - a(91): If a(78) < 0 Or a(78) > 11 Then GoTo 960
a(77) = 2 * Pr12 - a(78) - a(89) - a(90): If a(77) < 0 Or a(77) > 11 Then GoTo 960
a(76) = 2 * Pr12 - a(77) - a(88) - a(89): If a(76) < 0 Or a(76) > 11 Then GoTo 960
a(75) = 2 * Pr12 - a(76) - a(87) - a(88): If a(75) < 0 Or a(75) > 11 Then GoTo 960
a(74) = 2 * Pr12 - a(75) - a(86) - a(87): If a(74) < 0 Or a(74) > 11 Then GoTo 960
a(73) = 2 * Pr12 - a(74) - a(85) - a(86): If a(73) < 0 Or a(73) > 11 Then GoTo 960
' Check Row 6
For i1 = 73 To 84
b(i1 - 72) = a(i1)
Next i1
GoSub 1800: If fl1 = 0 Then GoTo 960
a(72) = Pr12 - a(138): a(71) = Pr12 - a(137): a(70) = Pr12 - a(136): a(69) = Pr12 - a(135):
a(68) = Pr12 - a(134): a(67) = Pr12 - a(133): a(66) = Pr12 - a(144): a(65) = Pr12 - a(143):
a(64) = Pr12 - a(142): a(63) = Pr12 - a(141): a(62) = Pr12 - a(140): a(61) = Pr12 - a(139):
a(60) = Pr12 - a(126): a(59) = Pr12 - a(125): a(58) = Pr12 - a(124): a(57) = Pr12 - a(123):
a(56) = Pr12 - a(122): a(55) = Pr12 - a(121): a(54) = Pr12 - a(132): a(53) = Pr12 - a(131):
a(52) = Pr12 - a(130): a(51) = Pr12 - a(129): a(50) = Pr12 - a(128): a(49) = Pr12 - a(127):
a(48) = Pr12 - a(114): a(47) = Pr12 - a(113): a(46) = Pr12 - a(112): a(45) = Pr12 - a(111):
a(44) = Pr12 - a(110): a(43) = Pr12 - a(109): a(42) = Pr12 - a(120): a(41) = Pr12 - a(119):
a(40) = Pr12 - a(118): a(39) = Pr12 - a(117): a(38) = Pr12 - a(116): a(37) = Pr12 - a(115):
a(36) = Pr12 - a(102): a(35) = Pr12 - a(101): a(34) = Pr12 - a(100): a(33) = Pr12 - a(99):
a(32) = Pr12 - a(98): a(31) = Pr12 - a(97): a(30) = Pr12 - a(108): a(29) = Pr12 - a(107):
a(28) = Pr12 - a(106): a(27) = Pr12 - a(105): a(26) = Pr12 - a(104): a(25) = Pr12 - a(103):
a(24) = Pr12 - a(90): a(23) = Pr12 - a(89): a(22) = Pr12 - a(88): a(21) = Pr12 - a(87):
a(20) = Pr12 - a(86): a(19) = Pr12 - a(85): a(18) = Pr12 - a(96): a(17) = Pr12 - a(95):
a(16) = Pr12 - a(94): a(15) = Pr12 - a(93): a(14) = Pr12 - a(92): a(13) = Pr12 - a(91):
a(12) = Pr12 - a(78): a(11) = Pr12 - a(77): a(10) = Pr12 - a(76): a(9) = Pr12 - a(75):
a(8) = Pr12 - a(74): a(7) = Pr12 - a(73): a(6) = Pr12 - a(84): a(5) = Pr12 - a(83):
a(4) = Pr12 - a(82): a(3) = Pr12 - a(81): a(2) = Pr12 - a(80): a(1) = Pr12 - a(79):
'Check Diagonal 1
i2 = 1
For i1 = 1 To 12:
b(i1) = a(i2): i2 = i2 + 13
Next i1
GoSub 1800: If fl1 = 0 Then GoTo 960
'Check Diagonal 2
i2 = 12
For i1 = 1 To 12:
b(i1) = a(i2): i2 = i2 + 11
Next i1
GoSub 1800: If fl1 = 0 Then GoTo 960
n9 = n9 + 1
GoSub 2650 'Print results (squares)
' GoSub 2645 'Print results (selected numbers
' Cells(1, 1).Value = n9 'Counting
960 Next j96
1080 Next j108
1200 Next j120
1320 Next j132
1390 Next j139
1400 Next j140
1410 Next j141
1420 Next j142
1430 Next j143
1440 Next j144
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine CompLat12c")
End
' Exclude solutions with identical numbers Latin Lines Order 12
1800 fl1 = 1
For j1 = 1 To 12
a2 = b(j1):
For j2 = (1 + j1) To 12
If a2 = b(j2) Then fl1 = 0: Return
Next j2
1810 Next j1
Return
' Print results (selected numbers)
2645 For i1 = 1 To 144
Cells(n9, i1).Value = a(i1)
Next i1
Cells(n9, 145).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 + 1, k2 + 1).Select
Cells(k1, k2 + 1).Select
Cells(k1, k2 + 1).Font.Color = -4165632
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
End Sub
