Fix use of errstatus.

stopcriterion
Salvatore Filippone 7 years ago
parent cc144c0d51
commit eeb5a5e00f

@ -155,8 +155,10 @@ subroutine mld_c_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_p
integer(psb_ipk_) :: debug_level, debug_unit
name='mld_c_dec_aggregator_mat_asb'
if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_

@ -93,8 +93,10 @@ subroutine mld_c_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_
integer(psb_ipk_) :: debug_level, debug_unit
name='mld_c_dec_aggregator_tprol'
if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_

@ -106,10 +106,12 @@ subroutine mld_c_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
integer(psb_lpk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err
if(psb_get_errstatus() /= 0) return
info=psb_success_
name = 'mld_map_to_tprol'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
!

@ -96,10 +96,12 @@ subroutine mld_c_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
integer(psb_ipk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
name = 'mld_soc1_map_bld'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
!

@ -96,10 +96,12 @@ subroutine mld_c_soc2_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
integer(psb_ipk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
name = 'mld_soc2_map_bld'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
!

@ -98,8 +98,10 @@ subroutine mld_c_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
integer(psb_ipk_) :: debug_level, debug_unit
name='mld_c_symdec_aggregator_tprol'
if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_

@ -112,9 +112,11 @@ subroutine mld_caggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
real(psb_spk_) :: anorm, omega, tmp, dg, theta
name='mld_aggrmat_biz_asb'
if(psb_get_errstatus().ne.0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -146,9 +146,11 @@ subroutine mld_caggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
complex(psb_spk_) :: tmp, alpha, beta, ommx
name='mld_aggrmat_minnrg'
if(psb_get_errstatus().ne.0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -124,10 +124,11 @@ subroutine mld_caggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
& naggr, nzt, naggrm1, naggrp1, i, k
name='mld_aggrmat_nosmth_asb'
if(psb_get_errstatus().ne.0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()

@ -155,8 +155,10 @@ subroutine mld_d_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_p
integer(psb_ipk_) :: debug_level, debug_unit
name='mld_d_dec_aggregator_mat_asb'
if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_

@ -93,8 +93,10 @@ subroutine mld_d_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_
integer(psb_ipk_) :: debug_level, debug_unit
name='mld_d_dec_aggregator_tprol'
if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_

@ -106,10 +106,12 @@ subroutine mld_d_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
integer(psb_lpk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err
if(psb_get_errstatus() /= 0) return
info=psb_success_
name = 'mld_map_to_tprol'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
!

@ -96,10 +96,12 @@ subroutine mld_d_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
integer(psb_ipk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
name = 'mld_soc1_map_bld'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
!

@ -96,10 +96,12 @@ subroutine mld_d_soc2_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
integer(psb_ipk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
name = 'mld_soc2_map_bld'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
!

@ -98,8 +98,10 @@ subroutine mld_d_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
integer(psb_ipk_) :: debug_level, debug_unit
name='mld_d_symdec_aggregator_tprol'
if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_

@ -112,9 +112,11 @@ subroutine mld_daggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
real(psb_dpk_) :: anorm, omega, tmp, dg, theta
name='mld_aggrmat_biz_asb'
if(psb_get_errstatus().ne.0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -146,9 +146,11 @@ subroutine mld_daggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
real(psb_dpk_) :: tmp, alpha, beta, ommx
name='mld_aggrmat_minnrg'
if(psb_get_errstatus().ne.0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -124,10 +124,11 @@ subroutine mld_daggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
& naggr, nzt, naggrm1, naggrp1, i, k
name='mld_aggrmat_nosmth_asb'
if(psb_get_errstatus().ne.0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()

@ -155,8 +155,10 @@ subroutine mld_s_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_p
integer(psb_ipk_) :: debug_level, debug_unit
name='mld_s_dec_aggregator_mat_asb'
if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_

@ -93,8 +93,10 @@ subroutine mld_s_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_
integer(psb_ipk_) :: debug_level, debug_unit
name='mld_s_dec_aggregator_tprol'
if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_

@ -106,10 +106,12 @@ subroutine mld_s_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
integer(psb_lpk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err
if(psb_get_errstatus() /= 0) return
info=psb_success_
name = 'mld_map_to_tprol'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
!

@ -96,10 +96,12 @@ subroutine mld_s_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
integer(psb_ipk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
name = 'mld_soc1_map_bld'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
!

@ -96,10 +96,12 @@ subroutine mld_s_soc2_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
integer(psb_ipk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
name = 'mld_soc2_map_bld'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
!

@ -98,8 +98,10 @@ subroutine mld_s_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
integer(psb_ipk_) :: debug_level, debug_unit
name='mld_s_symdec_aggregator_tprol'
if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_

@ -112,9 +112,11 @@ subroutine mld_saggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
real(psb_spk_) :: anorm, omega, tmp, dg, theta
name='mld_aggrmat_biz_asb'
if(psb_get_errstatus().ne.0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -146,9 +146,11 @@ subroutine mld_saggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
real(psb_spk_) :: tmp, alpha, beta, ommx
name='mld_aggrmat_minnrg'
if(psb_get_errstatus().ne.0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -124,10 +124,11 @@ subroutine mld_saggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
& naggr, nzt, naggrm1, naggrp1, i, k
name='mld_aggrmat_nosmth_asb'
if(psb_get_errstatus().ne.0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()

@ -155,8 +155,10 @@ subroutine mld_z_dec_aggregator_mat_asb(ag,parms,a,desc_a,ilaggr,nlaggr,ac,op_p
integer(psb_ipk_) :: debug_level, debug_unit
name='mld_z_dec_aggregator_mat_asb'
if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_

@ -93,8 +93,10 @@ subroutine mld_z_dec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,op_
integer(psb_ipk_) :: debug_level, debug_unit
name='mld_z_dec_aggregator_tprol'
if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_

@ -106,10 +106,12 @@ subroutine mld_z_map_to_tprol(desc_a,ilaggr,nlaggr,op_prol,info)
integer(psb_lpk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err
if(psb_get_errstatus() /= 0) return
info=psb_success_
name = 'mld_map_to_tprol'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
!

@ -96,10 +96,12 @@ subroutine mld_z_soc1_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
integer(psb_ipk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
name = 'mld_soc1_map_bld'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
!

@ -96,10 +96,12 @@ subroutine mld_z_soc2_map_bld(iorder,theta,a,desc_a,nlaggr,ilaggr,info)
integer(psb_ipk_) :: nrow, ncol, n_ne
character(len=20) :: name, ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
name = 'mld_soc2_map_bld'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
!

@ -98,8 +98,10 @@ subroutine mld_z_symdec_aggregator_build_tprol(ag,parms,a,desc_a,ilaggr,nlaggr,
integer(psb_ipk_) :: debug_level, debug_unit
name='mld_z_symdec_aggregator_tprol'
if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_

@ -112,9 +112,11 @@ subroutine mld_zaggrmat_biz_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_restr
real(psb_dpk_) :: anorm, omega, tmp, dg, theta
name='mld_aggrmat_biz_asb'
if(psb_get_errstatus().ne.0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -146,9 +146,11 @@ subroutine mld_zaggrmat_minnrg_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
complex(psb_dpk_) :: tmp, alpha, beta, ommx
name='mld_aggrmat_minnrg'
if(psb_get_errstatus().ne.0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -124,10 +124,11 @@ subroutine mld_zaggrmat_nosmth_asb(a,desc_a,ilaggr,nlaggr,parms,ac,op_prol,op_re
& naggr, nzt, naggrm1, naggrp1, i, k
name='mld_aggrmat_nosmth_asb'
if(psb_get_errstatus().ne.0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
ictxt = desc_a%get_context()
icomm = desc_a%get_mpic()

@ -53,10 +53,12 @@ subroutine mld_c_base_onelev_build(lv,info,amold,vmold,imold)
character(len=20) :: name, ch_err
name = 'mld_onelev_build'
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
if (.not.associated(lv%base_desc)) then

@ -114,8 +114,10 @@ subroutine mld_c_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
integer(psb_ipk_) :: debug_level, debug_unit
name='mld_c_onelev_mat_asb'
if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_
@ -140,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,ac,op_prol,op_restr,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb')

@ -53,10 +53,12 @@ subroutine mld_d_base_onelev_build(lv,info,amold,vmold,imold)
character(len=20) :: name, ch_err
name = 'mld_onelev_build'
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
if (.not.associated(lv%base_desc)) then

@ -114,8 +114,10 @@ subroutine mld_d_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
integer(psb_ipk_) :: debug_level, debug_unit
name='mld_d_onelev_mat_asb'
if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_
@ -140,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,ac,op_prol,op_restr,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb')

@ -53,10 +53,12 @@ subroutine mld_s_base_onelev_build(lv,info,amold,vmold,imold)
character(len=20) :: name, ch_err
name = 'mld_onelev_build'
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
if (.not.associated(lv%base_desc)) then

@ -114,8 +114,10 @@ subroutine mld_s_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
integer(psb_ipk_) :: debug_level, debug_unit
name='mld_s_onelev_mat_asb'
if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_
@ -140,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,ac,op_prol,op_restr,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb')

@ -53,10 +53,12 @@ subroutine mld_z_base_onelev_build(lv,info,amold,vmold,imold)
character(len=20) :: name, ch_err
name = 'mld_onelev_build'
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
if (.not.associated(lv%base_desc)) then

@ -114,8 +114,10 @@ subroutine mld_z_base_onelev_mat_asb(lv,a,desc_a,ilaggr,nlaggr,op_prol,info)
integer(psb_ipk_) :: debug_level, debug_unit
name='mld_z_onelev_mat_asb'
if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_
@ -140,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,ac,op_prol,op_restr,info)
if(info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb')

@ -108,10 +108,12 @@ subroutine mld_c_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
character(len=20) :: name, ch_err
logical, parameter :: debug=.false.
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
@ -362,8 +364,10 @@ contains
logical, parameter :: debug=.false.
name='mld_c_extaggr_bld'
if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)

@ -93,10 +93,12 @@ subroutine mld_c_hierarchy_bld(a,desc_a,prec,info)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -104,10 +104,12 @@ subroutine mld_c_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -102,10 +102,12 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -415,7 +415,7 @@ subroutine mld_cprecaply2_vect(prec,x,y,desc_data,info,trans,work)
& nswps,work_,wv,info)
end if
end associate
if (psb_get_errstatus() /=0) info = psb_err_internal_error_
if (psb_errstatus_fatal()) info = psb_err_internal_error_
if (info /= 0) then
info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Smoother application',&
@ -561,7 +561,7 @@ subroutine mld_cprecaply1_vect(prec,x,desc_data,info,trans,work)
if (info == 0) call psb_geaxpby(cone,ww,czero,x,desc_data,info)
end if
if (psb_get_errstatus() /=0) info = psb_err_internal_error_
if (psb_errstatus_fatal()) info = psb_err_internal_error_
if (info /=0) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='Smoother application',&

@ -83,10 +83,12 @@ subroutine mld_cprecbld(a,desc_a,prec,info,amold,vmold,imold)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -108,10 +108,12 @@ subroutine mld_d_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
character(len=20) :: name, ch_err
logical, parameter :: debug=.false.
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
@ -362,8 +364,10 @@ contains
logical, parameter :: debug=.false.
name='mld_d_extaggr_bld'
if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)

@ -93,10 +93,12 @@ subroutine mld_d_hierarchy_bld(a,desc_a,prec,info)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -104,10 +104,12 @@ subroutine mld_d_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -102,10 +102,12 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -415,7 +415,7 @@ subroutine mld_dprecaply2_vect(prec,x,y,desc_data,info,trans,work)
& nswps,work_,wv,info)
end if
end associate
if (psb_get_errstatus() /=0) info = psb_err_internal_error_
if (psb_errstatus_fatal()) info = psb_err_internal_error_
if (info /= 0) then
info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Smoother application',&
@ -561,7 +561,7 @@ subroutine mld_dprecaply1_vect(prec,x,desc_data,info,trans,work)
if (info == 0) call psb_geaxpby(done,ww,dzero,x,desc_data,info)
end if
if (psb_get_errstatus() /=0) info = psb_err_internal_error_
if (psb_errstatus_fatal()) info = psb_err_internal_error_
if (info /=0) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='Smoother application',&

@ -83,10 +83,12 @@ subroutine mld_dprecbld(a,desc_a,prec,info,amold,vmold,imold)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -108,10 +108,12 @@ subroutine mld_s_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
character(len=20) :: name, ch_err
logical, parameter :: debug=.false.
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
@ -362,8 +364,10 @@ contains
logical, parameter :: debug=.false.
name='mld_s_extaggr_bld'
if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)

@ -93,10 +93,12 @@ subroutine mld_s_hierarchy_bld(a,desc_a,prec,info)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -104,10 +104,12 @@ subroutine mld_s_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -102,10 +102,12 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -415,7 +415,7 @@ subroutine mld_sprecaply2_vect(prec,x,y,desc_data,info,trans,work)
& nswps,work_,wv,info)
end if
end associate
if (psb_get_errstatus() /=0) info = psb_err_internal_error_
if (psb_errstatus_fatal()) info = psb_err_internal_error_
if (info /= 0) then
info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Smoother application',&
@ -561,7 +561,7 @@ subroutine mld_sprecaply1_vect(prec,x,desc_data,info,trans,work)
if (info == 0) call psb_geaxpby(sone,ww,szero,x,desc_data,info)
end if
if (psb_get_errstatus() /=0) info = psb_err_internal_error_
if (psb_errstatus_fatal()) info = psb_err_internal_error_
if (info /=0) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='Smoother application',&

@ -83,10 +83,12 @@ subroutine mld_sprecbld(a,desc_a,prec,info,amold,vmold,imold)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -108,10 +108,12 @@ subroutine mld_z_extprol_bld(a,desc_a,p,prolv,restrv,info,amold,vmold,imold)
character(len=20) :: name, ch_err
logical, parameter :: debug=.false.
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
@ -362,8 +364,10 @@ contains
logical, parameter :: debug=.false.
name='mld_z_extaggr_bld'
if (psb_get_errstatus().ne.0) return
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
info = psb_success_
ictxt = desc_a%get_context()
call psb_info(ictxt,me,np)

@ -93,10 +93,12 @@ subroutine mld_z_hierarchy_bld(a,desc_a,prec,info)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -104,10 +104,12 @@ subroutine mld_z_smoothers_bld(a,desc_a,prec,info,amold,vmold,imold)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -102,10 +102,12 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -415,7 +415,7 @@ subroutine mld_zprecaply2_vect(prec,x,y,desc_data,info,trans,work)
& nswps,work_,wv,info)
end if
end associate
if (psb_get_errstatus() /=0) info = psb_err_internal_error_
if (psb_errstatus_fatal()) info = psb_err_internal_error_
if (info /= 0) then
info = psb_err_from_subroutine_ai_
call psb_errpush(info,name,a_err='Smoother application',&
@ -561,7 +561,7 @@ subroutine mld_zprecaply1_vect(prec,x,desc_data,info,trans,work)
if (info == 0) call psb_geaxpby(zone,ww,zzero,x,desc_data,info)
end if
if (psb_get_errstatus() /=0) info = psb_err_internal_error_
if (psb_errstatus_fatal()) info = psb_err_internal_error_
if (info /=0) then
info = psb_err_internal_error_
call psb_errpush(info,name,a_err='Smoother application',&

@ -83,10 +83,12 @@ subroutine mld_zprecbld(a,desc_a,prec,info,amold,vmold,imold)
integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err
if (psb_get_errstatus().ne.0) return
info=psb_success_
err=0
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()

@ -304,9 +304,11 @@ contains
character(len=20) :: name, ch_err
name='mld_cilu0_factint'
if(psb_get_errstatus().ne.0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
ma = a%get_nrows()
mb = b%get_nrows()
@ -569,9 +571,11 @@ contains
character(len=20), parameter :: name='ilu_copyin'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
if (psb_toupper(upd) == 'F') then
select type(aa => a%a)

@ -289,9 +289,11 @@ contains
character(len=20), parameter :: name='mld_ciluk_factint'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
select case(ialg)
@ -503,9 +505,11 @@ contains
character(len=20), parameter :: name='iluk_copyin'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
call heap%init(info)
select type (aa=> a%a)
@ -829,9 +833,11 @@ contains
character(len=20), parameter :: name='mld_ciluk_factint'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
d(i) = czero

@ -311,9 +311,11 @@ contains
character(len=20), parameter :: name='mld_cilut_factint'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
ma = a%get_nrows()
@ -524,9 +526,11 @@ contains
real(psb_spk_), external :: dnrm2
character(len=20), parameter :: name='mld_cilut_factint'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
call heap%init(info)
if (info /= psb_success_) then
@ -907,9 +911,11 @@ contains
character(len=20) :: ch_err
logical :: fndmaxup
if (psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
!
! Here we need to apply also the dropping rule base on the fill-in.

@ -304,9 +304,11 @@ contains
character(len=20) :: name, ch_err
name='mld_dilu0_factint'
if(psb_get_errstatus().ne.0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
ma = a%get_nrows()
mb = b%get_nrows()
@ -569,9 +571,11 @@ contains
character(len=20), parameter :: name='ilu_copyin'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
if (psb_toupper(upd) == 'F') then
select type(aa => a%a)

@ -289,9 +289,11 @@ contains
character(len=20), parameter :: name='mld_diluk_factint'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
select case(ialg)
@ -503,9 +505,11 @@ contains
character(len=20), parameter :: name='iluk_copyin'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
call heap%init(info)
select type (aa=> a%a)
@ -829,9 +833,11 @@ contains
character(len=20), parameter :: name='mld_diluk_factint'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
d(i) = dzero

@ -311,9 +311,11 @@ contains
character(len=20), parameter :: name='mld_dilut_factint'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
ma = a%get_nrows()
@ -524,9 +526,11 @@ contains
real(psb_dpk_), external :: dnrm2
character(len=20), parameter :: name='mld_dilut_factint'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
call heap%init(info)
if (info /= psb_success_) then
@ -907,9 +911,11 @@ contains
character(len=20) :: ch_err
logical :: fndmaxup
if (psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
!
! Here we need to apply also the dropping rule base on the fill-in.

@ -304,9 +304,11 @@ contains
character(len=20) :: name, ch_err
name='mld_silu0_factint'
if(psb_get_errstatus().ne.0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
ma = a%get_nrows()
mb = b%get_nrows()
@ -569,9 +571,11 @@ contains
character(len=20), parameter :: name='ilu_copyin'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
if (psb_toupper(upd) == 'F') then
select type(aa => a%a)

@ -289,9 +289,11 @@ contains
character(len=20), parameter :: name='mld_siluk_factint'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
select case(ialg)
@ -503,9 +505,11 @@ contains
character(len=20), parameter :: name='iluk_copyin'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
call heap%init(info)
select type (aa=> a%a)
@ -829,9 +833,11 @@ contains
character(len=20), parameter :: name='mld_siluk_factint'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
d(i) = szero

@ -311,9 +311,11 @@ contains
character(len=20), parameter :: name='mld_silut_factint'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
ma = a%get_nrows()
@ -524,9 +526,11 @@ contains
real(psb_spk_), external :: dnrm2
character(len=20), parameter :: name='mld_silut_factint'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
call heap%init(info)
if (info /= psb_success_) then
@ -907,9 +911,11 @@ contains
character(len=20) :: ch_err
logical :: fndmaxup
if (psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
!
! Here we need to apply also the dropping rule base on the fill-in.

@ -304,9 +304,11 @@ contains
character(len=20) :: name, ch_err
name='mld_zilu0_factint'
if(psb_get_errstatus().ne.0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
ma = a%get_nrows()
mb = b%get_nrows()
@ -569,9 +571,11 @@ contains
character(len=20), parameter :: name='ilu_copyin'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
if (psb_toupper(upd) == 'F') then
select type(aa => a%a)

@ -289,9 +289,11 @@ contains
character(len=20), parameter :: name='mld_ziluk_factint'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
select case(ialg)
@ -503,9 +505,11 @@ contains
character(len=20), parameter :: name='iluk_copyin'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
call heap%init(info)
select type (aa=> a%a)
@ -829,9 +833,11 @@ contains
character(len=20), parameter :: name='mld_ziluk_factint'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
d(i) = zzero

@ -311,9 +311,11 @@ contains
character(len=20), parameter :: name='mld_zilut_factint'
character(len=20) :: ch_err
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
ma = a%get_nrows()
@ -524,9 +526,11 @@ contains
real(psb_dpk_), external :: dnrm2
character(len=20), parameter :: name='mld_zilut_factint'
if (psb_get_errstatus() /= 0) return
info = psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
call heap%init(info)
if (info /= psb_success_) then
@ -907,9 +911,11 @@ contains
character(len=20) :: ch_err
logical :: fndmaxup
if (psb_get_errstatus() /= 0) return
info=psb_success_
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
!
! Here we need to apply also the dropping rule base on the fill-in.

@ -534,10 +534,12 @@ contains
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=psb_success_
name = 'mld_cprecfree'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
me=-1
@ -560,10 +562,12 @@ contains
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=psb_success_
name = 'mld_cprecfree'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
me=-1
call prec%free_wrk(info)
@ -848,10 +852,12 @@ contains
integer(psb_ipk_) :: me,err_act,i,j,level,nlev, nc2l
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=psb_success_
name = 'mld_c_allocate_wrk'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
nlev = size(prec%precv)
level = 1
do level = 1, nlev
@ -887,10 +893,12 @@ contains
integer(psb_ipk_) :: me,err_act,i,j,level, nlev, nc2l
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=psb_success_
name = 'mld_c_free_wrk'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
nlev = size(prec%precv)
do level = 1, nlev

@ -534,10 +534,12 @@ contains
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=psb_success_
name = 'mld_dprecfree'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
me=-1
@ -560,10 +562,12 @@ contains
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=psb_success_
name = 'mld_dprecfree'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
me=-1
call prec%free_wrk(info)
@ -848,10 +852,12 @@ contains
integer(psb_ipk_) :: me,err_act,i,j,level,nlev, nc2l
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=psb_success_
name = 'mld_d_allocate_wrk'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
nlev = size(prec%precv)
level = 1
do level = 1, nlev
@ -887,10 +893,12 @@ contains
integer(psb_ipk_) :: me,err_act,i,j,level, nlev, nc2l
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=psb_success_
name = 'mld_d_free_wrk'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
nlev = size(prec%precv)
do level = 1, nlev

@ -534,10 +534,12 @@ contains
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=psb_success_
name = 'mld_sprecfree'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
me=-1
@ -560,10 +562,12 @@ contains
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=psb_success_
name = 'mld_sprecfree'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
me=-1
call prec%free_wrk(info)
@ -848,10 +852,12 @@ contains
integer(psb_ipk_) :: me,err_act,i,j,level,nlev, nc2l
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=psb_success_
name = 'mld_s_allocate_wrk'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
nlev = size(prec%precv)
level = 1
do level = 1, nlev
@ -887,10 +893,12 @@ contains
integer(psb_ipk_) :: me,err_act,i,j,level, nlev, nc2l
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=psb_success_
name = 'mld_s_free_wrk'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
nlev = size(prec%precv)
do level = 1, nlev

@ -534,10 +534,12 @@ contains
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=psb_success_
name = 'mld_zprecfree'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
me=-1
@ -560,10 +562,12 @@ contains
integer(psb_ipk_) :: me,err_act,i
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=psb_success_
name = 'mld_zprecfree'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
me=-1
call prec%free_wrk(info)
@ -848,10 +852,12 @@ contains
integer(psb_ipk_) :: me,err_act,i,j,level,nlev, nc2l
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=psb_success_
name = 'mld_z_allocate_wrk'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
nlev = size(prec%precv)
level = 1
do level = 1, nlev
@ -887,10 +893,12 @@ contains
integer(psb_ipk_) :: me,err_act,i,j,level, nlev, nc2l
character(len=20) :: name
if(psb_get_errstatus().ne.0) return
info=psb_success_
name = 'mld_z_free_wrk'
call psb_erractionsave(err_act)
if (psb_errstatus_fatal()) then
info = psb_err_internal_error_; goto 9999
end if
nlev = size(prec%precv)
do level = 1, nlev

Loading…
Cancel
Save