From 65519fdb0525b4a8a3087cc873a6d2ed3ffdf99f Mon Sep 17 00:00:00 2001 From: sfilippone Date: Wed, 24 Apr 2024 13:27:04 +0200 Subject: [PATCH] Rescale AND col numbers and cleanup impl --- base/serial/impl/psb_c_mat_impl.F90 | 46 ++++++++++------------------- base/serial/impl/psb_d_mat_impl.F90 | 46 ++++++++++------------------- base/serial/impl/psb_s_mat_impl.F90 | 46 ++++++++++------------------- base/serial/impl/psb_z_mat_impl.F90 | 46 ++++++++++------------------- base/tools/psb_cspasb.f90 | 37 ----------------------- base/tools/psb_dspasb.f90 | 37 ----------------------- base/tools/psb_sspasb.f90 | 37 ----------------------- base/tools/psb_zspasb.f90 | 37 ----------------------- 8 files changed, 64 insertions(+), 268 deletions(-) diff --git a/base/serial/impl/psb_c_mat_impl.F90 b/base/serial/impl/psb_c_mat_impl.F90 index 8c1a28e1..605f1d02 100644 --- a/base/serial/impl/psb_c_mat_impl.F90 +++ b/base/serial/impl/psb_c_mat_impl.F90 @@ -1413,7 +1413,7 @@ subroutine psb_c_split_nd(a,n_rows,n_cols,info) call a%a%csclip(acoo,info,jmax=n_rows,rscale=.false.,cscale=.false.) allocate(a%ad,mold=a%a) call a%ad%mv_from_coo(acoo,info) - call a%a%csclip(acoo,info,jmin=n_rows+1,jmax=n_cols,rscale=.false.,cscale=.false.) + call a%a%csclip(acoo,info,jmin=n_rows+1,jmax=n_cols,rscale=.false.,cscale=.true.) if (use_ecsr) then allocate(andclip) call andclip%mv_from_coo(acoo,info) @@ -2534,11 +2534,6 @@ subroutine psb_c_cssm(alpha,a,x,beta,y,info,trans,scale,d) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then - info = psb_err_invalid_mat_state_ - call psb_errpush(info,name) - goto 9999 - endif if (allocated(a%a)) then call a%a%spsm(alpha,x,beta,y,info,trans,scale,d) @@ -2577,11 +2572,6 @@ subroutine psb_c_cssv(alpha,a,x,beta,y,info,trans,scale,d) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then - info = psb_err_invalid_mat_state_ - call psb_errpush(info,name) - goto 9999 - endif if (allocated(a%a)) then call a%a%spsm(alpha,x,beta,y,info,trans,scale,d) @@ -2622,11 +2612,7 @@ subroutine psb_c_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then - info = psb_err_invalid_mat_state_ - call psb_errpush(info,name) - goto 9999 - endif + if (.not.allocated(x%v)) then info = psb_err_invalid_vect_state_ call psb_errpush(info,name) @@ -2690,7 +2676,7 @@ function psb_c_maxval(a) result(res) call psb_get_erraction(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2728,7 +2714,7 @@ function psb_c_csnmi(a) result(res) info = psb_success_ call psb_get_erraction(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2760,7 +2746,7 @@ function psb_c_csnm1(a) result(res) call psb_get_erraction(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2792,7 +2778,7 @@ function psb_c_rowsum(a,info) result(d) call psb_erractionsave(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2835,7 +2821,7 @@ function psb_c_arwsum(a,info) result(d) call psb_erractionsave(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2879,7 +2865,7 @@ function psb_c_colsum(a,info) result(d) call psb_erractionsave(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2923,7 +2909,7 @@ function psb_c_aclsum(a,info) result(d) call psb_erractionsave(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2968,7 +2954,7 @@ function psb_c_get_diag(a,info) result(d) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3016,7 +3002,7 @@ subroutine psb_c_scal(d,a,info,side) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3061,7 +3047,7 @@ subroutine psb_c_scals(d,a,info) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3103,7 +3089,7 @@ subroutine psb_c_scalplusidentity(d,a,info) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3147,7 +3133,7 @@ subroutine psb_c_spaxpby(alpha,a,beta,b,info) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3193,7 +3179,7 @@ function psb_c_cmpval(a,val,tol,info) result(res) res = .false. info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3237,7 +3223,7 @@ function psb_c_cmpmat(a,b,tol,info) result(res) res = .false. info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 diff --git a/base/serial/impl/psb_d_mat_impl.F90 b/base/serial/impl/psb_d_mat_impl.F90 index 6453fecf..04294147 100644 --- a/base/serial/impl/psb_d_mat_impl.F90 +++ b/base/serial/impl/psb_d_mat_impl.F90 @@ -1413,7 +1413,7 @@ subroutine psb_d_split_nd(a,n_rows,n_cols,info) call a%a%csclip(acoo,info,jmax=n_rows,rscale=.false.,cscale=.false.) allocate(a%ad,mold=a%a) call a%ad%mv_from_coo(acoo,info) - call a%a%csclip(acoo,info,jmin=n_rows+1,jmax=n_cols,rscale=.false.,cscale=.false.) + call a%a%csclip(acoo,info,jmin=n_rows+1,jmax=n_cols,rscale=.false.,cscale=.true.) if (use_ecsr) then allocate(andclip) call andclip%mv_from_coo(acoo,info) @@ -2534,11 +2534,6 @@ subroutine psb_d_cssm(alpha,a,x,beta,y,info,trans,scale,d) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then - info = psb_err_invalid_mat_state_ - call psb_errpush(info,name) - goto 9999 - endif if (allocated(a%a)) then call a%a%spsm(alpha,x,beta,y,info,trans,scale,d) @@ -2577,11 +2572,6 @@ subroutine psb_d_cssv(alpha,a,x,beta,y,info,trans,scale,d) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then - info = psb_err_invalid_mat_state_ - call psb_errpush(info,name) - goto 9999 - endif if (allocated(a%a)) then call a%a%spsm(alpha,x,beta,y,info,trans,scale,d) @@ -2622,11 +2612,7 @@ subroutine psb_d_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then - info = psb_err_invalid_mat_state_ - call psb_errpush(info,name) - goto 9999 - endif + if (.not.allocated(x%v)) then info = psb_err_invalid_vect_state_ call psb_errpush(info,name) @@ -2690,7 +2676,7 @@ function psb_d_maxval(a) result(res) call psb_get_erraction(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2728,7 +2714,7 @@ function psb_d_csnmi(a) result(res) info = psb_success_ call psb_get_erraction(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2760,7 +2746,7 @@ function psb_d_csnm1(a) result(res) call psb_get_erraction(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2792,7 +2778,7 @@ function psb_d_rowsum(a,info) result(d) call psb_erractionsave(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2835,7 +2821,7 @@ function psb_d_arwsum(a,info) result(d) call psb_erractionsave(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2879,7 +2865,7 @@ function psb_d_colsum(a,info) result(d) call psb_erractionsave(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2923,7 +2909,7 @@ function psb_d_aclsum(a,info) result(d) call psb_erractionsave(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2968,7 +2954,7 @@ function psb_d_get_diag(a,info) result(d) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3016,7 +3002,7 @@ subroutine psb_d_scal(d,a,info,side) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3061,7 +3047,7 @@ subroutine psb_d_scals(d,a,info) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3103,7 +3089,7 @@ subroutine psb_d_scalplusidentity(d,a,info) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3147,7 +3133,7 @@ subroutine psb_d_spaxpby(alpha,a,beta,b,info) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3193,7 +3179,7 @@ function psb_d_cmpval(a,val,tol,info) result(res) res = .false. info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3237,7 +3223,7 @@ function psb_d_cmpmat(a,b,tol,info) result(res) res = .false. info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 diff --git a/base/serial/impl/psb_s_mat_impl.F90 b/base/serial/impl/psb_s_mat_impl.F90 index d6ea8403..8ef25603 100644 --- a/base/serial/impl/psb_s_mat_impl.F90 +++ b/base/serial/impl/psb_s_mat_impl.F90 @@ -1413,7 +1413,7 @@ subroutine psb_s_split_nd(a,n_rows,n_cols,info) call a%a%csclip(acoo,info,jmax=n_rows,rscale=.false.,cscale=.false.) allocate(a%ad,mold=a%a) call a%ad%mv_from_coo(acoo,info) - call a%a%csclip(acoo,info,jmin=n_rows+1,jmax=n_cols,rscale=.false.,cscale=.false.) + call a%a%csclip(acoo,info,jmin=n_rows+1,jmax=n_cols,rscale=.false.,cscale=.true.) if (use_ecsr) then allocate(andclip) call andclip%mv_from_coo(acoo,info) @@ -2534,11 +2534,6 @@ subroutine psb_s_cssm(alpha,a,x,beta,y,info,trans,scale,d) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then - info = psb_err_invalid_mat_state_ - call psb_errpush(info,name) - goto 9999 - endif if (allocated(a%a)) then call a%a%spsm(alpha,x,beta,y,info,trans,scale,d) @@ -2577,11 +2572,6 @@ subroutine psb_s_cssv(alpha,a,x,beta,y,info,trans,scale,d) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then - info = psb_err_invalid_mat_state_ - call psb_errpush(info,name) - goto 9999 - endif if (allocated(a%a)) then call a%a%spsm(alpha,x,beta,y,info,trans,scale,d) @@ -2622,11 +2612,7 @@ subroutine psb_s_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then - info = psb_err_invalid_mat_state_ - call psb_errpush(info,name) - goto 9999 - endif + if (.not.allocated(x%v)) then info = psb_err_invalid_vect_state_ call psb_errpush(info,name) @@ -2690,7 +2676,7 @@ function psb_s_maxval(a) result(res) call psb_get_erraction(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2728,7 +2714,7 @@ function psb_s_csnmi(a) result(res) info = psb_success_ call psb_get_erraction(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2760,7 +2746,7 @@ function psb_s_csnm1(a) result(res) call psb_get_erraction(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2792,7 +2778,7 @@ function psb_s_rowsum(a,info) result(d) call psb_erractionsave(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2835,7 +2821,7 @@ function psb_s_arwsum(a,info) result(d) call psb_erractionsave(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2879,7 +2865,7 @@ function psb_s_colsum(a,info) result(d) call psb_erractionsave(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2923,7 +2909,7 @@ function psb_s_aclsum(a,info) result(d) call psb_erractionsave(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2968,7 +2954,7 @@ function psb_s_get_diag(a,info) result(d) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3016,7 +3002,7 @@ subroutine psb_s_scal(d,a,info,side) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3061,7 +3047,7 @@ subroutine psb_s_scals(d,a,info) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3103,7 +3089,7 @@ subroutine psb_s_scalplusidentity(d,a,info) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3147,7 +3133,7 @@ subroutine psb_s_spaxpby(alpha,a,beta,b,info) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3193,7 +3179,7 @@ function psb_s_cmpval(a,val,tol,info) result(res) res = .false. info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3237,7 +3223,7 @@ function psb_s_cmpmat(a,b,tol,info) result(res) res = .false. info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 diff --git a/base/serial/impl/psb_z_mat_impl.F90 b/base/serial/impl/psb_z_mat_impl.F90 index d39d776d..9cf016dc 100644 --- a/base/serial/impl/psb_z_mat_impl.F90 +++ b/base/serial/impl/psb_z_mat_impl.F90 @@ -1413,7 +1413,7 @@ subroutine psb_z_split_nd(a,n_rows,n_cols,info) call a%a%csclip(acoo,info,jmax=n_rows,rscale=.false.,cscale=.false.) allocate(a%ad,mold=a%a) call a%ad%mv_from_coo(acoo,info) - call a%a%csclip(acoo,info,jmin=n_rows+1,jmax=n_cols,rscale=.false.,cscale=.false.) + call a%a%csclip(acoo,info,jmin=n_rows+1,jmax=n_cols,rscale=.false.,cscale=.true.) if (use_ecsr) then allocate(andclip) call andclip%mv_from_coo(acoo,info) @@ -2534,11 +2534,6 @@ subroutine psb_z_cssm(alpha,a,x,beta,y,info,trans,scale,d) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then - info = psb_err_invalid_mat_state_ - call psb_errpush(info,name) - goto 9999 - endif if (allocated(a%a)) then call a%a%spsm(alpha,x,beta,y,info,trans,scale,d) @@ -2577,11 +2572,6 @@ subroutine psb_z_cssv(alpha,a,x,beta,y,info,trans,scale,d) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then - info = psb_err_invalid_mat_state_ - call psb_errpush(info,name) - goto 9999 - endif if (allocated(a%a)) then call a%a%spsm(alpha,x,beta,y,info,trans,scale,d) @@ -2622,11 +2612,7 @@ subroutine psb_z_cssv_vect(alpha,a,x,beta,y,info,trans,scale,d) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then - info = psb_err_invalid_mat_state_ - call psb_errpush(info,name) - goto 9999 - endif + if (.not.allocated(x%v)) then info = psb_err_invalid_vect_state_ call psb_errpush(info,name) @@ -2690,7 +2676,7 @@ function psb_z_maxval(a) result(res) call psb_get_erraction(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2728,7 +2714,7 @@ function psb_z_csnmi(a) result(res) info = psb_success_ call psb_get_erraction(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2760,7 +2746,7 @@ function psb_z_csnm1(a) result(res) call psb_get_erraction(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2792,7 +2778,7 @@ function psb_z_rowsum(a,info) result(d) call psb_erractionsave(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2835,7 +2821,7 @@ function psb_z_arwsum(a,info) result(d) call psb_erractionsave(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2879,7 +2865,7 @@ function psb_z_colsum(a,info) result(d) call psb_erractionsave(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2923,7 +2909,7 @@ function psb_z_aclsum(a,info) result(d) call psb_erractionsave(err_act) info = psb_success_ - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -2968,7 +2954,7 @@ function psb_z_get_diag(a,info) result(d) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3016,7 +3002,7 @@ subroutine psb_z_scal(d,a,info,side) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3061,7 +3047,7 @@ subroutine psb_z_scals(d,a,info) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3103,7 +3089,7 @@ subroutine psb_z_scalplusidentity(d,a,info) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3147,7 +3133,7 @@ subroutine psb_z_spaxpby(alpha,a,beta,b,info) info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3193,7 +3179,7 @@ function psb_z_cmpval(a,val,tol,info) result(res) res = .false. info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 @@ -3237,7 +3223,7 @@ function psb_z_cmpmat(a,b,tol,info) result(res) res = .false. info = psb_success_ call psb_erractionsave(err_act) - if (.not.allocated(a%a)) then + if (a%is_null()) then info = psb_err_invalid_mat_state_ call psb_errpush(info,name) goto 9999 diff --git a/base/tools/psb_cspasb.f90 b/base/tools/psb_cspasb.f90 index db8af75a..0dc9bd9f 100644 --- a/base/tools/psb_cspasb.f90 +++ b/base/tools/psb_cspasb.f90 @@ -178,44 +178,7 @@ subroutine psb_cspasb(a,desc_a, info, afmt, upd, mold, bld_and) end if if (bld_and_) then -!!$ allocate(a%ad,mold=a%a) -!!$ allocate(a%and,mold=a%a)o call a%split_nd(n_row,n_col,info) -!!$ block -!!$ character(len=1024) :: fname -!!$ type(psb_c_coo_sparse_mat) :: acoo -!!$ type(psb_c_csr_sparse_mat), allocatable :: aclip -!!$ type(psb_c_ecsr_sparse_mat), allocatable :: andclip -!!$ logical, parameter :: use_ecsr=.true. -!!$ allocate(aclip) -!!$ call a%a%csclip(acoo,info,jmax=n_row,rscale=.false.,cscale=.false.) -!!$ allocate(a%ad,mold=a%a) -!!$ call a%ad%mv_from_coo(acoo,info) -!!$ call a%a%csclip(acoo,info,jmin=n_row+1,jmax=n_col,rscale=.false.,cscale=.false.) -!!$ if (use_ecsr) then -!!$ allocate(andclip) -!!$ call andclip%mv_from_coo(acoo,info) -!!$ call move_alloc(andclip,a%and) -!!$ else -!!$ allocate(a%and,mold=a%a) -!!$ call a%and%mv_from_coo(acoo,info) -!!$ end if -!!$ if (.false.) then -!!$ write(fname,'(a,i2.2,a)') 'adclip_',me,'.mtx' -!!$ open(25,file=fname) -!!$ call a%ad%print(25) -!!$ close(25) -!!$ write(fname,'(a,i2.2,a)') 'andclip_',me,'.mtx' -!!$ open(25,file=fname) -!!$ call a%and%print(25) -!!$ close(25) -!!$ !call andclip%set_cols(n_col) -!!$ write(*,*) me,' ',trim(name),' ad ',& -!!$ &a%ad%get_nrows(),a%ad%get_ncols(),n_row,n_col -!!$ write(*,*) me,' ',trim(name),' and ',& -!!$ &a%and%get_nrows(),a%and%get_ncols(),n_row,n_col -!!$ end if -!!$ end block else if (allocated(a%ad)) deallocate(a%ad) if (allocated(a%and)) deallocate(a%and) diff --git a/base/tools/psb_dspasb.f90 b/base/tools/psb_dspasb.f90 index 236568a1..c901aefd 100644 --- a/base/tools/psb_dspasb.f90 +++ b/base/tools/psb_dspasb.f90 @@ -178,44 +178,7 @@ subroutine psb_dspasb(a,desc_a, info, afmt, upd, mold, bld_and) end if if (bld_and_) then -!!$ allocate(a%ad,mold=a%a) -!!$ allocate(a%and,mold=a%a)o call a%split_nd(n_row,n_col,info) -!!$ block -!!$ character(len=1024) :: fname -!!$ type(psb_d_coo_sparse_mat) :: acoo -!!$ type(psb_d_csr_sparse_mat), allocatable :: aclip -!!$ type(psb_d_ecsr_sparse_mat), allocatable :: andclip -!!$ logical, parameter :: use_ecsr=.true. -!!$ allocate(aclip) -!!$ call a%a%csclip(acoo,info,jmax=n_row,rscale=.false.,cscale=.false.) -!!$ allocate(a%ad,mold=a%a) -!!$ call a%ad%mv_from_coo(acoo,info) -!!$ call a%a%csclip(acoo,info,jmin=n_row+1,jmax=n_col,rscale=.false.,cscale=.false.) -!!$ if (use_ecsr) then -!!$ allocate(andclip) -!!$ call andclip%mv_from_coo(acoo,info) -!!$ call move_alloc(andclip,a%and) -!!$ else -!!$ allocate(a%and,mold=a%a) -!!$ call a%and%mv_from_coo(acoo,info) -!!$ end if -!!$ if (.false.) then -!!$ write(fname,'(a,i2.2,a)') 'adclip_',me,'.mtx' -!!$ open(25,file=fname) -!!$ call a%ad%print(25) -!!$ close(25) -!!$ write(fname,'(a,i2.2,a)') 'andclip_',me,'.mtx' -!!$ open(25,file=fname) -!!$ call a%and%print(25) -!!$ close(25) -!!$ !call andclip%set_cols(n_col) -!!$ write(*,*) me,' ',trim(name),' ad ',& -!!$ &a%ad%get_nrows(),a%ad%get_ncols(),n_row,n_col -!!$ write(*,*) me,' ',trim(name),' and ',& -!!$ &a%and%get_nrows(),a%and%get_ncols(),n_row,n_col -!!$ end if -!!$ end block else if (allocated(a%ad)) deallocate(a%ad) if (allocated(a%and)) deallocate(a%and) diff --git a/base/tools/psb_sspasb.f90 b/base/tools/psb_sspasb.f90 index 110097c5..990ba3b4 100644 --- a/base/tools/psb_sspasb.f90 +++ b/base/tools/psb_sspasb.f90 @@ -178,44 +178,7 @@ subroutine psb_sspasb(a,desc_a, info, afmt, upd, mold, bld_and) end if if (bld_and_) then -!!$ allocate(a%ad,mold=a%a) -!!$ allocate(a%and,mold=a%a)o call a%split_nd(n_row,n_col,info) -!!$ block -!!$ character(len=1024) :: fname -!!$ type(psb_s_coo_sparse_mat) :: acoo -!!$ type(psb_s_csr_sparse_mat), allocatable :: aclip -!!$ type(psb_s_ecsr_sparse_mat), allocatable :: andclip -!!$ logical, parameter :: use_ecsr=.true. -!!$ allocate(aclip) -!!$ call a%a%csclip(acoo,info,jmax=n_row,rscale=.false.,cscale=.false.) -!!$ allocate(a%ad,mold=a%a) -!!$ call a%ad%mv_from_coo(acoo,info) -!!$ call a%a%csclip(acoo,info,jmin=n_row+1,jmax=n_col,rscale=.false.,cscale=.false.) -!!$ if (use_ecsr) then -!!$ allocate(andclip) -!!$ call andclip%mv_from_coo(acoo,info) -!!$ call move_alloc(andclip,a%and) -!!$ else -!!$ allocate(a%and,mold=a%a) -!!$ call a%and%mv_from_coo(acoo,info) -!!$ end if -!!$ if (.false.) then -!!$ write(fname,'(a,i2.2,a)') 'adclip_',me,'.mtx' -!!$ open(25,file=fname) -!!$ call a%ad%print(25) -!!$ close(25) -!!$ write(fname,'(a,i2.2,a)') 'andclip_',me,'.mtx' -!!$ open(25,file=fname) -!!$ call a%and%print(25) -!!$ close(25) -!!$ !call andclip%set_cols(n_col) -!!$ write(*,*) me,' ',trim(name),' ad ',& -!!$ &a%ad%get_nrows(),a%ad%get_ncols(),n_row,n_col -!!$ write(*,*) me,' ',trim(name),' and ',& -!!$ &a%and%get_nrows(),a%and%get_ncols(),n_row,n_col -!!$ end if -!!$ end block else if (allocated(a%ad)) deallocate(a%ad) if (allocated(a%and)) deallocate(a%and) diff --git a/base/tools/psb_zspasb.f90 b/base/tools/psb_zspasb.f90 index 2cb53368..576ff99b 100644 --- a/base/tools/psb_zspasb.f90 +++ b/base/tools/psb_zspasb.f90 @@ -178,44 +178,7 @@ subroutine psb_zspasb(a,desc_a, info, afmt, upd, mold, bld_and) end if if (bld_and_) then -!!$ allocate(a%ad,mold=a%a) -!!$ allocate(a%and,mold=a%a)o call a%split_nd(n_row,n_col,info) -!!$ block -!!$ character(len=1024) :: fname -!!$ type(psb_z_coo_sparse_mat) :: acoo -!!$ type(psb_z_csr_sparse_mat), allocatable :: aclip -!!$ type(psb_z_ecsr_sparse_mat), allocatable :: andclip -!!$ logical, parameter :: use_ecsr=.true. -!!$ allocate(aclip) -!!$ call a%a%csclip(acoo,info,jmax=n_row,rscale=.false.,cscale=.false.) -!!$ allocate(a%ad,mold=a%a) -!!$ call a%ad%mv_from_coo(acoo,info) -!!$ call a%a%csclip(acoo,info,jmin=n_row+1,jmax=n_col,rscale=.false.,cscale=.false.) -!!$ if (use_ecsr) then -!!$ allocate(andclip) -!!$ call andclip%mv_from_coo(acoo,info) -!!$ call move_alloc(andclip,a%and) -!!$ else -!!$ allocate(a%and,mold=a%a) -!!$ call a%and%mv_from_coo(acoo,info) -!!$ end if -!!$ if (.false.) then -!!$ write(fname,'(a,i2.2,a)') 'adclip_',me,'.mtx' -!!$ open(25,file=fname) -!!$ call a%ad%print(25) -!!$ close(25) -!!$ write(fname,'(a,i2.2,a)') 'andclip_',me,'.mtx' -!!$ open(25,file=fname) -!!$ call a%and%print(25) -!!$ close(25) -!!$ !call andclip%set_cols(n_col) -!!$ write(*,*) me,' ',trim(name),' ad ',& -!!$ &a%ad%get_nrows(),a%ad%get_ncols(),n_row,n_col -!!$ write(*,*) me,' ',trim(name),' and ',& -!!$ &a%and%get_nrows(),a%and%get_ncols(),n_row,n_col -!!$ end if -!!$ end block else if (allocated(a%ad)) deallocate(a%ad) if (allocated(a%and)) deallocate(a%and)