' Perfect Diagonal Magic Cubes (m >= 10, m Mod 3 ≠ 0)
' Tested with Office 2007 under Windows 7
Sub Perfect10()
y = MsgBox("Locked", vbCritical, "Routine Perfect10")
End
Sheets("Klad1").Select
m = 10: N = 8
For k = 0 To m - 1
If k < m - 1 - k Then k1 = k Else k1 = m - 1 - k
For i = 0 To m - 1
i11 = i11 + 1
If i < m - 1 - i Then i1 = i Else i1 = m - 1 - i
For j = 0 To m - 1
j11 = j11 + 1: j12 = j12 + 1
If j < m - 1 - j Then j1 = j Else j1 = m - 1 - j
v = 4*Int(2*i/m) + 2*Int(2*j/m) + ((Int(2*i/m) + Int(2*j/m) + Int(2*k/m)) Mod 2) '(0 <= v <= 7),
z1 = (i1 + j1 - 2 * k1)
While z1 < 0
z1 = z1 + m / 2
Wend
z = z1 Mod (m / 2)
cijk = (2 * i1 + j1 + k1) Mod (m / 2) ' 0 <= bijk < m/2
dijk = (i1 + 2 * j1 + k1) Mod (m / 2) ' 0 <= cijk < m/2
eijk = (i1 + j1 + 2 * k1) Mod (m / 2) ' 0 <= dijk < m/2
x = F8(v, z, N)
bijk = D8(x, i1, j1, k1, i, j, k, m)
' Print Cube
If j11 = m + 1 Then j11 = 1
If j12 = m ^ 2 + 1 Then j12 = 1: i11 = i11 + 1
aijk = bijk * (m / 2) ^ 3 + cijk * (m / 2) ^ 2 + dijk * (m / 2) + eijk + 1
Cells(i11 + 1, j11 + 1).Value = aijk
Next j
Next i
Next k
End
End Sub
Function F8(v, z, N)
If Int(v / 2) = v / 2 Then 'v is even
Select Case z
Case 0: F8 = v
Case 1: F8 = v + 1
Case 2: F8 = N / 2 - 1 - v / 2
Case 3: F8 = N - 1 - v / 2
Case 4, 6: F8 = N - 1 - v
Case 5, 7: F8 = v
End Select
Else 'v is odd
Select Case z
Case 0: F8 = v
Case 1: F8 = v - 1
Case 2: F8 = N - 1 - (v - 1) / 2
Case 3: F8 = N / 2 - 1 - (v - 1) / 2
Case 4, 6: F8 = N - 1 - v
Case 5, 7: F8 = v
End Select
End If
End Function
Function D8(x, i1, j1, k1, i, j, k, m)
fl1 = 0: fl2 = 0
If j1 = (k1 + 1) Mod (m / 2) And i >= m / 2 And i1 = k1 Then fl1 = 1: GoTo 10
If i1 = (k1 + 1) Mod (m / 2) And j >= m / 2 And j1 = k1 Then fl1 = 1: GoTo 10
If j1 = (k1 + (m + 2) / 4) Mod (m / 2) And i >= m / 2 And i1 = j1 Then fl1 = 1: GoTo 10
k2 = (k1 - 1) Mod (m / 2)
If k2 < 0 Then k2 = (k1 - 1 + m / 2) Mod (m / 2)
If j1 = (k1 + 1) Mod (m / 2) And i >= m / 2 And i1 = k2 Then fl1 = 1: GoTo 10
If i1 = (k1 + 1) Mod (m / 2) And j >= m / 2 And j1 = k2 Then fl1 = 1: GoTo 10
i2 = (j1 - 1) Mod (m / 2)
If i2 < 0 Then i2 = (j1 - 1 + m / 2) Mod (m / 2)
If j1 = (k1 + (m + 2) / 4) Mod (m / 2) And i >= m / 2 And i1 = i2 Then fl1 = 1: GoTo 10
10
If fl1 = 1 Then
D8 = x + (-1) ^ x
Else
D8 = x
End If
End Function
