fortran基於svd分解求解廣義逆矩陣

fortran的MKl函數庫中好像沒有求解廣義逆矩陣的sub
本篇文章給出基於svd分解求廣義逆矩陣的示例代碼
program pinv
        use lapack95
        implicit none
        integer           :: i, m, n
        real, allocatable :: A(:,:), U(:,:), S(:,:), V(:,:), pinv_A(:,:), s1(:), SS(:,:)
        
        write(*,'(g0)') '請輸入矩陣的大小m,n: '
        read(*,*) m, n
        
        allocate( A(m,n), U(m,m), S(m,n), s1(min(m,n)), V(n,n), pinv_A(n,m) )

        call random_seed()
        call random_number(A)

        write(*,'(g0)') 'A is...'
        do i = 1, size(A,1)
                write(*,'(*(f11.4))') A(i,:)
        end do
        

        call gesvd( A, s1, U, V )  !// 這裏返回的V是V的轉置Vt
        
        write(*,'(g0)') 'U is...'
        do i = 1, size(U,1)
                write(*,'(*(f11.4))') U(i,:)
        end do
        
        write(*,'(g0)') 'S is...'
        S = 0.d0
        forall( i = 1:min(m,n) ) S(i,i) = s1(i)
        
        do i = 1, size(S,1)
                write(*,'(*(f11.4))') S(i,:)
        end do
        
        write(*,'(g0)') 'V is...'
        do i = 1, size(V,1)
                write(*,'(*(f11.4))') V(i,:)
        end do
        
        write(*,'(g0)') 'cheching, A is ...'
        A = matmul( matmul(U,S), V )  !// A = U*S*V'
        do i = 1, size(A,1)
                write(*,'(*(f11.4))') A(i,:)
        end do
        
        V = transpose(V)
        forall( i = 1:min(m,n) ) S(i,i) = 1.d0 / S(i,i)
        if ( m >= n ) then
                allocate( SS(n,n) )
                SS = S(1:n,1:n)
                pinv_A = matmul( matmul(V,SS), transpose(U(:,1:n)) )
        else
                allocate( SS(m,m) )
                SS = S(1:m,1:m)
                pinv_A = matmul( matmul(V(:,1:m), SS), transpose(U) )  !// pinv(A) = V*S*U'
        end if
        
        write(*,'(g0)') 'pinv(A) is...'
        do i = 1, size(pinv_A,1)
                write(*,'(*(f11.4))') pinv_A(i,:)
        end do
        
        deallocate( A, U, S, V, SS, s1, pinv_A )
        
end program pinv

結果如下所示：
請輸入矩陣的大小m,n:
4 3
A is...
     0.1300     0.1040     0.4871
     0.6307     0.7867     0.5991
     0.9404     0.2276     0.0034
     0.1887     0.9871     0.0505
U is...
    -0.1928    -0.0002     0.6973     0.6904
    -0.7028     0.0499     0.3916    -0.5918
    -0.4487    -0.7870    -0.3542     0.2322
    -0.5172     0.6150    -0.4848     0.3454
S is...
     1.6359     0.0000     0.0000
     0.0000     0.7568     0.0000
     0.0000     0.0000     0.5834
     0.0000     0.0000     0.0000
V is...
    -0.6039    -0.7248    -0.3317
    -0.7830     0.6172     0.0768
    -0.1491    -0.3061     0.9403
cheching, A is ...
     0.1300     0.1040     0.4871
     0.6307     0.7867     0.5991
     0.9404     0.2276     0.0034
     0.1887     0.9871     0.0505
pinv(A) is...
    -0.1068     0.1077     1.0704    -0.3215
    -0.2806     0.1466    -0.2572     0.9851
     1.1629     0.7787    -0.5598    -0.6141

計算結果正確