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/comm/psb_cgather.f90
 base/comm/psb_chalo.f90
 base/comm/psb_covrl.f90
 base/comm/psb_cscatter.F90
 base/comm/psb_cspgather.F90
 base/comm/psb_dgather.f90
 base/comm/psb_dhalo.f90
 base/comm/psb_dovrl.f90
 base/comm/psb_dscatter.F90
 base/comm/psb_dspgather.F90
 base/comm/psb_igather.f90
 base/comm/psb_ihalo.f90
 base/comm/psb_iovrl.f90
 base/comm/psb_iscatter.F90
 base/comm/psb_sgather.f90
 base/comm/psb_shalo.f90
 base/comm/psb_sovrl.f90
 base/comm/psb_sscatter.F90
 base/comm/psb_sspgather.F90
 base/comm/psb_zgather.f90
 base/comm/psb_zhalo.f90
 base/comm/psb_zovrl.f90
 base/comm/psb_zscatter.F90
 base/comm/psb_zspgather.F90
 base/modules/psb_c_base_mat_mod.f90
 base/modules/psb_c_linmap_mod.f90
 base/modules/psb_check_mod.f90
 base/modules/psb_d_base_mat_mod.f90
 base/modules/psb_d_linmap_mod.f90
 base/modules/psb_desc_mod.F90
 base/modules/psb_gen_block_map_mod.f90
 base/modules/psb_glist_map_mod.f90
 base/modules/psb_hash_map_mod.f90
 base/modules/psb_indx_map_mod.f90
 base/modules/psb_list_map_mod.f90
 base/modules/psb_realloc_mod.F90
 base/modules/psb_repl_map_mod.f90
 base/modules/psb_s_base_mat_mod.f90
 base/modules/psb_s_linmap_mod.f90
 base/modules/psb_serial_mod.f90
 base/modules/psb_z_base_mat_mod.f90
 base/modules/psb_z_linmap_mod.f90
 base/serial/impl/psb_c_base_mat_impl.F90
 base/serial/impl/psb_d_base_mat_impl.F90
 base/serial/impl/psb_s_base_mat_impl.F90
 base/serial/impl/psb_z_base_mat_impl.F90

New error handling
psblas3-accel
Salvatore Filippone 10 years ago
parent c5f6bd308c
commit 895b7abc5f
46 changed files with 554 additions and 1851 deletions
Show Stats Download Patch File Download Diff File

31
base/comm/psb_cgather.f90
Unescape Escape View File

@ -127,7 +127,7 @@ subroutine psb_cgatherm(globx, locx, desc_a, info, iroot)
call psb_errpush(info,name)
goto 9999
end if
call psb_realloc(m,k,globx,info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
@ -160,13 +160,8 @@ subroutine psb_cgatherm(globx, locx, desc_a, info, iroot)
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_cgatherm
@ -298,21 +293,21 @@ subroutine psb_cgatherv(globx, locx, desc_a, info, iroot)
call psb_errpush(info,name)
goto 9999
end if
call psb_realloc(m,globx,info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
globx(:)=czero
do i=1,desc_a%get_local_rows()
call psb_loc_to_glob(i,idx,desc_a,info)
globx(idx) = locx(i)
end do
! adjust overlapped elements
do i=1, size(desc_a%ovrlap_elem,1)
if (me /= desc_a%ovrlap_elem(i,3)) then
@ -321,19 +316,14 @@ subroutine psb_cgatherv(globx, locx, desc_a, info, iroot)
globx(idx) = czero
end if
end do
call psb_sum(ictxt,globx(1:m),root=root)
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_cgatherv
@ -446,13 +436,8 @@ subroutine psb_cgather_vect(globx, locx, desc_a, info, iroot)
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_cgather_vect

21
base/comm/psb_chalo.f90
Unescape Escape View File

@ -208,14 +208,9 @@ subroutine psb_chalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
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_chalom
@ -409,14 +404,9 @@ subroutine psb_chalov(x,desc_a,info,alpha,work,tran,mode,data)
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_chalov
@ -560,12 +550,7 @@ subroutine psb_chalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
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_chalo_vect

21
base/comm/psb_covrl.f90
Unescape Escape View File

@ -193,14 +193,9 @@ subroutine psb_covrlm(x,desc_a,info,jx,ik,work,update,mode)
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_covrlm
!!$
!!$ Parallel Sparse BLAS version 3.1
@ -378,14 +373,9 @@ subroutine psb_covrlv(x,desc_a,info,work,update,mode)
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_covrlv
@ -508,13 +498,8 @@ subroutine psb_covrl_vect(x,desc_a,info,work,update,mode)
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_covrl_vect

14
base/comm/psb_cscatter.F90
Unescape Escape View File

@ -233,14 +233,9 @@ subroutine psb_cscatterm(globx, locx, desc_a, info, iroot)
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_cscatterm
@ -468,13 +463,8 @@ subroutine psb_cscatterv(globx, locx, desc_a, info, iroot)
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_cscatterv

8
base/comm/psb_cspgather.F90
Unescape Escape View File

@ -149,12 +149,8 @@ subroutine psb_csp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
9999 continue
call psb_errpush(info,name)
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
return
call psb_error_handler(ictxt,err_act)
return
end subroutine psb_csp_allgather

31
base/comm/psb_dgather.f90
Unescape Escape View File

@ -127,7 +127,7 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot)
call psb_errpush(info,name)
goto 9999
end if
call psb_realloc(m,k,globx,info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
@ -160,13 +160,8 @@ subroutine psb_dgatherm(globx, locx, desc_a, info, iroot)
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_dgatherm
@ -298,21 +293,21 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot)
call psb_errpush(info,name)
goto 9999
end if
call psb_realloc(m,globx,info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
globx(:)=dzero
do i=1,desc_a%get_local_rows()
call psb_loc_to_glob(i,idx,desc_a,info)
globx(idx) = locx(i)
end do
! adjust overlapped elements
do i=1, size(desc_a%ovrlap_elem,1)
if (me /= desc_a%ovrlap_elem(i,3)) then
@ -321,19 +316,14 @@ subroutine psb_dgatherv(globx, locx, desc_a, info, iroot)
globx(idx) = dzero
end if
end do
call psb_sum(ictxt,globx(1:m),root=root)
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_dgatherv
@ -446,13 +436,8 @@ subroutine psb_dgather_vect(globx, locx, desc_a, info, iroot)
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_dgather_vect

21
base/comm/psb_dhalo.f90
Unescape Escape View File

@ -208,14 +208,9 @@ subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
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_dhalom
@ -409,14 +404,9 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data)
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_dhalov
@ -560,12 +550,7 @@ subroutine psb_dhalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
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_dhalo_vect

21
base/comm/psb_dovrl.f90
Unescape Escape View File

@ -193,14 +193,9 @@ subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode)
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_dovrlm
!!$
!!$ Parallel Sparse BLAS version 3.1
@ -378,14 +373,9 @@ subroutine psb_dovrlv(x,desc_a,info,work,update,mode)
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_dovrlv
@ -508,13 +498,8 @@ subroutine psb_dovrl_vect(x,desc_a,info,work,update,mode)
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_dovrl_vect

14
base/comm/psb_dscatter.F90
Unescape Escape View File

@ -233,14 +233,9 @@ subroutine psb_dscatterm(globx, locx, desc_a, info, iroot)
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_dscatterm
@ -468,13 +463,8 @@ subroutine psb_dscatterv(globx, locx, desc_a, info, iroot)
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_dscatterv

8
base/comm/psb_dspgather.F90
Unescape Escape View File

@ -149,12 +149,8 @@ subroutine psb_dsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
9999 continue
call psb_errpush(info,name)
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
return
call psb_error_handler(ictxt,err_act)
return
end subroutine psb_dsp_allgather

21
base/comm/psb_igather.f90
Unescape Escape View File

@ -160,14 +160,9 @@ subroutine psb_igatherm(globx, locx, desc_a, info, iroot)
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_igatherm
@ -319,14 +314,9 @@ subroutine psb_igatherv(globx, locx, desc_a, info, iroot)
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_igatherv
@ -437,13 +427,8 @@ subroutine psb_igather_vect(globx, locx, desc_a, info, iroot)
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_igather_vect

21
base/comm/psb_ihalo.f90
Unescape Escape View File

@ -212,14 +212,9 @@ subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
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_ihalom
@ -415,14 +410,9 @@ subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data)
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_ihalov
@ -568,12 +558,7 @@ subroutine psb_ihalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
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_ihalo_vect

21
base/comm/psb_iovrl.f90
Unescape Escape View File

@ -191,14 +191,9 @@ subroutine psb_iovrlm(x,desc_a,info,jx,ik,work,update,mode)
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_iovrlm
!!$
@ -379,14 +374,9 @@ subroutine psb_iovrlv(x,desc_a,info,work,update,mode)
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_iovrlv
subroutine psb_iovrl_vect(x,desc_a,info,work,update,mode)
@ -508,13 +498,8 @@ subroutine psb_iovrl_vect(x,desc_a,info,work,update,mode)
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_iovrl_vect

14
base/comm/psb_iscatter.F90
Unescape Escape View File

@ -217,14 +217,9 @@ subroutine psb_iscatterm(globx, locx, desc_a, info, iroot)
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_iscatterm
@ -424,13 +419,8 @@ subroutine psb_iscatterv(globx, locx, desc_a, info, iroot)
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_iscatterv

31
base/comm/psb_sgather.f90
Unescape Escape View File

@ -127,7 +127,7 @@ subroutine psb_sgatherm(globx, locx, desc_a, info, iroot)
call psb_errpush(info,name)
goto 9999
end if
call psb_realloc(m,k,globx,info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
@ -160,13 +160,8 @@ subroutine psb_sgatherm(globx, locx, desc_a, info, iroot)
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_sgatherm
@ -298,21 +293,21 @@ subroutine psb_sgatherv(globx, locx, desc_a, info, iroot)
call psb_errpush(info,name)
goto 9999
end if
call psb_realloc(m,globx,info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
globx(:)=szero
do i=1,desc_a%get_local_rows()
call psb_loc_to_glob(i,idx,desc_a,info)
globx(idx) = locx(i)
end do
! adjust overlapped elements
do i=1, size(desc_a%ovrlap_elem,1)
if (me /= desc_a%ovrlap_elem(i,3)) then
@ -321,19 +316,14 @@ subroutine psb_sgatherv(globx, locx, desc_a, info, iroot)
globx(idx) = szero
end if
end do
call psb_sum(ictxt,globx(1:m),root=root)
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_sgatherv
@ -446,13 +436,8 @@ subroutine psb_sgather_vect(globx, locx, desc_a, info, iroot)
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_sgather_vect

21
base/comm/psb_shalo.f90
Unescape Escape View File

@ -208,14 +208,9 @@ subroutine psb_shalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
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_shalom
@ -409,14 +404,9 @@ subroutine psb_shalov(x,desc_a,info,alpha,work,tran,mode,data)
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_shalov
@ -560,12 +550,7 @@ subroutine psb_shalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
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_shalo_vect

21
base/comm/psb_sovrl.f90
Unescape Escape View File

@ -193,14 +193,9 @@ subroutine psb_sovrlm(x,desc_a,info,jx,ik,work,update,mode)
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_sovrlm
!!$
!!$ Parallel Sparse BLAS version 3.1
@ -378,14 +373,9 @@ subroutine psb_sovrlv(x,desc_a,info,work,update,mode)
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_sovrlv
@ -508,13 +498,8 @@ subroutine psb_sovrl_vect(x,desc_a,info,work,update,mode)
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_sovrl_vect

14
base/comm/psb_sscatter.F90
Unescape Escape View File

@ -233,14 +233,9 @@ subroutine psb_sscatterm(globx, locx, desc_a, info, iroot)
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_sscatterm
@ -468,13 +463,8 @@ subroutine psb_sscatterv(globx, locx, desc_a, info, iroot)
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_sscatterv

8
base/comm/psb_sspgather.F90
Unescape Escape View File

@ -149,12 +149,8 @@ subroutine psb_ssp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
9999 continue
call psb_errpush(info,name)
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
return
call psb_error_handler(ictxt,err_act)
return
end subroutine psb_ssp_allgather

31
base/comm/psb_zgather.f90
Unescape Escape View File

@ -127,7 +127,7 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot)
call psb_errpush(info,name)
goto 9999
end if
call psb_realloc(m,k,globx,info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
@ -160,13 +160,8 @@ subroutine psb_zgatherm(globx, locx, desc_a, info, iroot)
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_zgatherm
@ -298,21 +293,21 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot)
call psb_errpush(info,name)
goto 9999
end if
call psb_realloc(m,globx,info)
if (info /= psb_success_) then
info=psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
globx(:)=zzero
do i=1,desc_a%get_local_rows()
call psb_loc_to_glob(i,idx,desc_a,info)
globx(idx) = locx(i)
end do
! adjust overlapped elements
do i=1, size(desc_a%ovrlap_elem,1)
if (me /= desc_a%ovrlap_elem(i,3)) then
@ -321,19 +316,14 @@ subroutine psb_zgatherv(globx, locx, desc_a, info, iroot)
globx(idx) = zzero
end if
end do
call psb_sum(ictxt,globx(1:m),root=root)
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_zgatherv
@ -446,13 +436,8 @@ subroutine psb_zgather_vect(globx, locx, desc_a, info, iroot)
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_zgather_vect

21
base/comm/psb_zhalo.f90
Unescape Escape View File

@ -208,14 +208,9 @@ subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
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_zhalom
@ -409,14 +404,9 @@ subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode,data)
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_zhalov
@ -560,12 +550,7 @@ subroutine psb_zhalo_vect(x,desc_a,info,alpha,work,tran,mode,data)
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_zhalo_vect

21
base/comm/psb_zovrl.f90
Unescape Escape View File

@ -193,14 +193,9 @@ subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update,mode)
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_zovrlm
!!$
!!$ Parallel Sparse BLAS version 3.1
@ -378,14 +373,9 @@ subroutine psb_zovrlv(x,desc_a,info,work,update,mode)
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_zovrlv
@ -508,13 +498,8 @@ subroutine psb_zovrl_vect(x,desc_a,info,work,update,mode)
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_zovrl_vect

14
base/comm/psb_zscatter.F90
Unescape Escape View File

@ -233,14 +233,9 @@ subroutine psb_zscatterm(globx, locx, desc_a, info, iroot)
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_zscatterm
@ -468,13 +463,8 @@ subroutine psb_zscatterv(globx, locx, desc_a, info, iroot)
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_zscatterv

8
base/comm/psb_zspgather.F90
Unescape Escape View File

@ -149,12 +149,8 @@ subroutine psb_zsp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keep
9999 continue
call psb_errpush(info,name)
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
call psb_error()
return
end if
return
call psb_error_handler(ictxt,err_act)
return
end subroutine psb_zsp_allgather

2
base/modules/psb_c_base_mat_mod.f90
Unescape Escape View File

@ -153,7 +153,7 @@ module psb_c_base_mat_mod
procedure, pass(a) :: mv_from_coo => psb_c_mv_coo_from_coo
procedure, pass(a) :: mv_to_fmt => psb_c_mv_coo_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_c_mv_coo_from_fmt
procedure, pass(a) :: csput_a => psb_c_coo_csput_a
procedure, pass(a) :: csput_a => psb_c_coo_csput_a
procedure, pass(a) :: get_diag => psb_c_coo_get_diag
procedure, pass(a) :: csgetrow => psb_c_coo_csgetrow
procedure, pass(a) :: csgetptn => psb_c_coo_csgetptn

7
base/modules/psb_c_linmap_mod.f90
Unescape Escape View File

@ -247,10 +247,9 @@ contains
ierr(1) = 2
info = psb_err_missing_override_method_
call psb_errpush(info,name,i_err=ierr)
call psb_get_erraction(err_act)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
call psb_erractionsave(err_act)
call psb_error_handler(err_act)
end select

21
base/modules/psb_check_mod.f90
Unescape Escape View File

@ -162,13 +162,8 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_chkvect
@ -282,13 +277,8 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_chkglobvect
@ -423,13 +413,8 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_chkmat

2
base/modules/psb_d_base_mat_mod.f90
Unescape Escape View File

@ -153,7 +153,7 @@ module psb_d_base_mat_mod
procedure, pass(a) :: mv_from_coo => psb_d_mv_coo_from_coo
procedure, pass(a) :: mv_to_fmt => psb_d_mv_coo_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_d_mv_coo_from_fmt
procedure, pass(a) :: csput_a => psb_d_coo_csput_a
procedure, pass(a) :: csput_a => psb_d_coo_csput_a
procedure, pass(a) :: get_diag => psb_d_coo_get_diag
procedure, pass(a) :: csgetrow => psb_d_coo_csgetrow
procedure, pass(a) :: csgetptn => psb_d_coo_csgetptn

7
base/modules/psb_d_linmap_mod.f90
Unescape Escape View File

@ -247,10 +247,9 @@ contains
ierr(1) = 2
info = psb_err_missing_override_method_
call psb_errpush(info,name,i_err=ierr)
call psb_get_erraction(err_act)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
call psb_erractionsave(err_act)
call psb_error_handler(err_act)
end select

184
base/modules/psb_desc_mod.F90
Unescape Escape View File

@ -672,15 +672,11 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
9999 call psb_error_handler(err_act)
return
end subroutine psb_cd_get_list
@ -752,15 +748,10 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_cd_v_get_list
!
@ -792,18 +783,8 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_ret_) then
return
else
if (ictxt == -1) then
call psb_error()
else
call psb_error(ictxt)
end if
end if
9999 call psb_error_handler(err_act)
return
end subroutine psb_cdfree
@ -944,15 +925,10 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_ret_) then
return
else
call psb_error()
end if
return
end subroutine psb_cdtransfer
@ -1053,14 +1029,8 @@ contains
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_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine psb_cd_clone
@ -1159,13 +1129,9 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error(ictxt)
return
end if
Return
9999 call psb_error_handler(ictxt,err_act)
return
end Subroutine psb_cd_get_recv_idx
@ -1208,14 +1174,11 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
Return
9999 call psb_error_handler(err_act)
return
end subroutine cd_l2gs1
subroutine cd_l2gs2(idxin,idxout,desc,info,mask,owned)
@ -1248,14 +1211,9 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
Return
9999 call psb_error_handler(err_act)
return
end subroutine cd_l2gs2
@ -1288,13 +1246,9 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
Return
9999 call psb_error_handler(err_act)
return
end subroutine cd_l2gv1
@ -1327,13 +1281,9 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
Return
9999 call psb_error_handler(err_act)
return
end subroutine cd_l2gv2
@ -1366,13 +1316,9 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
Return
9999 call psb_error_handler(err_act)
return
end subroutine cd_g2ls1
@ -1406,14 +1352,9 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
Return
9999 call psb_error_handler(err_act)
return
end subroutine cd_g2ls2
@ -1446,14 +1387,9 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
Return
9999 call psb_error_handler(err_act)
return
end subroutine cd_g2lv1
@ -1488,14 +1424,9 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
Return
9999 call psb_error_handler(err_act)
return
end subroutine cd_g2lv2
@ -1529,14 +1460,9 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
Return
9999 call psb_error_handler(err_act)
return
end subroutine cd_g2ls1_ins
@ -1571,14 +1497,9 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
Return
9999 call psb_error_handler(err_act)
return
end subroutine cd_g2ls2_ins
@ -1613,14 +1534,9 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
Return
9999 call psb_error_handler(err_act)
return
end subroutine cd_g2lv1_ins
@ -1655,13 +1571,9 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
Return
9999 call psb_error_handler(err_act)
return
end subroutine cd_g2lv2_ins
@ -1694,13 +1606,9 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
Return
9999 call psb_error_handler(err_act)
return
end subroutine cd_fnd_owner

26
base/modules/psb_gen_block_map_mod.f90
Unescape Escape View File

@ -1170,12 +1170,10 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
9999 call psb_error_handler(err_act)
return
end subroutine block_clone
@ -1222,11 +1220,9 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
9999 call psb_error_handler(err_act)
return
end subroutine block_reinit
@ -1270,11 +1266,9 @@ contains
!!$ call psb_erractionrestore(err_act)
!!$ return
!!$
!!$9999 continue
!!$ call psb_erractionrestore(err_act)
!!$ if (err_act /= psb_act_ret_) then
!!$ call psb_error()
!!$ end if
!!$
!!$9999 call psb_error_handler(err_act)
!!$
!!$ return
!!$ end subroutine block_reinit
!!$

8
base/modules/psb_glist_map_mod.f90
Unescape Escape View File

@ -241,11 +241,9 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
9999 call psb_error_handler(err_act)
return
end subroutine glist_clone

28
base/modules/psb_hash_map_mod.f90
Unescape Escape View File

@ -715,14 +715,8 @@ contains
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_ret_) then
return
else
call psb_error(ictxt)
end if
return
end subroutine hash_g2lv1_ins
@ -1421,12 +1415,10 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
9999 call psb_error_handler(err_act)
return
end subroutine hash_clone
@ -1485,7 +1477,7 @@ contains
call idxmap%g2lip_ins(idx(nr+1:nc),info,lidx=lidx(nr+1:nc))
end if
if (info /= psb_success_) then
info = psb_err_from_subroutine_
call psb_errpush(info,name)
@ -1494,11 +1486,9 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
9999 call psb_error_handler(err_act)
return
end subroutine hash_reinit

65
base/modules/psb_indx_map_mod.f90
Unescape Escape View File

@ -462,9 +462,7 @@ contains
call psb_errpush(psb_err_missing_override_method_,&
& name,a_err=idxmap%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
call psb_error_handler(err_act)
return
end subroutine base_l2gs1
@ -490,10 +488,7 @@ contains
call psb_errpush(psb_err_missing_override_method_,&
& name,a_err=idxmap%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine base_l2gs2
@ -517,9 +512,7 @@ contains
call psb_errpush(psb_err_missing_override_method_,&
& name,a_err=idxmap%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
call psb_error_handler(err_act)
return
end subroutine base_l2gv1
@ -543,9 +536,7 @@ contains
call psb_errpush(psb_err_missing_override_method_,&
& name,a_err=idxmap%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
call psb_error_handler(err_act)
return
end subroutine base_l2gv2
@ -570,9 +561,7 @@ contains
call psb_errpush(psb_err_missing_override_method_,&
& name,a_err=idxmap%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
call psb_error_handler(err_act)
return
end subroutine base_g2ls1
@ -598,9 +587,7 @@ contains
call psb_errpush(psb_err_missing_override_method_,&
& name,a_err=idxmap%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
call psb_error_handler(err_act)
return
end subroutine base_g2ls2
@ -625,9 +612,7 @@ contains
call psb_errpush(psb_err_missing_override_method_,&
& name,a_err=idxmap%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
call psb_error_handler(err_act)
return
end subroutine base_g2lv1
@ -653,9 +638,7 @@ contains
call psb_errpush(psb_err_missing_override_method_,&
& name,a_err=idxmap%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
call psb_error_handler(err_act)
return
@ -682,9 +665,7 @@ contains
call psb_errpush(psb_err_missing_override_method_,&
& name,a_err=idxmap%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
call psb_error_handler(err_act)
return
end subroutine base_g2ls1_ins
@ -710,9 +691,7 @@ contains
call psb_errpush(psb_err_missing_override_method_,&
& name,a_err=idxmap%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
call psb_error_handler(err_act)
return
end subroutine base_g2ls2_ins
@ -738,9 +717,7 @@ contains
call psb_errpush(psb_err_missing_override_method_,&
& name,a_err=idxmap%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
call psb_error_handler(err_act)
return
end subroutine base_g2lv1_ins
@ -766,9 +743,7 @@ contains
call psb_errpush(psb_err_missing_override_method_,&
& name,a_err=idxmap%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
call psb_error_handler(err_act)
return
end subroutine base_g2lv2_ins
@ -791,9 +766,7 @@ contains
call psb_errpush(psb_err_missing_override_method_,&
& name,a_err=idxmap%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
call psb_error_handler(err_act)
return
end subroutine base_asb
@ -849,9 +822,7 @@ contains
call psb_errpush(psb_err_missing_override_method_,&
& name,a_err=idxmap%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
call psb_error_handler(err_act)
return
end subroutine base_init_vl
@ -875,9 +846,7 @@ contains
call psb_errpush(psb_err_missing_override_method_,&
& name,a_err=idxmap%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
call psb_error_handler(err_act)
return
end subroutine base_clone
@ -901,9 +870,7 @@ contains
call psb_errpush(psb_err_missing_override_method_,&
& name,a_err=idxmap%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
call psb_error_handler(err_act)
return
end subroutine base_reinit

7
base/modules/psb_list_map_mod.f90
Unescape Escape View File

@ -698,11 +698,8 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
9999 call psb_error_handler(err_act)
return
end subroutine list_clone

525
base/modules/psb_realloc_mod.F90
View File

File diff suppressed because it is too large Load Diff

7
base/modules/psb_repl_map_mod.f90
Unescape Escape View File

@ -798,11 +798,8 @@ contains
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
9999 call psb_error_handler(err_act)
return
end subroutine repl_clone

2
base/modules/psb_s_base_mat_mod.f90
Unescape Escape View File

@ -153,7 +153,7 @@ module psb_s_base_mat_mod
procedure, pass(a) :: mv_from_coo => psb_s_mv_coo_from_coo
procedure, pass(a) :: mv_to_fmt => psb_s_mv_coo_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_s_mv_coo_from_fmt
procedure, pass(a) :: csput_a => psb_s_coo_csput_a
procedure, pass(a) :: csput_a => psb_s_coo_csput_a
procedure, pass(a) :: get_diag => psb_s_coo_get_diag
procedure, pass(a) :: csgetrow => psb_s_coo_csgetrow
procedure, pass(a) :: csgetptn => psb_s_coo_csgetptn

7
base/modules/psb_s_linmap_mod.f90
Unescape Escape View File

@ -247,10 +247,9 @@ contains
ierr(1) = 2
info = psb_err_missing_override_method_
call psb_errpush(info,name,i_err=ierr)
call psb_get_erraction(err_act)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
call psb_erractionsave(err_act)
call psb_error_handler(err_act)
end select

1
base/modules/psb_serial_mod.f90
Unescape Escape View File

@ -325,7 +325,6 @@ contains
end do
end if
return
return
end subroutine zrot
!
!

2
base/modules/psb_z_base_mat_mod.f90
Unescape Escape View File

@ -153,7 +153,7 @@ module psb_z_base_mat_mod
procedure, pass(a) :: mv_from_coo => psb_z_mv_coo_from_coo
procedure, pass(a) :: mv_to_fmt => psb_z_mv_coo_to_fmt
procedure, pass(a) :: mv_from_fmt => psb_z_mv_coo_from_fmt
procedure, pass(a) :: csput_a => psb_z_coo_csput_a
procedure, pass(a) :: csput_a => psb_z_coo_csput_a
procedure, pass(a) :: get_diag => psb_z_coo_get_diag
procedure, pass(a) :: csgetrow => psb_z_coo_csgetrow
procedure, pass(a) :: csgetptn => psb_z_coo_csgetptn

7
base/modules/psb_z_linmap_mod.f90
Unescape Escape View File

@ -247,10 +247,9 @@ contains
ierr(1) = 2
info = psb_err_missing_override_method_
call psb_errpush(info,name,i_err=ierr)
call psb_get_erraction(err_act)
if (err_act /= psb_act_ret_) then
call psb_error()
end if
call psb_erractionsave(err_act)
call psb_error_handler(err_act)
end select

260
base/serial/impl/psb_c_base_mat_impl.F90
Unescape Escape View File

@ -55,17 +55,14 @@ subroutine psb_c_base_cp_to_coo(a,b,info)
character(len=20) :: name='to_coo'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_c_base_cp_to_coo
@ -83,17 +80,14 @@ subroutine psb_c_base_cp_from_coo(a,b,info)
character(len=20) :: name='from_coo'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_c_base_cp_from_coo
@ -131,14 +125,8 @@ subroutine psb_c_base_cp_to_fmt(a,b,info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
return
end subroutine psb_c_base_cp_to_fmt
@ -177,13 +165,8 @@ subroutine psb_c_base_cp_from_fmt(a,b,info)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_c_base_cp_from_fmt
@ -221,13 +204,8 @@ subroutine psb_c_base_mv_to_coo(a,b,info)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_c_base_mv_to_coo
@ -263,13 +241,8 @@ subroutine psb_c_base_mv_from_coo(a,b,info)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_c_base_mv_from_coo
@ -342,17 +315,14 @@ subroutine psb_c_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
character(len=20) :: name='csput'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_c_base_csput_a
@ -394,13 +364,8 @@ subroutine psb_c_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_c_base_csput_v
@ -428,17 +393,14 @@ subroutine psb_c_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_c_base_csgetrow
@ -536,13 +498,8 @@ subroutine psb_c_base_csgetblk(imin,imax,a,b,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_c_base_csgetblk
@ -626,13 +583,8 @@ subroutine psb_c_base_csclip(a,b,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_c_base_csclip
@ -742,13 +694,8 @@ subroutine psb_c_base_tril(a,b,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_c_base_tril
@ -852,13 +799,8 @@ subroutine psb_c_base_triu(a,b,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_c_base_triu
@ -938,17 +880,14 @@ subroutine psb_c_base_mold(a,b,info)
character(len=20) :: name='base_mold'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_c_base_mold
@ -984,10 +923,8 @@ subroutine psb_c_base_transp_2mat(a,b)
call psb_erractionrestore(err_act)
return
9999 continue
if (err_act /= psb_act_ret_) then
call psb_error()
end if
9999 call psb_error_handler(err_act)
return
@ -1024,10 +961,8 @@ subroutine psb_c_base_transc_2mat(a,b)
call psb_erractionrestore(err_act)
return
9999 continue
if (err_act /= psb_act_ret_) then
call psb_error()
end if
9999 call psb_error_handler(err_act)
return
end subroutine psb_c_base_transc_2mat
@ -1058,10 +993,8 @@ subroutine psb_c_base_transp_1mat(a)
call psb_erractionrestore(err_act)
return
9999 continue
if (err_act /= psb_act_ret_) then
call psb_error()
end if
9999 call psb_error_handler(err_act)
return
@ -1092,10 +1025,8 @@ subroutine psb_c_base_transc_1mat(a)
call psb_erractionrestore(err_act)
return
9999 continue
if (err_act /= psb_act_ret_) then
call psb_error()
end if
9999 call psb_error_handler(err_act)
return
@ -1131,17 +1062,14 @@ subroutine psb_c_base_csmm(alpha,a,x,beta,y,info,trans)
character(len=20) :: name='c_base_csmm'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_c_base_csmm
@ -1161,17 +1089,14 @@ subroutine psb_c_base_csmv(alpha,a,x,beta,y,info,trans)
character(len=20) :: name='c_base_csmv'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_c_base_csmv
@ -1192,17 +1117,14 @@ subroutine psb_c_base_inner_cssm(alpha,a,x,beta,y,info,trans)
character(len=20) :: name='c_base_inner_cssm'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_c_base_inner_cssm
@ -1222,17 +1144,14 @@ subroutine psb_c_base_inner_cssv(alpha,a,x,beta,y,info,trans)
character(len=20) :: name='c_base_inner_cssv'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_c_base_inner_cssv
@ -1365,13 +1284,8 @@ subroutine psb_c_base_cssm(alpha,a,x,beta,y,info,trans,scale,d)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
@ -1501,13 +1415,8 @@ subroutine psb_c_base_cssv(alpha,a,x,beta,y,info,trans,scale,d)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
contains
subroutine inner_vscal(n,d,x,y)
@ -1551,17 +1460,14 @@ subroutine psb_c_base_scals(d,a,info)
character(len=20) :: name='c_scals'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_c_base_scals
@ -1581,17 +1487,14 @@ subroutine psb_c_base_scal(d,a,info,side)
character(len=20) :: name='c_scal'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_c_base_scal
@ -1611,19 +1514,15 @@ function psb_c_base_maxval(a) result(res)
character(len=20) :: name='maxval'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
res = szero
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
res = szero
return
call psb_error_handler(err_act)
end function psb_c_base_maxval
@ -1661,13 +1560,8 @@ function psb_c_base_csnmi(a) result(res)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end function psb_c_base_csnmi
@ -1705,13 +1599,8 @@ function psb_c_base_csnm1(a) result(res)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end function psb_c_base_csnm1
@ -1728,18 +1617,14 @@ subroutine psb_c_base_rowsum(d,a)
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_c_base_rowsum
@ -1755,18 +1640,14 @@ subroutine psb_c_base_arwsum(d,a)
character(len=20) :: name='arwsum'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_c_base_arwsum
@ -1782,18 +1663,14 @@ subroutine psb_c_base_colsum(d,a)
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_c_base_colsum
@ -1809,18 +1686,14 @@ subroutine psb_c_base_aclsum(d,a)
character(len=20) :: name='aclsum'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_c_base_aclsum
@ -1840,18 +1713,14 @@ subroutine psb_c_base_get_diag(a,d,info)
character(len=20) :: name='get_diag'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_c_base_get_diag
@ -2029,13 +1898,8 @@ subroutine psb_c_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_c_base_vect_cssv
@ -2072,15 +1936,9 @@ subroutine psb_c_base_inner_vect_sv(alpha,a,x,beta,y,info,trans)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_c_base_inner_vect_sv

260
base/serial/impl/psb_d_base_mat_impl.F90
Unescape Escape View File

@ -55,17 +55,14 @@ subroutine psb_d_base_cp_to_coo(a,b,info)
character(len=20) :: name='to_coo'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_d_base_cp_to_coo
@ -83,17 +80,14 @@ subroutine psb_d_base_cp_from_coo(a,b,info)
character(len=20) :: name='from_coo'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_d_base_cp_from_coo
@ -131,14 +125,8 @@ subroutine psb_d_base_cp_to_fmt(a,b,info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
return
end subroutine psb_d_base_cp_to_fmt
@ -177,13 +165,8 @@ subroutine psb_d_base_cp_from_fmt(a,b,info)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_d_base_cp_from_fmt
@ -221,13 +204,8 @@ subroutine psb_d_base_mv_to_coo(a,b,info)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_d_base_mv_to_coo
@ -263,13 +241,8 @@ subroutine psb_d_base_mv_from_coo(a,b,info)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_d_base_mv_from_coo
@ -342,17 +315,14 @@ subroutine psb_d_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
character(len=20) :: name='csput'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_d_base_csput_a
@ -394,13 +364,8 @@ subroutine psb_d_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_d_base_csput_v
@ -428,17 +393,14 @@ subroutine psb_d_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_d_base_csgetrow
@ -536,13 +498,8 @@ subroutine psb_d_base_csgetblk(imin,imax,a,b,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_d_base_csgetblk
@ -626,13 +583,8 @@ subroutine psb_d_base_csclip(a,b,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_d_base_csclip
@ -742,13 +694,8 @@ subroutine psb_d_base_tril(a,b,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_d_base_tril
@ -852,13 +799,8 @@ subroutine psb_d_base_triu(a,b,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_d_base_triu
@ -938,17 +880,14 @@ subroutine psb_d_base_mold(a,b,info)
character(len=20) :: name='base_mold'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_d_base_mold
@ -984,10 +923,8 @@ subroutine psb_d_base_transp_2mat(a,b)
call psb_erractionrestore(err_act)
return
9999 continue
if (err_act /= psb_act_ret_) then
call psb_error()
end if
9999 call psb_error_handler(err_act)
return
@ -1024,10 +961,8 @@ subroutine psb_d_base_transc_2mat(a,b)
call psb_erractionrestore(err_act)
return
9999 continue
if (err_act /= psb_act_ret_) then
call psb_error()
end if
9999 call psb_error_handler(err_act)
return
end subroutine psb_d_base_transc_2mat
@ -1058,10 +993,8 @@ subroutine psb_d_base_transp_1mat(a)
call psb_erractionrestore(err_act)
return
9999 continue
if (err_act /= psb_act_ret_) then
call psb_error()
end if
9999 call psb_error_handler(err_act)
return
@ -1092,10 +1025,8 @@ subroutine psb_d_base_transc_1mat(a)
call psb_erractionrestore(err_act)
return
9999 continue
if (err_act /= psb_act_ret_) then
call psb_error()
end if
9999 call psb_error_handler(err_act)
return
@ -1131,17 +1062,14 @@ subroutine psb_d_base_csmm(alpha,a,x,beta,y,info,trans)
character(len=20) :: name='d_base_csmm'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_d_base_csmm
@ -1161,17 +1089,14 @@ subroutine psb_d_base_csmv(alpha,a,x,beta,y,info,trans)
character(len=20) :: name='d_base_csmv'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_d_base_csmv
@ -1192,17 +1117,14 @@ subroutine psb_d_base_inner_cssm(alpha,a,x,beta,y,info,trans)
character(len=20) :: name='d_base_inner_cssm'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_d_base_inner_cssm
@ -1222,17 +1144,14 @@ subroutine psb_d_base_inner_cssv(alpha,a,x,beta,y,info,trans)
character(len=20) :: name='d_base_inner_cssv'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_d_base_inner_cssv
@ -1365,13 +1284,8 @@ subroutine psb_d_base_cssm(alpha,a,x,beta,y,info,trans,scale,d)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
@ -1501,13 +1415,8 @@ subroutine psb_d_base_cssv(alpha,a,x,beta,y,info,trans,scale,d)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
contains
subroutine inner_vscal(n,d,x,y)
@ -1551,17 +1460,14 @@ subroutine psb_d_base_scals(d,a,info)
character(len=20) :: name='d_scals'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_d_base_scals
@ -1581,17 +1487,14 @@ subroutine psb_d_base_scal(d,a,info,side)
character(len=20) :: name='d_scal'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_d_base_scal
@ -1611,19 +1514,15 @@ function psb_d_base_maxval(a) result(res)
character(len=20) :: name='maxval'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
res = dzero
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
res = dzero
return
call psb_error_handler(err_act)
end function psb_d_base_maxval
@ -1661,13 +1560,8 @@ function psb_d_base_csnmi(a) result(res)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end function psb_d_base_csnmi
@ -1705,13 +1599,8 @@ function psb_d_base_csnm1(a) result(res)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end function psb_d_base_csnm1
@ -1728,18 +1617,14 @@ subroutine psb_d_base_rowsum(d,a)
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_d_base_rowsum
@ -1755,18 +1640,14 @@ subroutine psb_d_base_arwsum(d,a)
character(len=20) :: name='arwsum'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_d_base_arwsum
@ -1782,18 +1663,14 @@ subroutine psb_d_base_colsum(d,a)
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_d_base_colsum
@ -1809,18 +1686,14 @@ subroutine psb_d_base_aclsum(d,a)
character(len=20) :: name='aclsum'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_d_base_aclsum
@ -1840,18 +1713,14 @@ subroutine psb_d_base_get_diag(a,d,info)
character(len=20) :: name='get_diag'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_d_base_get_diag
@ -2029,13 +1898,8 @@ subroutine psb_d_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_d_base_vect_cssv
@ -2072,15 +1936,9 @@ subroutine psb_d_base_inner_vect_sv(alpha,a,x,beta,y,info,trans)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_d_base_inner_vect_sv

260
base/serial/impl/psb_s_base_mat_impl.F90
Unescape Escape View File

@ -55,17 +55,14 @@ subroutine psb_s_base_cp_to_coo(a,b,info)
character(len=20) :: name='to_coo'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_s_base_cp_to_coo
@ -83,17 +80,14 @@ subroutine psb_s_base_cp_from_coo(a,b,info)
character(len=20) :: name='from_coo'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_s_base_cp_from_coo
@ -131,14 +125,8 @@ subroutine psb_s_base_cp_to_fmt(a,b,info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
return
end subroutine psb_s_base_cp_to_fmt
@ -177,13 +165,8 @@ subroutine psb_s_base_cp_from_fmt(a,b,info)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_s_base_cp_from_fmt
@ -221,13 +204,8 @@ subroutine psb_s_base_mv_to_coo(a,b,info)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_s_base_mv_to_coo
@ -263,13 +241,8 @@ subroutine psb_s_base_mv_from_coo(a,b,info)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_s_base_mv_from_coo
@ -342,17 +315,14 @@ subroutine psb_s_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
character(len=20) :: name='csput'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_s_base_csput_a
@ -394,13 +364,8 @@ subroutine psb_s_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_s_base_csput_v
@ -428,17 +393,14 @@ subroutine psb_s_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_s_base_csgetrow
@ -536,13 +498,8 @@ subroutine psb_s_base_csgetblk(imin,imax,a,b,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_s_base_csgetblk
@ -626,13 +583,8 @@ subroutine psb_s_base_csclip(a,b,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_s_base_csclip
@ -742,13 +694,8 @@ subroutine psb_s_base_tril(a,b,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_s_base_tril
@ -852,13 +799,8 @@ subroutine psb_s_base_triu(a,b,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_s_base_triu
@ -938,17 +880,14 @@ subroutine psb_s_base_mold(a,b,info)
character(len=20) :: name='base_mold'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_s_base_mold
@ -984,10 +923,8 @@ subroutine psb_s_base_transp_2mat(a,b)
call psb_erractionrestore(err_act)
return
9999 continue
if (err_act /= psb_act_ret_) then
call psb_error()
end if
9999 call psb_error_handler(err_act)
return
@ -1024,10 +961,8 @@ subroutine psb_s_base_transc_2mat(a,b)
call psb_erractionrestore(err_act)
return
9999 continue
if (err_act /= psb_act_ret_) then
call psb_error()
end if
9999 call psb_error_handler(err_act)
return
end subroutine psb_s_base_transc_2mat
@ -1058,10 +993,8 @@ subroutine psb_s_base_transp_1mat(a)
call psb_erractionrestore(err_act)
return
9999 continue
if (err_act /= psb_act_ret_) then
call psb_error()
end if
9999 call psb_error_handler(err_act)
return
@ -1092,10 +1025,8 @@ subroutine psb_s_base_transc_1mat(a)
call psb_erractionrestore(err_act)
return
9999 continue
if (err_act /= psb_act_ret_) then
call psb_error()
end if
9999 call psb_error_handler(err_act)
return
@ -1131,17 +1062,14 @@ subroutine psb_s_base_csmm(alpha,a,x,beta,y,info,trans)
character(len=20) :: name='s_base_csmm'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_s_base_csmm
@ -1161,17 +1089,14 @@ subroutine psb_s_base_csmv(alpha,a,x,beta,y,info,trans)
character(len=20) :: name='s_base_csmv'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_s_base_csmv
@ -1192,17 +1117,14 @@ subroutine psb_s_base_inner_cssm(alpha,a,x,beta,y,info,trans)
character(len=20) :: name='s_base_inner_cssm'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_s_base_inner_cssm
@ -1222,17 +1144,14 @@ subroutine psb_s_base_inner_cssv(alpha,a,x,beta,y,info,trans)
character(len=20) :: name='s_base_inner_cssv'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_s_base_inner_cssv
@ -1365,13 +1284,8 @@ subroutine psb_s_base_cssm(alpha,a,x,beta,y,info,trans,scale,d)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
@ -1501,13 +1415,8 @@ subroutine psb_s_base_cssv(alpha,a,x,beta,y,info,trans,scale,d)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
contains
subroutine inner_vscal(n,d,x,y)
@ -1551,17 +1460,14 @@ subroutine psb_s_base_scals(d,a,info)
character(len=20) :: name='s_scals'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_s_base_scals
@ -1581,17 +1487,14 @@ subroutine psb_s_base_scal(d,a,info,side)
character(len=20) :: name='s_scal'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_s_base_scal
@ -1611,19 +1514,15 @@ function psb_s_base_maxval(a) result(res)
character(len=20) :: name='maxval'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
res = szero
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
res = szero
return
call psb_error_handler(err_act)
end function psb_s_base_maxval
@ -1661,13 +1560,8 @@ function psb_s_base_csnmi(a) result(res)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end function psb_s_base_csnmi
@ -1705,13 +1599,8 @@ function psb_s_base_csnm1(a) result(res)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end function psb_s_base_csnm1
@ -1728,18 +1617,14 @@ subroutine psb_s_base_rowsum(d,a)
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_s_base_rowsum
@ -1755,18 +1640,14 @@ subroutine psb_s_base_arwsum(d,a)
character(len=20) :: name='arwsum'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_s_base_arwsum
@ -1782,18 +1663,14 @@ subroutine psb_s_base_colsum(d,a)
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_s_base_colsum
@ -1809,18 +1686,14 @@ subroutine psb_s_base_aclsum(d,a)
character(len=20) :: name='aclsum'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_s_base_aclsum
@ -1840,18 +1713,14 @@ subroutine psb_s_base_get_diag(a,d,info)
character(len=20) :: name='get_diag'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_s_base_get_diag
@ -2029,13 +1898,8 @@ subroutine psb_s_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_s_base_vect_cssv
@ -2072,15 +1936,9 @@ subroutine psb_s_base_inner_vect_sv(alpha,a,x,beta,y,info,trans)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_s_base_inner_vect_sv

260
base/serial/impl/psb_z_base_mat_impl.F90
Unescape Escape View File

@ -55,17 +55,14 @@ subroutine psb_z_base_cp_to_coo(a,b,info)
character(len=20) :: name='to_coo'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_z_base_cp_to_coo
@ -83,17 +80,14 @@ subroutine psb_z_base_cp_from_coo(a,b,info)
character(len=20) :: name='from_coo'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_z_base_cp_from_coo
@ -131,14 +125,8 @@ subroutine psb_z_base_cp_to_fmt(a,b,info)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
return
end subroutine psb_z_base_cp_to_fmt
@ -177,13 +165,8 @@ subroutine psb_z_base_cp_from_fmt(a,b,info)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_z_base_cp_from_fmt
@ -221,13 +204,8 @@ subroutine psb_z_base_mv_to_coo(a,b,info)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_z_base_mv_to_coo
@ -263,13 +241,8 @@ subroutine psb_z_base_mv_from_coo(a,b,info)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_z_base_mv_from_coo
@ -342,17 +315,14 @@ subroutine psb_z_base_csput_a(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
character(len=20) :: name='csput'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_z_base_csput_a
@ -394,13 +364,8 @@ subroutine psb_z_base_csput_v(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl)
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_z_base_csput_v
@ -428,17 +393,14 @@ subroutine psb_z_base_csgetrow(imin,imax,a,nz,ia,ja,val,info,&
character(len=20) :: name='csget'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_z_base_csgetrow
@ -536,13 +498,8 @@ subroutine psb_z_base_csgetblk(imin,imax,a,b,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_z_base_csgetblk
@ -626,13 +583,8 @@ subroutine psb_z_base_csclip(a,b,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_z_base_csclip
@ -742,13 +694,8 @@ subroutine psb_z_base_tril(a,b,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_z_base_tril
@ -852,13 +799,8 @@ subroutine psb_z_base_triu(a,b,info,&
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_z_base_triu
@ -938,17 +880,14 @@ subroutine psb_z_base_mold(a,b,info)
character(len=20) :: name='base_mold'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_z_base_mold
@ -984,10 +923,8 @@ subroutine psb_z_base_transp_2mat(a,b)
call psb_erractionrestore(err_act)
return
9999 continue
if (err_act /= psb_act_ret_) then
call psb_error()
end if
9999 call psb_error_handler(err_act)
return
@ -1024,10 +961,8 @@ subroutine psb_z_base_transc_2mat(a,b)
call psb_erractionrestore(err_act)
return
9999 continue
if (err_act /= psb_act_ret_) then
call psb_error()
end if
9999 call psb_error_handler(err_act)
return
end subroutine psb_z_base_transc_2mat
@ -1058,10 +993,8 @@ subroutine psb_z_base_transp_1mat(a)
call psb_erractionrestore(err_act)
return
9999 continue
if (err_act /= psb_act_ret_) then
call psb_error()
end if
9999 call psb_error_handler(err_act)
return
@ -1092,10 +1025,8 @@ subroutine psb_z_base_transc_1mat(a)
call psb_erractionrestore(err_act)
return
9999 continue
if (err_act /= psb_act_ret_) then
call psb_error()
end if
9999 call psb_error_handler(err_act)
return
@ -1131,17 +1062,14 @@ subroutine psb_z_base_csmm(alpha,a,x,beta,y,info,trans)
character(len=20) :: name='z_base_csmm'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_z_base_csmm
@ -1161,17 +1089,14 @@ subroutine psb_z_base_csmv(alpha,a,x,beta,y,info,trans)
character(len=20) :: name='z_base_csmv'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_z_base_csmv
@ -1192,17 +1117,14 @@ subroutine psb_z_base_inner_cssm(alpha,a,x,beta,y,info,trans)
character(len=20) :: name='z_base_inner_cssm'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_z_base_inner_cssm
@ -1222,17 +1144,14 @@ subroutine psb_z_base_inner_cssv(alpha,a,x,beta,y,info,trans)
character(len=20) :: name='z_base_inner_cssv'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_z_base_inner_cssv
@ -1365,13 +1284,8 @@ subroutine psb_z_base_cssm(alpha,a,x,beta,y,info,trans,scale,d)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
@ -1501,13 +1415,8 @@ subroutine psb_z_base_cssv(alpha,a,x,beta,y,info,trans,scale,d)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
contains
subroutine inner_vscal(n,d,x,y)
@ -1551,17 +1460,14 @@ subroutine psb_z_base_scals(d,a,info)
character(len=20) :: name='z_scals'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_z_base_scals
@ -1581,17 +1487,14 @@ subroutine psb_z_base_scal(d,a,info,side)
character(len=20) :: name='z_scal'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_z_base_scal
@ -1611,19 +1514,15 @@ function psb_z_base_maxval(a) result(res)
character(len=20) :: name='maxval'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
res = dzero
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
res = dzero
return
call psb_error_handler(err_act)
end function psb_z_base_maxval
@ -1661,13 +1560,8 @@ function psb_z_base_csnmi(a) result(res)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end function psb_z_base_csnmi
@ -1705,13 +1599,8 @@ function psb_z_base_csnm1(a) result(res)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end function psb_z_base_csnm1
@ -1728,18 +1617,14 @@ subroutine psb_z_base_rowsum(d,a)
character(len=20) :: name='rowsum'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_z_base_rowsum
@ -1755,18 +1640,14 @@ subroutine psb_z_base_arwsum(d,a)
character(len=20) :: name='arwsum'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_z_base_arwsum
@ -1782,18 +1663,14 @@ subroutine psb_z_base_colsum(d,a)
character(len=20) :: name='colsum'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_z_base_colsum
@ -1809,18 +1686,14 @@ subroutine psb_z_base_aclsum(d,a)
character(len=20) :: name='aclsum'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_z_base_aclsum
@ -1840,18 +1713,14 @@ subroutine psb_z_base_get_diag(a,d,info)
character(len=20) :: name='get_diag'
logical, parameter :: debug=.false.
call psb_get_erraction(err_act)
call psb_erractionsave(err_act)
! This is the base version. If we get here
! it means the derived class is incomplete,
! so we throw an error.
info = psb_err_missing_override_method_
call psb_errpush(info,name,a_err=a%get_fmt())
if (err_act /= psb_act_ret_) then
call psb_error()
end if
return
call psb_error_handler(err_act)
end subroutine psb_z_base_get_diag
@ -2029,13 +1898,8 @@ subroutine psb_z_base_vect_cssv(alpha,a,x,beta,y,info,trans,scale,d)
return
9999 continue
call psb_erractionrestore(err_act)
9999 call psb_error_handler(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_z_base_vect_cssv
@ -2072,15 +1936,9 @@ subroutine psb_z_base_inner_vect_sv(alpha,a,x,beta,y,info,trans)
call psb_erractionrestore(err_act)
return
9999 call psb_error_handler(err_act)
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_z_base_inner_vect_sv

Write Preview
Loading…
Cancel
Save