fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

OpenMP loop in samples data generation

Browse Source
omp-walther
sfilippone 2 years ago
parent 73e5d49913
commit 494b8b925f
2 changed files with 444 additions and 396 deletions
Show Stats Download Patch File Download Diff File

104
samples/advanced/pdegen/amg_d_genpde_mod.F90
Unescape Escape View File

@ -93,6 +93,9 @@ contains
& a1,a2,a3,b1,b2,b3,c,g,info,f,amold,vmold,partition, nrl,iv) & a1,a2,a3,b1,b2,b3,c,g,info,f,amold,vmold,partition, nrl,iv)
use psb_base_mod use psb_base_mod
use psb_util_mod use psb_util_mod
#if defined(OPENMP)
use omp_lib
#endif
! !
! Discretizes the partial differential equation ! Discretizes the partial differential equation
! !
@ -128,7 +131,6 @@ contains
type(psb_d_csc_sparse_mat) :: acsc type(psb_d_csc_sparse_mat) :: acsc
type(psb_d_coo_sparse_mat) :: acoo type(psb_d_coo_sparse_mat) :: acoo
type(psb_d_csr_sparse_mat) :: acsr type(psb_d_csr_sparse_mat) :: acsr
real(psb_dpk_) :: zt(nb),x,y,z,xph,xmh,yph,ymh,zph,zmh
integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_ integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_
integer(psb_lpk_) :: m,n,glob_row,nt integer(psb_lpk_) :: m,n,glob_row,nt
integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner
@ -141,8 +143,7 @@ contains
! Process grid ! Process grid
integer(psb_ipk_) :: np, iam integer(psb_ipk_) :: np, iam
integer(psb_ipk_) :: icoeff integer(psb_ipk_) :: icoeff
integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:) integer(psb_lpk_), allocatable :: myidx(:)
real(psb_dpk_), allocatable :: val(:)
! deltah dimension of each grid cell ! deltah dimension of each grid cell
! deltat discretization time ! deltat discretization time
real(psb_dpk_) :: deltah, sqdeltah, deltah2 real(psb_dpk_) :: deltah, sqdeltah, deltah2
@ -368,32 +369,35 @@ contains
call psb_barrier(ctxt) call psb_barrier(ctxt)
talc = psb_wtime()-t0 talc = psb_wtime()-t0
if (info /= psb_success_) then call psb_barrier(ctxt)
info=psb_err_from_subroutine_ t1 = psb_wtime()
ch_err='allocation rout.' !$omp parallel shared(deltah,myidx,a,desc_a)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
! we build an auxiliary matrix consisting of one row at a
! time; just a small matrix. might be extended to generate
! a bunch of rows per call.
! !
block
integer(psb_ipk_) :: i,j,k,ii,ib,icoeff, ix,iy,iz, ith,nth
integer(psb_lpk_) :: glob_row
integer(psb_lpk_), allocatable :: irow(:),icol(:)
real(psb_dpk_), allocatable :: val(:)
real(psb_dpk_) :: x,y,z, zt(nb)
#if defined(OPENMP)
nth = omp_get_num_threads()
ith = omp_get_thread_num()
#else
nth = 1
ith = 0
#endif
allocate(val(20*nb),irow(20*nb),& allocate(val(20*nb),irow(20*nb),&
&icol(20*nb),stat=info) &icol(20*nb),stat=info)
if (info /= psb_success_ ) then if (info /= psb_success_ ) then
info=psb_err_alloc_dealloc_ info=psb_err_alloc_dealloc_
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 !goto 9999
endif endif
!$omp do schedule(dynamic)
! loop over rows belonging to current process in a block !
! distribution.
call psb_barrier(ctxt)
t1 = psb_wtime()
do ii=1, nlr, nb do ii=1, nlr, nb
if (info /= psb_success_) cycle
ib = min(nb,nlr-ii+1) ib = min(nb,nlr-ii+1)
icoeff = 1 icoeff = 1
do k=1,ib do k=1,ib
@ -473,14 +477,20 @@ contains
endif endif
end do end do
!write(0,*) ' Outer in_parallel ',omp_in_parallel()
call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info) call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
if(info /= psb_success_) exit if(info /= psb_success_) cycle
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info) call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
if(info /= psb_success_) exit if(info /= psb_success_) cycle
zt(:)=dzero zt(:)=dzero
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info) call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
if(info /= psb_success_) exit if(info /= psb_success_) cycle
end do end do
!$omp end do
deallocate(val,irow,icol)
end block
!$omp end parallel
tgen = psb_wtime()-t1 tgen = psb_wtime()-t1
if(info /= psb_success_) then if(info /= psb_success_) then
@ -490,7 +500,6 @@ contains
goto 9999 goto 9999
end if end if
deallocate(val,irow,icol)
call psb_barrier(ctxt) call psb_barrier(ctxt)
t1 = psb_wtime() t1 = psb_wtime()
@ -557,6 +566,9 @@ contains
& a1,a2,b1,b2,c,g,info,f,amold,vmold,partition, nrl,iv) & a1,a2,b1,b2,c,g,info,f,amold,vmold,partition, nrl,iv)
use psb_base_mod use psb_base_mod
use psb_util_mod use psb_util_mod
#if defined(OPENMP)
use omp_lib
#endif
! !
! Discretizes the partial differential equation ! Discretizes the partial differential equation
! !
@ -591,7 +603,6 @@ contains
type(psb_d_csc_sparse_mat) :: acsc type(psb_d_csc_sparse_mat) :: acsc
type(psb_d_coo_sparse_mat) :: acoo type(psb_d_coo_sparse_mat) :: acoo
type(psb_d_csr_sparse_mat) :: acsr type(psb_d_csr_sparse_mat) :: acsr
real(psb_dpk_) :: zt(nb),x,y,z,xph,xmh,yph,ymh,zph,zmh
integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_ integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_
integer(psb_lpk_) :: m,n,glob_row,nt integer(psb_lpk_) :: m,n,glob_row,nt
integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner
@ -604,8 +615,7 @@ contains
! Process grid ! Process grid
integer(psb_ipk_) :: np, iam integer(psb_ipk_) :: np, iam
integer(psb_ipk_) :: icoeff integer(psb_ipk_) :: icoeff
integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:) integer(psb_lpk_), allocatable :: myidx(:)
real(psb_dpk_), allocatable :: val(:)
! deltah dimension of each grid cell ! deltah dimension of each grid cell
! deltat discretization time ! deltat discretization time
real(psb_dpk_) :: deltah, sqdeltah, deltah2, dd real(psb_dpk_) :: deltah, sqdeltah, deltah2, dd
@ -816,24 +826,35 @@ contains
goto 9999 goto 9999
end if end if
! we build an auxiliary matrix consisting of one row at a call psb_barrier(ctxt)
! time; just a small matrix. might be extended to generate t1 = psb_wtime()
! a bunch of rows per call. !$omp parallel shared(deltah,myidx,a,desc_a)
! !
block
integer(psb_ipk_) :: i,j,k,ii,ib,icoeff, ix,iy,iz, ith,nth
integer(psb_lpk_) :: glob_row
integer(psb_lpk_), allocatable :: irow(:),icol(:)
real(psb_dpk_), allocatable :: val(:)
real(psb_dpk_) :: x,y,z, zt(nb)
#if defined(OPENMP)
nth = omp_get_num_threads()
ith = omp_get_thread_num()
#else
nth = 1
ith = 0
#endif
allocate(val(20*nb),irow(20*nb),& allocate(val(20*nb),irow(20*nb),&
&icol(20*nb),stat=info) &icol(20*nb),stat=info)
if (info /= psb_success_ ) then if (info /= psb_success_ ) then
info=psb_err_alloc_dealloc_ info=psb_err_alloc_dealloc_
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 !goto 9999
endif endif
! loop over rows belonging to current process in a block ! loop over rows belonging to current process in a block
! distribution. ! distribution.
!$omp do schedule(dynamic)
call psb_barrier(ctxt) !
t1 = psb_wtime()
do ii=1, nlr,nb do ii=1, nlr,nb
ib = min(nb,nlr-ii+1) ib = min(nb,nlr-ii+1)
icoeff = 1 icoeff = 1
@ -896,13 +917,18 @@ contains
end do end do
call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info) call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
if(info /= psb_success_) exit if(info /= psb_success_) cycle
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info) call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
if(info /= psb_success_) exit if(info /= psb_success_) cycle
zt(:)=dzero zt(:)=dzero
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info) call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
if(info /= psb_success_) exit if(info /= psb_success_) cycle
end do end do
!$omp end do
deallocate(val,irow,icol)
end block
!$omp end parallel
tgen = psb_wtime()-t1 tgen = psb_wtime()-t1
if(info /= psb_success_) then if(info /= psb_success_) then
@ -912,8 +938,6 @@ contains
goto 9999 goto 9999
end if end if
deallocate(val,irow,icol)
call psb_barrier(ctxt) call psb_barrier(ctxt)
t1 = psb_wtime() t1 = psb_wtime()
call psb_cdasb(desc_a,info) call psb_cdasb(desc_a,info)

104
samples/advanced/pdegen/amg_s_genpde_mod.F90
Unescape Escape View File

@ -93,6 +93,9 @@ contains
& a1,a2,a3,b1,b2,b3,c,g,info,f,amold,vmold,partition, nrl,iv) & a1,a2,a3,b1,b2,b3,c,g,info,f,amold,vmold,partition, nrl,iv)
use psb_base_mod use psb_base_mod
use psb_util_mod use psb_util_mod
#if defined(OPENMP)
use omp_lib
#endif
! !
! Discretizes the partial differential equation ! Discretizes the partial differential equation
! !
@ -128,7 +131,6 @@ contains
type(psb_s_csc_sparse_mat) :: acsc type(psb_s_csc_sparse_mat) :: acsc
type(psb_s_coo_sparse_mat) :: acoo type(psb_s_coo_sparse_mat) :: acoo
type(psb_s_csr_sparse_mat) :: acsr type(psb_s_csr_sparse_mat) :: acsr
real(psb_spk_) :: zt(nb),x,y,z,xph,xmh,yph,ymh,zph,zmh
integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_ integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_
integer(psb_lpk_) :: m,n,glob_row,nt integer(psb_lpk_) :: m,n,glob_row,nt
integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner
@ -141,8 +143,7 @@ contains
! Process grid ! Process grid
integer(psb_ipk_) :: np, iam integer(psb_ipk_) :: np, iam
integer(psb_ipk_) :: icoeff integer(psb_ipk_) :: icoeff
integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:) integer(psb_lpk_), allocatable :: myidx(:)
real(psb_spk_), allocatable :: val(:)
! deltah dimension of each grid cell ! deltah dimension of each grid cell
! deltat discretization time ! deltat discretization time
real(psb_spk_) :: deltah, sqdeltah, deltah2 real(psb_spk_) :: deltah, sqdeltah, deltah2
@ -368,32 +369,35 @@ contains
call psb_barrier(ctxt) call psb_barrier(ctxt)
talc = psb_wtime()-t0 talc = psb_wtime()-t0
if (info /= psb_success_) then call psb_barrier(ctxt)
info=psb_err_from_subroutine_ t1 = psb_wtime()
ch_err='allocation rout.' !$omp parallel shared(deltah,myidx,a,desc_a)
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
! we build an auxiliary matrix consisting of one row at a
! time; just a small matrix. might be extended to generate
! a bunch of rows per call.
! !
block
integer(psb_ipk_) :: i,j,k,ii,ib,icoeff, ix,iy,iz, ith,nth
integer(psb_lpk_) :: glob_row
integer(psb_lpk_), allocatable :: irow(:),icol(:)
real(psb_spk_), allocatable :: val(:)
real(psb_spk_) :: x,y,z, zt(nb)
#if defined(OPENMP)
nth = omp_get_num_threads()
ith = omp_get_thread_num()
#else
nth = 1
ith = 0
#endif
allocate(val(20*nb),irow(20*nb),& allocate(val(20*nb),irow(20*nb),&
&icol(20*nb),stat=info) &icol(20*nb),stat=info)
if (info /= psb_success_ ) then if (info /= psb_success_ ) then
info=psb_err_alloc_dealloc_ info=psb_err_alloc_dealloc_
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 !goto 9999
endif endif
!$omp do schedule(dynamic)
! loop over rows belonging to current process in a block !
! distribution.
call psb_barrier(ctxt)
t1 = psb_wtime()
do ii=1, nlr, nb do ii=1, nlr, nb
if (info /= psb_success_) cycle
ib = min(nb,nlr-ii+1) ib = min(nb,nlr-ii+1)
icoeff = 1 icoeff = 1
do k=1,ib do k=1,ib
@ -473,14 +477,20 @@ contains
endif endif
end do end do
!write(0,*) ' Outer in_parallel ',omp_in_parallel()
call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info) call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
if(info /= psb_success_) exit if(info /= psb_success_) cycle
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info) call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
if(info /= psb_success_) exit if(info /= psb_success_) cycle
zt(:)=szero zt(:)=szero
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info) call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
if(info /= psb_success_) exit if(info /= psb_success_) cycle
end do end do
!$omp end do
deallocate(val,irow,icol)
end block
!$omp end parallel
tgen = psb_wtime()-t1 tgen = psb_wtime()-t1
if(info /= psb_success_) then if(info /= psb_success_) then
@ -490,7 +500,6 @@ contains
goto 9999 goto 9999
end if end if
deallocate(val,irow,icol)
call psb_barrier(ctxt) call psb_barrier(ctxt)
t1 = psb_wtime() t1 = psb_wtime()
@ -557,6 +566,9 @@ contains
& a1,a2,b1,b2,c,g,info,f,amold,vmold,partition, nrl,iv) & a1,a2,b1,b2,c,g,info,f,amold,vmold,partition, nrl,iv)
use psb_base_mod use psb_base_mod
use psb_util_mod use psb_util_mod
#if defined(OPENMP)
use omp_lib
#endif
! !
! Discretizes the partial differential equation ! Discretizes the partial differential equation
! !
@ -591,7 +603,6 @@ contains
type(psb_s_csc_sparse_mat) :: acsc type(psb_s_csc_sparse_mat) :: acsc
type(psb_s_coo_sparse_mat) :: acoo type(psb_s_coo_sparse_mat) :: acoo
type(psb_s_csr_sparse_mat) :: acsr type(psb_s_csr_sparse_mat) :: acsr
real(psb_spk_) :: zt(nb),x,y,z,xph,xmh,yph,ymh,zph,zmh
integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_ integer(psb_ipk_) :: nnz,nr,nlr,i,j,ii,ib,k, partition_
integer(psb_lpk_) :: m,n,glob_row,nt integer(psb_lpk_) :: m,n,glob_row,nt
integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner
@ -604,8 +615,7 @@ contains
! Process grid ! Process grid
integer(psb_ipk_) :: np, iam integer(psb_ipk_) :: np, iam
integer(psb_ipk_) :: icoeff integer(psb_ipk_) :: icoeff
integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:) integer(psb_lpk_), allocatable :: myidx(:)
real(psb_spk_), allocatable :: val(:)
! deltah dimension of each grid cell ! deltah dimension of each grid cell
! deltat discretization time ! deltat discretization time
real(psb_spk_) :: deltah, sqdeltah, deltah2, dd real(psb_spk_) :: deltah, sqdeltah, deltah2, dd
@ -816,24 +826,35 @@ contains
goto 9999 goto 9999
end if end if
! we build an auxiliary matrix consisting of one row at a call psb_barrier(ctxt)
! time; just a small matrix. might be extended to generate t1 = psb_wtime()
! a bunch of rows per call. !$omp parallel shared(deltah,myidx,a,desc_a)
! !
block
integer(psb_ipk_) :: i,j,k,ii,ib,icoeff, ix,iy,iz, ith,nth
integer(psb_lpk_) :: glob_row
integer(psb_lpk_), allocatable :: irow(:),icol(:)
real(psb_spk_), allocatable :: val(:)
real(psb_spk_) :: x,y,z, zt(nb)
#if defined(OPENMP)
nth = omp_get_num_threads()
ith = omp_get_thread_num()
#else
nth = 1
ith = 0
#endif
allocate(val(20*nb),irow(20*nb),& allocate(val(20*nb),irow(20*nb),&
&icol(20*nb),stat=info) &icol(20*nb),stat=info)
if (info /= psb_success_ ) then if (info /= psb_success_ ) then
info=psb_err_alloc_dealloc_ info=psb_err_alloc_dealloc_
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 !goto 9999
endif endif
! loop over rows belonging to current process in a block ! loop over rows belonging to current process in a block
! distribution. ! distribution.
!$omp do schedule(dynamic)
call psb_barrier(ctxt) !
t1 = psb_wtime()
do ii=1, nlr,nb do ii=1, nlr,nb
ib = min(nb,nlr-ii+1) ib = min(nb,nlr-ii+1)
icoeff = 1 icoeff = 1
@ -896,13 +917,18 @@ contains
end do end do
call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info) call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
if(info /= psb_success_) exit if(info /= psb_success_) cycle
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info) call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
if(info /= psb_success_) exit if(info /= psb_success_) cycle
zt(:)=szero zt(:)=szero
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info) call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
if(info /= psb_success_) exit if(info /= psb_success_) cycle
end do end do
!$omp end do
deallocate(val,irow,icol)
end block
!$omp end parallel
tgen = psb_wtime()-t1 tgen = psb_wtime()-t1
if(info /= psb_success_) then if(info /= psb_success_) then
@ -912,8 +938,6 @@ contains
goto 9999 goto 9999
end if end if
deallocate(val,irow,icol)
call psb_barrier(ctxt) call psb_barrier(ctxt)
t1 = psb_wtime() t1 = psb_wtime()
call psb_cdasb(desc_a,info) call psb_cdasb(desc_a,info)

Write Preview
Loading…
Cancel
Save