fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-20 04:42:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
base/psblas/psb_camax.f90
 base/psblas/psb_casum.f90
 base/psblas/psb_caxpby.f90
 base/psblas/psb_cdot.f90
 base/psblas/psb_cnrm2.f90
 base/psblas/psb_cnrmi.f90
 base/psblas/psb_cspmm.f90
 base/psblas/psb_cspnrm1.f90
 base/psblas/psb_cspsm.f90
 base/psblas/psb_damax.f90
 base/psblas/psb_dasum.f90
 base/psblas/psb_daxpby.f90
 base/psblas/psb_ddot.f90
 base/psblas/psb_dnrm2.f90
 base/psblas/psb_dnrmi.f90
 base/psblas/psb_dspmm.f90
 base/psblas/psb_dspnrm1.f90
 base/psblas/psb_dspsm.f90
 base/psblas/psb_samax.f90
 base/psblas/psb_sasum.f90
 base/psblas/psb_saxpby.f90
 base/psblas/psb_sdot.f90
 base/psblas/psb_snrm2.f90
 base/psblas/psb_snrmi.f90
 base/psblas/psb_sspmm.f90
 base/psblas/psb_sspnrm1.f90
 base/psblas/psb_sspsm.f90
 base/psblas/psb_zamax.f90
 base/psblas/psb_zasum.f90
 base/psblas/psb_zaxpby.f90
 base/psblas/psb_zdot.f90
 base/psblas/psb_znrm2.f90
 base/psblas/psb_znrmi.f90
 base/psblas/psb_zspmm.f90
 base/psblas/psb_zspnrm1.f90
 base/psblas/psb_zspsm.f90

New error handling.
This commit is contained in:
Salvatore Filippone
2014-12-21 09:17:20 +00:00
parent f343a60819
commit 0d49855313
36 changed files with 328 additions and 908 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/psblas/psb_camax.f90
+45 -70
View File
@@ -74,12 +74,12 @@ function psb_camax(x,desc_a, info, jx) result(res)
call psb_errpush(info,name)
goto 9999
endif
ix = 1
if (present(jx)) then
ijx = jx
ijx = jx
else
ijx = 1
ijx = 1
endif
m = desc_a%get_global_rows()
@@ -87,16 +87,16 @@ function psb_camax(x,desc_a, info, jx) result(res)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (iix /= 1) then
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
end if
! compute local max
@@ -105,20 +105,15 @@ function psb_camax(x,desc_a, info, jx) result(res)
else
res = szero
end if
! compute global max
call psb_amx(ictxt, res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_camax
@@ -197,7 +192,7 @@ function psb_camaxv (x,desc_a, info) result(res)
call psb_errpush(info,name)
goto 9999
endif
ix = 1
jx = 1
@@ -206,16 +201,16 @@ function psb_camaxv (x,desc_a, info) result(res)
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (iix /= 1) then
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
end if
! compute local max
@@ -224,20 +219,15 @@ function psb_camaxv (x,desc_a, info) result(res)
else
res = szero
end if
! compute global max
call psb_amx(ictxt, res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_camaxv
@@ -312,13 +302,8 @@ function psb_camax_vect(x, desc_a, info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_camax_vect
@@ -407,16 +392,16 @@ subroutine psb_camaxvs(res,x,desc_a, info)
ldx=size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (iix /= 1) then
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
end if
! compute local max
@@ -425,20 +410,15 @@ subroutine psb_camaxvs(res,x,desc_a, info)
else
res = szero
end if
! compute global max
call psb_amx(ictxt, res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_camaxvs
@@ -515,12 +495,12 @@ subroutine psb_cmamaxs(res,x,desc_a, info,jx)
call psb_errpush(info,name)
goto 9999
endif
ix = 1
if (present(jx)) then
ijx = jx
ijx = jx
else
ijx = 1
ijx = 1
endif
m = desc_a%get_global_rows()
@@ -528,16 +508,16 @@ subroutine psb_cmamaxs(res,x,desc_a, info,jx)
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (iix /= 1) then
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
end if
res(1:k) = szero
@@ -547,19 +527,14 @@ subroutine psb_cmamaxs(res,x,desc_a, info,jx)
res(i) = psb_amax(desc_a%get_local_rows()-iix+1,x(:,jjx+i-1))
end do
end if
! compute global max
call psb_amx(ictxt, res(1:k))
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_cmamaxs
base/psblas/psb_casum.f90
+4 -24
View File
@@ -119,13 +119,8 @@ function psb_casum (x,desc_a, info, jx) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_casum
@@ -197,13 +192,8 @@ function psb_casum_vect(x, desc_a, info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_casum_vect
@@ -322,13 +312,8 @@ function psb_casumv(x,desc_a, info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_casumv
@@ -447,12 +432,7 @@ subroutine psb_casumvs(res,x,desc_a, info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_casumvs
base/psblas/psb_caxpby.f90
+3 -18
View File
@@ -105,13 +105,8 @@ subroutine psb_caxpby_vect(alpha, x, beta, y,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_caxpby_vect
@@ -229,13 +224,8 @@ subroutine psb_caxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_caxpby
@@ -356,12 +346,7 @@ subroutine psb_caxpbyv(alpha, x, beta,y,desc_a,info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_caxpbyv
base/psblas/psb_cdot.f90
+5 -30
View File
@@ -137,13 +137,8 @@ function psb_cdot_vect(x, y, desc_a,info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_cdot_vect
@@ -238,13 +233,8 @@ function psb_cdot(x, y,desc_a, info, jx, jy) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_cdot
@@ -368,13 +358,8 @@ function psb_cdotv(x, y,desc_a, info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_cdotv
@@ -495,13 +480,8 @@ subroutine psb_cdotvs(res, x, y,desc_a, info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_cdotvs
@@ -636,12 +616,7 @@ subroutine psb_cmdots(res, x, y, desc_a, info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_cmdots
base/psblas/psb_cnrm2.f90
+6 -26
View File
@@ -119,13 +119,8 @@ function psb_cnrm2(x, desc_a, info, jx) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_cnrm2
@@ -237,20 +232,15 @@ function psb_cnrm2v(x, desc_a, info) result(res)
else
res = szero
end if
call psb_nrm2(ictxt,res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_cnrm2v
@@ -333,13 +323,8 @@ function psb_cnrm2_vect(x, desc_a, info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_cnrm2_vect
@@ -442,7 +427,7 @@ subroutine psb_cnrm2vs(res, x, desc_a, info)
if (desc_a%get_local_rows() > 0) then
ndim = desc_a%get_local_rows()
res = scnrm2( int(ndim,kind=psb_mpik_), x, int(ione,kind=psb_mpik_) )
! adjust because overlapped elements are computed more than once
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
@@ -460,12 +445,7 @@ subroutine psb_cnrm2vs(res, x, desc_a, info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_cnrm2vs
base/psblas/psb_cnrmi.f90
+1 -6
View File
@@ -106,12 +106,7 @@ function psb_cnrmi(a,desc_a,info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_cnrmi
base/psblas/psb_cspmm.f90
+9 -24
View File
@@ -348,13 +348,8 @@ subroutine psb_cspmm(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_cspmm
@@ -612,7 +607,7 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,&
call psi_ovrl_save(x,xvsave,desc_a,info)
if (info == psb_success_) call psi_ovrl_upd(x,desc_a,psb_avg_,info)
yp(nrow+1:ncol) = czero
! local Matrix-vector product
if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_)
@@ -626,13 +621,13 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,&
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (doswap_) then
call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),&
& cone,yp,desc_a,iwork,info)
if (info == psb_success_) call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& cone,yp,desc_a,iwork,info,data=psb_comm_ovr_)
if (debug_level >= psb_debug_comp_) &
& write(debug_unit,*) me,' ',trim(name),' swaptran ', info
if(info /= psb_success_) then
@@ -664,13 +659,8 @@ subroutine psb_cspmv(alpha,a,x,beta,y,desc_a,info,&
endif
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_cspmv
@@ -825,7 +815,7 @@ subroutine psb_cspmv_vect(alpha,a,x,beta,y,desc_a,info,&
!!! THIS SHOULD BE FIXED !!! But beta is almost never /= 0
!!$ yp(nrow+1:ncol) = czero
! local Matrix-vector product
if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_)
@@ -839,13 +829,13 @@ subroutine psb_cspmv_vect(alpha,a,x,beta,y,desc_a,info,&
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (doswap_) then
call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),&
& cone,y%v,desc_a,iwork,info)
if (info == psb_success_) call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& cone,y%v,desc_a,iwork,info,data=psb_comm_ovr_)
if (debug_level >= psb_debug_comp_) &
& write(debug_unit,*) me,' ',trim(name),' swaptran ', info
if(info /= psb_success_) then
@@ -877,12 +867,7 @@ subroutine psb_cspmv_vect(alpha,a,x,beta,y,desc_a,info,&
endif
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_cspmv_vect
base/psblas/psb_cspnrm1.f90
+2 -7
View File
@@ -102,7 +102,7 @@ function psb_cspnrm1(a,desc_a,info) result(res)
!!$ call psb_errpush(info,name,a_err=ch_err)
!!$ goto 9999
!!$ end if
if ((m /= 0).and.(n /= 0)) then
v = a%aclsum(info)
if (info == psb_success_) &
@@ -124,12 +124,7 @@ function psb_cspnrm1(a,desc_a,info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_cspnrm1
base/psblas/psb_cspsm.f90
+7 -22
View File
@@ -276,16 +276,11 @@ subroutine psb_cspsm(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_cspsm
!!$
!!$ Parallel Sparse BLAS version 3.1
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012, 2013
@@ -539,17 +534,12 @@ subroutine psb_cspsv(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_cspsv
subroutine psb_cspsv_vect(alpha,a,x,beta,y,desc_a,info,&
& trans, scale, choice, diag, work)
use psb_base_mod, psb_protect_name => psb_cspsv_vect
@@ -705,13 +695,8 @@ subroutine psb_cspsv_vect(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_cspsv_vect
base/psblas/psb_damax.f90
+45 -70
View File
@@ -74,12 +74,12 @@ function psb_damax(x,desc_a, info, jx) result(res)
call psb_errpush(info,name)
goto 9999
endif
ix = 1
if (present(jx)) then
ijx = jx
ijx = jx
else
ijx = 1
ijx = 1
endif
m = desc_a%get_global_rows()
@@ -87,16 +87,16 @@ function psb_damax(x,desc_a, info, jx) result(res)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (iix /= 1) then
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
end if
! compute local max
@@ -105,20 +105,15 @@ function psb_damax(x,desc_a, info, jx) result(res)
else
res = dzero
end if
! compute global max
call psb_amx(ictxt, res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_damax
@@ -197,7 +192,7 @@ function psb_damaxv (x,desc_a, info) result(res)
call psb_errpush(info,name)
goto 9999
endif
ix = 1
jx = 1
@@ -206,16 +201,16 @@ function psb_damaxv (x,desc_a, info) result(res)
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (iix /= 1) then
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
end if
! compute local max
@@ -224,20 +219,15 @@ function psb_damaxv (x,desc_a, info) result(res)
else
res = dzero
end if
! compute global max
call psb_amx(ictxt, res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_damaxv
@@ -312,13 +302,8 @@ function psb_damax_vect(x, desc_a, info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_damax_vect
@@ -407,16 +392,16 @@ subroutine psb_damaxvs(res,x,desc_a, info)
ldx=size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (iix /= 1) then
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
end if
! compute local max
@@ -425,20 +410,15 @@ subroutine psb_damaxvs(res,x,desc_a, info)
else
res = dzero
end if
! compute global max
call psb_amx(ictxt, res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_damaxvs
@@ -515,12 +495,12 @@ subroutine psb_dmamaxs(res,x,desc_a, info,jx)
call psb_errpush(info,name)
goto 9999
endif
ix = 1
if (present(jx)) then
ijx = jx
ijx = jx
else
ijx = 1
ijx = 1
endif
m = desc_a%get_global_rows()
@@ -528,16 +508,16 @@ subroutine psb_dmamaxs(res,x,desc_a, info,jx)
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (iix /= 1) then
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
end if
res(1:k) = dzero
@@ -547,19 +527,14 @@ subroutine psb_dmamaxs(res,x,desc_a, info,jx)
res(i) = psb_amax(desc_a%get_local_rows()-iix+1,x(:,jjx+i-1))
end do
end if
! compute global max
call psb_amx(ictxt, res(1:k))
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_dmamaxs
base/psblas/psb_dasum.f90
+4 -24
View File
@@ -119,13 +119,8 @@ function psb_dasum (x,desc_a, info, jx) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_dasum
@@ -197,13 +192,8 @@ function psb_dasum_vect(x, desc_a, info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_dasum_vect
@@ -322,13 +312,8 @@ function psb_dasumv(x,desc_a, info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_dasumv
@@ -447,12 +432,7 @@ subroutine psb_dasumvs(res,x,desc_a, info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_dasumvs
base/psblas/psb_daxpby.f90
+3 -18
View File
@@ -105,13 +105,8 @@ subroutine psb_daxpby_vect(alpha, x, beta, y,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_daxpby_vect
@@ -229,13 +224,8 @@ subroutine psb_daxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_daxpby
@@ -356,12 +346,7 @@ subroutine psb_daxpbyv(alpha, x, beta,y,desc_a,info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_daxpbyv
base/psblas/psb_ddot.f90
+5 -30
View File
@@ -137,13 +137,8 @@ function psb_ddot_vect(x, y, desc_a,info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_ddot_vect
@@ -238,13 +233,8 @@ function psb_ddot(x, y,desc_a, info, jx, jy) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_ddot
@@ -368,13 +358,8 @@ function psb_ddotv(x, y,desc_a, info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_ddotv
@@ -495,13 +480,8 @@ subroutine psb_ddotvs(res, x, y,desc_a, info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_ddotvs
@@ -636,12 +616,7 @@ subroutine psb_dmdots(res, x, y, desc_a, info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_dmdots
base/psblas/psb_dnrm2.f90
+6 -26
View File
@@ -119,13 +119,8 @@ function psb_dnrm2(x, desc_a, info, jx) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_dnrm2
@@ -237,20 +232,15 @@ function psb_dnrm2v(x, desc_a, info) result(res)
else
res = dzero
end if
call psb_nrm2(ictxt,res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_dnrm2v
@@ -333,13 +323,8 @@ function psb_dnrm2_vect(x, desc_a, info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_dnrm2_vect
@@ -442,7 +427,7 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
if (desc_a%get_local_rows() > 0) then
ndim = desc_a%get_local_rows()
res = dnrm2( int(ndim,kind=psb_mpik_), x, int(ione,kind=psb_mpik_) )
! adjust because overlapped elements are computed more than once
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
@@ -460,12 +445,7 @@ subroutine psb_dnrm2vs(res, x, desc_a, info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_dnrm2vs
base/psblas/psb_dnrmi.f90
+1 -6
View File
@@ -106,12 +106,7 @@ function psb_dnrmi(a,desc_a,info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_dnrmi
base/psblas/psb_dspmm.f90
+9 -24
View File
@@ -348,13 +348,8 @@ subroutine psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_dspmm
@@ -612,7 +607,7 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
call psi_ovrl_save(x,xvsave,desc_a,info)
if (info == psb_success_) call psi_ovrl_upd(x,desc_a,psb_avg_,info)
yp(nrow+1:ncol) = dzero
! local Matrix-vector product
if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_)
@@ -626,13 +621,13 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (doswap_) then
call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),&
& done,yp,desc_a,iwork,info)
if (info == psb_success_) call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& done,yp,desc_a,iwork,info,data=psb_comm_ovr_)
if (debug_level >= psb_debug_comp_) &
& write(debug_unit,*) me,' ',trim(name),' swaptran ', info
if(info /= psb_success_) then
@@ -664,13 +659,8 @@ subroutine psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
endif
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_dspmv
@@ -825,7 +815,7 @@ subroutine psb_dspmv_vect(alpha,a,x,beta,y,desc_a,info,&
!!! THIS SHOULD BE FIXED !!! But beta is almost never /= 0
!!$ yp(nrow+1:ncol) = dzero
! local Matrix-vector product
if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_)
@@ -839,13 +829,13 @@ subroutine psb_dspmv_vect(alpha,a,x,beta,y,desc_a,info,&
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (doswap_) then
call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),&
& done,y%v,desc_a,iwork,info)
if (info == psb_success_) call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& done,y%v,desc_a,iwork,info,data=psb_comm_ovr_)
if (debug_level >= psb_debug_comp_) &
& write(debug_unit,*) me,' ',trim(name),' swaptran ', info
if(info /= psb_success_) then
@@ -877,12 +867,7 @@ subroutine psb_dspmv_vect(alpha,a,x,beta,y,desc_a,info,&
endif
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_dspmv_vect
base/psblas/psb_dspnrm1.f90
+2 -7
View File
@@ -102,7 +102,7 @@ function psb_dspnrm1(a,desc_a,info) result(res)
!!$ call psb_errpush(info,name,a_err=ch_err)
!!$ goto 9999
!!$ end if
if ((m /= 0).and.(n /= 0)) then
v = a%aclsum(info)
if (info == psb_success_) &
@@ -124,12 +124,7 @@ function psb_dspnrm1(a,desc_a,info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_dspnrm1
base/psblas/psb_dspsm.f90
+7 -22
View File
@@ -276,16 +276,11 @@ subroutine psb_dspsm(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_dspsm
!!$
!!$ Parallel Sparse BLAS version 3.1
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012, 2013
@@ -539,17 +534,12 @@ subroutine psb_dspsv(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_dspsv
subroutine psb_dspsv_vect(alpha,a,x,beta,y,desc_a,info,&
& trans, scale, choice, diag, work)
use psb_base_mod, psb_protect_name => psb_dspsv_vect
@@ -705,13 +695,8 @@ subroutine psb_dspsv_vect(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_dspsv_vect
base/psblas/psb_samax.f90
+45 -70
View File
@@ -74,12 +74,12 @@ function psb_samax(x,desc_a, info, jx) result(res)
call psb_errpush(info,name)
goto 9999
endif
ix = 1
if (present(jx)) then
ijx = jx
ijx = jx
else
ijx = 1
ijx = 1
endif
m = desc_a%get_global_rows()
@@ -87,16 +87,16 @@ function psb_samax(x,desc_a, info, jx) result(res)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (iix /= 1) then
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
end if
! compute local max
@@ -105,20 +105,15 @@ function psb_samax(x,desc_a, info, jx) result(res)
else
res = szero
end if
! compute global max
call psb_amx(ictxt, res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_samax
@@ -197,7 +192,7 @@ function psb_samaxv (x,desc_a, info) result(res)
call psb_errpush(info,name)
goto 9999
endif
ix = 1
jx = 1
@@ -206,16 +201,16 @@ function psb_samaxv (x,desc_a, info) result(res)
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (iix /= 1) then
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
end if
! compute local max
@@ -224,20 +219,15 @@ function psb_samaxv (x,desc_a, info) result(res)
else
res = szero
end if
! compute global max
call psb_amx(ictxt, res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_samaxv
@@ -312,13 +302,8 @@ function psb_samax_vect(x, desc_a, info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_samax_vect
@@ -407,16 +392,16 @@ subroutine psb_samaxvs(res,x,desc_a, info)
ldx=size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (iix /= 1) then
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
end if
! compute local max
@@ -425,20 +410,15 @@ subroutine psb_samaxvs(res,x,desc_a, info)
else
res = szero
end if
! compute global max
call psb_amx(ictxt, res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_samaxvs
@@ -515,12 +495,12 @@ subroutine psb_smamaxs(res,x,desc_a, info,jx)
call psb_errpush(info,name)
goto 9999
endif
ix = 1
if (present(jx)) then
ijx = jx
ijx = jx
else
ijx = 1
ijx = 1
endif
m = desc_a%get_global_rows()
@@ -528,16 +508,16 @@ subroutine psb_smamaxs(res,x,desc_a, info,jx)
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (iix /= 1) then
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
end if
res(1:k) = szero
@@ -547,19 +527,14 @@ subroutine psb_smamaxs(res,x,desc_a, info,jx)
res(i) = psb_amax(desc_a%get_local_rows()-iix+1,x(:,jjx+i-1))
end do
end if
! compute global max
call psb_amx(ictxt, res(1:k))
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_smamaxs
base/psblas/psb_sasum.f90
+4 -24
View File
@@ -119,13 +119,8 @@ function psb_sasum (x,desc_a, info, jx) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_sasum
@@ -197,13 +192,8 @@ function psb_sasum_vect(x, desc_a, info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_sasum_vect
@@ -322,13 +312,8 @@ function psb_sasumv(x,desc_a, info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_sasumv
@@ -447,12 +432,7 @@ subroutine psb_sasumvs(res,x,desc_a, info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_sasumvs
base/psblas/psb_saxpby.f90
+3 -18
View File
@@ -105,13 +105,8 @@ subroutine psb_saxpby_vect(alpha, x, beta, y,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_saxpby_vect
@@ -229,13 +224,8 @@ subroutine psb_saxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_saxpby
@@ -356,12 +346,7 @@ subroutine psb_saxpbyv(alpha, x, beta,y,desc_a,info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_saxpbyv
base/psblas/psb_sdot.f90
+5 -30
View File
@@ -137,13 +137,8 @@ function psb_sdot_vect(x, y, desc_a,info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_sdot_vect
@@ -238,13 +233,8 @@ function psb_sdot(x, y,desc_a, info, jx, jy) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_sdot
@@ -368,13 +358,8 @@ function psb_sdotv(x, y,desc_a, info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_sdotv
@@ -495,13 +480,8 @@ subroutine psb_sdotvs(res, x, y,desc_a, info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_sdotvs
@@ -636,12 +616,7 @@ subroutine psb_smdots(res, x, y, desc_a, info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_smdots
base/psblas/psb_snrm2.f90
+6 -26
View File
@@ -119,13 +119,8 @@ function psb_snrm2(x, desc_a, info, jx) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_snrm2
@@ -237,20 +232,15 @@ function psb_snrm2v(x, desc_a, info) result(res)
else
res = szero
end if
call psb_nrm2(ictxt,res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_snrm2v
@@ -333,13 +323,8 @@ function psb_snrm2_vect(x, desc_a, info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_snrm2_vect
@@ -442,7 +427,7 @@ subroutine psb_snrm2vs(res, x, desc_a, info)
if (desc_a%get_local_rows() > 0) then
ndim = desc_a%get_local_rows()
res = snrm2( int(ndim,kind=psb_mpik_), x, int(ione,kind=psb_mpik_) )
! adjust because overlapped elements are computed more than once
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
@@ -460,12 +445,7 @@ subroutine psb_snrm2vs(res, x, desc_a, info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_snrm2vs
base/psblas/psb_snrmi.f90
+1 -6
View File
@@ -106,12 +106,7 @@ function psb_snrmi(a,desc_a,info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_snrmi
base/psblas/psb_sspmm.f90
+9 -24
View File
@@ -348,13 +348,8 @@ subroutine psb_sspmm(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_sspmm
@@ -612,7 +607,7 @@ subroutine psb_sspmv(alpha,a,x,beta,y,desc_a,info,&
call psi_ovrl_save(x,xvsave,desc_a,info)
if (info == psb_success_) call psi_ovrl_upd(x,desc_a,psb_avg_,info)
yp(nrow+1:ncol) = szero
! local Matrix-vector product
if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_)
@@ -626,13 +621,13 @@ subroutine psb_sspmv(alpha,a,x,beta,y,desc_a,info,&
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (doswap_) then
call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),&
& sone,yp,desc_a,iwork,info)
if (info == psb_success_) call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& sone,yp,desc_a,iwork,info,data=psb_comm_ovr_)
if (debug_level >= psb_debug_comp_) &
& write(debug_unit,*) me,' ',trim(name),' swaptran ', info
if(info /= psb_success_) then
@@ -664,13 +659,8 @@ subroutine psb_sspmv(alpha,a,x,beta,y,desc_a,info,&
endif
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_sspmv
@@ -825,7 +815,7 @@ subroutine psb_sspmv_vect(alpha,a,x,beta,y,desc_a,info,&
!!! THIS SHOULD BE FIXED !!! But beta is almost never /= 0
!!$ yp(nrow+1:ncol) = szero
! local Matrix-vector product
if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_)
@@ -839,13 +829,13 @@ subroutine psb_sspmv_vect(alpha,a,x,beta,y,desc_a,info,&
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (doswap_) then
call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),&
& sone,y%v,desc_a,iwork,info)
if (info == psb_success_) call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& sone,y%v,desc_a,iwork,info,data=psb_comm_ovr_)
if (debug_level >= psb_debug_comp_) &
& write(debug_unit,*) me,' ',trim(name),' swaptran ', info
if(info /= psb_success_) then
@@ -877,12 +867,7 @@ subroutine psb_sspmv_vect(alpha,a,x,beta,y,desc_a,info,&
endif
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_sspmv_vect
base/psblas/psb_sspnrm1.f90
+2 -7
View File
@@ -102,7 +102,7 @@ function psb_sspnrm1(a,desc_a,info) result(res)
!!$ call psb_errpush(info,name,a_err=ch_err)
!!$ goto 9999
!!$ end if
if ((m /= 0).and.(n /= 0)) then
v = a%aclsum(info)
if (info == psb_success_) &
@@ -124,12 +124,7 @@ function psb_sspnrm1(a,desc_a,info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_sspnrm1
base/psblas/psb_sspsm.f90
+7 -22
View File
@@ -276,16 +276,11 @@ subroutine psb_sspsm(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_sspsm
!!$
!!$ Parallel Sparse BLAS version 3.1
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012, 2013
@@ -539,17 +534,12 @@ subroutine psb_sspsv(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_sspsv
subroutine psb_sspsv_vect(alpha,a,x,beta,y,desc_a,info,&
& trans, scale, choice, diag, work)
use psb_base_mod, psb_protect_name => psb_sspsv_vect
@@ -705,13 +695,8 @@ subroutine psb_sspsv_vect(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_sspsv_vect
base/psblas/psb_zamax.f90
+45 -70
View File
@@ -74,12 +74,12 @@ function psb_zamax(x,desc_a, info, jx) result(res)
call psb_errpush(info,name)
goto 9999
endif
ix = 1
if (present(jx)) then
ijx = jx
ijx = jx
else
ijx = 1
ijx = 1
endif
m = desc_a%get_global_rows()
@@ -87,16 +87,16 @@ function psb_zamax(x,desc_a, info, jx) result(res)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (iix /= 1) then
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
end if
! compute local max
@@ -105,20 +105,15 @@ function psb_zamax(x,desc_a, info, jx) result(res)
else
res = dzero
end if
! compute global max
call psb_amx(ictxt, res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_zamax
@@ -197,7 +192,7 @@ function psb_zamaxv (x,desc_a, info) result(res)
call psb_errpush(info,name)
goto 9999
endif
ix = 1
jx = 1
@@ -206,16 +201,16 @@ function psb_zamaxv (x,desc_a, info) result(res)
call psb_chkvect(m,ione,ldx,ix,jx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (iix /= 1) then
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
end if
! compute local max
@@ -224,20 +219,15 @@ function psb_zamaxv (x,desc_a, info) result(res)
else
res = dzero
end if
! compute global max
call psb_amx(ictxt, res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_zamaxv
@@ -312,13 +302,8 @@ function psb_zamax_vect(x, desc_a, info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_zamax_vect
@@ -407,16 +392,16 @@ subroutine psb_zamaxvs(res,x,desc_a, info)
ldx=size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (iix /= 1) then
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
end if
! compute local max
@@ -425,20 +410,15 @@ subroutine psb_zamaxvs(res,x,desc_a, info)
else
res = dzero
end if
! compute global max
call psb_amx(ictxt, res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_zamaxvs
@@ -515,12 +495,12 @@ subroutine psb_zmamaxs(res,x,desc_a, info,jx)
call psb_errpush(info,name)
goto 9999
endif
ix = 1
if (present(jx)) then
ijx = jx
ijx = jx
else
ijx = 1
ijx = 1
endif
m = desc_a%get_global_rows()
@@ -528,16 +508,16 @@ subroutine psb_zmamaxs(res,x,desc_a, info,jx)
ldx = size(x,1)
call psb_chkvect(m,ione,ldx,ix,ijx,desc_a,info,iix,jjx)
if(info /= psb_success_) then
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
info=psb_err_from_subroutine_
ch_err='psb_chkvect'
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (iix /= 1) then
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
info=psb_err_ix_n1_iy_n1_unsupported_
call psb_errpush(info,name)
goto 9999
end if
res(1:k) = dzero
@@ -547,19 +527,14 @@ subroutine psb_zmamaxs(res,x,desc_a, info,jx)
res(i) = psb_amax(desc_a%get_local_rows()-iix+1,x(:,jjx+i-1))
end do
end if
! compute global max
call psb_amx(ictxt, res(1:k))
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_zmamaxs
base/psblas/psb_zasum.f90
+4 -24
View File
@@ -119,13 +119,8 @@ function psb_zasum (x,desc_a, info, jx) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_zasum
@@ -197,13 +192,8 @@ function psb_zasum_vect(x, desc_a, info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_zasum_vect
@@ -322,13 +312,8 @@ function psb_zasumv(x,desc_a, info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_zasumv
@@ -447,12 +432,7 @@ subroutine psb_zasumvs(res,x,desc_a, info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_zasumvs
base/psblas/psb_zaxpby.f90
+3 -18
View File
@@ -105,13 +105,8 @@ subroutine psb_zaxpby_vect(alpha, x, beta, y,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_zaxpby_vect
@@ -229,13 +224,8 @@ subroutine psb_zaxpby(alpha, x, beta,y,desc_a,info, n, jx, jy)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_zaxpby
@@ -356,12 +346,7 @@ subroutine psb_zaxpbyv(alpha, x, beta,y,desc_a,info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_zaxpbyv
base/psblas/psb_zdot.f90
+5 -30
View File
@@ -137,13 +137,8 @@ function psb_zdot_vect(x, y, desc_a,info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_zdot_vect
@@ -238,13 +233,8 @@ function psb_zdot(x, y,desc_a, info, jx, jy) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_zdot
@@ -368,13 +358,8 @@ function psb_zdotv(x, y,desc_a, info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_zdotv
@@ -495,13 +480,8 @@ subroutine psb_zdotvs(res, x, y,desc_a, info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_zdotvs
@@ -636,12 +616,7 @@ subroutine psb_zmdots(res, x, y, desc_a, info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_zmdots
base/psblas/psb_znrm2.f90
+6 -26
View File
@@ -119,13 +119,8 @@ function psb_znrm2(x, desc_a, info, jx) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_znrm2
@@ -237,20 +232,15 @@ function psb_znrm2v(x, desc_a, info) result(res)
else
res = dzero
end if
call psb_nrm2(ictxt,res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_znrm2v
@@ -333,13 +323,8 @@ function psb_znrm2_vect(x, desc_a, info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_znrm2_vect
@@ -442,7 +427,7 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
if (desc_a%get_local_rows() > 0) then
ndim = desc_a%get_local_rows()
res = dznrm2( int(ndim,kind=psb_mpik_), x, int(ione,kind=psb_mpik_) )
! adjust because overlapped elements are computed more than once
do i=1,size(desc_a%ovrlap_elem,1)
idx = desc_a%ovrlap_elem(i,1)
@@ -460,12 +445,7 @@ subroutine psb_znrm2vs(res, x, desc_a, info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_znrm2vs
base/psblas/psb_znrmi.f90
+1 -6
View File
@@ -106,12 +106,7 @@ function psb_znrmi(a,desc_a,info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_znrmi
base/psblas/psb_zspmm.f90
+9 -24
View File
@@ -348,13 +348,8 @@ subroutine psb_zspmm(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_zspmm
@@ -612,7 +607,7 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
call psi_ovrl_save(x,xvsave,desc_a,info)
if (info == psb_success_) call psi_ovrl_upd(x,desc_a,psb_avg_,info)
yp(nrow+1:ncol) = zzero
! local Matrix-vector product
if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_)
@@ -626,13 +621,13 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (doswap_) then
call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),&
& zone,yp,desc_a,iwork,info)
if (info == psb_success_) call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& zone,yp,desc_a,iwork,info,data=psb_comm_ovr_)
if (debug_level >= psb_debug_comp_) &
& write(debug_unit,*) me,' ',trim(name),' swaptran ', info
if(info /= psb_success_) then
@@ -664,13 +659,8 @@ subroutine psb_zspmv(alpha,a,x,beta,y,desc_a,info,&
endif
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_zspmv
@@ -825,7 +815,7 @@ subroutine psb_zspmv_vect(alpha,a,x,beta,y,desc_a,info,&
!!! THIS SHOULD BE FIXED !!! But beta is almost never /= 0
!!$ yp(nrow+1:ncol) = zzero
! local Matrix-vector product
if (info == psb_success_) call psb_csmm(alpha,a,x,beta,y,info,trans=trans_)
@@ -839,13 +829,13 @@ subroutine psb_zspmv_vect(alpha,a,x,beta,y,desc_a,info,&
call psb_errpush(info,name,a_err=ch_err)
goto 9999
end if
if (doswap_) then
call psi_swaptran(ior(psb_swap_send_,psb_swap_recv_),&
& zone,y%v,desc_a,iwork,info)
if (info == psb_success_) call psi_swapdata(ior(psb_swap_send_,psb_swap_recv_),&
& zone,y%v,desc_a,iwork,info,data=psb_comm_ovr_)
if (debug_level >= psb_debug_comp_) &
& write(debug_unit,*) me,' ',trim(name),' swaptran ', info
if(info /= psb_success_) then
@@ -877,12 +867,7 @@ subroutine psb_zspmv_vect(alpha,a,x,beta,y,desc_a,info,&
endif
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_zspmv_vect
base/psblas/psb_zspnrm1.f90
+2 -7
View File
@@ -102,7 +102,7 @@ function psb_zspnrm1(a,desc_a,info) result(res)
!!$ call psb_errpush(info,name,a_err=ch_err)
!!$ goto 9999
!!$ end if
if ((m /= 0).and.(n /= 0)) then
v = a%aclsum(info)
if (info == psb_success_) &
@@ -124,12 +124,7 @@ function psb_zspnrm1(a,desc_a,info) result(res)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end function psb_zspnrm1
base/psblas/psb_zspsm.f90
+7 -22
View File
@@ -276,16 +276,11 @@ subroutine psb_zspsm(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_zspsm
!!$
!!$ Parallel Sparse BLAS version 3.1
!!$ (C) Copyright 2006, 2007, 2008, 2009, 2010, 2012, 2013
@@ -539,17 +534,12 @@ subroutine psb_zspsv(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_zspsv
subroutine psb_zspsv_vect(alpha,a,x,beta,y,desc_a,info,&
& trans, scale, choice, diag, work)
use psb_base_mod, psb_protect_name => psb_zspsv_vect
@@ -705,13 +695,8 @@ subroutine psb_zspsv_vect(alpha,a,x,beta,y,desc_a,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(ictxt,err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
return
end subroutine psb_zspsv_vect