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

Merge branch 'development' into mumps-devel

Browse Source
This commit is contained in:
fdurastante
2026-09-23 09:43:46 +02:00
parent 64d7f8d761 a3e1be46ee
commit 2416855b68
24 changed files with 136 additions and 57 deletions
Download Patch File Download Diff File Expand all files Collapse all files
amgprec/amg_c_prec_type.f90
+5
View File
@@ -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
amgprec/amg_d_prec_type.f90
+5
View File
@@ -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
amgprec/amg_s_prec_type.f90
+5
View File
@@ -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
amgprec/amg_z_prec_type.f90
+5
View File
@@ -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
amgprec/impl/amg_c_hierarchy_bld.F90
+4 -8
View File
@@ -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
amgprec/impl/amg_cfile_prec_descr.f90
+12 -1
View File
@@ -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.
amgprec/impl/amg_d_hierarchy_bld.F90
+4 -9
View File
@@ -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,&
amgprec/impl/amg_dfile_prec_descr.f90
+12 -1
View File
@@ -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.
amgprec/impl/amg_s_hierarchy_bld.F90
+4 -8
View File
@@ -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
amgprec/impl/amg_sfile_prec_descr.f90
+12 -1
View File
@@ -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.
amgprec/impl/amg_z_hierarchy_bld.F90
+4 -8
View File
@@ -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
amgprec/impl/amg_zfile_prec_descr.f90
+12 -1
View File
@@ -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.
amgprec/impl/solver/amg_c_jac_solver_bld.f90
+4
View File
@@ -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)
amgprec/impl/solver/amg_c_l1_jac_solver_bld.f90
+4
View File
@@ -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)
amgprec/impl/solver/amg_d_jac_solver_bld.f90
+4
View File
@@ -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)
amgprec/impl/solver/amg_d_l1_jac_solver_bld.f90
+4
View File
@@ -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)
amgprec/impl/solver/amg_s_jac_solver_bld.f90
+4
View File
@@ -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)
amgprec/impl/solver/amg_s_l1_jac_solver_bld.f90
+4
View File
@@ -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)
amgprec/impl/solver/amg_z_jac_solver_bld.f90
+4
View File
@@ -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)
amgprec/impl/solver/amg_z_l1_jac_solver_bld.f90
+4
View File
@@ -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)
samples/advanced/pdegen/amg_d_genpde_mod.F90
+7 -7
View File
@@ -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
samples/advanced/pdegen/amg_s_genpde_mod.F90
+7 -7
View File
@@ -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
samples/simple/pdegen/amg_dpde_mod.f90
+3 -3
View File
@@ -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
!
samples/simple/pdegen/amg_spde_mod.f90
+3 -3
View File
@@ -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
!