Compare commits

..

No commits in common. '1faa0d57b3822dd79394b0a89caa9861498e6358' and 'f660aa7cde4f2b6b0b5011c96241dcf85fb55db0' have entirely different histories.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

@ -91,7 +91,7 @@ subroutine amg_c_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
sv%d(i) = cone/sv%d(i)
end if
end do
if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
allocate(sv%dv,stat=info)
if (info == psb_success_) then
call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold)
@ -172,7 +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)
end if
end do
if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
allocate(sv%dv,stat=info)
if (info == psb_success_) then
call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold)

@ -100,7 +100,7 @@ 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 (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
allocate(sv%dv,stat=info)
if (info == psb_success_) then
call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold)

@ -103,7 +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)
end if
end do
if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
allocate(sv%dv,stat=info)
if (info == psb_success_) then
call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold)

@ -91,7 +91,7 @@ subroutine amg_d_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
sv%d(i) = done/sv%d(i)
end if
end do
if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
allocate(sv%dv,stat=info)
if (info == psb_success_) then
call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold)
@ -172,7 +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)
end if
end do
if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
allocate(sv%dv,stat=info)
if (info == psb_success_) then
call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold)

@ -100,7 +100,7 @@ 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 (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
allocate(sv%dv,stat=info)
if (info == psb_success_) then
call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold)

@ -103,7 +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)
end if
end do
if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
allocate(sv%dv,stat=info)
if (info == psb_success_) then
call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold)

@ -91,7 +91,7 @@ subroutine amg_s_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
sv%d(i) = sone/sv%d(i)
end if
end do
if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
allocate(sv%dv,stat=info)
if (info == psb_success_) then
call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold)
@ -172,7 +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)
end if
end do
if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
allocate(sv%dv,stat=info)
if (info == psb_success_) then
call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold)

@ -100,7 +100,7 @@ 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 (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
allocate(sv%dv,stat=info)
if (info == psb_success_) then
call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold)

@ -103,7 +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)
end if
end do
if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
allocate(sv%dv,stat=info)
if (info == psb_success_) then
call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold)

@ -91,7 +91,7 @@ subroutine amg_z_diag_solver_bld(a,desc_a,sv,info,b,amold,vmold,imold)
sv%d(i) = zone/sv%d(i)
end if
end do
if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
allocate(sv%dv,stat=info)
if (info == psb_success_) then
call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold)
@ -172,7 +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)
end if
end do
if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
allocate(sv%dv,stat=info)
if (info == psb_success_) then
call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold)

@ -100,7 +100,7 @@ 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 (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
allocate(sv%dv,stat=info)
if (info == psb_success_) then
call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold)

@ -103,7 +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)
end if
end do
if (.not.allocated(sv%dv)) allocate(sv%dv,stat=info)
allocate(sv%dv,stat=info)
if (info == psb_success_) then
call sv%dv%bld(sv%d)
if (present(vmold)) call sv%dv%cnv(vmold)

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

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

Loading…
Cancel
Save