这是对我的问题49355095的跟进。我需要通过保留给定矩阵“ L”中的某些行和列来形成子矩阵“ S”。之所以出现困难,是因为所有数组都非常大,并且使用Harwell-Boeing格式以稀疏形式存储。如果该表单的详细信息相关,则可以对其进行编辑。如果注释掉了OMP指令,则下面列出的MWE可以满足我的需要:
!! compile with gfortran -g -fbounds-check -fopenmp -o HBSubmatrix HBSubmatrix.f90
Program HBSubmatrix
use, intrinsic :: iso_c_binding
Use omp_lib, Only : omp_get_num_threads
implicit none
integer(c_int),allocatable :: colptr(:),rowind(:),Scolptr(:),Srowind(:)
real(c_double),allocatable :: data(:),Sdata(:)
real(c_double) :: L(6,6)=reshape(1.0d0*[2,1,0,1,0,0,1,6,1,2,2,0,0,1,4,0,&
&2,1,1,2,0,4,1,0,0,2,2,1,6,1,0,0,1,0,1,2],[6,6])
! S arrays and following line are needed to make submatrix
integer(c_int) :: subnx,subnnz,subkcol,subkrow,thisrow,k,index
integer (c_int) :: ke,ne=4,kx,nx,nnz,nodes(3)
integer (c_int) :: t(4,3)=reshape((/1,2,5,6,2,3,4,5,4,5,2,3/),(/4,3/))
integer (c_int) :: keeprow(3)=[1,2,4],keepcol(3)=[3,5,6]
real (c_double) :: S(3,3)=reshape(1.d0*[0,1,0,0,2,1,0,0,0],[3,3])
nx=6;nnz=24
allocate(colptr(nx+1),rowind(nnz),data(nnz))
print *,"FullMatrix L"
write(*,fmt="(6(1x,f2.0))")(L(ke,:),ke=1,6)
!Sparse representation of L
colptr=[1,4,9,13,17,22,25]
rowind=[1,2,4,1,2,3,4,5,2,3,5,6,1,2,4,5,2,3,4,5,6,3,5,6]
data=1.0d0*[2,1,1,1,6,1,2,2,1,4,2,1,1,2,4,1,2,2,1,6,1,1,1,2]
print *,"Sparse L"
write(*,fmt="(25i3)")colptr
write(*,fmt="(24i3)")rowind
write(*,fmt="(24(1x,f2.0))")data
! reduce full matrix to a submatrix (inline HBSubMatrix)
subnx=size(keepcol)
subnnz=0
allocate(Scolptr(subnx+1));Scolptr=0;Scolptr(1)=1
allocate(Srowind(nnz));allocate(Sdata(nnz));
!!$ !$omp parallel default( none ) private (subkcol,subkrow,index)&
!!$ !$omp shared(keeprow,keepcol,subnx,subnnz,colptr,rowind,data,&
!!$ !$omp Scolptr,Srowind,Sdata)
!!$ !$omp do reduction( +:subnnz,Scolptr,Srowind,Sdata)
do subkcol=1,subnx
Scolptr(subkcol+1)=Scolptr(subkcol)
do subkrow=1,size(keeprow)
index=PHB(keeprow(subkrow),keepcol(subkcol))
if (index.gt.0) then
subnnz=subnnz+1
Scolptr(subkcol+1)=Scolptr(subkcol+1)+1
Srowind(subnnz)=subkrow
Sdata(subnnz)=data(index)
endif
end do
end do
!!$ !$omp end do
!!$ !$omp end parallel
!trim
Srowind=Srowind(1:subnnz)
Sdata=Sdata(1:subnnz)
print *,"SubMatrix, subnnz=",subnnz
write(*,fmt="(25i3)")Scolptr
write(*,fmt="(24i3)")Srowind
write(*,fmt="(12(1x,f2.0))")Sdata
contains
Function PHB(row,col)
! for col,row PHB return the corresponding position
! in the HB structure,
implicit none
integer (c_int),intent(in) :: col,row
integer (c_int) :: k,PHB
do k = colptr(col), colptr(col+1)-1
if (rowind(k).ne. row) then
PHB = 0
else
PHB = k
exit
end if
end do
End Function PHB
End Program HBSubmatrix
输出为
FullMatrix L
2. 1. 0. 1. 0. 0.
1. 6. 1. 2. 2. 0.
0. 1. 4. 0. 2. 1.
1. 2. 0. 4. 1. 0.
0. 2. 2. 1. 6. 1.
0. 0. 1. 0. 1. 2.
Sparse L
1 4 9 13 17 22 25
1 2 4 1 2 3 4 5 2 3 5 6 1 2 4 5 2 3 4 5 6 3 5 6
2. 1. 1. 1. 6. 1. 2. 2. 1. 4. 2. 1. 1. 2. 4. 1. 2. 2. 1. 6. 1. 1. 1. 2.
SubMatrix, subnnz= 3
1 2 4 4
2 2 3
1. 2. 1.
为了加快处理速度,我想使用OpenMP,我认为我可以将中央do循环中的剔除和排序视为一种简化。包含OMP指令后,输出的最后一部分是
SubMatrix, subnnz= 3
1 1 2 0
*********
3. 1. 0.
这是垃圾。
任何想法都会受到高度赞赏