Make base_solver_free a noop, check for error in level_setsv.

stopcriterion
Salvatore Filippone 7 years ago
parent eeb5a5e00f
commit 59a75755a9

@ -105,7 +105,7 @@ subroutine mld_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
character(len=24) :: name
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
type(psb_lcspmat_type) :: lac, op_restr
type(psb_lcspmat_type) :: lac, lac1, op_restr
type(psb_cspmat_type) :: ac, iop_restr, iop_prol
type(psb_lc_coo_sparse_mat) :: acoo, bcoo
type(psb_lc_csr_sparse_mat) :: acsr1
@ -142,7 +142,7 @@ subroutine mld_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
! the mapping defined by mld_aggrmap_bld and applying the aggregation
! algorithm specified by lv%iprcparm(mld_aggr_prol_)
!
call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info)
call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,lac,op_prol,op_restr,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb')
@ -158,7 +158,7 @@ subroutine mld_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
case(mld_distr_mat_)
call ac%mv_to(bcoo)
call lac%mv_to(bcoo)
nzl = bcoo%get_nzeros()
inl = nlaggr(me+1)
if (inl < nlaggr(me+1)) then
@ -180,7 +180,8 @@ subroutine mld_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Assembld aux descr. distr.'
call lv%ac%mv_from(bcoo)
call lac%mv_from(bcoo)
call lv%ac%mv_from_l(lac)
call lv%ac%set_nrows(lv%desc_ac%get_local_rows())
call lv%ac%set_ncols(lv%desc_ac%get_local_cols())
@ -231,11 +232,12 @@ subroutine mld_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
case(mld_repl_mat_)
!
!
call psb_cdall(ictxt,lv%desc_ac,info,mg=ntaggr,repl=.true.)
if (info == psb_success_) call psb_cdasb(lv%desc_ac,info)
if (info == psb_success_) &
& call psb_gather(lv%ac,ac,lv%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
& call psb_gather(lac1,lac,lv%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
call lv%ac%mv_from_l(lac1)
if (info /= psb_success_) goto 9999
case default

@ -72,7 +72,7 @@ subroutine mld_c_base_onelev_setsv(lev,val,info,pos)
if (allocated(lev%sm%sv)) then
if (.not.same_type_as(lev%sm%sv,val)) then
call lev%sm%sv%free(info)
deallocate(lev%sm%sv,stat=info)
if (info == 0) deallocate(lev%sm%sv,stat=info)
if (info /= 0) then
info = 3111
return
@ -117,7 +117,7 @@ subroutine mld_c_base_onelev_setsv(lev,val,info,pos)
if (allocated(lev%sm2a%sv)) then
if (.not.same_type_as(lev%sm2a%sv,val)) then
call lev%sm2a%sv%free(info)
deallocate(lev%sm2a%sv,stat=info)
if (info == 0) deallocate(lev%sm2a%sv,stat=info)
if (info /= 0) then
info = 3111
return

@ -105,7 +105,7 @@ subroutine mld_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
character(len=24) :: name
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
type(psb_ldspmat_type) :: lac, op_restr
type(psb_ldspmat_type) :: lac, lac1, op_restr
type(psb_dspmat_type) :: ac, iop_restr, iop_prol
type(psb_ld_coo_sparse_mat) :: acoo, bcoo
type(psb_ld_csr_sparse_mat) :: acsr1
@ -142,7 +142,7 @@ subroutine mld_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
! the mapping defined by mld_aggrmap_bld and applying the aggregation
! algorithm specified by lv%iprcparm(mld_aggr_prol_)
!
call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info)
call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,lac,op_prol,op_restr,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb')
@ -158,7 +158,7 @@ subroutine mld_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
case(mld_distr_mat_)
call ac%mv_to(bcoo)
call lac%mv_to(bcoo)
nzl = bcoo%get_nzeros()
inl = nlaggr(me+1)
if (inl < nlaggr(me+1)) then
@ -180,7 +180,8 @@ subroutine mld_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Assembld aux descr. distr.'
call lv%ac%mv_from(bcoo)
call lac%mv_from(bcoo)
call lv%ac%mv_from_l(lac)
call lv%ac%set_nrows(lv%desc_ac%get_local_rows())
call lv%ac%set_ncols(lv%desc_ac%get_local_cols())
@ -231,11 +232,12 @@ subroutine mld_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
case(mld_repl_mat_)
!
!
call psb_cdall(ictxt,lv%desc_ac,info,mg=ntaggr,repl=.true.)
if (info == psb_success_) call psb_cdasb(lv%desc_ac,info)
if (info == psb_success_) &
& call psb_gather(lv%ac,ac,lv%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
& call psb_gather(lac1,lac,lv%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
call lv%ac%mv_from_l(lac1)
if (info /= psb_success_) goto 9999
case default

@ -72,7 +72,7 @@ subroutine mld_d_base_onelev_setsv(lev,val,info,pos)
if (allocated(lev%sm%sv)) then
if (.not.same_type_as(lev%sm%sv,val)) then
call lev%sm%sv%free(info)
deallocate(lev%sm%sv,stat=info)
if (info == 0) deallocate(lev%sm%sv,stat=info)
if (info /= 0) then
info = 3111
return
@ -117,7 +117,7 @@ subroutine mld_d_base_onelev_setsv(lev,val,info,pos)
if (allocated(lev%sm2a%sv)) then
if (.not.same_type_as(lev%sm2a%sv,val)) then
call lev%sm2a%sv%free(info)
deallocate(lev%sm2a%sv,stat=info)
if (info == 0) deallocate(lev%sm2a%sv,stat=info)
if (info /= 0) then
info = 3111
return

@ -105,7 +105,7 @@ subroutine mld_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
character(len=24) :: name
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
type(psb_lsspmat_type) :: lac, op_restr
type(psb_lsspmat_type) :: lac, lac1, op_restr
type(psb_sspmat_type) :: ac, iop_restr, iop_prol
type(psb_ls_coo_sparse_mat) :: acoo, bcoo
type(psb_ls_csr_sparse_mat) :: acsr1
@ -142,7 +142,7 @@ subroutine mld_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
! the mapping defined by mld_aggrmap_bld and applying the aggregation
! algorithm specified by lv%iprcparm(mld_aggr_prol_)
!
call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info)
call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,lac,op_prol,op_restr,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb')
@ -158,7 +158,7 @@ subroutine mld_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
case(mld_distr_mat_)
call ac%mv_to(bcoo)
call lac%mv_to(bcoo)
nzl = bcoo%get_nzeros()
inl = nlaggr(me+1)
if (inl < nlaggr(me+1)) then
@ -180,7 +180,8 @@ subroutine mld_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Assembld aux descr. distr.'
call lv%ac%mv_from(bcoo)
call lac%mv_from(bcoo)
call lv%ac%mv_from_l(lac)
call lv%ac%set_nrows(lv%desc_ac%get_local_rows())
call lv%ac%set_ncols(lv%desc_ac%get_local_cols())
@ -231,11 +232,12 @@ subroutine mld_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
case(mld_repl_mat_)
!
!
call psb_cdall(ictxt,lv%desc_ac,info,mg=ntaggr,repl=.true.)
if (info == psb_success_) call psb_cdasb(lv%desc_ac,info)
if (info == psb_success_) &
& call psb_gather(lv%ac,ac,lv%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
& call psb_gather(lac1,lac,lv%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
call lv%ac%mv_from_l(lac1)
if (info /= psb_success_) goto 9999
case default

@ -72,7 +72,7 @@ subroutine mld_s_base_onelev_setsv(lev,val,info,pos)
if (allocated(lev%sm%sv)) then
if (.not.same_type_as(lev%sm%sv,val)) then
call lev%sm%sv%free(info)
deallocate(lev%sm%sv,stat=info)
if (info == 0) deallocate(lev%sm%sv,stat=info)
if (info /= 0) then
info = 3111
return
@ -117,7 +117,7 @@ subroutine mld_s_base_onelev_setsv(lev,val,info,pos)
if (allocated(lev%sm2a%sv)) then
if (.not.same_type_as(lev%sm2a%sv,val)) then
call lev%sm2a%sv%free(info)
deallocate(lev%sm2a%sv,stat=info)
if (info == 0) deallocate(lev%sm2a%sv,stat=info)
if (info /= 0) then
info = 3111
return

@ -105,7 +105,7 @@ subroutine mld_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
character(len=24) :: name
integer(psb_mpk_) :: ictxt, np, me
integer(psb_ipk_) :: err_act
type(psb_lzspmat_type) :: lac, op_restr
type(psb_lzspmat_type) :: lac, lac1, op_restr
type(psb_zspmat_type) :: ac, iop_restr, iop_prol
type(psb_lz_coo_sparse_mat) :: acoo, bcoo
type(psb_lz_csr_sparse_mat) :: acsr1
@ -142,7 +142,7 @@ subroutine mld_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
! the mapping defined by mld_aggrmap_bld and applying the aggregation
! algorithm specified by lv%iprcparm(mld_aggr_prol_)
!
call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,ac,op_prol,op_restr,info)
call lv%aggr%mat_asb(lv%parms,a,desc_a,ilaggr,nlaggr,lac,op_prol,op_restr,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb')
@ -158,7 +158,7 @@ subroutine mld_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
case(mld_distr_mat_)
call ac%mv_to(bcoo)
call lac%mv_to(bcoo)
nzl = bcoo%get_nzeros()
inl = nlaggr(me+1)
if (inl < nlaggr(me+1)) then
@ -180,7 +180,8 @@ subroutine mld_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),&
& 'Assembld aux descr. distr.'
call lv%ac%mv_from(bcoo)
call lac%mv_from(bcoo)
call lv%ac%mv_from_l(lac)
call lv%ac%set_nrows(lv%desc_ac%get_local_rows())
call lv%ac%set_ncols(lv%desc_ac%get_local_cols())
@ -231,11 +232,12 @@ subroutine mld_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
case(mld_repl_mat_)
!
!
call psb_cdall(ictxt,lv%desc_ac,info,mg=ntaggr,repl=.true.)
if (info == psb_success_) call psb_cdasb(lv%desc_ac,info)
if (info == psb_success_) &
& call psb_gather(lv%ac,ac,lv%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
& call psb_gather(lac1,lac,lv%desc_ac,info,dupl=psb_dupl_add_,keeploc=.false.)
call lv%ac%mv_from_l(lac1)
if (info /= psb_success_) goto 9999
case default

@ -72,7 +72,7 @@ subroutine mld_z_base_onelev_setsv(lev,val,info,pos)
if (allocated(lev%sm%sv)) then
if (.not.same_type_as(lev%sm%sv,val)) then
call lev%sm%sv%free(info)
deallocate(lev%sm%sv,stat=info)
if (info == 0) deallocate(lev%sm%sv,stat=info)
if (info /= 0) then
info = 3111
return
@ -117,7 +117,7 @@ subroutine mld_z_base_onelev_setsv(lev,val,info,pos)
if (allocated(lev%sm2a%sv)) then
if (.not.same_type_as(lev%sm2a%sv,val)) then
call lev%sm2a%sv%free(info)
deallocate(lev%sm2a%sv,stat=info)
if (info == 0) deallocate(lev%sm2a%sv,stat=info)
if (info /= 0) then
info = 3111
return

@ -48,9 +48,8 @@ subroutine mld_c_base_solver_free(sv,info)
call psb_erractionsave(err_act)
info = psb_err_missing_override_method_
call psb_errpush(info,name)
goto 9999
! Do nothing
info = psb_success_
call psb_erractionrestore(err_act)
return

@ -48,9 +48,8 @@ subroutine mld_d_base_solver_free(sv,info)
call psb_erractionsave(err_act)
info = psb_err_missing_override_method_
call psb_errpush(info,name)
goto 9999
! Do nothing
info = psb_success_
call psb_erractionrestore(err_act)
return

@ -48,9 +48,8 @@ subroutine mld_s_base_solver_free(sv,info)
call psb_erractionsave(err_act)
info = psb_err_missing_override_method_
call psb_errpush(info,name)
goto 9999
! Do nothing
info = psb_success_
call psb_erractionrestore(err_act)
return

@ -48,9 +48,8 @@ subroutine mld_z_base_solver_free(sv,info)
call psb_erractionsave(err_act)
info = psb_err_missing_override_method_
call psb_errpush(info,name)
goto 9999
! Do nothing
info = psb_success_
call psb_erractionrestore(err_act)
return

@ -224,8 +224,8 @@ contains
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lcspmat_type), intent(inout) :: op_prol
type(psb_cspmat_type), intent(out) :: ac,op_restr
type(psb_lcspmat_type), intent(inout) :: op_prol
type(psb_lcspmat_type), intent(out) :: ac,op_restr
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='c_base_aggregator_mat_asb'

@ -142,8 +142,8 @@ module mld_c_dec_aggregator_mod
type(psb_cspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lcspmat_type), intent(inout) :: op_prol
type(psb_cspmat_type), intent(out) :: ac,op_restr
type(psb_lcspmat_type), intent(inout) :: op_prol
type(psb_lcspmat_type), intent(out) :: ac,op_restr
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_dec_aggregator_mat_asb
end interface

@ -57,6 +57,7 @@ module mld_c_prec_type
use mld_c_base_smoother_mod
use mld_c_base_aggregator_mod
use mld_c_onelev_mod
use psb_base_mod, only : psb_erractionsave, psb_erractionrestore, psb_errstatus_fatal
use psb_prec_mod, only : psb_cprec_type
!
@ -538,7 +539,7 @@ contains
name = 'mld_cprecfree'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
info = psb_err_internal_error_; return
end if
me=-1

@ -224,8 +224,8 @@ contains
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_ldspmat_type), intent(inout) :: op_prol
type(psb_dspmat_type), intent(out) :: ac,op_restr
type(psb_ldspmat_type), intent(inout) :: op_prol
type(psb_ldspmat_type), intent(out) :: ac,op_restr
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_aggregator_mat_asb'

@ -142,8 +142,8 @@ module mld_d_dec_aggregator_mod
type(psb_dspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_ldspmat_type), intent(inout) :: op_prol
type(psb_dspmat_type), intent(out) :: ac,op_restr
type(psb_ldspmat_type), intent(inout) :: op_prol
type(psb_ldspmat_type), intent(out) :: ac,op_restr
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_dec_aggregator_mat_asb
end interface

@ -57,6 +57,7 @@ module mld_d_prec_type
use mld_d_base_smoother_mod
use mld_d_base_aggregator_mod
use mld_d_onelev_mod
use psb_base_mod, only : psb_erractionsave, psb_erractionrestore, psb_errstatus_fatal
use psb_prec_mod, only : psb_dprec_type
!
@ -538,7 +539,7 @@ contains
name = 'mld_dprecfree'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
info = psb_err_internal_error_; return
end if
me=-1

@ -224,8 +224,8 @@ contains
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lsspmat_type), intent(inout) :: op_prol
type(psb_sspmat_type), intent(out) :: ac,op_restr
type(psb_lsspmat_type), intent(inout) :: op_prol
type(psb_lsspmat_type), intent(out) :: ac,op_restr
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='s_base_aggregator_mat_asb'

@ -142,8 +142,8 @@ module mld_s_dec_aggregator_mod
type(psb_sspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lsspmat_type), intent(inout) :: op_prol
type(psb_sspmat_type), intent(out) :: ac,op_restr
type(psb_lsspmat_type), intent(inout) :: op_prol
type(psb_lsspmat_type), intent(out) :: ac,op_restr
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_dec_aggregator_mat_asb
end interface

@ -57,6 +57,7 @@ module mld_s_prec_type
use mld_s_base_smoother_mod
use mld_s_base_aggregator_mod
use mld_s_onelev_mod
use psb_base_mod, only : psb_erractionsave, psb_erractionrestore, psb_errstatus_fatal
use psb_prec_mod, only : psb_sprec_type
!
@ -538,7 +539,7 @@ contains
name = 'mld_sprecfree'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
info = psb_err_internal_error_; return
end if
me=-1

@ -224,8 +224,8 @@ contains
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lzspmat_type), intent(inout) :: op_prol
type(psb_zspmat_type), intent(out) :: ac,op_restr
type(psb_lzspmat_type), intent(inout) :: op_prol
type(psb_lzspmat_type), intent(out) :: ac,op_restr
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='z_base_aggregator_mat_asb'

@ -142,8 +142,8 @@ module mld_z_dec_aggregator_mod
type(psb_zspmat_type), intent(in) :: a
type(psb_desc_type), intent(in) :: desc_a
integer(psb_lpk_), intent(inout) :: ilaggr(:), nlaggr(:)
type(psb_lzspmat_type), intent(inout) :: op_prol
type(psb_zspmat_type), intent(out) :: ac,op_restr
type(psb_lzspmat_type), intent(inout) :: op_prol
type(psb_lzspmat_type), intent(out) :: ac,op_restr
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_dec_aggregator_mat_asb
end interface

@ -57,6 +57,7 @@ module mld_z_prec_type
use mld_z_base_smoother_mod
use mld_z_base_aggregator_mod
use mld_z_onelev_mod
use psb_base_mod, only : psb_erractionsave, psb_erractionrestore, psb_errstatus_fatal
use psb_prec_mod, only : psb_zprec_type
!
@ -538,7 +539,7 @@ contains
name = 'mld_zprecfree'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
info = psb_err_internal_error_; return
end if
me=-1

Loading…
Cancel
Save