' Constructs Associated Semi-Latin Squares (11 x 11)
' Diamond Inlays Order 5 and 6 (Part 2, Border)
' Tested with Office 365 under Windows 10
Sub SemiLat11b()
Dim a(121), a1(11), b(11)
Dim b1(121), c(121)
y = MsgBox("Locked", vbCritical, "Routine SemiLat11b")
End
n2 = 0: n9 = 0: k1 = 1: k2 = 1
For i1 = 1 To 11
a1(i1) = i1 - 1
Next i1
m1 = 1: m2 = 11: s1 = 55: p11 = 2 * s1 / 11
Sheets("Klad1").Select
t1 = Timer
For j150 = 319 To 400
' Raed Semi Latin Diamonds
For i1 = 1 To 121
a(i1) = Sheets("SemiLat67a").Cells(j150, i1).Value
Next i1
' Complete Associated Border
For j117 = m1 To m2
a(117) = a1(j117)
a(5) = p11 - a(117):
a(115) = s1 - a(5) - a(16) - a(27) - a(38) - a(49) - a(60) - a(71) - a(82) - a(93) - a(104)
If a(115) < a1(m1) Or a(115) > a1(m2) Then GoTo 1170:
a(7) = p11 - a(115):
n10 = 3: b(1) = a(115): b(2) = a(116): b(3) = a(117)
GoSub 1800: If fl1 = 0 Then GoTo 1170
For j77 = m1 To m2
a(77) = a1(j77)
a(45) = p11 - a(77):
a(55) = s1 - a(45) - a(46) - a(47) - a(48) - a(49) - a(50) - a(51) - a(52) - a(53) - a(54)
If a(55) < a1(m1) Or a(55) > a1(m2) Then GoTo 770:
a(67) = p11 - a(55):
n10 = 11: For i1 = 1 To n10: b(i1) = a(66 + i1): Next i1 'Check Row 5 / 7
GoSub 1800: If fl1 = 0 Then GoTo 770
For j121 = m1 To m2
a(121) = a1(j121)
a(1) = p11 - a(121):
n10 = 4: b(1) = a(115): b(2) = a(116): b(3) = a(117): b(4) = a(121)
GoSub 1800: If fl1 = 0 Then GoTo 1170
For j109 = m1 To m2
a(109) = a1(j109)
a(13) = p11 - a(109):
n10 = 4: b(1) = a(104): b(2) = a(105): b(3) = a(106): b(4) = a(109)
GoSub 1800: If fl1 = 0 Then GoTo 1090
For j97 = m1 To m2
a(97) = a1(j97)
a(25) = p11 - a(97)
n10 = 6: For i1 = 1 To n10: b(i1) = a(91 + i1): Next i1
GoSub 1800: If fl1 = 0 Then GoTo 970
i2 = 0 'Diagonal 1
For i1 = 1 To 11
b(i1) = a(1 + i2 * 12):
i2 = i2 + 1
Next i1
n10 = 11: GoSub 1800: If fl1 = 0 Then GoTo 970
For j111 = m1 To m2
a(111) = a1(j111)
a(11) = p11 - a(111):
n10 = 5: b(1) = a(115): b(2) = a(116): b(3) = a(117): b(4) = a(121): b(5) = a(111)
GoSub 1800: If fl1 = 0 Then GoTo 1110
For j101 = m1 To m2
a(101) = a1(j101)
a(21) = p11 - a(101):
n10 = 5: b(1) = a(104): b(2) = a(105): b(3) = a(106): b(4) = a(109): b(5) = a(101)
GoSub 1800: If fl1 = 0 Then GoTo 1010
For j91 = m1 To m2
a(91) = a1(j91)
a(31) = p11 - a(91):
n10 = 7: For i1 = 1 To n10: b(i1) = a(90 + i1): Next i1
GoSub 1800: If fl1 = 0 Then GoTo 910
i2 = 0 'Diagonal 2
For i1 = 1 To 11
b(i1) = a(11 + i2 * 10):
i2 = i2 + 1
Next i1
n10 = 11: GoSub 1800: If fl1 = 0 Then GoTo 910
For j118 = m1 To m2
a(118) = a1(j118)
a(4) = p11 - a(118):
n10 = 6: b(1) = a(115): b(2) = a(116): b(3) = a(117): b(4) = a(121): b(5) = a(111): b(6) = a(118)
GoSub 1800: If fl1 = 0 Then GoTo 1180
For j114 = m1 To m2
a(114) = a1(j114)
a(8) = p11 - a(114):
n10 = 7: b(1) = a(115): b(2) = a(116): b(3) = a(117): b(4) = a(121): b(5) = a(111): b(6) = a(118): b(7) = a(114)
GoSub 1800: If fl1 = 0 Then GoTo 1140
For j107 = m1 To m2
a(107) = a1(j107)
a(15) = p11 - a(107):
n10 = 6: b(1) = a(104): b(2) = a(105): b(3) = a(106): b(4) = a(109): b(5) = a(101): b(6) = a(107)
GoSub 1800: If fl1 = 0 Then GoTo 1070
a(103) = s1 - a(4) - a(15) - a(26) - a(37) - a(48) - a(59) - a(70) - a(81) - a(92) - a(114)
If a(103) < a1(m1) Or a(103) > a1(m2) Then GoTo 1070:
a(19) = p11 - a(103):
n10 = 7: b(1) = a(104): b(2) = a(105): b(3) = a(106): b(4) = a(109): b(5) = a(101): b(6) = a(107): b(7) = a(103)
GoSub 1800: If fl1 = 0 Then GoTo 1070
For j120 = m1 To m2
a(120) = a1(j120)
a(2) = p11 - a(120):
For j119 = m1 To m2
a(119) = a1(j119)
a(3) = p11 - a(119):
For j113 = m1 To m2
a(113) = a1(j113)
a(9) = p11 - a(113):
a(112) = s1 - a(111) - a(113) - a(114) - a(115) - a(116) - a(117) - a(118) - a(119) - a(120) - a(121)
If a(112) < a1(m1) Or a(112) > a1(m2) Then GoTo 1130:
a(10) = p11 - a(112):
n10 = 11: For i1 = 1 To n10: b(i1) = a(i1): Next i1 'Check Row 1 / 11
GoSub 1800: If fl1 = 0 Then GoTo 1130
For j108 = m1 To m2
a(108) = a1(j108)
a(14) = p11 - a(108):
a(102) = s1 - a(3) - a(14) - a(25) - a(36) - a(47) - a(58) - a(69) - a(80) - a(91) - a(113)
If a(102) < a1(m1) Or a(102) > a1(m2) Then GoTo 1080:
a(20) = p11 - a(102):
n10 = 9: For i1 = 1 To n10: b(i1) = a(100 + i1): Next i1
GoSub 1800: If fl1 = 0 Then GoTo 1080
For j110 = m1 To m2
a(110) = a1(j110)
a(12) = p11 - a(110):
a(100) = s1 - a(101) - a(102) - a(103) - a(104) - a(105) - a(106) - a(107) - a(108) - a(109) - a(110)
If a(100) < a1(m1) Or a(100) > a1(m2) Then GoTo 1100:
a(22) = p11 - a(100):
n10 = 11: For i1 = 1 To n10: b(i1) = a(i1 + 11): Next i1 'Check Row 2 / 10
GoSub 1800: If fl1 = 0 Then GoTo 1100
For j78 = m1 To m2
a(78) = a1(j78)
a(44) = p11 - a(78):
For j34 = m1 To m2
a(34) = a1(j34)
a(88) = p11 - a(34):
For j79 = m1 To m2
a(79) = a1(j79)
a(43) = p11 - a(79):
a(87) = s1 - a(78) - a(79) - a(80) - a(81) - a(82) - a(83) - a(84) - a(85) - a(86) - a(88)
If a(87) < a1(m1) Or a(87) > a1(m2) Then GoTo 790:
a(35) = p11 - a(87):
n10 = 11: For i1 = 1 To n10: b(i1) = a(i1 + 77): Next i1 'Check Row 4 / 8
GoSub 1800: If fl1 = 0 Then GoTo 790
For j89 = m1 To m2
a(89) = a1(j89)
a(33) = p11 - a(89):
a(23) = s1 - a(1) - a(12) - a(34) - a(45) - a(56) - a(67) - a(78) - a(89) - a(100) - a(111)
If a(23) < a1(m1) Or a(23) > a1(m2) Then GoTo 890:
a(99) = p11 - a(23)
n10 = 9: For i1 = 1 To 7: b(i1) = a(i1 + 90): Next i1
b(8) = a(89): b(9) = a(99)
GoSub 1800: If fl1 = 0 Then GoTo 890
a(98) = (-a(21) + a(23) + a(25) + a(26) + a(27) + a(28) + a(29) + a(30) + a(31) +
+ a(33) - a(43) - a(54) - a(65) - a(76) - a(87) - a(109) + a(112) - a(120)) / 2
If a(98) < a1(m1) Or a(98) > a1(m2) Or CInt(a(98)) <> a(98) Then GoTo 890:
a(24) = p11 - a(98)
a(90) = s1 - a(98) - a(89) - a(91) - a(92) - a(93) - a(94) - a(95) - a(96) - a(97) - a(99)
If a(90) < a1(m1) Or a(90) > a1(m2) Then GoTo 890:
a(32) = p11 - a(90)
n10 = 11: For i1 = 1 To n10: b(i1) = a(i1 + 22): Next i1 'Check Row 3 / 9
GoSub 1800: If fl1 = 0 Then GoTo 890
' Calculate c() = 11 * a() + b1() + 1
GoSub 1500: If fl1 = 0 Then GoTo 890
' GoSub 1500: If n20 > 4 Then GoTo 890
n9 = n9 + 1
GoSub 2650 'Print results (squares)
' GoSub 2645 'Print results (selected numbers
' Cells(1, 1).Value = n9 'Counting
890 Next j89
790 Next j79
340 Next j34
780 Next j78
1100 Next j110
1080 Next j108
1130 Next j113
1190 Next j119
1200 Next j120
1070 Next j107
1140 Next j114
1180 Next j118
910 Next j91
1010 Next j101
1110 Next j111
970 Next j97
1090 Next j109
1210 Next j121
770 Next j77
1170 Next j117
1550 Next j150
t2 = Timer
t10 = Str(t2 - t1) + " sec., " + Str(n9) + " Solutions for sum" + Str(s1)
y = MsgBox(t10, 0, "Routine SemiLat11b")
End
1500 fl1 = 1
' Rotated (Option)
'' b1(1) = a(111): b1(2) = a(100): b1(3) = a(89): b1(4) = a(78): b1(5) = a(67): b1(6) = a(56):
'' b1(7) = a(45): b1(8) = a(34): b1(9) = a(23): b1(10) = a(12): b1(11) = a(1):
'' b1(12) = a(112): b1(13) = a(101): b1(14) = a(90): b1(15) = a(79): b1(16) = a(68): b1(17) = a(57):
'' b1(18) = a(46): b1(19) = a(35): b1(20) = a(24): b1(21) = a(13): b1(22) = a(2):
'' b1(23) = a(113): b1(24) = a(102): b1(25) = a(91): b1(26) = a(80): b1(27) = a(69): b1(28) = a(58):
'' b1(29) = a(47): b1(30) = a(36): b1(31) = a(25): b1(32) = a(14): b1(33) = a(3):
'' b1(34) = a(114): b1(35) = a(103): b1(36) = a(92): b1(37) = a(81): b1(38) = a(70): b1(39) = a(59):
'' b1(40) = a(48): b1(41) = a(37): b1(42) = a(26): b1(43) = a(15): b1(44) = a(4):
'' b1(45) = a(115): b1(46) = a(104): b1(47) = a(93): b1(48) = a(82): b1(49) = a(71): b1(50) = a(60):
'' b1(51) = a(49): b1(52) = a(38): b1(53) = a(27): b1(54) = a(16): b1(55) = a(5):
'' b1(56) = a(116): b1(57) = a(105): b1(58) = a(94): b1(59) = a(83): b1(60) = a(72): b1(61) = a(61):
'' b1(62) = a(50): b1(63) = a(39): b1(64) = a(28): b1(65) = a(17): b1(66) = a(6):
'' b1(67) = a(117): b1(68) = a(106): b1(69) = a(95): b1(70) = a(84): b1(71) = a(73): b1(72) = a(62):
'' b1(73) = a(51): b1(74) = a(40): b1(75) = a(29): b1(76) = a(18): b1(77) = a(7):
'' b1(78) = a(118): b1(79) = a(107): b1(80) = a(96): b1(81) = a(85): b1(82) = a(74): b1(83) = a(63):
'' b1(84) = a(52): b1(85) = a(41): b1(86) = a(30): b1(87) = a(19): b1(88) = a(8):
'' b1(89) = a(119): b1(90) = a(108): b1(91) = a(97): b1(92) = a(86): b1(93) = a(75): b1(94) = a(64):
'' b1(95) = a(53): b1(96) = a(42): b1(97) = a(31): b1(98) = a(20): b1(99) = a(9):
'' b1(100) = a(120): b1(101) = a(109): b1(102) = a(98): b1(103) = a(87): b1(104) = a(76): b1(105) = a(65):
'' b1(106) = a(54): b1(107) = a(43): b1(108) = a(32): b1(109) = a(21): b1(110) = a(10):
'' b1(111) = a(121): b1(112) = a(110): b1(113) = a(99): b1(114) = a(88): b1(115) = a(77): b1(116) = a(66):
'' b1(117) = a(55): b1(118) = a(44): b1(119) = a(33): b1(120) = a(22): b1(121) = a(11):
' Transpose (Option)
b1(1) = a(1): b1(2) = a(12): b1(3) = a(23): b1(4) = a(34): b1(5) = a(45): b1(6) = a(56):
b1(7) = a(67): b1(8) = a(78): b1(9) = a(89): b1(10) = a(100): b1(11) = a(111):
b1(12) = a(2): b1(13) = a(13): b1(14) = a(24): b1(15) = a(35): b1(16) = a(46): b1(17) = a(57):
b1(18) = a(68): b1(19) = a(79): b1(20) = a(90): b1(21) = a(101): b1(22) = a(112):
b1(23) = a(3): b1(24) = a(14): b1(25) = a(25): b1(26) = a(36): b1(27) = a(47): b1(28) = a(58):
b1(29) = a(69): b1(30) = a(80): b1(31) = a(91): b1(32) = a(102): b1(33) = a(113):
b1(34) = a(4): b1(35) = a(15): b1(36) = a(26): b1(37) = a(37): b1(38) = a(48): b1(39) = a(59):
b1(40) = a(70): b1(41) = a(81): b1(42) = a(92): b1(43) = a(103): b1(44) = a(114):
b1(45) = a(5): b1(46) = a(16): b1(47) = a(27): b1(48) = a(38): b1(49) = a(49): b1(50) = a(60):
b1(51) = a(71): b1(52) = a(82): b1(53) = a(93): b1(54) = a(104): b1(55) = a(115):
b1(56) = a(6): b1(57) = a(17): b1(58) = a(28): b1(59) = a(39): b1(60) = a(50): b1(61) = a(61):
b1(62) = a(72): b1(63) = a(83): b1(64) = a(94): b1(65) = a(105): b1(66) = a(116):
b1(67) = a(7): b1(68) = a(18): b1(69) = a(29): b1(70) = a(40): b1(71) = a(51): b1(72) = a(62):
b1(73) = a(73): b1(74) = a(84): b1(75) = a(95): b1(76) = a(106): b1(77) = a(117):
b1(78) = a(8): b1(79) = a(19): b1(80) = a(30): b1(81) = a(41): b1(82) = a(52): b1(83) = a(63):
b1(84) = a(74): b1(85) = a(85): b1(86) = a(96): b1(87) = a(107): b1(88) = a(118):
b1(89) = a(9): b1(90) = a(20): b1(91) = a(31): b1(92) = a(42): b1(93) = a(53): b1(94) = a(64):
b1(95) = a(75): b1(96) = a(86): b1(97) = a(97): b1(98) = a(108): b1(99) = a(119):
b1(100) = a(10): b1(101) = a(21): b1(102) = a(32): b1(103) = a(43): b1(104) = a(54): b1(105) = a(65):
b1(106) = a(76): b1(107) = a(87): b1(108) = a(98): b1(109) = a(109): b1(110) = a(120):
b1(111) = a(11): b1(112) = a(22): b1(113) = a(33): b1(114) = a(44): b1(115) = a(55): b1(116) = a(66):
b1(117) = a(77): b1(118) = a(88): b1(119) = a(99): b1(120) = a(110): b1(121) = a(121):
Erase c
For i1 = 1 To 121
c(i1) = 11 * a(i1) + b1(i1) + 1
Next i1
fl1 = 1: n20 = 0
For j1 = 1 To 121
a2 = c(j1):
For j2 = (1 + j1) To 121
If a2 = c(j2) Then fl1 = 0: Return
''If a2 = c(j2) Then n20 = n20 + 1
Next j2
1510 Next j1
Return
' Exclude solutions with identical numbers Latin Lines Order 11
1800 fl1 = 1
For j1 = 1 To n10
a2 = b(j1):
For j2 = (1 + j1) To n10
If a2 = b(j2) Then fl1 = 0: Return
Next j2
1810 Next j1
Return
' Print results (selected numbers)
2645 For i1 = 1 To 121
Cells(n9, i1).Value = a(i1)
Next i1
Cells(n9, 122).Value = n9
Return
' Print results (squares)
2650 n2 = n2 + 1
If n2 = 5 Then
n2 = 1: k1 = k1 + 12: k2 = 1
Else
If n9 > 1 Then k2 = k2 + 12
End If
Cells(2, 1).Value = n20
Cells(k1, k2 + 1).Font.Color = -4165632
Cells(k1, k2 + 1).Value = CStr(n9)
Cells(k1, k2 + 2).Value = j150
Cells(k1, k2 + 3).Value = n20
i3 = 0
For i1 = 1 To 11
For i2 = 1 To 11
i3 = i3 + 1
Cells(k1 + i1, k2 + i2).Value = c(i3) ''c(i3)
Next i2
Next i1
Return
End Sub
