Parallel.For 并发执行报错：稀疏矩阵构建异常排查

问题描述 #

运行CreateB函数构建系统稀疏矩阵B时，启用Parallel.For并发执行后错误率约0.1%（小数据集下数千次测试），串行执行则无错误。函数仅读取myLFV结构作为输入，执行期间未对其修改，.BusDict已声明为ConcurrentDictionary。尝试过SyncLock和await解决，但不想拆分传递所需数据，寻求无需额外拆分的解决方案。

核心代码 #

Friend Function CreateB(ByVal myLFV As MyVars.Data, mySender As MainWindow) As Matrix(Of Single)

    If mySender.DirtyB Then
        ' Define Matrix B for the system
        With myLFV
            Dim n As Integer = .N - 1 ' remove reference from count
            Dim myB = Matrix(Of Single).Build.Sparse(n, n, 0.0F)

            'Parallel.For(.Bus0 + 1, .Buses.Length,
            '    Sub(k)
            For k = .Bus0 + 1 To UBound(.Buses)
                Dim diag As Single = 0.0F
                For j = .Buses(k).FirstBranch To .Buses(k).FirstBranch + .Buses(k).NConns - 1
                    Dim suscept As Single = GetFlowElementSusceptance(myLFV, j)
                    diag += suscept
                    If .BusDict(.dblEntry(j).Tbus) > 0 Then myB(k - 1, .BusDict(.dblEntry(j).Tbus) - 1) -= suscept
                Next j
                myB(k - 1, k - 1) += diag
            Next k
            'End Sub)
            mySender.DirtyB = False
            Return myB
        End With
    End If

    Return Nothing

End Function

补充类型声明 #

Public Class Data

    Public Header As MyVars.Header
    Public Buses() As MyVars.BusData
    Public Loads() As MyVars.LoadData
    Public FixedShunts() As MyVars.FixedShuntData
    Public Gens() As MyVars.GenData
    Public Lines() As MyVars.LineData
    Public TX() As MyVars.TXData
    Public Areas() As MyVars.AreaData
    Public Zones() As MyVars.ZoneData
    Public Owners() As MyVars.OwnerData
    Public dblEntry() As MyVars.DBlEntry
End Class

Public Class BusData
    Public Property Number As Integer = Integer.MinValue
    Public Property Name As String = ""
    Public Property KV As Single = Single.MinValue
    Public Property Code As Integer = Integer.MinValue
    Public Property Area As Integer = Integer.MinValue
    Public Property Zone As Integer = Integer.MinValue
    Public Property Owner As Integer = Integer.MinValue
    Public Property Vpu As Single = Single.MinValue
    Public Property Vang As Single = Single.MinValue
    Public Property NConns As Integer = Integer.MinValue
    Public Property FirstBranch As Integer = Integer.MinValue
    Public Property NGens As Integer = Integer.MinValue
    Public Property NLoads As Integer = Integer.MinValue
    Public Property NFixShunts As Integer = Integer.MinValue
    Public Property IsSwing As Boolean = False
End Class

Private Function GetFlowElementSusceptance(myLFV As Data, i As Integer) As Single
    Select Case myLFV.dblEntry(i).BrType
        Case "Line"
            Dim j As Integer = myLFV.dblEntry(i).Index
            GetFlowElementSusceptance = -1.0 / myLFV.Lines(j).Impedance * myLFV.Lines(j).Status
        Case "TX"
            Dim j As Integer = myLFV.dblEntry(i).Index
            GetFlowElementSusceptance = -1.0 / myLFV.TX(j).Impedance * myLFV.TX(j).Status
        Case Else
            GetFlowElementSusceptance = 0.0
    End Select
End Function

问题分析 #

偶发错误的核心原因是对稀疏矩阵myB的并发写入冲突：

• myLFV是只读资源，BusDict是线程安全的，这两部分不会引发问题；但myB是普通稀疏矩阵，不支持并发元素修改操作。
• 当多个线程同时修改myB的同一个元素（比如不同母线的连接关系指向同一个目标母线时），非原子性的读写操作会导致数值被覆盖或计算错误，这就是0.1%错误率的来源。

解决方案（无需拆分数据） #

方案1：细粒度锁控制矩阵写入

对每个矩阵元素的修改操作加锁，避免并发冲突：

' 替换原Parallel.For部分
Parallel.For(.Bus0 + 1, .Buses.Length,
    Sub(k)
        Dim diag As Single = 0.0F
        For j = .Buses(k).FirstBranch To .Buses(k).FirstBranch + .Buses(k).NConns - 1
            Dim suscept As Single = GetFlowElementSusceptance(myLFV, j)
            diag += suscept
            Dim targetBusIdx = .BusDict(.dblEntry(j).Tbus) - 1
            If targetBusIdx >= 0 Then
                SyncLock myB
                    myB(k - 1, targetBusIdx) -= suscept
                End SyncLock
            End If
        Next j
        SyncLock myB
            myB(k - 1, k - 1) += diag
        End SyncLock
    End Sub)

注：细粒度锁会一定程度降低并行效率，适合对性能要求不极致的场景。

方案2：线程局部矩阵+合并（高效无锁）

每个线程独立计算局部矩阵，最后合并结果，完全避免并发冲突：

If mySender.DirtyB Then
    With myLFV
        Dim n As Integer = .N - 1
        ' 线程局部存储，每个线程维护自己的局部矩阵
        Dim localMatrices = New ConcurrentBag(Of Matrix(Of Single))()
        
        Parallel.For(.Bus0 + 1, .Buses.Length,
            Sub(k)
                Dim localB = Matrix(Of Single).Build.Sparse(n, n, 0.0F)
                Dim diag As Single = 0.0F
                For j = .Buses(k).FirstBranch To .Buses(k).FirstBranch + .Buses(k).NConns - 1
                    Dim suscept As Single = GetFlowElementSusceptance(myLFV, j)
                    diag += suscept
                    Dim targetBusIdx = .BusDict(.dblEntry(j).Tbus) - 1
                    If targetBusIdx >= 0 Then
                        localB(k - 1, targetBusIdx) -= suscept
                    End If
                Next j
                localB(k - 1, k - 1) += diag
                localMatrices.Add(localB)
            End Sub)
        
        ' 合并所有局部矩阵到最终矩阵
        Dim myB = Matrix(Of Single).Build.Sparse(n, n, 0.0F)
        For Each localB In localMatrices
            myB += localB
        Next
        
        mySender.DirtyB = False
        Return myB
    End With
End If

这是电力系统矩阵并行构建的常用模式，既保留并行效率，又无需拆分输入数据，完全符合需求。

关键注意点 #

• 并行操作的核心冲突永远是共享可写资源，只要确保每个线程只操作独立资源（如方案2的局部矩阵），就能彻底避免并发问题。
• 方案2的合并操作是矩阵加法，对于稀疏矩阵来说计算开销极低，整体性能优于加锁方案。

内容的提问来源于stack exchange，提问作者JAS