From cc144c0d51905a782e0b2db36c17b1fc1ca8adf6 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 26 Jun 2018 14:58:15 +0100 Subject: [PATCH] Fixes for mat asb. Compiles, to be fully debugged. --- .../impl/level/mld_c_base_onelev_mat_asb.f90 | 11 ++-- .../impl/level/mld_d_base_onelev_mat_asb.f90 | 11 ++-- .../impl/level/mld_s_base_onelev_mat_asb.f90 | 11 ++-- .../impl/level/mld_z_base_onelev_mat_asb.f90 | 11 ++-- tests/pdegen/mld_d_pde2d.f90 | 53 +++++-------------- tests/pdegen/mld_d_pde3d.f90 | 28 +++++----- tests/pdegen/mld_s_pde2d.f90 | 53 +++++-------------- tests/pdegen/mld_s_pde3d.f90 | 28 +++++----- 8 files changed, 72 insertions(+), 134 deletions(-) diff --git a/mlprec/impl/level/mld_c_base_onelev_mat_asb.f90 b/mlprec/impl/level/mld_c_base_onelev_mat_asb.f90 index f34ead9e..d2373e22 100644 --- a/mlprec/impl/level/mld_c_base_onelev_mat_asb.f90 +++ b/mlprec/impl/level/mld_c_base_onelev_mat_asb.f90 @@ -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 diff --git a/mlprec/impl/level/mld_d_base_onelev_mat_asb.f90 b/mlprec/impl/level/mld_d_base_onelev_mat_asb.f90 index f962d790..22b4c0ef 100644 --- a/mlprec/impl/level/mld_d_base_onelev_mat_asb.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_mat_asb.f90 @@ -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 diff --git a/mlprec/impl/level/mld_s_base_onelev_mat_asb.f90 b/mlprec/impl/level/mld_s_base_onelev_mat_asb.f90 index 6757cf54..dd607b62 100644 --- a/mlprec/impl/level/mld_s_base_onelev_mat_asb.f90 +++ b/mlprec/impl/level/mld_s_base_onelev_mat_asb.f90 @@ -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 diff --git a/mlprec/impl/level/mld_z_base_onelev_mat_asb.f90 b/mlprec/impl/level/mld_z_base_onelev_mat_asb.f90 index e3b22e41..ea4823ed 100644 --- a/mlprec/impl/level/mld_z_base_onelev_mat_asb.f90 +++ b/mlprec/impl/level/mld_z_base_onelev_mat_asb.f90 @@ -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 diff --git a/tests/pdegen/mld_d_pde2d.f90 b/tests/pdegen/mld_d_pde2d.f90 index 766b5d3b..d91c6626 100644 --- a/tests/pdegen/mld_d_pde2d.f90 +++ b/tests/pdegen/mld_d_pde2d.f90 @@ -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 diff --git a/tests/pdegen/mld_d_pde3d.f90 b/tests/pdegen/mld_d_pde3d.f90 index cba5eb2c..9b1ea386 100644 --- a/tests/pdegen/mld_d_pde3d.f90 +++ b/tests/pdegen/mld_d_pde3d.f90 @@ -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 diff --git a/tests/pdegen/mld_s_pde2d.f90 b/tests/pdegen/mld_s_pde2d.f90 index 1a33f843..d0d94cb4 100644 --- a/tests/pdegen/mld_s_pde2d.f90 +++ b/tests/pdegen/mld_s_pde2d.f90 @@ -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 diff --git a/tests/pdegen/mld_s_pde3d.f90 b/tests/pdegen/mld_s_pde3d.f90 index d073a23b..fd81c0dc 100644 --- a/tests/pdegen/mld_s_pde3d.f90 +++ b/tests/pdegen/mld_s_pde3d.f90 @@ -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