diff --git a/mlprec/impl/level/mld_c_base_onelev_mat_asb.f90 b/mlprec/impl/level/mld_c_base_onelev_mat_asb.f90 index b96bba43..07b717a8 100644 --- a/mlprec/impl/level/mld_c_base_onelev_mat_asb.f90 +++ b/mlprec/impl/level/mld_c_base_onelev_mat_asb.f90 @@ -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 diff --git a/mlprec/impl/level/mld_c_base_onelev_setsv.F90 b/mlprec/impl/level/mld_c_base_onelev_setsv.F90 index 16530915..f73c7348 100644 --- a/mlprec/impl/level/mld_c_base_onelev_setsv.F90 +++ b/mlprec/impl/level/mld_c_base_onelev_setsv.F90 @@ -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 diff --git a/mlprec/impl/level/mld_d_base_onelev_mat_asb.f90 b/mlprec/impl/level/mld_d_base_onelev_mat_asb.f90 index 60359196..98e630e8 100644 --- a/mlprec/impl/level/mld_d_base_onelev_mat_asb.f90 +++ b/mlprec/impl/level/mld_d_base_onelev_mat_asb.f90 @@ -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 diff --git a/mlprec/impl/level/mld_d_base_onelev_setsv.F90 b/mlprec/impl/level/mld_d_base_onelev_setsv.F90 index 65f219ca..a00813c7 100644 --- a/mlprec/impl/level/mld_d_base_onelev_setsv.F90 +++ b/mlprec/impl/level/mld_d_base_onelev_setsv.F90 @@ -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 diff --git a/mlprec/impl/level/mld_s_base_onelev_mat_asb.f90 b/mlprec/impl/level/mld_s_base_onelev_mat_asb.f90 index 95c745ca..32e0f377 100644 --- a/mlprec/impl/level/mld_s_base_onelev_mat_asb.f90 +++ b/mlprec/impl/level/mld_s_base_onelev_mat_asb.f90 @@ -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 diff --git a/mlprec/impl/level/mld_s_base_onelev_setsv.F90 b/mlprec/impl/level/mld_s_base_onelev_setsv.F90 index cbc4cacf..ac1c05d9 100644 --- a/mlprec/impl/level/mld_s_base_onelev_setsv.F90 +++ b/mlprec/impl/level/mld_s_base_onelev_setsv.F90 @@ -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 diff --git a/mlprec/impl/level/mld_z_base_onelev_mat_asb.f90 b/mlprec/impl/level/mld_z_base_onelev_mat_asb.f90 index 60567b41..cb540e34 100644 --- a/mlprec/impl/level/mld_z_base_onelev_mat_asb.f90 +++ b/mlprec/impl/level/mld_z_base_onelev_mat_asb.f90 @@ -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 diff --git a/mlprec/impl/level/mld_z_base_onelev_setsv.F90 b/mlprec/impl/level/mld_z_base_onelev_setsv.F90 index 30c68af4..9481b8f2 100644 --- a/mlprec/impl/level/mld_z_base_onelev_setsv.F90 +++ b/mlprec/impl/level/mld_z_base_onelev_setsv.F90 @@ -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 diff --git a/mlprec/impl/solver/mld_c_base_solver_free.f90 b/mlprec/impl/solver/mld_c_base_solver_free.f90 index 27577351..002e5b2a 100644 --- a/mlprec/impl/solver/mld_c_base_solver_free.f90 +++ b/mlprec/impl/solver/mld_c_base_solver_free.f90 @@ -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 diff --git a/mlprec/impl/solver/mld_d_base_solver_free.f90 b/mlprec/impl/solver/mld_d_base_solver_free.f90 index 386cbc30..cbc271fd 100644 --- a/mlprec/impl/solver/mld_d_base_solver_free.f90 +++ b/mlprec/impl/solver/mld_d_base_solver_free.f90 @@ -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 diff --git a/mlprec/impl/solver/mld_s_base_solver_free.f90 b/mlprec/impl/solver/mld_s_base_solver_free.f90 index 7ba4a04c..f71e1cf8 100644 --- a/mlprec/impl/solver/mld_s_base_solver_free.f90 +++ b/mlprec/impl/solver/mld_s_base_solver_free.f90 @@ -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 diff --git a/mlprec/impl/solver/mld_z_base_solver_free.f90 b/mlprec/impl/solver/mld_z_base_solver_free.f90 index 21a8099f..84b03763 100644 --- a/mlprec/impl/solver/mld_z_base_solver_free.f90 +++ b/mlprec/impl/solver/mld_z_base_solver_free.f90 @@ -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 diff --git a/mlprec/mld_c_base_aggregator_mod.f90 b/mlprec/mld_c_base_aggregator_mod.f90 index 50fddf72..12448514 100644 --- a/mlprec/mld_c_base_aggregator_mod.f90 +++ b/mlprec/mld_c_base_aggregator_mod.f90 @@ -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' diff --git a/mlprec/mld_c_dec_aggregator_mod.f90 b/mlprec/mld_c_dec_aggregator_mod.f90 index 1d012a65..1c0e134a 100644 --- a/mlprec/mld_c_dec_aggregator_mod.f90 +++ b/mlprec/mld_c_dec_aggregator_mod.f90 @@ -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 diff --git a/mlprec/mld_c_prec_type.f90 b/mlprec/mld_c_prec_type.f90 index cc1829e8..6e3827f4 100644 --- a/mlprec/mld_c_prec_type.f90 +++ b/mlprec/mld_c_prec_type.f90 @@ -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 @@ -551,7 +552,7 @@ contains end subroutine mld_cprecfree subroutine mld_c_prec_free(prec,info) - + implicit none ! Arguments diff --git a/mlprec/mld_d_base_aggregator_mod.f90 b/mlprec/mld_d_base_aggregator_mod.f90 index 8b72d83d..b7c7f12a 100644 --- a/mlprec/mld_d_base_aggregator_mod.f90 +++ b/mlprec/mld_d_base_aggregator_mod.f90 @@ -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' diff --git a/mlprec/mld_d_dec_aggregator_mod.f90 b/mlprec/mld_d_dec_aggregator_mod.f90 index eae6158c..02becb72 100644 --- a/mlprec/mld_d_dec_aggregator_mod.f90 +++ b/mlprec/mld_d_dec_aggregator_mod.f90 @@ -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 diff --git a/mlprec/mld_d_prec_type.f90 b/mlprec/mld_d_prec_type.f90 index a8a71d29..682e8856 100644 --- a/mlprec/mld_d_prec_type.f90 +++ b/mlprec/mld_d_prec_type.f90 @@ -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 @@ -551,7 +552,7 @@ contains end subroutine mld_dprecfree subroutine mld_d_prec_free(prec,info) - + implicit none ! Arguments diff --git a/mlprec/mld_s_base_aggregator_mod.f90 b/mlprec/mld_s_base_aggregator_mod.f90 index 2a11ceec..384549d0 100644 --- a/mlprec/mld_s_base_aggregator_mod.f90 +++ b/mlprec/mld_s_base_aggregator_mod.f90 @@ -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' diff --git a/mlprec/mld_s_dec_aggregator_mod.f90 b/mlprec/mld_s_dec_aggregator_mod.f90 index 124a2428..b418b347 100644 --- a/mlprec/mld_s_dec_aggregator_mod.f90 +++ b/mlprec/mld_s_dec_aggregator_mod.f90 @@ -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 diff --git a/mlprec/mld_s_prec_type.f90 b/mlprec/mld_s_prec_type.f90 index b1593386..a9a7b4ce 100644 --- a/mlprec/mld_s_prec_type.f90 +++ b/mlprec/mld_s_prec_type.f90 @@ -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 @@ -551,7 +552,7 @@ contains end subroutine mld_sprecfree subroutine mld_s_prec_free(prec,info) - + implicit none ! Arguments diff --git a/mlprec/mld_z_base_aggregator_mod.f90 b/mlprec/mld_z_base_aggregator_mod.f90 index 6e94c3e9..6689343f 100644 --- a/mlprec/mld_z_base_aggregator_mod.f90 +++ b/mlprec/mld_z_base_aggregator_mod.f90 @@ -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' diff --git a/mlprec/mld_z_dec_aggregator_mod.f90 b/mlprec/mld_z_dec_aggregator_mod.f90 index a8048ff5..b8070a8c 100644 --- a/mlprec/mld_z_dec_aggregator_mod.f90 +++ b/mlprec/mld_z_dec_aggregator_mod.f90 @@ -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 diff --git a/mlprec/mld_z_prec_type.f90 b/mlprec/mld_z_prec_type.f90 index 2c1858dd..32b92b88 100644 --- a/mlprec/mld_z_prec_type.f90 +++ b/mlprec/mld_z_prec_type.f90 @@ -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 @@ -551,7 +552,7 @@ contains end subroutine mld_zprecfree subroutine mld_z_prec_free(prec,info) - + implicit none ! Arguments