fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Rescale AND col numbers and cleanup impl

Browse Source
repack-ovrlp
sfilippone 9 months ago
parent 106b92687b
commit 65519fdb05
8 changed files with 64 additions and 268 deletions
Show Stats Download Patch File Download Diff File

46
base/serial/impl/psb_c_mat_impl.F90
Unescape Escape View File

@ -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

46
base/serial/impl/psb_d_mat_impl.F90
Unescape Escape View File

@ -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

46
base/serial/impl/psb_s_mat_impl.F90
Unescape Escape View File

@ -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

46
base/serial/impl/psb_z_mat_impl.F90
Unescape Escape View File

@ -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

37
base/tools/psb_cspasb.f90
Unescape Escape View File

@ -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)

37
base/tools/psb_dspasb.f90
Unescape Escape View File

@ -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)

37
base/tools/psb_sspasb.f90
Unescape Escape View File

@ -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)

37
base/tools/psb_zspasb.f90
Unescape Escape View File

@ -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)

Write Preview
Loading…
Cancel
Save