fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
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.
psblas3-accel
Salvatore Filippone 10 years ago
parent f343a60819
commit 0d49855313
36 changed files with 328 additions and 908 deletions
Show Stats Download Patch File Download Diff File

115
base/psblas/psb_camax.f90
Unescape Escape 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

28
base/psblas/psb_casum.f90
Unescape Escape 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

21
base/psblas/psb_caxpby.f90
Unescape Escape 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

35
base/psblas/psb_cdot.f90
Unescape Escape 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

32
base/psblas/psb_cnrm2.f90
Unescape Escape 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

7
base/psblas/psb_cnrmi.f90
Unescape Escape 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

33
base/psblas/psb_cspmm.f90
Unescape Escape 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

9
base/psblas/psb_cspnrm1.f90
Unescape Escape 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

29
base/psblas/psb_cspsm.f90
Unescape Escape 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

115
base/psblas/psb_damax.f90
Unescape Escape 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

28
base/psblas/psb_dasum.f90
Unescape Escape 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

21
base/psblas/psb_daxpby.f90
Unescape Escape 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

35
base/psblas/psb_ddot.f90
Unescape Escape 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

32
base/psblas/psb_dnrm2.f90
Unescape Escape 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

7
base/psblas/psb_dnrmi.f90
Unescape Escape 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

33
base/psblas/psb_dspmm.f90
Unescape Escape 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

9
base/psblas/psb_dspnrm1.f90
Unescape Escape 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

29
base/psblas/psb_dspsm.f90
Unescape Escape 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

115
base/psblas/psb_samax.f90
Unescape Escape 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

28
base/psblas/psb_sasum.f90
Unescape Escape 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

21
base/psblas/psb_saxpby.f90
Unescape Escape 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

35
base/psblas/psb_sdot.f90
Unescape Escape 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

32
base/psblas/psb_snrm2.f90
Unescape Escape 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

7
base/psblas/psb_snrmi.f90
Unescape Escape 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

33
base/psblas/psb_sspmm.f90
Unescape Escape 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

9
base/psblas/psb_sspnrm1.f90
Unescape Escape 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

29
base/psblas/psb_sspsm.f90
Unescape Escape 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

115
base/psblas/psb_zamax.f90
Unescape Escape 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

28
base/psblas/psb_zasum.f90
Unescape Escape 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

21
base/psblas/psb_zaxpby.f90
Unescape Escape 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

35
base/psblas/psb_zdot.f90
Unescape Escape 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

32
base/psblas/psb_znrm2.f90
Unescape Escape 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

7
base/psblas/psb_znrmi.f90
Unescape Escape 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

33
base/psblas/psb_zspmm.f90
Unescape Escape 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

9
base/psblas/psb_zspnrm1.f90
Unescape Escape 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

29
base/psblas/psb_zspsm.f90
Unescape Escape 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

Write Preview
Loading…
Cancel
Save