Fix build of BJAC diagonal block factorization.

pizdaint-runs
Salvatore Filippone 5 years ago
parent 8f167a3295
commit de75eec402

@ -51,6 +51,7 @@ subroutine mld_c_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
class(psb_c_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
! Local variables
type(psb_cspmat_type) :: tmpa
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='c_jac_smoother_bld', ch_err
@ -77,12 +78,17 @@ subroutine mld_c_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
call sm%nd%free()
sm%pa => a
sm%nd_nnz_tot = nztota
call psb_sum(ictxt,sm%nd_nnz_tot)
call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
class default
if (smsv%is_global()) then
! Do not put anything into SM%ND since the solver
! is acting globally.
call sm%nd%free()
sm%nd_nnz_tot = 0
call psb_sum(ictxt,sm%nd_nnz_tot)
call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
else
call a%csclip(sm%nd,info,&
& jmin=nrow_a+1,rscale=.false.,cscale=.false.)
@ -96,6 +102,10 @@ subroutine mld_c_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
endif
end if
sm%nd_nnz_tot = sm%nd%get_nzeros()
call psb_sum(ictxt,sm%nd_nnz_tot)
call a%csclip(tmpa,info,&
& jmax=nrow_a,rscale=.false.,cscale=.false.)
call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
end if
end select
if (info /= psb_success_) then
@ -103,15 +113,7 @@ subroutine mld_c_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
& a_err='clip & psb_spcnv csr 4')
goto 9999
end if
call psb_sum(ictxt,sm%nd_nnz_tot)
call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='solver build')
goto 9999
end if
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' end'

@ -108,7 +108,9 @@ subroutine mld_c_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
sm%nd_nnz_tot = sm%nd%get_nzeros()
call psb_sum(ictxt,sm%nd_nnz_tot)
arwsum = sm%nd%arwsum(info)
call a%cp_to(tmpcoo)
call a%csclip(tmpa,info,&
& jmax=nrow_a,rscale=.false.,cscale=.false.)
call tmpa%mv_to(tmpcoo)
call tmpcoo%set_dupl(psb_dupl_add_)
nz = tmpcoo%get_nzeros()
call tmpcoo%reallocate(nz+n_row)

@ -51,6 +51,7 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
class(psb_d_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
! Local variables
type(psb_dspmat_type) :: tmpa
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='d_jac_smoother_bld', ch_err
@ -77,12 +78,17 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
call sm%nd%free()
sm%pa => a
sm%nd_nnz_tot = nztota
call psb_sum(ictxt,sm%nd_nnz_tot)
call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
class default
if (smsv%is_global()) then
! Do not put anything into SM%ND since the solver
! is acting globally.
call sm%nd%free()
sm%nd_nnz_tot = 0
call psb_sum(ictxt,sm%nd_nnz_tot)
call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
else
call a%csclip(sm%nd,info,&
& jmin=nrow_a+1,rscale=.false.,cscale=.false.)
@ -96,6 +102,10 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
endif
end if
sm%nd_nnz_tot = sm%nd%get_nzeros()
call psb_sum(ictxt,sm%nd_nnz_tot)
call a%csclip(tmpa,info,&
& jmax=nrow_a,rscale=.false.,cscale=.false.)
call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
end if
end select
if (info /= psb_success_) then
@ -103,15 +113,7 @@ subroutine mld_d_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
& a_err='clip & psb_spcnv csr 4')
goto 9999
end if
call psb_sum(ictxt,sm%nd_nnz_tot)
call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='solver build')
goto 9999
end if
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' end'

@ -108,7 +108,9 @@ subroutine mld_d_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
sm%nd_nnz_tot = sm%nd%get_nzeros()
call psb_sum(ictxt,sm%nd_nnz_tot)
arwsum = sm%nd%arwsum(info)
call a%cp_to(tmpcoo)
call a%csclip(tmpa,info,&
& jmax=nrow_a,rscale=.false.,cscale=.false.)
call tmpa%mv_to(tmpcoo)
call tmpcoo%set_dupl(psb_dupl_add_)
nz = tmpcoo%get_nzeros()
call tmpcoo%reallocate(nz+n_row)

@ -51,6 +51,7 @@ subroutine mld_s_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
class(psb_s_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
! Local variables
type(psb_sspmat_type) :: tmpa
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='s_jac_smoother_bld', ch_err
@ -77,12 +78,17 @@ subroutine mld_s_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
call sm%nd%free()
sm%pa => a
sm%nd_nnz_tot = nztota
call psb_sum(ictxt,sm%nd_nnz_tot)
call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
class default
if (smsv%is_global()) then
! Do not put anything into SM%ND since the solver
! is acting globally.
call sm%nd%free()
sm%nd_nnz_tot = 0
call psb_sum(ictxt,sm%nd_nnz_tot)
call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
else
call a%csclip(sm%nd,info,&
& jmin=nrow_a+1,rscale=.false.,cscale=.false.)
@ -96,6 +102,10 @@ subroutine mld_s_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
endif
end if
sm%nd_nnz_tot = sm%nd%get_nzeros()
call psb_sum(ictxt,sm%nd_nnz_tot)
call a%csclip(tmpa,info,&
& jmax=nrow_a,rscale=.false.,cscale=.false.)
call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
end if
end select
if (info /= psb_success_) then
@ -103,15 +113,7 @@ subroutine mld_s_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
& a_err='clip & psb_spcnv csr 4')
goto 9999
end if
call psb_sum(ictxt,sm%nd_nnz_tot)
call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='solver build')
goto 9999
end if
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' end'

@ -108,7 +108,9 @@ subroutine mld_s_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
sm%nd_nnz_tot = sm%nd%get_nzeros()
call psb_sum(ictxt,sm%nd_nnz_tot)
arwsum = sm%nd%arwsum(info)
call a%cp_to(tmpcoo)
call a%csclip(tmpa,info,&
& jmax=nrow_a,rscale=.false.,cscale=.false.)
call tmpa%mv_to(tmpcoo)
call tmpcoo%set_dupl(psb_dupl_add_)
nz = tmpcoo%get_nzeros()
call tmpcoo%reallocate(nz+n_row)

@ -51,6 +51,7 @@ subroutine mld_z_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
class(psb_z_base_vect_type), intent(in), optional :: vmold
class(psb_i_base_vect_type), intent(in), optional :: imold
! Local variables
type(psb_zspmat_type) :: tmpa
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nzeros
integer(psb_ipk_) :: ictxt,np,me,i, err_act, debug_unit, debug_level
character(len=20) :: name='z_jac_smoother_bld', ch_err
@ -77,12 +78,17 @@ subroutine mld_z_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
call sm%nd%free()
sm%pa => a
sm%nd_nnz_tot = nztota
call psb_sum(ictxt,sm%nd_nnz_tot)
call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
class default
if (smsv%is_global()) then
! Do not put anything into SM%ND since the solver
! is acting globally.
call sm%nd%free()
sm%nd_nnz_tot = 0
call psb_sum(ictxt,sm%nd_nnz_tot)
call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
else
call a%csclip(sm%nd,info,&
& jmin=nrow_a+1,rscale=.false.,cscale=.false.)
@ -96,6 +102,10 @@ subroutine mld_z_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
endif
end if
sm%nd_nnz_tot = sm%nd%get_nzeros()
call psb_sum(ictxt,sm%nd_nnz_tot)
call a%csclip(tmpa,info,&
& jmax=nrow_a,rscale=.false.,cscale=.false.)
call sm%sv%build(tmpa,desc_a,info,amold=amold,vmold=vmold)
end if
end select
if (info /= psb_success_) then
@ -103,15 +113,7 @@ subroutine mld_z_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
& a_err='clip & psb_spcnv csr 4')
goto 9999
end if
call psb_sum(ictxt,sm%nd_nnz_tot)
call sm%sv%build(a,desc_a,info,amold=amold,vmold=vmold)
if (info /= psb_success_) then
call psb_errpush(psb_err_from_subroutine_,name,&
& a_err='solver build')
goto 9999
end if
if (debug_level >= psb_debug_outer_) &
& write(debug_unit,*) me,' ',trim(name),' end'

@ -108,7 +108,9 @@ subroutine mld_z_l1_jac_smoother_bld(a,desc_a,sm,info,amold,vmold,imold)
sm%nd_nnz_tot = sm%nd%get_nzeros()
call psb_sum(ictxt,sm%nd_nnz_tot)
arwsum = sm%nd%arwsum(info)
call a%cp_to(tmpcoo)
call a%csclip(tmpa,info,&
& jmax=nrow_a,rscale=.false.,cscale=.false.)
call tmpa%mv_to(tmpcoo)
call tmpcoo%set_dupl(psb_dupl_add_)
nz = tmpcoo%get_nzeros()
call tmpcoo%reallocate(nz+n_row)

Loading…
Cancel
Save