diff --git a/amgprec/amg_c_prec_type.f90 b/amgprec/amg_c_prec_type.f90 index 6cb59939..0359efdd 100644 --- a/amgprec/amg_c_prec_type.f90 +++ b/amgprec/amg_c_prec_type.f90 @@ -636,6 +636,11 @@ contains if (allocated(prec%precv)) then do i=1,size(prec%precv) call prec%precv(i)%free(info) + if (psb_errstatus_fatal()) then + info=psb_err_internal_error_ + call psb_errpush(info,name) + goto 9999 + end if end do deallocate(prec%precv,stat=info) end if diff --git a/amgprec/amg_d_prec_type.f90 b/amgprec/amg_d_prec_type.f90 index 4ff41d15..1a9a932e 100644 --- a/amgprec/amg_d_prec_type.f90 +++ b/amgprec/amg_d_prec_type.f90 @@ -636,6 +636,11 @@ contains if (allocated(prec%precv)) then do i=1,size(prec%precv) call prec%precv(i)%free(info) + if (psb_errstatus_fatal()) then + info=psb_err_internal_error_ + call psb_errpush(info,name) + goto 9999 + end if end do deallocate(prec%precv,stat=info) end if diff --git a/amgprec/amg_s_prec_type.f90 b/amgprec/amg_s_prec_type.f90 index 68ff409b..ea87bbf3 100644 --- a/amgprec/amg_s_prec_type.f90 +++ b/amgprec/amg_s_prec_type.f90 @@ -636,6 +636,11 @@ contains if (allocated(prec%precv)) then do i=1,size(prec%precv) call prec%precv(i)%free(info) + if (psb_errstatus_fatal()) then + info=psb_err_internal_error_ + call psb_errpush(info,name) + goto 9999 + end if end do deallocate(prec%precv,stat=info) end if diff --git a/amgprec/amg_z_prec_type.f90 b/amgprec/amg_z_prec_type.f90 index 7bc73992..9d44ca06 100644 --- a/amgprec/amg_z_prec_type.f90 +++ b/amgprec/amg_z_prec_type.f90 @@ -636,6 +636,11 @@ contains if (allocated(prec%precv)) then do i=1,size(prec%precv) call prec%precv(i)%free(info) + if (psb_errstatus_fatal()) then + info=psb_err_internal_error_ + call psb_errpush(info,name) + goto 9999 + end if end do deallocate(prec%precv,stat=info) end if diff --git a/amgprec/impl/amg_c_hierarchy_bld.F90 b/amgprec/impl/amg_c_hierarchy_bld.F90 index 37e009ea..42deda4b 100644 --- a/amgprec/impl/amg_c_hierarchy_bld.F90 +++ b/amgprec/impl/amg_c_hierarchy_bld.F90 @@ -366,14 +366,10 @@ subroutine amg_c_hierarchy_bld(a,desc_a,prec,info,cpymat) if (i>2) then if (sizeratio < mnaggratio) then - if (sizeratio > 1) then - newsz = i - else - ! - ! We are not gaining - ! - newsz = i-1 - end if + ! + ! We are not gaining + ! + newsz = i-1 end if if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then diff --git a/amgprec/impl/amg_cfile_prec_descr.f90 b/amgprec/impl/amg_cfile_prec_descr.f90 index 399e719b..130c719c 100644 --- a/amgprec/impl/amg_cfile_prec_descr.f90 +++ b/amgprec/impl/amg_cfile_prec_descr.f90 @@ -88,6 +88,7 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity,prefix) logical :: is_symgs character(len=20), parameter :: name='amg_file_prec_descr' integer(psb_ipk_) :: iout_, root_, verbosity_ + integer(psb_lpk_) :: gl_nrows,gl_ncols,gl_nzeros character(1024) :: prefix_ info = psb_success_ @@ -122,6 +123,12 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity,prefix) if (root_ == -1) root_ = me if (verbosity_ >=0) then + gl_nrows = prec%precv(1)%base_a%get_nrows() + gl_ncols = prec%precv(1)%base_a%get_ncols() + gl_nzeros = prec%precv(1)%base_a%get_nzeros() + call psb_sum(ctxt,gl_nrows) + call psb_sum(ctxt,gl_ncols) + call psb_sum(ctxt,gl_nzeros) ! ! The preconditioner description is printed by processor psb_root_. ! This agrees with the fact that all the parameters defining the @@ -141,7 +148,11 @@ subroutine amg_cfile_prec_descr(prec,info,iout,root, verbosity,prefix) write(iout_,*) write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner description' - + write(iout_,*) + write(iout_,*) trim(prefix_),' Base matrix : ',& + & gl_nrows, gl_ncols, gl_nzeros + write(iout_,*) + if (nlev == 1) then ! ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel. diff --git a/amgprec/impl/amg_d_hierarchy_bld.F90 b/amgprec/impl/amg_d_hierarchy_bld.F90 index 452a404f..d74801ed 100644 --- a/amgprec/impl/amg_d_hierarchy_bld.F90 +++ b/amgprec/impl/amg_d_hierarchy_bld.F90 @@ -366,14 +366,10 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat) if (i>2) then if (sizeratio < mnaggratio) then - if (sizeratio > 1) then - newsz = i - else - ! - ! We are not gaining - ! - newsz = i-1 - end if + ! + ! We are not gaining + ! + newsz = i-1 end if if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then @@ -434,7 +430,6 @@ subroutine amg_d_hierarchy_bld(a,desc_a,prec,info,cpymat) & ilaggr,nlaggr,op_prol,info) if (do_timings) call psb_toc(idx_matasb) end if - if (info /= psb_success_) then write(ch_err,'(a,i7)') 'Mat asb fail @ level ',i call psb_errpush(psb_err_internal_error_,name,& diff --git a/amgprec/impl/amg_dfile_prec_descr.f90 b/amgprec/impl/amg_dfile_prec_descr.f90 index 8d429643..fd2395d0 100644 --- a/amgprec/impl/amg_dfile_prec_descr.f90 +++ b/amgprec/impl/amg_dfile_prec_descr.f90 @@ -88,6 +88,7 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity,prefix) logical :: is_symgs character(len=20), parameter :: name='amg_file_prec_descr' integer(psb_ipk_) :: iout_, root_, verbosity_ + integer(psb_lpk_) :: gl_nrows,gl_ncols,gl_nzeros character(1024) :: prefix_ info = psb_success_ @@ -122,6 +123,12 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity,prefix) if (root_ == -1) root_ = me if (verbosity_ >=0) then + gl_nrows = prec%precv(1)%base_a%get_nrows() + gl_ncols = prec%precv(1)%base_a%get_ncols() + gl_nzeros = prec%precv(1)%base_a%get_nzeros() + call psb_sum(ctxt,gl_nrows) + call psb_sum(ctxt,gl_ncols) + call psb_sum(ctxt,gl_nzeros) ! ! The preconditioner description is printed by processor psb_root_. ! This agrees with the fact that all the parameters defining the @@ -141,7 +148,11 @@ subroutine amg_dfile_prec_descr(prec,info,iout,root, verbosity,prefix) write(iout_,*) write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner description' - + write(iout_,*) + write(iout_,*) trim(prefix_),' Base matrix : ',& + & gl_nrows, gl_ncols, gl_nzeros + write(iout_,*) + if (nlev == 1) then ! ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel. diff --git a/amgprec/impl/amg_s_hierarchy_bld.F90 b/amgprec/impl/amg_s_hierarchy_bld.F90 index 454847ef..826a1efa 100644 --- a/amgprec/impl/amg_s_hierarchy_bld.F90 +++ b/amgprec/impl/amg_s_hierarchy_bld.F90 @@ -366,14 +366,10 @@ subroutine amg_s_hierarchy_bld(a,desc_a,prec,info,cpymat) if (i>2) then if (sizeratio < mnaggratio) then - if (sizeratio > 1) then - newsz = i - else - ! - ! We are not gaining - ! - newsz = i-1 - end if + ! + ! We are not gaining + ! + newsz = i-1 end if if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then diff --git a/amgprec/impl/amg_sfile_prec_descr.f90 b/amgprec/impl/amg_sfile_prec_descr.f90 index 08a4032e..277b25f0 100644 --- a/amgprec/impl/amg_sfile_prec_descr.f90 +++ b/amgprec/impl/amg_sfile_prec_descr.f90 @@ -88,6 +88,7 @@ subroutine amg_sfile_prec_descr(prec,info,iout,root, verbosity,prefix) logical :: is_symgs character(len=20), parameter :: name='amg_file_prec_descr' integer(psb_ipk_) :: iout_, root_, verbosity_ + integer(psb_lpk_) :: gl_nrows,gl_ncols,gl_nzeros character(1024) :: prefix_ info = psb_success_ @@ -122,6 +123,12 @@ subroutine amg_sfile_prec_descr(prec,info,iout,root, verbosity,prefix) if (root_ == -1) root_ = me if (verbosity_ >=0) then + gl_nrows = prec%precv(1)%base_a%get_nrows() + gl_ncols = prec%precv(1)%base_a%get_ncols() + gl_nzeros = prec%precv(1)%base_a%get_nzeros() + call psb_sum(ctxt,gl_nrows) + call psb_sum(ctxt,gl_ncols) + call psb_sum(ctxt,gl_nzeros) ! ! The preconditioner description is printed by processor psb_root_. ! This agrees with the fact that all the parameters defining the @@ -141,7 +148,11 @@ subroutine amg_sfile_prec_descr(prec,info,iout,root, verbosity,prefix) write(iout_,*) write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner description' - + write(iout_,*) + write(iout_,*) trim(prefix_),' Base matrix : ',& + & gl_nrows, gl_ncols, gl_nzeros + write(iout_,*) + if (nlev == 1) then ! ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel. diff --git a/amgprec/impl/amg_z_hierarchy_bld.F90 b/amgprec/impl/amg_z_hierarchy_bld.F90 index 6678530a..f01d8a1b 100644 --- a/amgprec/impl/amg_z_hierarchy_bld.F90 +++ b/amgprec/impl/amg_z_hierarchy_bld.F90 @@ -366,14 +366,10 @@ subroutine amg_z_hierarchy_bld(a,desc_a,prec,info,cpymat) if (i>2) then if (sizeratio < mnaggratio) then - if (sizeratio > 1) then - newsz = i - else - ! - ! We are not gaining - ! - newsz = i-1 - end if + ! + ! We are not gaining + ! + newsz = i-1 end if if (all(nlaggr == prec%precv(i-1)%linmap%naggr)) then diff --git a/amgprec/impl/amg_zfile_prec_descr.f90 b/amgprec/impl/amg_zfile_prec_descr.f90 index 2fd88026..8f4864f2 100644 --- a/amgprec/impl/amg_zfile_prec_descr.f90 +++ b/amgprec/impl/amg_zfile_prec_descr.f90 @@ -88,6 +88,7 @@ subroutine amg_zfile_prec_descr(prec,info,iout,root, verbosity,prefix) logical :: is_symgs character(len=20), parameter :: name='amg_file_prec_descr' integer(psb_ipk_) :: iout_, root_, verbosity_ + integer(psb_lpk_) :: gl_nrows,gl_ncols,gl_nzeros character(1024) :: prefix_ info = psb_success_ @@ -122,6 +123,12 @@ subroutine amg_zfile_prec_descr(prec,info,iout,root, verbosity,prefix) if (root_ == -1) root_ = me if (verbosity_ >=0) then + gl_nrows = prec%precv(1)%base_a%get_nrows() + gl_ncols = prec%precv(1)%base_a%get_ncols() + gl_nzeros = prec%precv(1)%base_a%get_nzeros() + call psb_sum(ctxt,gl_nrows) + call psb_sum(ctxt,gl_ncols) + call psb_sum(ctxt,gl_nzeros) ! ! The preconditioner description is printed by processor psb_root_. ! This agrees with the fact that all the parameters defining the @@ -141,7 +148,11 @@ subroutine amg_zfile_prec_descr(prec,info,iout,root, verbosity,prefix) write(iout_,*) write(iout_,'(a,1x,a)') trim(prefix_),'Preconditioner description' - + write(iout_,*) + write(iout_,*) trim(prefix_),' Base matrix : ',& + & gl_nrows, gl_ncols, gl_nzeros + write(iout_,*) + if (nlev == 1) then ! ! Here we have a gigantic kludge just to handle Symmetrized Gauss-Seidel. diff --git a/amgprec/impl/solver/amg_c_jac_solver_bld.f90 b/amgprec/impl/solver/amg_c_jac_solver_bld.f90 index d6ab3f0b..9fbcd717 100644 --- a/amgprec/impl/solver/amg_c_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_c_jac_solver_bld.f90 @@ -100,6 +100,10 @@ subroutine amg_c_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = cone/sv%d(i) end if end do + if (allocated(sv%dv)) then + call sv%dv%free(info) + deallocate(sv%dv) + end if allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) diff --git a/amgprec/impl/solver/amg_c_l1_jac_solver_bld.f90 b/amgprec/impl/solver/amg_c_l1_jac_solver_bld.f90 index b5665ef4..1d0d2cf1 100644 --- a/amgprec/impl/solver/amg_c_l1_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_c_l1_jac_solver_bld.f90 @@ -103,6 +103,10 @@ subroutine amg_c_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = cone/sv%d(i) end if end do + if (allocated(sv%dv)) then + call sv%dv%free(info) + deallocate(sv%dv) + end if allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) diff --git a/amgprec/impl/solver/amg_d_jac_solver_bld.f90 b/amgprec/impl/solver/amg_d_jac_solver_bld.f90 index 3e5e5b38..23a0b190 100644 --- a/amgprec/impl/solver/amg_d_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_d_jac_solver_bld.f90 @@ -100,6 +100,10 @@ subroutine amg_d_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = done/sv%d(i) end if end do + if (allocated(sv%dv)) then + call sv%dv%free(info) + deallocate(sv%dv) + end if allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) diff --git a/amgprec/impl/solver/amg_d_l1_jac_solver_bld.f90 b/amgprec/impl/solver/amg_d_l1_jac_solver_bld.f90 index cbe0adf3..411501ec 100644 --- a/amgprec/impl/solver/amg_d_l1_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_d_l1_jac_solver_bld.f90 @@ -103,6 +103,10 @@ subroutine amg_d_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = done/sv%d(i) end if end do + if (allocated(sv%dv)) then + call sv%dv%free(info) + deallocate(sv%dv) + end if allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) diff --git a/amgprec/impl/solver/amg_s_jac_solver_bld.f90 b/amgprec/impl/solver/amg_s_jac_solver_bld.f90 index 1ffd0f53..1afadf09 100644 --- a/amgprec/impl/solver/amg_s_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_s_jac_solver_bld.f90 @@ -100,6 +100,10 @@ subroutine amg_s_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = sone/sv%d(i) end if end do + if (allocated(sv%dv)) then + call sv%dv%free(info) + deallocate(sv%dv) + end if allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) diff --git a/amgprec/impl/solver/amg_s_l1_jac_solver_bld.f90 b/amgprec/impl/solver/amg_s_l1_jac_solver_bld.f90 index d87da5fd..ad82fb3b 100644 --- a/amgprec/impl/solver/amg_s_l1_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_s_l1_jac_solver_bld.f90 @@ -103,6 +103,10 @@ subroutine amg_s_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = sone/sv%d(i) end if end do + if (allocated(sv%dv)) then + call sv%dv%free(info) + deallocate(sv%dv) + end if allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) diff --git a/amgprec/impl/solver/amg_z_jac_solver_bld.f90 b/amgprec/impl/solver/amg_z_jac_solver_bld.f90 index 172200ac..e84a019b 100644 --- a/amgprec/impl/solver/amg_z_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_z_jac_solver_bld.f90 @@ -100,6 +100,10 @@ subroutine amg_z_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = zone/sv%d(i) end if end do + if (allocated(sv%dv)) then + call sv%dv%free(info) + deallocate(sv%dv) + end if allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) diff --git a/amgprec/impl/solver/amg_z_l1_jac_solver_bld.f90 b/amgprec/impl/solver/amg_z_l1_jac_solver_bld.f90 index e9d7955c..391cee83 100644 --- a/amgprec/impl/solver/amg_z_l1_jac_solver_bld.f90 +++ b/amgprec/impl/solver/amg_z_l1_jac_solver_bld.f90 @@ -103,6 +103,10 @@ subroutine amg_z_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold) sv%d(i) = zone/sv%d(i) end if end do + if (allocated(sv%dv)) then + call sv%dv%free(info) + deallocate(sv%dv) + end if allocate(sv%dv,stat=info) if (info == psb_success_) then call sv%dv%bld(sv%d) diff --git a/samples/advanced/pdegen/amg_d_genpde_mod.F90 b/samples/advanced/pdegen/amg_d_genpde_mod.F90 index 0d3b6264..e0d53bce 100644 --- a/samples/advanced/pdegen/amg_d_genpde_mod.F90 +++ b/samples/advanced/pdegen/amg_d_genpde_mod.F90 @@ -180,7 +180,7 @@ contains else partition_ = 3 end if - deltah = done/(idim+2) + deltah = done/(idim+1) sqdeltah = deltah*deltah deltah2 = 2.0_psb_dpk_* deltah @@ -416,9 +416,9 @@ contains ! 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 + x = (ix)*deltah + y = (iy)*deltah + z = (iz)*deltah zt(k) = f_(x,y,z) ! internal point: build discretization ! @@ -647,7 +647,7 @@ contains f_ => d_null_func_2d end if - deltah = done/(idim+2) + deltah = done/(idim+1) sqdeltah = deltah*deltah deltah2 = 2.0_psb_dpk_* deltah @@ -879,8 +879,8 @@ contains ! compute gridpoint coordinates call idx2ijk(ix,iy,glob_row,idim,idim) ! x, y coordinates - x = (ix-1)*deltah - y = (iy-1)*deltah + x = (ix)*deltah + y = (iy)*deltah zt(k) = f_(x,y) ! internal point: build discretization diff --git a/samples/advanced/pdegen/amg_s_genpde_mod.F90 b/samples/advanced/pdegen/amg_s_genpde_mod.F90 index c481fc07..872b1c7e 100644 --- a/samples/advanced/pdegen/amg_s_genpde_mod.F90 +++ b/samples/advanced/pdegen/amg_s_genpde_mod.F90 @@ -176,7 +176,7 @@ contains else partition_ = 3 end if - deltah = sone/(idim+2) + deltah = sone/(idim+1) sqdeltah = deltah*deltah deltah2 = 2.0_psb_spk_* deltah @@ -412,9 +412,9 @@ contains ! 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 + x = (ix)*deltah + y = (iy)*deltah + z = (iz)*deltah zt(k) = f_(x,y,z) ! internal point: build discretization ! @@ -643,7 +643,7 @@ contains f_ => s_null_func_2d end if - deltah = sone/(idim+2) + deltah = sone/(idim+1) sqdeltah = deltah*deltah deltah2 = 2.0_psb_spk_* deltah @@ -875,8 +875,8 @@ contains ! compute gridpoint coordinates call idx2ijk(ix,iy,glob_row,idim,idim) ! x, y coordinates - x = (ix-1)*deltah - y = (iy-1)*deltah + x = (ix)*deltah + y = (iy)*deltah zt(k) = f_(x,y) ! internal point: build discretization diff --git a/samples/simple/pdegen/amg_dpde_mod.f90 b/samples/simple/pdegen/amg_dpde_mod.f90 index 5bfe79aa..fba9dcf7 100644 --- a/samples/simple/pdegen/amg_dpde_mod.f90 +++ b/samples/simple/pdegen/amg_dpde_mod.f90 @@ -369,9 +369,9 @@ contains ! 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 + x = (ix)*deltah + y = (iy)*deltah + z = (iz)*deltah zt(k) = f_(x,y,z) ! internal point: build discretization ! diff --git a/samples/simple/pdegen/amg_spde_mod.f90 b/samples/simple/pdegen/amg_spde_mod.f90 index 78907603..c3fdcfe7 100644 --- a/samples/simple/pdegen/amg_spde_mod.f90 +++ b/samples/simple/pdegen/amg_spde_mod.f90 @@ -369,9 +369,9 @@ contains ! 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 + x = (ix)*deltah + y = (iy)*deltah + z = (iz)*deltah zt(k) = f_(x,y,z) ! internal point: build discretization !