如何使此Fortran OpenMP简化工作?

时间:2018-12-07 18:19:19

标签: fortran openmp

这是对我的问题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.

这是垃圾。

任何想法都会受到高度赞赏

0 个答案:

没有答案