fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-19 20:32:13 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'dev-openmp' into TestFerdous

Browse Source
This commit is contained in:
sfilippone
2023-06-08 09:30:44 +02:00
parent edea0caa63 494b8b925f
commit f523d0195f
201 changed files with 7080 additions and 1787 deletions
Download Patch File Download Diff File Expand all files Collapse all files
samples/advanced/fileread/amg_cf_sample.f90
+2 -2
View File
@@ -676,8 +676,9 @@ contains
call read_data(prec%aggr_prol,inp_unit) ! aggregation type
call read_data(prec%par_aggr_alg,inp_unit) ! parallel aggregation alg
call read_data(prec%aggr_ord,inp_unit) ! ordering for aggregation
call read_data(prec%aggr_filter,inp_unit) ! filtering
call read_data(prec%mncrratio,inp_unit) ! minimum aggregation ratio
call read_data(prec%aggr_filter,inp_unit) ! filtering
call read_data(prec%athres,inp_unit) ! smoothed aggr thresh
call read_data(prec%thrvsz,inp_unit) ! size of aggr thresh vector
if (prec%thrvsz > 0) then
call psb_realloc(prec%thrvsz,prec%athresv,info)
@@ -685,7 +686,6 @@ contains
else
read(inp_unit,*) ! dummy read to skip a record
end if
call read_data(prec%athres,inp_unit) ! smoothed aggr thresh
! coasest-level solver
call read_data(prec%csolve,inp_unit) ! coarsest-lev solver
call read_data(prec%csbsolve,inp_unit) ! coarsest-lev subsolver
samples/advanced/fileread/amg_df_sample.f90
+2 -2
View File
@@ -676,8 +676,9 @@ contains
call read_data(prec%aggr_prol,inp_unit) ! aggregation type
call read_data(prec%par_aggr_alg,inp_unit) ! parallel aggregation alg
call read_data(prec%aggr_ord,inp_unit) ! ordering for aggregation
call read_data(prec%aggr_filter,inp_unit) ! filtering
call read_data(prec%mncrratio,inp_unit) ! minimum aggregation ratio
call read_data(prec%aggr_filter,inp_unit) ! filtering
call read_data(prec%athres,inp_unit) ! smoothed aggr thresh
call read_data(prec%thrvsz,inp_unit) ! size of aggr thresh vector
if (prec%thrvsz > 0) then
call psb_realloc(prec%thrvsz,prec%athresv,info)
@@ -685,7 +686,6 @@ contains
else
read(inp_unit,*) ! dummy read to skip a record
end if
call read_data(prec%athres,inp_unit) ! smoothed aggr thresh
! coasest-level solver
call read_data(prec%csolve,inp_unit) ! coarsest-lev solver
call read_data(prec%csbsolve,inp_unit) ! coarsest-lev subsolver
samples/advanced/fileread/amg_sf_sample.f90
+2 -2
View File
@@ -676,8 +676,9 @@ contains
call read_data(prec%aggr_prol,inp_unit) ! aggregation type
call read_data(prec%par_aggr_alg,inp_unit) ! parallel aggregation alg
call read_data(prec%aggr_ord,inp_unit) ! ordering for aggregation
call read_data(prec%aggr_filter,inp_unit) ! filtering
call read_data(prec%mncrratio,inp_unit) ! minimum aggregation ratio
call read_data(prec%aggr_filter,inp_unit) ! filtering
call read_data(prec%athres,inp_unit) ! smoothed aggr thresh
call read_data(prec%thrvsz,inp_unit) ! size of aggr thresh vector
if (prec%thrvsz > 0) then
call psb_realloc(prec%thrvsz,prec%athresv,info)
@@ -685,7 +686,6 @@ contains
else
read(inp_unit,*) ! dummy read to skip a record
end if
call read_data(prec%athres,inp_unit) ! smoothed aggr thresh
! coasest-level solver
call read_data(prec%csolve,inp_unit) ! coarsest-lev solver
call read_data(prec%csbsolve,inp_unit) ! coarsest-lev subsolver
samples/advanced/fileread/amg_zf_sample.f90
+2 -2
View File
@@ -676,8 +676,9 @@ contains
call read_data(prec%aggr_prol,inp_unit) ! aggregation type
call read_data(prec%par_aggr_alg,inp_unit) ! parallel aggregation alg
call read_data(prec%aggr_ord,inp_unit) ! ordering for aggregation
call read_data(prec%aggr_filter,inp_unit) ! filtering
call read_data(prec%mncrratio,inp_unit) ! minimum aggregation ratio
call read_data(prec%aggr_filter,inp_unit) ! filtering
call read_data(prec%athres,inp_unit) ! smoothed aggr thresh
call read_data(prec%thrvsz,inp_unit) ! size of aggr thresh vector
if (prec%thrvsz > 0) then
call psb_realloc(prec%thrvsz,prec%athresv,info)
@@ -685,7 +686,6 @@ contains
else
read(inp_unit,*) ! dummy read to skip a record
end if
call read_data(prec%athres,inp_unit) ! smoothed aggr thresh
! coasest-level solver
call read_data(prec%csolve,inp_unit) ! coarsest-lev solver
call read_data(prec%csbsolve,inp_unit) ! coarsest-lev subsolver
samples/advanced/fileread/runs/amg_cfs.inp
+2 -2
View File
@@ -41,11 +41,11 @@ VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MUL
SMOOTHED ! Type of aggregation: SMOOTHED UNSMOOTHED
DEC ! Parallel aggregation: DEC, SYMDEC
NATURAL ! Ordering of aggregation NATURAL DEGREE
FILTER ! Filtering of matrix: FILTER NOFILTER
-1.5 ! Coarsening ratio, if < 0 use library default
FILTER ! Filtering of matrix: FILTER NOFILTER
-0.0100d0 ! Smoothed aggregation threshold, ignored if < 0
-2 ! Number of thresholds in vector, next line ignored if <= 0
0.05 0.025 ! Thresholds
-0.0100d0 ! Smoothed aggregation threshold, ignored if < 0
%%%%%%%%%%% Coarse level solver %%%%%%%%%%%%%%%%
SLU ! Coarsest-level solver: MUMPS UMF SLU SLUDIST JACOBI GS BJAC
SLU ! Coarsest-level subsolver for BJAC: ILU ILUT MILU UMF MUMPS SLU
samples/advanced/fileread/runs/amg_dfs.inp
+5 -5
View File
@@ -1,8 +1,8 @@
%%%%%%%%%%% General arguments % Lines starting with % are ignored.
mld_mat.mtx ! Other matrices from: http://math.nist.gov/MatrixMarket/ or
mld_rhs.mtx ! rhs ! http://www.cise.ufl.edu/research/sparse/matrices/index.html
amg_mat.mtx ! Other matrices from: http://math.nist.gov/MatrixMarket/ or
amg_rhs.mtx ! rhs ! http://www.cise.ufl.edu/research/sparse/matrices/index.html
NONE ! Initial guess
mld_sol.mtx ! Reference solution
amg_sol.mtx ! Reference solution
MM ! File format: MatrixMarket or Harwell-Boeing
CSR ! Storage format: CSR COO JAD
GRAPH ! PART (partition method): BLOCK GRAPH
@@ -41,11 +41,11 @@ VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MUL
SMOOTHED ! Type of aggregation: SMOOTHED UNSMOOTHED
DEC ! Parallel aggregation: DEC, SYMDEC
NATURAL ! Ordering of aggregation NATURAL DEGREE
FILTER ! Filtering of matrix: FILTER NOFILTER
-1.5 ! Coarsening ratio, if < 0 use library default
FILTER ! Filtering of matrix: FILTER NOFILTER
-0.0100d0 ! Smoothed aggregation threshold, ignored if < 0
-2 ! Number of thresholds in vector, next line ignored if <= 0
0.05 0.025 ! Thresholds
-0.0100d0 ! Smoothed aggregation threshold, ignored if < 0
%%%%%%%%%%% Coarse level solver %%%%%%%%%%%%%%%%
UMF ! Coarsest-level solver: MUMPS UMF SLU SLUDIST JACOBI GS BJAC
UMF ! Coarsest-level subsolver for BJAC: ILU ILUT MILU UMF MUMPS SLU
samples/advanced/fileread/runs/amg_sfs.inp
+5 -5
View File
@@ -1,8 +1,8 @@
%%%%%%%%%%% General arguments % Lines starting with % are ignored.
mld_mat.mtx ! Other matrices from: http://math.nist.gov/MatrixMarket/ or
mld_rhs.mtx ! rhs ! http://www.cise.ufl.edu/research/sparse/matrices/index.html
amg_mat.mtx ! Other matrices from: http://math.nist.gov/MatrixMarket/ or
amg_rhs.mtx ! rhs ! http://www.cise.ufl.edu/research/sparse/matrices/index.html
NONE ! Initial guess
mld_sol.mtx ! Reference solution
amg_sol.mtx ! Reference solution
MM ! File format: MatrixMarket or Harwell-Boeing
CSR ! Storage format: CSR COO JAD
GRAPH ! PART (partition method): BLOCK GRAPH
@@ -41,11 +41,11 @@ VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MUL
SMOOTHED ! Type of aggregation: SMOOTHED UNSMOOTHED
DEC ! Parallel aggregation: DEC, SYMDEC
NATURAL ! Ordering of aggregation NATURAL DEGREE
FILTER ! Filtering of matrix: FILTER NOFILTER
-1.5 ! Coarsening ratio, if < 0 use library default
FILTER ! Filtering of matrix: FILTER NOFILTER
-0.0100d0 ! Smoothed aggregation threshold, ignored if < 0
-2 ! Number of thresholds in vector, next line ignored if <= 0
0.05 0.025 ! Thresholds
-0.0100d0 ! Smoothed aggregation threshold, ignored if < 0
%%%%%%%%%%% Coarse level solver %%%%%%%%%%%%%%%%
SLU ! Coarsest-level solver: MUMPS UMF SLU SLUDIST JACOBI GS BJAC
SLU ! Coarsest-level subsolver for BJAC: ILU ILUT MILU UMF MUMPS SLU
samples/advanced/fileread/runs/amg_zfs.inp
+2 -2
View File
@@ -41,11 +41,11 @@ VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MUL
SMOOTHED ! Type of aggregation: SMOOTHED UNSMOOTHED
DEC ! Parallel aggregation: DEC, SYMDEC
NATURAL ! Ordering of aggregation NATURAL DEGREE
FILTER ! Filtering of matrix: FILTER NOFILTER
-1.5 ! Coarsening ratio, if < 0 use library default
FILTER ! Filtering of matrix: FILTER NOFILTER
-0.0100d0 ! Smoothed aggregation threshold, ignored if < 0
-2 ! Number of thresholds in vector, next line ignored if <= 0
0.05 0.025 ! Thresholds
-0.0100d0 ! Smoothed aggregation threshold, ignored if < 0
%%%%%%%%%%% Coarse level solver %%%%%%%%%%%%%%%%
UMF ! Coarsest-level solver: MUMPS UMF SLU SLUDIST JACOBI GS BJAC
UMF ! Coarsest-level subsolver for BJAC: ILU ILUT MILU UMF MUMPS SLU
samples/advanced/pdegen/Makefile
+3 -3
View File
@@ -3,11 +3,11 @@ AMGINCDIR=$(AMGDIR)/include
include $(AMGINCDIR)/Make.inc.amg4psblas
AMGMODDIR=$(AMGDIR)/modules
AMGLIBDIR=$(AMGDIR)/lib
AMG_LIBS=-L$(AMGLIBDIR) -lpsb_krylov -lamg_prec -lpsb_prec
AMG_LIBS=-L$(AMGLIBDIR) -lpsb_krylov -lamg_prec -lpsb_prec
FINCLUDES=$(FMFLAG). $(FMFLAG)$(AMGMODDIR) $(FMFLAG)$(AMGINCDIR) $(PSBLAS_INCLUDES) $(FIFLAG).
LINKOPT=
XTRALINK=-lstdc++ -lroma -L../../../../ParallelRomaF-main/lib/ -fopenmp
XTRALINK=-lstdc++ -lroma -fopenmp
EXEDIR=./runs
all: amg_s_pde3d amg_d_pde3d amg_s_pde2d amg_d_pde2d
@@ -45,7 +45,7 @@ check: all
clean:
/bin/rm -f data_input.o *.o *$(.mod)\
$(EXEDIR)/mld_d_pde3d $(EXEDIR)/mld_s_pde3d $(EXEDIR)/mld_d_pde2d $(EXEDIR)/mld_s_pde2d
$(EXEDIR)/amg_d_pde3d $(EXEDIR)/amg_s_pde3d $(EXEDIR)/amg_d_pde2d $(EXEDIR)/amg_s_pde2d
verycleanlib:
(cd ../..; make veryclean)
samples/advanced/pdegen/amg_d_genpde_mod.F90
+227 -203
View File
@@ -93,6 +93,9 @@ contains
& a1,a2,a3,b1,b2,b3,c,g,info,f,amold,vmold,partition, nrl,iv)
use psb_base_mod
use psb_util_mod
#if defined(OPENMP)
use omp_lib
#endif
!
! Discretizes the partial differential equation
!
@@ -128,7 +131,6 @@ contains
type(psb_d_csc_sparse_mat) :: acsc
type(psb_d_coo_sparse_mat) :: acoo
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_lpk_) :: m,n,glob_row,nt
integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner
@@ -141,8 +143,7 @@ contains
! Process grid
integer(psb_ipk_) :: np, iam
integer(psb_ipk_) :: icoeff
integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:)
real(psb_dpk_), allocatable :: val(:)
integer(psb_lpk_), allocatable :: myidx(:)
! deltah dimension of each grid cell
! deltat discretization time
real(psb_dpk_) :: deltah, sqdeltah, deltah2
@@ -368,119 +369,128 @@ contains
call psb_barrier(ctxt)
talc = psb_wtime()-t0
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='allocation rout.'
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.
!
allocate(val(20*nb),irow(20*nb),&
&icol(20*nb),stat=info)
if (info /= psb_success_ ) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
! loop over rows belonging to current process in a block
! distribution.
call psb_barrier(ctxt)
t1 = psb_wtime()
do ii=1, nlr,nb
ib = min(nb,nlr-ii+1)
icoeff = 1
do k=1,ib
i=ii+k-1
! local matrix pointer
glob_row=myidx(i)
! compute gridpoint coordinates
call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim)
! x, y, z coordinates
x = (ix-1)*deltah
y = (iy-1)*deltah
z = (iz-1)*deltah
zt(k) = f_(x,y,z)
! internal point: build discretization
!
! term depending on (x-1,y,z)
!
val(icoeff) = -a1(x,y,z)/sqdeltah-b1(x,y,z)/deltah2
if (ix == 1) then
zt(k) = g(dzero,y,z)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix-1,iy,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y-1,z)
val(icoeff) = -a2(x,y,z)/sqdeltah-b2(x,y,z)/deltah2
if (iy == 1) then
zt(k) = g(x,dzero,z)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy-1,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y,z-1)
val(icoeff)=-a3(x,y,z)/sqdeltah-b3(x,y,z)/deltah2
if (iz == 1) then
zt(k) = g(x,y,dzero)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy,iz-1,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
!$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),&
&icol(20*nb),stat=info)
if (info /= psb_success_ ) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name)
!goto 9999
endif
! term depending on (x,y,z)
val(icoeff)=(2*done)*(a1(x,y,z)+a2(x,y,z)+a3(x,y,z))/sqdeltah &
& + c(x,y,z)
call ijk2idx(icol(icoeff),ix,iy,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
! term depending on (x,y,z+1)
val(icoeff)=-a3(x,y,z)/sqdeltah+b3(x,y,z)/deltah2
if (iz == idim) then
zt(k) = g(x,y,done)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy,iz+1,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y+1,z)
val(icoeff)=-a2(x,y,z)/sqdeltah+b2(x,y,z)/deltah2
if (iy == idim) then
zt(k) = g(x,done,z)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy+1,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x+1,y,z)
val(icoeff)=-a1(x,y,z)/sqdeltah+b1(x,y,z)/deltah2
if (ix==idim) then
zt(k) = g(done,y,z)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix+1,iy,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
!$omp do schedule(dynamic)
!
do ii=1, nlr, nb
if (info /= psb_success_) cycle
ib = min(nb,nlr-ii+1)
icoeff = 1
do k=1,ib
i=ii+k-1
! local matrix pointer
glob_row=myidx(i)
! compute gridpoint coordinates
call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim)
! x, y, z coordinates
x = (ix-1)*deltah
y = (iy-1)*deltah
z = (iz-1)*deltah
zt(k) = f_(x,y,z)
! internal point: build discretization
!
! term depending on (x-1,y,z)
!
val(icoeff) = -a1(x,y,z)/sqdeltah-b1(x,y,z)/deltah2
if (ix == 1) then
zt(k) = g(dzero,y,z)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix-1,iy,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y-1,z)
val(icoeff) = -a2(x,y,z)/sqdeltah-b2(x,y,z)/deltah2
if (iy == 1) then
zt(k) = g(x,dzero,z)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy-1,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y,z-1)
val(icoeff)=-a3(x,y,z)/sqdeltah-b3(x,y,z)/deltah2
if (iz == 1) then
zt(k) = g(x,y,dzero)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy,iz-1,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y,z)
val(icoeff)=(2*done)*(a1(x,y,z)+a2(x,y,z)+a3(x,y,z))/sqdeltah &
& + c(x,y,z)
call ijk2idx(icol(icoeff),ix,iy,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
! term depending on (x,y,z+1)
val(icoeff)=-a3(x,y,z)/sqdeltah+b3(x,y,z)/deltah2
if (iz == idim) then
zt(k) = g(x,y,done)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy,iz+1,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y+1,z)
val(icoeff)=-a2(x,y,z)/sqdeltah+b2(x,y,z)/deltah2
if (iy == idim) then
zt(k) = g(x,done,z)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy+1,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x+1,y,z)
val(icoeff)=-a1(x,y,z)/sqdeltah+b1(x,y,z)/deltah2
if (ix==idim) then
zt(k) = g(done,y,z)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix+1,iy,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
end do
!write(0,*) ' Outer in_parallel ',omp_in_parallel()
call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
if(info /= psb_success_) cycle
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
if(info /= psb_success_) cycle
zt(:)=dzero
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
if(info /= psb_success_) cycle
end do
call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
if(info /= psb_success_) exit
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
if(info /= psb_success_) exit
zt(:)=dzero
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
if(info /= psb_success_) exit
end do
!$omp end do
deallocate(val,irow,icol)
end block
!$omp end parallel
tgen = psb_wtime()-t1
if(info /= psb_success_) then
@@ -490,7 +500,6 @@ contains
goto 9999
end if
deallocate(val,irow,icol)
call psb_barrier(ctxt)
t1 = psb_wtime()
@@ -500,9 +509,9 @@ contains
t1 = psb_wtime()
if (info == psb_success_) then
if (present(amold)) then
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold)
call psb_spasb(a,desc_a,info,mold=amold)
else
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
call psb_spasb(a,desc_a,info,afmt=afmt)
end if
end if
call psb_barrier(ctxt)
@@ -557,6 +566,9 @@ contains
& a1,a2,b1,b2,c,g,info,f,amold,vmold,partition, nrl,iv)
use psb_base_mod
use psb_util_mod
#if defined(OPENMP)
use omp_lib
#endif
!
! Discretizes the partial differential equation
!
@@ -591,7 +603,6 @@ contains
type(psb_d_csc_sparse_mat) :: acsc
type(psb_d_coo_sparse_mat) :: acoo
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_lpk_) :: m,n,glob_row,nt
integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner
@@ -604,8 +615,7 @@ contains
! Process grid
integer(psb_ipk_) :: np, iam
integer(psb_ipk_) :: icoeff
integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:)
real(psb_dpk_), allocatable :: val(:)
integer(psb_lpk_), allocatable :: myidx(:)
! deltah dimension of each grid cell
! deltat discretization time
real(psb_dpk_) :: deltah, sqdeltah, deltah2, dd
@@ -791,7 +801,7 @@ contains
!write(0,*) iam,' Check on neighbours: ',desc_a%get_p_adjcncy()
end if
end block
case default
write(psb_err_unit,*) iam, 'Initialization error: should not get here'
info = -1
@@ -816,93 +826,109 @@ contains
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.
!
allocate(val(20*nb),irow(20*nb),&
&icol(20*nb),stat=info)
if (info /= psb_success_ ) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
! loop over rows belonging to current process in a block
! distribution.
call psb_barrier(ctxt)
t1 = psb_wtime()
do ii=1, nlr,nb
ib = min(nb,nlr-ii+1)
icoeff = 1
do k=1,ib
i=ii+k-1
! local matrix pointer
glob_row=myidx(i)
! compute gridpoint coordinates
call idx2ijk(ix,iy,glob_row,idim,idim)
! x, y coordinates
x = (ix-1)*deltah
y = (iy-1)*deltah
!$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),&
&icol(20*nb),stat=info)
if (info /= psb_success_ ) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name)
!goto 9999
endif
zt(k) = f_(x,y)
! internal point: build discretization
!
! term depending on (x-1,y)
!
val(icoeff) = -a1(x,y)/sqdeltah-b1(x,y)/deltah2
if (ix == 1) then
zt(k) = g(dzero,y)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix-1,iy,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y-1)
val(icoeff) = -a2(x,y)/sqdeltah-b2(x,y)/deltah2
if (iy == 1) then
zt(k) = g(x,dzero)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy-1,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! loop over rows belonging to current process in a block
! distribution.
!$omp do schedule(dynamic)
!
do ii=1, nlr,nb
ib = min(nb,nlr-ii+1)
icoeff = 1
do k=1,ib
i=ii+k-1
! local matrix pointer
glob_row=myidx(i)
! compute gridpoint coordinates
call idx2ijk(ix,iy,glob_row,idim,idim)
! x, y coordinates
x = (ix-1)*deltah
y = (iy-1)*deltah
! term depending on (x,y)
val(icoeff)=(2*done)*(a1(x,y) + a2(x,y))/sqdeltah + c(x,y)
call ijk2idx(icol(icoeff),ix,iy,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
! term depending on (x,y+1)
val(icoeff)=-a2(x,y)/sqdeltah+b2(x,y)/deltah2
if (iy == idim) then
zt(k) = g(x,done)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy+1,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x+1,y)
val(icoeff)=-a1(x,y)/sqdeltah+b1(x,y)/deltah2
if (ix==idim) then
zt(k) = g(done,y)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix+1,iy,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
zt(k) = f_(x,y)
! internal point: build discretization
!
! term depending on (x-1,y)
!
val(icoeff) = -a1(x,y)/sqdeltah-b1(x,y)/deltah2
if (ix == 1) then
zt(k) = g(dzero,y)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix-1,iy,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y-1)
val(icoeff) = -a2(x,y)/sqdeltah-b2(x,y)/deltah2
if (iy == 1) then
zt(k) = g(x,dzero)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy-1,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y)
val(icoeff)=(2*done)*(a1(x,y) + a2(x,y))/sqdeltah + c(x,y)
call ijk2idx(icol(icoeff),ix,iy,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
! term depending on (x,y+1)
val(icoeff)=-a2(x,y)/sqdeltah+b2(x,y)/deltah2
if (iy == idim) then
zt(k) = g(x,done)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy+1,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x+1,y)
val(icoeff)=-a1(x,y)/sqdeltah+b1(x,y)/deltah2
if (ix==idim) then
zt(k) = g(done,y)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix+1,iy,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
end do
call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
if(info /= psb_success_) cycle
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
if(info /= psb_success_) cycle
zt(:)=dzero
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
if(info /= psb_success_) cycle
end do
call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
if(info /= psb_success_) exit
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
if(info /= psb_success_) exit
zt(:)=dzero
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
if(info /= psb_success_) exit
end do
!$omp end do
deallocate(val,irow,icol)
end block
!$omp end parallel
tgen = psb_wtime()-t1
if(info /= psb_success_) then
@@ -912,8 +938,6 @@ contains
goto 9999
end if
deallocate(val,irow,icol)
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_cdasb(desc_a,info)
@@ -922,9 +946,9 @@ contains
t1 = psb_wtime()
if (info == psb_success_) then
if (present(amold)) then
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold)
call psb_spasb(a,desc_a,info,mold=amold)
else
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
call psb_spasb(a,desc_a,info,afmt=afmt)
end if
end if
call psb_barrier(ctxt)
samples/advanced/pdegen/amg_d_pde2d.f90
+2 -2
View File
@@ -581,8 +581,9 @@ contains
call read_data(prec%aggr_type,inp_unit) ! type of aggregation
call read_data(prec%aggr_size,inp_unit) ! Requested size of the aggregates for MATCHBOXP
call read_data(prec%aggr_ord,inp_unit) ! ordering for aggregation
call read_data(prec%aggr_filter,inp_unit) ! filtering
call read_data(prec%mncrratio,inp_unit) ! minimum aggregation ratio
call read_data(prec%aggr_filter,inp_unit) ! filtering
call read_data(prec%athres,inp_unit) ! smoothed aggr thresh
call read_data(prec%thrvsz,inp_unit) ! size of aggr thresh vector
if (prec%thrvsz > 0) then
call psb_realloc(prec%thrvsz,prec%athresv,info)
@@ -590,7 +591,6 @@ contains
else
read(inp_unit,*) ! dummy read to skip a record
end if
call read_data(prec%athres,inp_unit) ! smoothed aggr thresh
! coasest-level solver
call read_data(prec%csolve,inp_unit) ! coarsest-lev solver
call read_data(prec%csbsolve,inp_unit) ! coarsest-lev subsolver
samples/advanced/pdegen/amg_d_pde3d.f90 → samples/advanced/pdegen/amg_d_pde3d.F90
+15 -1
View File
@@ -74,6 +74,9 @@ program amg_d_pde3d
use amg_d_pde3d_exp_mod
use amg_d_pde3d_gauss_mod
use amg_d_genpde_mod
#if defined(OPENMP)
use omp_lib
#endif
implicit none
! input parameters
@@ -94,7 +97,7 @@ program amg_d_pde3d
type(psb_d_vect_type) :: x,b,r
! parallel environment
type(psb_ctxt_type) :: ctxt
integer(psb_ipk_) :: iam, np
integer(psb_ipk_) :: iam, np, nth
! solver parameters
integer(psb_ipk_) :: iter, itmax,itrace, istopc, irst, nlv
@@ -201,6 +204,15 @@ program amg_d_pde3d
call psb_init(ctxt)
call psb_info(ctxt,iam,np)
#if defined(OPENMP)
!$OMP parallel shared(nth)
!$OMP master
nth = omp_get_num_threads()
!$OMP end master
!$OMP end parallel
#else
nth = 1
#endif
if (iam < 0) then
! This should not happen, but just in case
@@ -464,6 +476,8 @@ program amg_d_pde3d
call prec%descr(info,iout=psb_out_unit)
if (iam == psb_root_) then
write(psb_out_unit,'("Computed solution on ",i8," processors")') np
write(psb_out_unit,'("Number of threads : ",i12)') nth
write(psb_out_unit,'("Total number of tasks : ",i12)') nth*np
write(psb_out_unit,'("Linear system size : ",i12)') system_size
write(psb_out_unit,'("PDE Coefficients : ",a)') trim(pdecoeff)
write(psb_out_unit,'("Krylov method : ",a)') trim(s_choice%kmethd)
samples/advanced/pdegen/amg_s_genpde_mod.F90
+227 -203
View File
@@ -93,6 +93,9 @@ contains
& a1,a2,a3,b1,b2,b3,c,g,info,f,amold,vmold,partition, nrl,iv)
use psb_base_mod
use psb_util_mod
#if defined(OPENMP)
use omp_lib
#endif
!
! Discretizes the partial differential equation
!
@@ -128,7 +131,6 @@ contains
type(psb_s_csc_sparse_mat) :: acsc
type(psb_s_coo_sparse_mat) :: acoo
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_lpk_) :: m,n,glob_row,nt
integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner
@@ -141,8 +143,7 @@ contains
! Process grid
integer(psb_ipk_) :: np, iam
integer(psb_ipk_) :: icoeff
integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:)
real(psb_spk_), allocatable :: val(:)
integer(psb_lpk_), allocatable :: myidx(:)
! deltah dimension of each grid cell
! deltat discretization time
real(psb_spk_) :: deltah, sqdeltah, deltah2
@@ -368,119 +369,128 @@ contains
call psb_barrier(ctxt)
talc = psb_wtime()-t0
if (info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='allocation rout.'
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.
!
allocate(val(20*nb),irow(20*nb),&
&icol(20*nb),stat=info)
if (info /= psb_success_ ) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
! loop over rows belonging to current process in a block
! distribution.
call psb_barrier(ctxt)
t1 = psb_wtime()
do ii=1, nlr,nb
ib = min(nb,nlr-ii+1)
icoeff = 1
do k=1,ib
i=ii+k-1
! local matrix pointer
glob_row=myidx(i)
! compute gridpoint coordinates
call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim)
! x, y, z coordinates
x = (ix-1)*deltah
y = (iy-1)*deltah
z = (iz-1)*deltah
zt(k) = f_(x,y,z)
! internal point: build discretization
!
! term depending on (x-1,y,z)
!
val(icoeff) = -a1(x,y,z)/sqdeltah-b1(x,y,z)/deltah2
if (ix == 1) then
zt(k) = g(szero,y,z)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix-1,iy,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y-1,z)
val(icoeff) = -a2(x,y,z)/sqdeltah-b2(x,y,z)/deltah2
if (iy == 1) then
zt(k) = g(x,szero,z)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy-1,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y,z-1)
val(icoeff)=-a3(x,y,z)/sqdeltah-b3(x,y,z)/deltah2
if (iz == 1) then
zt(k) = g(x,y,szero)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy,iz-1,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
!$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),&
&icol(20*nb),stat=info)
if (info /= psb_success_ ) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name)
!goto 9999
endif
! term depending on (x,y,z)
val(icoeff)=(2*sone)*(a1(x,y,z)+a2(x,y,z)+a3(x,y,z))/sqdeltah &
& + c(x,y,z)
call ijk2idx(icol(icoeff),ix,iy,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
! term depending on (x,y,z+1)
val(icoeff)=-a3(x,y,z)/sqdeltah+b3(x,y,z)/deltah2
if (iz == idim) then
zt(k) = g(x,y,sone)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy,iz+1,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y+1,z)
val(icoeff)=-a2(x,y,z)/sqdeltah+b2(x,y,z)/deltah2
if (iy == idim) then
zt(k) = g(x,sone,z)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy+1,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x+1,y,z)
val(icoeff)=-a1(x,y,z)/sqdeltah+b1(x,y,z)/deltah2
if (ix==idim) then
zt(k) = g(sone,y,z)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix+1,iy,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
!$omp do schedule(dynamic)
!
do ii=1, nlr, nb
if (info /= psb_success_) cycle
ib = min(nb,nlr-ii+1)
icoeff = 1
do k=1,ib
i=ii+k-1
! local matrix pointer
glob_row=myidx(i)
! compute gridpoint coordinates
call idx2ijk(ix,iy,iz,glob_row,idim,idim,idim)
! x, y, z coordinates
x = (ix-1)*deltah
y = (iy-1)*deltah
z = (iz-1)*deltah
zt(k) = f_(x,y,z)
! internal point: build discretization
!
! term depending on (x-1,y,z)
!
val(icoeff) = -a1(x,y,z)/sqdeltah-b1(x,y,z)/deltah2
if (ix == 1) then
zt(k) = g(szero,y,z)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix-1,iy,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y-1,z)
val(icoeff) = -a2(x,y,z)/sqdeltah-b2(x,y,z)/deltah2
if (iy == 1) then
zt(k) = g(x,szero,z)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy-1,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y,z-1)
val(icoeff)=-a3(x,y,z)/sqdeltah-b3(x,y,z)/deltah2
if (iz == 1) then
zt(k) = g(x,y,szero)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy,iz-1,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y,z)
val(icoeff)=(2*sone)*(a1(x,y,z)+a2(x,y,z)+a3(x,y,z))/sqdeltah &
& + c(x,y,z)
call ijk2idx(icol(icoeff),ix,iy,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
! term depending on (x,y,z+1)
val(icoeff)=-a3(x,y,z)/sqdeltah+b3(x,y,z)/deltah2
if (iz == idim) then
zt(k) = g(x,y,sone)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy,iz+1,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y+1,z)
val(icoeff)=-a2(x,y,z)/sqdeltah+b2(x,y,z)/deltah2
if (iy == idim) then
zt(k) = g(x,sone,z)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy+1,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x+1,y,z)
val(icoeff)=-a1(x,y,z)/sqdeltah+b1(x,y,z)/deltah2
if (ix==idim) then
zt(k) = g(sone,y,z)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix+1,iy,iz,idim,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
end do
!write(0,*) ' Outer in_parallel ',omp_in_parallel()
call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
if(info /= psb_success_) cycle
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
if(info /= psb_success_) cycle
zt(:)=szero
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
if(info /= psb_success_) cycle
end do
call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
if(info /= psb_success_) exit
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
if(info /= psb_success_) exit
zt(:)=szero
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
if(info /= psb_success_) exit
end do
!$omp end do
deallocate(val,irow,icol)
end block
!$omp end parallel
tgen = psb_wtime()-t1
if(info /= psb_success_) then
@@ -490,7 +500,6 @@ contains
goto 9999
end if
deallocate(val,irow,icol)
call psb_barrier(ctxt)
t1 = psb_wtime()
@@ -500,9 +509,9 @@ contains
t1 = psb_wtime()
if (info == psb_success_) then
if (present(amold)) then
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold)
call psb_spasb(a,desc_a,info,mold=amold)
else
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
call psb_spasb(a,desc_a,info,afmt=afmt)
end if
end if
call psb_barrier(ctxt)
@@ -557,6 +566,9 @@ contains
& a1,a2,b1,b2,c,g,info,f,amold,vmold,partition, nrl,iv)
use psb_base_mod
use psb_util_mod
#if defined(OPENMP)
use omp_lib
#endif
!
! Discretizes the partial differential equation
!
@@ -591,7 +603,6 @@ contains
type(psb_s_csc_sparse_mat) :: acsc
type(psb_s_coo_sparse_mat) :: acoo
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_lpk_) :: m,n,glob_row,nt
integer(psb_ipk_) :: ix,iy,iz,ia,indx_owner
@@ -604,8 +615,7 @@ contains
! Process grid
integer(psb_ipk_) :: np, iam
integer(psb_ipk_) :: icoeff
integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:)
real(psb_spk_), allocatable :: val(:)
integer(psb_lpk_), allocatable :: myidx(:)
! deltah dimension of each grid cell
! deltat discretization time
real(psb_spk_) :: deltah, sqdeltah, deltah2, dd
@@ -791,7 +801,7 @@ contains
!write(0,*) iam,' Check on neighbours: ',desc_a%get_p_adjcncy()
end if
end block
case default
write(psb_err_unit,*) iam, 'Initialization error: should not get here'
info = -1
@@ -816,93 +826,109 @@ contains
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.
!
allocate(val(20*nb),irow(20*nb),&
&icol(20*nb),stat=info)
if (info /= psb_success_ ) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
endif
! loop over rows belonging to current process in a block
! distribution.
call psb_barrier(ctxt)
t1 = psb_wtime()
do ii=1, nlr,nb
ib = min(nb,nlr-ii+1)
icoeff = 1
do k=1,ib
i=ii+k-1
! local matrix pointer
glob_row=myidx(i)
! compute gridpoint coordinates
call idx2ijk(ix,iy,glob_row,idim,idim)
! x, y coordinates
x = (ix-1)*deltah
y = (iy-1)*deltah
!$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),&
&icol(20*nb),stat=info)
if (info /= psb_success_ ) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name)
!goto 9999
endif
zt(k) = f_(x,y)
! internal point: build discretization
!
! term depending on (x-1,y)
!
val(icoeff) = -a1(x,y)/sqdeltah-b1(x,y)/deltah2
if (ix == 1) then
zt(k) = g(szero,y)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix-1,iy,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y-1)
val(icoeff) = -a2(x,y)/sqdeltah-b2(x,y)/deltah2
if (iy == 1) then
zt(k) = g(x,szero)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy-1,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! loop over rows belonging to current process in a block
! distribution.
!$omp do schedule(dynamic)
!
do ii=1, nlr,nb
ib = min(nb,nlr-ii+1)
icoeff = 1
do k=1,ib
i=ii+k-1
! local matrix pointer
glob_row=myidx(i)
! compute gridpoint coordinates
call idx2ijk(ix,iy,glob_row,idim,idim)
! x, y coordinates
x = (ix-1)*deltah
y = (iy-1)*deltah
! term depending on (x,y)
val(icoeff)=(2*sone)*(a1(x,y) + a2(x,y))/sqdeltah + c(x,y)
call ijk2idx(icol(icoeff),ix,iy,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
! term depending on (x,y+1)
val(icoeff)=-a2(x,y)/sqdeltah+b2(x,y)/deltah2
if (iy == idim) then
zt(k) = g(x,sone)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy+1,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x+1,y)
val(icoeff)=-a1(x,y)/sqdeltah+b1(x,y)/deltah2
if (ix==idim) then
zt(k) = g(sone,y)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix+1,iy,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
zt(k) = f_(x,y)
! internal point: build discretization
!
! term depending on (x-1,y)
!
val(icoeff) = -a1(x,y)/sqdeltah-b1(x,y)/deltah2
if (ix == 1) then
zt(k) = g(szero,y)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix-1,iy,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y-1)
val(icoeff) = -a2(x,y)/sqdeltah-b2(x,y)/deltah2
if (iy == 1) then
zt(k) = g(x,szero)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy-1,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x,y)
val(icoeff)=(2*sone)*(a1(x,y) + a2(x,y))/sqdeltah + c(x,y)
call ijk2idx(icol(icoeff),ix,iy,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
! term depending on (x,y+1)
val(icoeff)=-a2(x,y)/sqdeltah+b2(x,y)/deltah2
if (iy == idim) then
zt(k) = g(x,sone)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix,iy+1,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
! term depending on (x+1,y)
val(icoeff)=-a1(x,y)/sqdeltah+b1(x,y)/deltah2
if (ix==idim) then
zt(k) = g(sone,y)*(-val(icoeff)) + zt(k)
else
call ijk2idx(icol(icoeff),ix+1,iy,idim,idim)
irow(icoeff) = glob_row
icoeff = icoeff+1
endif
end do
call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
if(info /= psb_success_) cycle
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
if(info /= psb_success_) cycle
zt(:)=szero
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
if(info /= psb_success_) cycle
end do
call psb_spins(icoeff-1,irow,icol,val,a,desc_a,info)
if(info /= psb_success_) exit
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
if(info /= psb_success_) exit
zt(:)=szero
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
if(info /= psb_success_) exit
end do
!$omp end do
deallocate(val,irow,icol)
end block
!$omp end parallel
tgen = psb_wtime()-t1
if(info /= psb_success_) then
@@ -912,8 +938,6 @@ contains
goto 9999
end if
deallocate(val,irow,icol)
call psb_barrier(ctxt)
t1 = psb_wtime()
call psb_cdasb(desc_a,info)
@@ -922,9 +946,9 @@ contains
t1 = psb_wtime()
if (info == psb_success_) then
if (present(amold)) then
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold)
call psb_spasb(a,desc_a,info,mold=amold)
else
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
call psb_spasb(a,desc_a,info,afmt=afmt)
end if
end if
call psb_barrier(ctxt)
samples/advanced/pdegen/amg_s_pde2d.f90
+2 -2
View File
@@ -581,8 +581,9 @@ contains
call read_data(prec%aggr_type,inp_unit) ! type of aggregation
call read_data(prec%aggr_size,inp_unit) ! Requested size of the aggregates for MATCHBOXP
call read_data(prec%aggr_ord,inp_unit) ! ordering for aggregation
call read_data(prec%aggr_filter,inp_unit) ! filtering
call read_data(prec%mncrratio,inp_unit) ! minimum aggregation ratio
call read_data(prec%aggr_filter,inp_unit) ! filtering
call read_data(prec%athres,inp_unit) ! smoothed aggr thresh
call read_data(prec%thrvsz,inp_unit) ! size of aggr thresh vector
if (prec%thrvsz > 0) then
call psb_realloc(prec%thrvsz,prec%athresv,info)
@@ -590,7 +591,6 @@ contains
else
read(inp_unit,*) ! dummy read to skip a record
end if
call read_data(prec%athres,inp_unit) ! smoothed aggr thresh
! coasest-level solver
call read_data(prec%csolve,inp_unit) ! coarsest-lev solver
call read_data(prec%csbsolve,inp_unit) ! coarsest-lev subsolver
samples/advanced/pdegen/amg_s_pde3d.f90
+2 -2
View File
@@ -585,8 +585,9 @@ contains
call read_data(prec%aggr_type,inp_unit) ! type of aggregation
call read_data(prec%aggr_size,inp_unit) ! Requested size of the aggregates for MATCHBOXP
call read_data(prec%aggr_ord,inp_unit) ! ordering for aggregation
call read_data(prec%aggr_filter,inp_unit) ! filtering
call read_data(prec%mncrratio,inp_unit) ! minimum aggregation ratio
call read_data(prec%aggr_filter,inp_unit) ! filtering
call read_data(prec%athres,inp_unit) ! smoothed aggr thresh
call read_data(prec%thrvsz,inp_unit) ! size of aggr thresh vector
if (prec%thrvsz > 0) then
call psb_realloc(prec%thrvsz,prec%athresv,info)
@@ -594,7 +595,6 @@ contains
else
read(inp_unit,*) ! dummy read to skip a record
end if
call read_data(prec%athres,inp_unit) ! smoothed aggr thresh
! coasest-level solver
call read_data(prec%csolve,inp_unit) ! coarsest-lev solver
call read_data(prec%csbsolve,inp_unit) ! coarsest-lev subsolver
samples/advanced/pdegen/runs/amg_pde2d.inp
+2 -2
View File
@@ -43,11 +43,11 @@ COUPLED ! Parallel aggregation: DEC, SYMDEC, COUPLED
MATCHBOXP ! aggregation measure SOC1, MATCHBOXP
8 ! Requested size of the aggregates for MATCHBOXP
NATURAL ! Ordering of aggregation NATURAL DEGREE
FILTER ! Filtering of matrix: FILTER NOFILTER
-1.5 ! Coarsening ratio, if < 0 use library default
FILTER ! Filtering of matrix: FILTER NOFILTER
-0.0100d0 ! Smoothed aggregation threshold, ignored if < 0
-2 ! Number of thresholds in vector, next line ignored if <= 0
0.05 0.025 ! Thresholds
-0.0100d0 ! Smoothed aggregation threshold, ignored if < 0
%%%%%%%%%%% Coarse level solver %%%%%%%%%%%%%%%%
BJAC ! Coarsest-level solver: MUMPS UMF SLU SLUDIST JACOBI GS BJAC
ILU ! Coarsest-level subsolver for BJAC: ILU ILUT MILU UMF MUMPS SLU
samples/advanced/pdegen/runs/amg_pde3d.inp
+3 -3
View File
@@ -1,6 +1,6 @@
%%%%%%%%%%% General arguments % Lines starting with % are ignored.
CSR ! Storage format CSR COO JAD
0080 ! IDIM; domain size. Linear system size is IDIM**3
0200 ! IDIM; domain size. Linear system size is IDIM**3
CONST ! PDECOEFF: CONST, EXP, GAUSS Coefficients of the PDE
BICGSTAB ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS FCG GCR RGMRES
2 ! ISTOPC
@@ -43,11 +43,11 @@ COUPLED ! Parallel aggregation: DEC, SYMDEC, COUPLED
MATCHBOXP ! aggregation measure SOC1, MATCHBOXP
8 ! Requested size of the aggregates for MATCHBOXP
NATURAL ! Ordering of aggregation NATURAL DEGREE
NOFILTER ! Filtering of matrix: FILTER NOFILTER
-1.5 ! Coarsening ratio, if < 0 use library default
FILTER ! Filtering of matrix: FILTER NOFILTER
-0.0100d0 ! Smoothed aggregation threshold, ignored if < 0
-2 ! Number of thresholds in vector, next line ignored if <= 0
0.05 0.025 ! Thresholds
-0.0100d0 ! Smoothed aggregation threshold, ignored if < 0
%%%%%%%%%%% Coarse level solver %%%%%%%%%%%%%%%%
BJAC ! Coarsest-level solver: MUMPS UMF SLU SLUDIST JACOBI GS BJAC
ILU ! Coarsest-level subsolver for BJAC: ILU ILUT MILU UMF MUMPS SLU
samples/advanced/pdegen/runs/tnewmtc.inp
+2 -2
View File
@@ -1,6 +1,6 @@
%%%%%%%%%%% General arguments % Lines starting with % are ignored.
CSR ! Storage format CSR COO JAD
0080 ! IDIM; domain size. Linear system size is IDIM**3
0140 ! IDIM; domain size. Linear system size is IDIM**3
CONST ! PDECOEFF: CONST, EXP, GAUSS Coefficients of the PDE
BICGSTAB ! Iterative method: BiCGSTAB BiCGSTABL BiCG CG CGS FCG GCR RGMRES
2 ! ISTOPC
@@ -40,7 +40,7 @@ VCYCLE ! Type of multilevel CYCLE: VCYCLE WCYCLE KCYCLE MUL
-3 ! Target coarse matrix size per process; if <0, lib default
SMOOTHED ! Type of aggregation: SMOOTHED UNSMOOTHED
NEWMTC ! Parallel aggregation: DEC, SYMDEC, COUPLED NEWMTC
MATCHBOXP ! aggregation measure SOC1, MATCHBOXP NEWMTC
NEWMTC ! aggregation measure SOC1, MATCHBOXP NEWMTC
8 ! Requested size of the aggregates for MATCHBOXP
NATURAL ! Ordering of aggregation NATURAL DEGREE
NOFILTER ! Filtering of matrix: FILTER NOFILTER
samples/simple/pdegen/amg_dpde_mod.f90
+2 -2
View File
@@ -465,9 +465,9 @@ contains
t1 = psb_wtime()
if (info == psb_success_) then
if (present(amold)) then
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold)
call psb_spasb(a,desc_a,info,mold=amold)
else
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
call psb_spasb(a,desc_a,info,afmt=afmt)
end if
end if
call psb_barrier(ctxt)
samples/simple/pdegen/amg_spde_mod.f90
+2 -2
View File
@@ -465,9 +465,9 @@ contains
t1 = psb_wtime()
if (info == psb_success_) then
if (present(amold)) then
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,mold=amold)
call psb_spasb(a,desc_a,info,mold=amold)
else
call psb_spasb(a,desc_a,info,dupl=psb_dupl_err_,afmt=afmt)
call psb_spasb(a,desc_a,info,afmt=afmt)
end if
end if
call psb_barrier(ctxt)