我仍然在咬牙切齿,因为在v2015中无法捕捉到600x600方形网格舱口的交叉点,而不会有很多麻烦。
我会偷看这个,因为我越来越觉得已经完成了....再。 我的发现...
自2015年以来,solprof绘制了相反弧线的法线。
似乎有一个严重的精度问题,涉及从vb6插入转换矩阵。
Function EIGEN_JK(ByRef M As Variant) As Variant
'***************************************************************************
'**Function computes the eigenvalues and eigenvectors for a real **
'**symmetric positive definite matrix using the "JK Method".The **
'**first column of the return matrix contains the eigenvalues and **
'**the rest of the p+1 columns contain the eigenvectors. **
'**See: **
'**KAISER,H.F. (1972) "THE JK METHOD: A PROCEDURE FOR FINDING THE **
'**EIGENVALUES OF A REAL SYMMETRIC MATRIX", The Computer Journal, **
'**VOL.15, 271-273. **
'***************************************************************************
Dim A() As Variant, Ematrix() As Double
Dim i As Long, j As Long, k As Long, iter As Long, p As Long
Dim den As Double, hold As Double, Sin_ As Double, num As Double
Dim Sin2 As Double, Cos2 As Double, Cos_ As Double, Test As Double
Dim Tan2 As Double, Cot2 As Double, tmp As Double
Const eps As Double = 1E-16
On Error GoTo EndProc
A = M
p = UBound(A, 1)
ReDim Ematrix(1 To p, 1 To p + 1)
For iter = 1 To 15
'Orthogonalize pairs of columns in upper off diag
For j = 1 To p - 1
For k = j + 1 To p
den = 0#
num = 0#
'Perform single plane rotation
For i = 1 To p
num = num + 2 * A(i, j) * A(i, k) ': numerator eq. 11
den = den + (A(i, j) + A(i, k)) * _
(A(i, j) - A(i, k)) ': denominator eq. 11
Next i
'Skip rotation if aij is zero and correct ordering
If Abs(num) = 0 Then Exit For
'Perform Rotation
If Abs(num)5 Then Exit For
hold = Test
Next iter
If iter = 16 Then MsgBox "JK Iteration has not converged."
'Compute eigenvalues/eigenvectors
For j = 1 To p
'Compute eigenvalues
For k = 1 To p
Ematrix(j, 1) = Ematrix(j, 1) + A(k, j) ^ 2
Next k
Ematrix(j, 1) = Sqr(Ematrix(j, 1))
'Normalize eigenvectors
For i = 1 To p
If Ematrix(j, 1) <= 0 Then
Ematrix(i, j + 1) = 0
Else
Ematrix(i, j + 1) = A(i, j) / Ematrix(j, 1)
End If
Next i
Next j
EIGEN_JK = Ematrix
Exit Function
EndProc:
MsgBox prompt:="Error in function EIGEN_JK!" & vbCr & vbCr & _
"Error: " & Err.Description & ".", Buttons:=48, _
Title:="Run time error!"
End Function
这可能可以修复它们。我还没有成功。
除此之外,除了浪费时间什么都没有。
ps。很高兴再次见到你们。 现在2017年即将到来,我们终于到了2016年!
喜欢这个。
现在是什么控制了图层名称的字母顺序
最大排序。
页:
1
[2]