Merge branch 'maint-1.2.0' into merge-maint-par

merge-maint-par
sfilippone 2 months ago
commit e08b8b7072

@ -1,5 +1,4 @@
$Format:%d%n%n$ $Format:%d%n%n$
# Fall back version, probably last release:
1.2.1 1.2.1
# AMG4PSBLAS version file. # AMG4PSBLAS version file.

@ -7,7 +7,7 @@
(C) Copyright 2025 Salvatore Filippone (C) Copyright 2025 Salvatore Filippone
(C) Copyright 2025 Pasqua D'Ambra (C) Copyright 2025 Pasqua D'Ambra
(C) Copyright 2025 Fabio Durastante (C) Copyright 2025 Fabio Durastante
Redistribution and use in source and binary forms, with or without Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions modification, are permitted provided that the following conditions
are met: are met:

@ -345,7 +345,6 @@ contains
if (allocated(sm%sv)) then if (allocated(sm%sv)) then
call sm%sv%free(info) call sm%sv%free(info)
if (info == psb_success_) deallocate(sm%sv,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
call psb_errpush(info,name) call psb_errpush(info,name)

@ -671,6 +671,10 @@ contains
info = psb_err_internal_error_; goto 9999 info = psb_err_internal_error_; goto 9999
end if end if
!
! In the internals, do FREE on components,
! but do not deallocate them
!
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
do i=1,size(prec%precv) do i=1,size(prec%precv)
call prec%precv(i)%free_smoothers(info) call prec%precv(i)%free_smoothers(info)

@ -345,7 +345,6 @@ contains
if (allocated(sm%sv)) then if (allocated(sm%sv)) then
call sm%sv%free(info) call sm%sv%free(info)
if (info == psb_success_) deallocate(sm%sv,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
call psb_errpush(info,name) call psb_errpush(info,name)

@ -279,7 +279,6 @@ contains
if (allocated(sm%sv)) then if (allocated(sm%sv)) then
call sm%sv%free(info) call sm%sv%free(info)
if (info == psb_success_) deallocate(sm%sv,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
call psb_errpush(info,name) call psb_errpush(info,name)

@ -671,6 +671,10 @@ contains
info = psb_err_internal_error_; goto 9999 info = psb_err_internal_error_; goto 9999
end if end if
!
! In the internals, do FREE on components,
! but do not deallocate them
!
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
do i=1,size(prec%precv) do i=1,size(prec%precv)
call prec%precv(i)%free_smoothers(info) call prec%precv(i)%free_smoothers(info)

@ -345,7 +345,6 @@ contains
if (allocated(sm%sv)) then if (allocated(sm%sv)) then
call sm%sv%free(info) call sm%sv%free(info)
if (info == psb_success_) deallocate(sm%sv,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
call psb_errpush(info,name) call psb_errpush(info,name)

@ -279,7 +279,6 @@ contains
if (allocated(sm%sv)) then if (allocated(sm%sv)) then
call sm%sv%free(info) call sm%sv%free(info)
if (info == psb_success_) deallocate(sm%sv,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
call psb_errpush(info,name) call psb_errpush(info,name)

@ -671,6 +671,10 @@ contains
info = psb_err_internal_error_; goto 9999 info = psb_err_internal_error_; goto 9999
end if end if
!
! In the internals, do FREE on components,
! but do not deallocate them
!
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
do i=1,size(prec%precv) do i=1,size(prec%precv)
call prec%precv(i)%free_smoothers(info) call prec%precv(i)%free_smoothers(info)

@ -345,7 +345,6 @@ contains
if (allocated(sm%sv)) then if (allocated(sm%sv)) then
call sm%sv%free(info) call sm%sv%free(info)
if (info == psb_success_) deallocate(sm%sv,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
call psb_errpush(info,name) call psb_errpush(info,name)

@ -671,6 +671,10 @@ contains
info = psb_err_internal_error_; goto 9999 info = psb_err_internal_error_; goto 9999
end if end if
!
! In the internals, do FREE on components,
! but do not deallocate them
!
if (allocated(prec%precv)) then if (allocated(prec%precv)) then
do i=1,size(prec%precv) do i=1,size(prec%precv)
call prec%precv(i)%free_smoothers(info) call prec%precv(i)%free_smoothers(info)

@ -53,7 +53,6 @@ subroutine amg_c_as_smoother_free(sm,info)
if (allocated(sm%sv)) then if (allocated(sm%sv)) then
call sm%sv%free(info) call sm%sv%free(info)
if (info == psb_success_) deallocate(sm%sv,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
call psb_errpush(info,name) call psb_errpush(info,name)

@ -52,7 +52,6 @@ subroutine amg_c_base_smoother_free(sm,info)
if (allocated(sm%sv)) then if (allocated(sm%sv)) then
call sm%sv%free(info) call sm%sv%free(info)
if (info == psb_success_) deallocate(sm%sv,stat=info)
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_

@ -53,7 +53,6 @@ subroutine amg_d_as_smoother_free(sm,info)
if (allocated(sm%sv)) then if (allocated(sm%sv)) then
call sm%sv%free(info) call sm%sv%free(info)
if (info == psb_success_) deallocate(sm%sv,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
call psb_errpush(info,name) call psb_errpush(info,name)

@ -52,7 +52,6 @@ subroutine amg_d_base_smoother_free(sm,info)
if (allocated(sm%sv)) then if (allocated(sm%sv)) then
call sm%sv%free(info) call sm%sv%free(info)
if (info == psb_success_) deallocate(sm%sv,stat=info)
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_

@ -53,7 +53,6 @@ subroutine amg_s_as_smoother_free(sm,info)
if (allocated(sm%sv)) then if (allocated(sm%sv)) then
call sm%sv%free(info) call sm%sv%free(info)
if (info == psb_success_) deallocate(sm%sv,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
call psb_errpush(info,name) call psb_errpush(info,name)

@ -52,7 +52,6 @@ subroutine amg_s_base_smoother_free(sm,info)
if (allocated(sm%sv)) then if (allocated(sm%sv)) then
call sm%sv%free(info) call sm%sv%free(info)
if (info == psb_success_) deallocate(sm%sv,stat=info)
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_

@ -53,7 +53,6 @@ subroutine amg_z_as_smoother_free(sm,info)
if (allocated(sm%sv)) then if (allocated(sm%sv)) then
call sm%sv%free(info) call sm%sv%free(info)
if (info == psb_success_) deallocate(sm%sv,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_
call psb_errpush(info,name) call psb_errpush(info,name)

@ -52,7 +52,6 @@ subroutine amg_z_base_smoother_free(sm,info)
if (allocated(sm%sv)) then if (allocated(sm%sv)) then
call sm%sv%free(info) call sm%sv%free(info)
if (info == psb_success_) deallocate(sm%sv,stat=info)
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_alloc_dealloc_ info = psb_err_alloc_dealloc_

@ -91,11 +91,7 @@ subroutine amg_c_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
sv%d(i) = cone/sv%d(i) sv%d(i) = cone/sv%d(i)
end if end if
end do end do
if (allocated(sv%dv)) then if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
call sv%dv%free(info)
deallocate(sv%dv)
end if
allocate(sv%dv,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
call sv%dv%bld(sv%d) call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold) if (present(vmold)) call sv%dv%cnv(vmold)
@ -176,11 +172,7 @@ subroutine amg_c_l1_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
sv%d(i) = cone/sv%d(i) sv%d(i) = cone/sv%d(i)
end if end if
end do end do
if (allocated(sv%dv)) then if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
call sv%dv%free(info)
deallocate(sv%dv)
end if
allocate(sv%dv,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
call sv%dv%bld(sv%d) call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold) if (present(vmold)) call sv%dv%cnv(vmold)

@ -100,11 +100,7 @@ subroutine amg_c_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
sv%d(i) = cone/sv%d(i) sv%d(i) = cone/sv%d(i)
end if end if
end do end do
if (allocated(sv%dv)) then if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
call sv%dv%free(info)
deallocate(sv%dv)
end if
allocate(sv%dv,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
call sv%dv%bld(sv%d) call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold) if (present(vmold)) call sv%dv%cnv(vmold)

@ -103,11 +103,7 @@ subroutine amg_c_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
sv%d(i) = cone/sv%d(i) sv%d(i) = cone/sv%d(i)
end if end if
end do end do
if (allocated(sv%dv)) then if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
call sv%dv%free(info)
deallocate(sv%dv)
end if
allocate(sv%dv,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
call sv%dv%bld(sv%d) call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold) if (present(vmold)) call sv%dv%cnv(vmold)

@ -91,11 +91,7 @@ subroutine amg_d_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
sv%d(i) = done/sv%d(i) sv%d(i) = done/sv%d(i)
end if end if
end do end do
if (allocated(sv%dv)) then if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
call sv%dv%free(info)
deallocate(sv%dv)
end if
allocate(sv%dv,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
call sv%dv%bld(sv%d) call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold) if (present(vmold)) call sv%dv%cnv(vmold)
@ -176,11 +172,7 @@ subroutine amg_d_l1_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
sv%d(i) = done/sv%d(i) sv%d(i) = done/sv%d(i)
end if end if
end do end do
if (allocated(sv%dv)) then if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
call sv%dv%free(info)
deallocate(sv%dv)
end if
allocate(sv%dv,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
call sv%dv%bld(sv%d) call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold) if (present(vmold)) call sv%dv%cnv(vmold)

@ -100,11 +100,7 @@ subroutine amg_d_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
sv%d(i) = done/sv%d(i) sv%d(i) = done/sv%d(i)
end if end if
end do end do
if (allocated(sv%dv)) then if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
call sv%dv%free(info)
deallocate(sv%dv)
end if
allocate(sv%dv,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
call sv%dv%bld(sv%d) call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold) if (present(vmold)) call sv%dv%cnv(vmold)

@ -103,11 +103,7 @@ subroutine amg_d_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
sv%d(i) = done/sv%d(i) sv%d(i) = done/sv%d(i)
end if end if
end do end do
if (allocated(sv%dv)) then if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
call sv%dv%free(info)
deallocate(sv%dv)
end if
allocate(sv%dv,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
call sv%dv%bld(sv%d) call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold) if (present(vmold)) call sv%dv%cnv(vmold)

@ -91,11 +91,7 @@ subroutine amg_s_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
sv%d(i) = sone/sv%d(i) sv%d(i) = sone/sv%d(i)
end if end if
end do end do
if (allocated(sv%dv)) then if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
call sv%dv%free(info)
deallocate(sv%dv)
end if
allocate(sv%dv,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
call sv%dv%bld(sv%d) call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold) if (present(vmold)) call sv%dv%cnv(vmold)
@ -176,11 +172,7 @@ subroutine amg_s_l1_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
sv%d(i) = sone/sv%d(i) sv%d(i) = sone/sv%d(i)
end if end if
end do end do
if (allocated(sv%dv)) then if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
call sv%dv%free(info)
deallocate(sv%dv)
end if
allocate(sv%dv,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
call sv%dv%bld(sv%d) call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold) if (present(vmold)) call sv%dv%cnv(vmold)

@ -100,11 +100,7 @@ subroutine amg_s_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
sv%d(i) = sone/sv%d(i) sv%d(i) = sone/sv%d(i)
end if end if
end do end do
if (allocated(sv%dv)) then if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
call sv%dv%free(info)
deallocate(sv%dv)
end if
allocate(sv%dv,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
call sv%dv%bld(sv%d) call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold) if (present(vmold)) call sv%dv%cnv(vmold)

@ -103,11 +103,7 @@ subroutine amg_s_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
sv%d(i) = sone/sv%d(i) sv%d(i) = sone/sv%d(i)
end if end if
end do end do
if (allocated(sv%dv)) then if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
call sv%dv%free(info)
deallocate(sv%dv)
end if
allocate(sv%dv,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
call sv%dv%bld(sv%d) call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold) if (present(vmold)) call sv%dv%cnv(vmold)

@ -91,11 +91,7 @@ subroutine amg_z_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
sv%d(i) = zone/sv%d(i) sv%d(i) = zone/sv%d(i)
end if end if
end do end do
if (allocated(sv%dv)) then if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
call sv%dv%free(info)
deallocate(sv%dv)
end if
allocate(sv%dv,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
call sv%dv%bld(sv%d) call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold) if (present(vmold)) call sv%dv%cnv(vmold)
@ -176,11 +172,7 @@ subroutine amg_z_l1_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
sv%d(i) = zone/sv%d(i) sv%d(i) = zone/sv%d(i)
end if end if
end do end do
if (allocated(sv%dv)) then if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
call sv%dv%free(info)
deallocate(sv%dv)
end if
allocate(sv%dv,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
call sv%dv%bld(sv%d) call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold) if (present(vmold)) call sv%dv%cnv(vmold)

@ -100,11 +100,7 @@ subroutine amg_z_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
sv%d(i) = zone/sv%d(i) sv%d(i) = zone/sv%d(i)
end if end if
end do end do
if (allocated(sv%dv)) then if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
call sv%dv%free(info)
deallocate(sv%dv)
end if
allocate(sv%dv,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
call sv%dv%bld(sv%d) call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold) if (present(vmold)) call sv%dv%cnv(vmold)

@ -103,11 +103,7 @@ subroutine amg_z_l1_jac_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
sv%d(i) = zone/sv%d(i) sv%d(i) = zone/sv%d(i)
end if end if
end do end do
if (allocated(sv%dv)) then if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
call sv%dv%free(info)
deallocate(sv%dv)
end if
allocate(sv%dv,stat=info)
if (info == psb_success_) then if (info == psb_success_) then
call sv%dv%bld(sv%d) call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold) if (present(vmold)) call sv%dv%cnv(vmold)

@ -172,15 +172,17 @@ contains
end function amg_c_dprecbld end function amg_c_dprecbld
function amg_c_dhierarchy_build(ah,cdh,ph) bind(c) result(res) function amg_c_dhierarchy_build(ah,cdh,ph) bind(c) result(res)
use psb_base_mod
implicit none implicit none
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ph,ah,cdh type(psb_c_object_type) :: ph,ah,cdh
integer(psb_ipk_) :: iret
type(amg_dprec_type), pointer :: precp type(amg_dprec_type), pointer :: precp
type(psb_dspmat_type), pointer :: ap type(psb_dspmat_type), pointer :: ap
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
character(len=80) :: fptype character(len=80) :: fptype
integer(psb_ipk_) :: iret, act
res = -1 res = -1
@ -204,11 +206,16 @@ contains
res = AMGC_ERR_FILTER(iret) res = AMGC_ERR_FILTER(iret)
AMGC_ERR_HANDLE(res) AMGC_ERR_HANDLE(res)
if (res /=0) then
act = psb_act_abort_
call psb_error_handler(act)
end if
return return
end function amg_c_dhierarchy_build end function amg_c_dhierarchy_build
function amg_c_dsmoothers_build(ah,cdh,ph) bind(c) result(res) function amg_c_dsmoothers_build(ah,cdh,ph) bind(c) result(res)
use psb_base_mod
implicit none implicit none
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res
@ -217,7 +224,7 @@ contains
type(psb_dspmat_type), pointer :: ap type(psb_dspmat_type), pointer :: ap
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
character(len=80) :: fptype character(len=80) :: fptype
integer(psb_ipk_) :: iret integer(psb_ipk_) :: iret, act
res = -1 res = -1
@ -241,7 +248,10 @@ contains
res = AMGC_ERR_FILTER(iret) res = AMGC_ERR_FILTER(iret)
AMGC_ERR_HANDLE(res) AMGC_ERR_HANDLE(res)
if (res /=0) then
act = psb_act_abort_
call psb_error_handler(act)
end if
return return
end function amg_c_dsmoothers_build end function amg_c_dsmoothers_build
@ -371,7 +381,7 @@ contains
type(psb_c_object_type) :: ah,cdh,ph,bh,xh type(psb_c_object_type) :: ah,cdh,ph,bh,xh
character(c_char) :: methd(*) character(c_char) :: methd(*)
type(solveroptions) :: options type(solveroptions) :: options
res= amg_c_dkrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh, & res= amg_c_dkrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh, &
& itmax=options%itmax, iter=options%iter,& & itmax=options%itmax, iter=options%iter,&
& itrace=options%itrace, istop=options%istop,& & itrace=options%itrace, istop=options%istop,&

@ -140,11 +140,11 @@ contains
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ph,ah,cdh type(psb_c_object_type) :: ph,ah,cdh
integer(psb_ipk_) :: iret
type(amg_zprec_type), pointer :: precp type(amg_zprec_type), pointer :: precp
type(psb_zspmat_type), pointer :: ap type(psb_zspmat_type), pointer :: ap
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
character(len=80) :: fptype character(len=80) :: fptype
integer(psb_ipk_) :: iret
res = -1 res = -1
@ -173,15 +173,17 @@ contains
end function amg_c_zprecbld end function amg_c_zprecbld
function amg_c_zhierarchy_build(ah,cdh,ph) bind(c) result(res) function amg_c_zhierarchy_build(ah,cdh,ph) bind(c) result(res)
use psb_base_mod
implicit none implicit none
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ph,ah,cdh type(psb_c_object_type) :: ph,ah,cdh
integer(psb_ipk_) :: iret
type(amg_zprec_type), pointer :: precp type(amg_zprec_type), pointer :: precp
type(psb_zspmat_type), pointer :: ap type(psb_zspmat_type), pointer :: ap
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
character(len=80) :: fptype character(len=80) :: fptype
integer(psb_ipk_) :: iret, act
res = -1 res = -1
@ -206,19 +208,24 @@ contains
res = AMGC_ERR_FILTER(iret) res = AMGC_ERR_FILTER(iret)
AMGC_ERR_HANDLE(res) AMGC_ERR_HANDLE(res)
if (res /=0) then
act = psb_act_abort_
call psb_error_handler(act)
end if
return return
end function amg_c_zhierarchy_build end function amg_c_zhierarchy_build
function amg_c_zsmoothers_build(ah,cdh,ph) bind(c) result(res) function amg_c_zsmoothers_build(ah,cdh,ph) bind(c) result(res)
use psb_base_mod
implicit none implicit none
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res
type(psb_c_object_type) :: ph,ah,cdh type(psb_c_object_type) :: ph,ah,cdh
integer(psb_ipk_) :: iret
type(amg_zprec_type), pointer :: precp type(amg_zprec_type), pointer :: precp
type(psb_zspmat_type), pointer :: ap type(psb_zspmat_type), pointer :: ap
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
character(len=80) :: fptype character(len=80) :: fptype
integer(psb_ipk_) :: iret, act
res = -1 res = -1
@ -243,6 +250,11 @@ contains
res = AMGC_ERR_FILTER(iret) res = AMGC_ERR_FILTER(iret)
AMGC_ERR_HANDLE(res) AMGC_ERR_HANDLE(res)
if (res /=0) then
act = psb_act_abort_
call psb_error_handler(act)
end if
return return
end function amg_c_zsmoothers_build end function amg_c_zsmoothers_build

Loading…
Cancel
Save