pinvs.txt

常用的数值算法的VB程序

Sub PINVS(IE1, IE2, JE1, JSF, JC1, K, C(), NCI, NCJ, NCK, S(), NSI, NSJ)
    ZERO = 0#: ONE = 1
    Dim PSCL(10), INDXR(10)
    JE2 = JE1 + IE2 - IE1
    JS1 = JE2 + 1
    For I = IE1 To IE2
        BIG = ZERO
        For J = JE1 To JE2
            If Abs(S(I, J)) > BIG Then BIG = Abs(S(I, J))
        Next J
        If BIG = ZERO Then Print "Singular matrix, row all 0"
        PSCL(I) = ONE / BIG
        INDXR(I) = 0
    Next I
    For ID = IE1 To IE2
        PIV = ZERO
        For I = IE1 To IE2
            If INDXR(I) = 0 Then
                BIG = ZERO
                For J = JE1 To JE2
                    If Abs(S(I, J)) > BIG Then
                        JP = J
                        BIG = Abs(S(I, J))
                    End If
                Next J
                If BIG * PSCL(I) > PIV Then
                    IPIV = I
                    JPIV = JP
                    PIV = BIG * PSCL(I)
                End If
            End If
        Next I
        If S(IPIV, JPIV) = ZERO Then Print "Singular matrix"
        INDXR(IPIV) = JPIV
        PIVINV = ONE / S(IPIV, JPIV)
        For J = JE1 To JSF
            S(IPIV, J) = S(IPIV, J) * PIVINV
        Next J
        S(IPIV, JPIV) = ONE
        For I = IE1 To IE2
            If INDXR(I) <> JPIV Then
                If S(I, JPIV) <> ZERO Then
                    DUM = S(I, JPIV)
                    For J = JE1 To JSF
                        S(I, J) = S(I, J) - DUM * S(IPIV, J)
                    Next J
                    S(I, JPIV) = ZERO
                End If
            End If
        Next I
    Next ID
    JCOFF = JC1 - JS1
    ICOFF = IE1 - JE1
    For I = IE1 To IE2
        IROW = INDXR(I) + ICOFF
        For J = JS1 To JSF
            C(IROW, J + JCOFF, K) = S(I, J)
        Next J
    Next I
End Sub