fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 14:44:55 +00:00
Code Issues Packages Projects Releases Wiki Activity

Fixes for mat asb. Compiles, to be fully debugged.

Browse Source
This commit is contained in:
Salvatore Filippone
2018-06-26 14:58:15 +01:00
parent 013a55142b
commit cc144c0d51
8 changed files with 72 additions and 134 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mlprec/impl/level/mld_c_base_onelev_mat_asb.f90
+6 -5
View File
@@ -106,7 +106,7 @@ subroutine mld_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
type(psb_lcspmat_type) :: lac, op_restr
type(psb_cspmat_type) :: ac
type(psb_cspmat_type) :: ac, iop_restr, iop_prol
type(psb_lc_coo_sparse_mat) :: acoo, bcoo
type(psb_lc_csr_sparse_mat) :: acsr1
integer(psb_lpk_) :: ntaggr, nr, nc
@@ -253,11 +253,12 @@ subroutine mld_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
! op_restr => PR^T i.e. restriction operator
! op_prol => PR i.e. prolongation operator
!
call iop_restr%mv_from_l(op_restr)
call iop_prol%mv_from_l(op_prol)
lv%map = psb_linmap(psb_map_aggr_,desc_a,&
& lv%desc_ac,op_restr,op_prol,ilaggr,nlaggr)
if (info == psb_success_) call op_prol%free()
if (info == psb_success_) call op_restr%free()
& lv%desc_ac,iop_restr,iop_prol,ilaggr,nlaggr)
if (info == psb_success_) call iop_prol%free()
if (info == psb_success_) call iop_restr%free()
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')
goto 9999
mlprec/impl/level/mld_d_base_onelev_mat_asb.f90
+6 -5
View File
@@ -106,7 +106,7 @@ subroutine mld_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
type(psb_ldspmat_type) :: lac, op_restr
type(psb_dspmat_type) :: ac
type(psb_dspmat_type) :: ac, iop_restr, iop_prol
type(psb_ld_coo_sparse_mat) :: acoo, bcoo
type(psb_ld_csr_sparse_mat) :: acsr1
integer(psb_lpk_) :: ntaggr, nr, nc
@@ -253,11 +253,12 @@ subroutine mld_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
! op_restr => PR^T i.e. restriction operator
! op_prol => PR i.e. prolongation operator
!
call iop_restr%mv_from_l(op_restr)
call iop_prol%mv_from_l(op_prol)
lv%map = psb_linmap(psb_map_aggr_,desc_a,&
& lv%desc_ac,op_restr,op_prol,ilaggr,nlaggr)
if (info == psb_success_) call op_prol%free()
if (info == psb_success_) call op_restr%free()
& lv%desc_ac,iop_restr,iop_prol,ilaggr,nlaggr)
if (info == psb_success_) call iop_prol%free()
if (info == psb_success_) call iop_restr%free()
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')
goto 9999
mlprec/impl/level/mld_s_base_onelev_mat_asb.f90
+6 -5
View File
@@ -106,7 +106,7 @@ subroutine mld_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
type(psb_lsspmat_type) :: lac, op_restr
type(psb_sspmat_type) :: ac
type(psb_sspmat_type) :: ac, iop_restr, iop_prol
type(psb_ls_coo_sparse_mat) :: acoo, bcoo
type(psb_ls_csr_sparse_mat) :: acsr1
integer(psb_lpk_) :: ntaggr, nr, nc
@@ -253,11 +253,12 @@ subroutine mld_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
! op_restr => PR^T i.e. restriction operator
! op_prol => PR i.e. prolongation operator
!
call iop_restr%mv_from_l(op_restr)
call iop_prol%mv_from_l(op_prol)
lv%map = psb_linmap(psb_map_aggr_,desc_a,&
& lv%desc_ac,op_restr,op_prol,ilaggr,nlaggr)
if (info == psb_success_) call op_prol%free()
if (info == psb_success_) call op_restr%free()
& lv%desc_ac,iop_restr,iop_prol,ilaggr,nlaggr)
if (info == psb_success_) call iop_prol%free()
if (info == psb_success_) call iop_restr%free()
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')
goto 9999
mlprec/impl/level/mld_z_base_onelev_mat_asb.f90
+6 -5
View File
@@ -106,7 +106,7 @@ subroutine mld_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
type(psb_lzspmat_type) :: lac, op_restr
type(psb_zspmat_type) :: ac
type(psb_zspmat_type) :: ac, iop_restr, iop_prol
type(psb_lz_coo_sparse_mat) :: acoo, bcoo
type(psb_lz_csr_sparse_mat) :: acsr1
integer(psb_lpk_) :: ntaggr, nr, nc
@@ -253,11 +253,12 @@ subroutine mld_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
! op_restr => PR^T i.e. restriction operator
! op_prol => PR i.e. prolongation operator
!
call iop_restr%mv_from_l(op_restr)
call iop_prol%mv_from_l(op_prol)
lv%map = psb_linmap(psb_map_aggr_,desc_a,&
& lv%desc_ac,op_restr,op_prol,ilaggr,nlaggr)
if (info == psb_success_) call op_prol%free()
if (info == psb_success_) call op_restr%free()
& lv%desc_ac,iop_restr,iop_prol,ilaggr,nlaggr)
if (info == psb_success_) call iop_prol%free()
if (info == psb_success_) call iop_restr%free()
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='sp_Free')
goto 9999
tests/pdegen/mld_d_pde2d.f90
+12 -41
View File
@@ -74,7 +74,7 @@ module mld_d_pde2d_mod
real(psb_dpk_), intent(in) :: x,y
real(psb_dpk_) :: val
end function d_func_2d
end interface
end interface
interface mld_gen_pde2d
module procedure mld_d_gen_pde2d
@@ -85,7 +85,7 @@ contains
real(psb_dpk_), intent(in) :: x,y
real(psb_dpk_) :: val
val = dzero
end function d_null_func_2d
@@ -156,17 +156,10 @@ contains
! subroutine to allocate and fill in the coefficient matrix and
! the rhs.
!
<<<<<<< HEAD
subroutine mld_d_gen_pde2d(ictxt,idim,a,bv,xv,desc_a,afmt,&
& a1,a2,b1,b2,c,g,info,f,amold,vmold,imold,partition,nrl,iv)
use psb_base_mod
use psb_util_mod
=======
subroutine mld_d_gen_pde2d(ictxt,idim,a,bv,xv,desc_a,afmt,info,&
& f,amold,vmold,imold,partition,nrl,iv)
use psb_base_mod
use psb_util_mod
>>>>>>> mrgext
use psb_util_mod
!
! Discretizes the partial differential equation
!
@@ -202,15 +195,19 @@ contains
type(psb_d_coo_sparse_mat) :: acoo
type(psb_d_csr_sparse_mat) :: acsr
real(psb_dpk_) :: zt(nb),x,y,z
integer(psb_ipk_) :: m,n,nnz,nr,nt,glob_row,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_ipk_) :: ix,iy,iz,ia,indx_owner
! For 2D partition
integer(psb_ipk_) :: npx,npy,npdims(2),iamx,iamy,mynx,myny
! Note: integer control variables going directly into an MPI call
! must be 4 bytes, i.e. psb_mpk_
integer(psb_mpk_) :: npdims(2), npp, minfo
integer(psb_ipk_) :: npx,npy,iamx,iamy,mynx,myny
integer(psb_ipk_), allocatable :: bndx(:),bndy(:)
! Process grid
integer(psb_ipk_) :: np, iam
integer(psb_ipk_) :: icoeff
integer(psb_ipk_), allocatable :: irow(:),icol(:),myidx(:)
integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:)
real(psb_dpk_), allocatable :: val(:)
! deltah dimension of each grid cell
! deltat discretization time
@@ -252,7 +249,7 @@ contains
! initialize array descriptor and sparse matrix storage. provide an
! estimate of the number of non zeroes
m = idim*idim
m = (1_psb_lpk_)*idim*idim
n = m
nnz = ((n*7)/(np))
if(iam == psb_root_) write(psb_out_unit,'("Generating Matrix (size=",i0,")...")')n
@@ -280,32 +277,6 @@ contains
return
end if
<<<<<<< HEAD
select case(partition_)
case(1)
! A BLOCK partition
if (present(nrl)) then
nr = nrl
else
!
! Using a simple BLOCK distribution.
!
nt = (m+np-1)/np
nr = max(0,min(nt,m-(iam*nt)))
end if
nt = nr
call psb_sum(ictxt,nt)
if (nt /= m) then
write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m
info = -1
call psb_barrier(ictxt)
call psb_abort(ictxt)
return
end if
=======
>>>>>>> mrgext
!
! First example of use of CDALL: specify for each process a number of
! contiguous rows
@@ -561,9 +532,9 @@ contains
return
end subroutine mld_d_gen_pde2d
end module mld_d_pde2d_mod
program mld_d_pde2d
use psb_base_mod
use mld_prec_mod
tests/pdegen/mld_d_pde3d.f90
+12 -16
View File
@@ -65,9 +65,10 @@
! into subcubes, each one assigned to a process.
!
module mld_d_pde3d_mod
use psb_base_mod, only : psb_dpk_, psb_ipk_, psb_desc_type,&
use psb_base_mod, only : psb_dpk_, psb_ipk_, psb_lpk_, psb_desc_type,&
& psb_dspmat_type, psb_d_vect_type, dzero,&
& psb_d_base_sparse_mat, psb_d_base_vect_type, psb_i_base_vect_type
& psb_d_base_sparse_mat, psb_d_base_vect_type, &
& psb_i_base_vect_type, psb_l_base_vect_type
interface
function d_func_3d(x,y,z) result(val)
@@ -95,7 +96,6 @@ contains
!
! functions parametrizing the differential equation
!
!
! Note: b1, b2 and b3 are the coefficients of the first
! derivative of the unknown function. The default
@@ -124,6 +124,7 @@ contains
implicit none
real(psb_dpk_) :: b3
real(psb_dpk_), intent(in) :: x,y,z
b3=dzero
end function b3
function c(x,y,z)
@@ -172,13 +173,8 @@ contains
! subroutine to allocate and fill in the coefficient matrix and
! the rhs.
!
<<<<<<< HEAD
subroutine mld_d_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,&
& a1,a2,a3,b1,b2,b3,c,g,info,f,amold,vmold,imold,partition,nrl,iv)
=======
subroutine mld_d_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,info,&
& f,amold,vmold,imold,partition,nrl,iv)
>>>>>>> mrgext
use psb_base_mod
use psb_util_mod
!
@@ -216,15 +212,19 @@ contains
type(psb_d_coo_sparse_mat) :: acoo
type(psb_d_csr_sparse_mat) :: acsr
real(psb_dpk_) :: zt(nb),x,y,z
integer(psb_ipk_) :: m,n,nnz,nr,nt,glob_row,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_ipk_) :: ix,iy,iz,ia,indx_owner
! For 3D partition
integer(psb_ipk_) :: npx,npy,npz, npdims(3),iamx,iamy,iamz,mynx,myny,mynz
! Note: integer control variables going directly into an MPI call
! must be 4 bytes, i.e. psb_mpk_
integer(psb_mpk_) :: npdims(3), npp, minfo
integer(psb_ipk_) :: npx,npy,npz, iamx,iamy,iamz,mynx,myny,mynz
integer(psb_ipk_), allocatable :: bndx(:),bndy(:),bndz(:)
! Process grid
integer(psb_ipk_) :: np, iam
integer(psb_ipk_) :: icoeff
integer(psb_ipk_), allocatable :: irow(:),icol(:),myidx(:)
integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:)
real(psb_dpk_), allocatable :: val(:)
! deltah dimension of each grid cell
! deltat discretization time
@@ -266,15 +266,11 @@ contains
! initialize array descriptor and sparse matrix storage. provide an
! estimate of the number of non zeroes
m = idim*idim*idim
m = (1_psb_lpk_*idim)*idim*idim
n = m
nnz = ((n*7)/(np))
if(iam == psb_root_) write(psb_out_unit,'("Generating Matrix (size=",i0,")...")')n
<<<<<<< HEAD
=======
t0 = psb_wtime()
>>>>>>> mrgext
select case(partition_)
case(1)
! A BLOCK partition
tests/pdegen/mld_s_pde2d.f90
+12 -41
View File
@@ -74,7 +74,7 @@ module mld_s_pde2d_mod
real(psb_spk_), intent(in) :: x,y
real(psb_spk_) :: val
end function s_func_2d
end interface
end interface
interface mld_gen_pde2d
module procedure mld_s_gen_pde2d
@@ -85,7 +85,7 @@ contains
real(psb_spk_), intent(in) :: x,y
real(psb_spk_) :: val
val = szero
end function s_null_func_2d
@@ -156,17 +156,10 @@ contains
! subroutine to allocate and fill in the coefficient matrix and
! the rhs.
!
<<<<<<< HEAD
subroutine mld_s_gen_pde2d(ictxt,idim,a,bv,xv,desc_a,afmt,&
& a1,a2,b1,b2,c,g,info,f,amold,vmold,imold,partition,nrl,iv)
use psb_base_mod
use psb_util_mod
=======
subroutine mld_s_gen_pde2d(ictxt,idim,a,bv,xv,desc_a,afmt,info,&
& f,amold,vmold,imold,partition,nrl,iv)
use psb_base_mod
use psb_util_mod
>>>>>>> mrgext
use psb_util_mod
!
! Discretizes the partial differential equation
!
@@ -202,15 +195,19 @@ contains
type(psb_s_coo_sparse_mat) :: acoo
type(psb_s_csr_sparse_mat) :: acsr
real(psb_spk_) :: zt(nb),x,y,z
integer(psb_ipk_) :: m,n,nnz,nr,nt,glob_row,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_ipk_) :: ix,iy,iz,ia,indx_owner
! For 2D partition
integer(psb_ipk_) :: npx,npy,npdims(2),iamx,iamy,mynx,myny
! Note: integer control variables going directly into an MPI call
! must be 4 bytes, i.e. psb_mpk_
integer(psb_mpk_) :: npdims(2), npp, minfo
integer(psb_ipk_) :: npx,npy,iamx,iamy,mynx,myny
integer(psb_ipk_), allocatable :: bndx(:),bndy(:)
! Process grid
integer(psb_ipk_) :: np, iam
integer(psb_ipk_) :: icoeff
integer(psb_ipk_), allocatable :: irow(:),icol(:),myidx(:)
integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:)
real(psb_spk_), allocatable :: val(:)
! deltah dimension of each grid cell
! deltat discretization time
@@ -252,7 +249,7 @@ contains
! initialize array descriptor and sparse matrix storage. provide an
! estimate of the number of non zeroes
m = idim*idim
m = (1_psb_lpk_)*idim*idim
n = m
nnz = ((n*7)/(np))
if(iam == psb_root_) write(psb_out_unit,'("Generating Matrix (size=",i0,")...")')n
@@ -280,32 +277,6 @@ contains
return
end if
<<<<<<< HEAD
select case(partition_)
case(1)
! A BLOCK partition
if (present(nrl)) then
nr = nrl
else
!
! Using a simple BLOCK distribution.
!
nt = (m+np-1)/np
nr = max(0,min(nt,m-(iam*nt)))
end if
nt = nr
call psb_sum(ictxt,nt)
if (nt /= m) then
write(psb_err_unit,*) iam, 'Initialization error ',nr,nt,m
info = -1
call psb_barrier(ictxt)
call psb_abort(ictxt)
return
end if
=======
>>>>>>> mrgext
!
! First example of use of CDALL: specify for each process a number of
! contiguous rows
@@ -561,9 +532,9 @@ contains
return
end subroutine mld_s_gen_pde2d
end module mld_s_pde2d_mod
program mld_s_pde2d
use psb_base_mod
use mld_prec_mod
tests/pdegen/mld_s_pde3d.f90
+12 -16
View File
@@ -65,9 +65,10 @@
! into subcubes, each one assigned to a process.
!
module mld_s_pde3d_mod
use psb_base_mod, only : psb_spk_, psb_ipk_, psb_desc_type,&
use psb_base_mod, only : psb_spk_, psb_ipk_, psb_lpk_, psb_desc_type,&
& psb_sspmat_type, psb_s_vect_type, szero,&
& psb_s_base_sparse_mat, psb_s_base_vect_type, psb_i_base_vect_type
& psb_s_base_sparse_mat, psb_s_base_vect_type, &
& psb_i_base_vect_type, psb_l_base_vect_type
interface
function s_func_3d(x,y,z) result(val)
@@ -95,7 +96,6 @@ contains
!
! functions parametrizing the differential equation
!
!
! Note: b1, b2 and b3 are the coefficients of the first
! derivative of the unknown function. The default
@@ -124,6 +124,7 @@ contains
implicit none
real(psb_spk_) :: b3
real(psb_spk_), intent(in) :: x,y,z
b3=szero
end function b3
function c(x,y,z)
@@ -172,13 +173,8 @@ contains
! subroutine to allocate and fill in the coefficient matrix and
! the rhs.
!
<<<<<<< HEAD
subroutine mld_s_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,&
& a1,a2,a3,b1,b2,b3,c,g,info,f,amold,vmold,imold,partition,nrl,iv)
=======
subroutine mld_s_gen_pde3d(ictxt,idim,a,bv,xv,desc_a,afmt,info,&
& f,amold,vmold,imold,partition,nrl,iv)
>>>>>>> mrgext
use psb_base_mod
use psb_util_mod
!
@@ -216,15 +212,19 @@ contains
type(psb_s_coo_sparse_mat) :: acoo
type(psb_s_csr_sparse_mat) :: acsr
real(psb_spk_) :: zt(nb),x,y,z
integer(psb_ipk_) :: m,n,nnz,nr,nt,glob_row,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_ipk_) :: ix,iy,iz,ia,indx_owner
! For 3D partition
integer(psb_ipk_) :: npx,npy,npz, npdims(3),iamx,iamy,iamz,mynx,myny,mynz
! Note: integer control variables going directly into an MPI call
! must be 4 bytes, i.e. psb_mpk_
integer(psb_mpk_) :: npdims(3), npp, minfo
integer(psb_ipk_) :: npx,npy,npz, iamx,iamy,iamz,mynx,myny,mynz
integer(psb_ipk_), allocatable :: bndx(:),bndy(:),bndz(:)
! Process grid
integer(psb_ipk_) :: np, iam
integer(psb_ipk_) :: icoeff
integer(psb_ipk_), allocatable :: irow(:),icol(:),myidx(:)
integer(psb_lpk_), allocatable :: irow(:),icol(:),myidx(:)
real(psb_spk_), allocatable :: val(:)
! deltah dimension of each grid cell
! deltat discretization time
@@ -266,15 +266,11 @@ contains
! initialize array descriptor and sparse matrix storage. provide an
! estimate of the number of non zeroes
m = idim*idim*idim
m = (1_psb_lpk_*idim)*idim*idim
n = m
nnz = ((n*7)/(np))
if(iam == psb_root_) write(psb_out_unit,'("Generating Matrix (size=",i0,")...")')n
<<<<<<< HEAD
=======
t0 = psb_wtime()
>>>>>>> mrgext
select case(partition_)
case(1)
! A BLOCK partition