Как я могу сделать это сокращение Fortran OpenMP работать? - PullRequest
0 голосов
/ 07 декабря 2018

Это продолжение моего вопроса 49355095. Мне нужно сформировать подматрицу "S", сохранив определенные строки и столбцы из заданной матрицы "L".Трудность возникает из-за того, что все массивы очень большие и хранятся в разреженном виде с использованием формата Harwell-Boeing.Если детали этой формы актуальны, я могу отредактировать их. MWE, перечисленный ниже, делает то, что мне нужно, если закомментированы директивы OMP:

!! 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.

, что является мусором.

Любые идеи будут высоко оценены

...