fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-07 07:04:57 +00:00
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
This commit is contained in:
Salvatore Filippone
2014-12-20 19:39:34 +00:00
parent c5f6bd308c
commit 895b7abc5f
46 changed files with 554 additions and 1851 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/comm/psb_cgather.f90
+8 -23
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
base/comm/psb_chalo.f90
+3 -18
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
base/comm/psb_covrl.f90
+3 -18
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
base/comm/psb_cscatter.F90
+2 -12
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
base/comm/psb_cspgather.F90
+2 -6
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
base/comm/psb_dgather.f90
+8 -23
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
base/comm/psb_dhalo.f90
+3 -18
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
base/comm/psb_dovrl.f90
+3 -18
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
base/comm/psb_dscatter.F90
+2 -12
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
base/comm/psb_dspgather.F90
+2 -6
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
base/comm/psb_igather.f90
+3 -18
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
base/comm/psb_ihalo.f90
+3 -18
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
base/comm/psb_iovrl.f90
+3 -18
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
base/comm/psb_iscatter.F90
+2 -12
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
base/comm/psb_sgather.f90
+8 -23
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
base/comm/psb_shalo.f90
+3 -18
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
base/comm/psb_sovrl.f90
+3 -18
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
base/comm/psb_sscatter.F90
+2 -12
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
base/comm/psb_sspgather.F90
+2 -6
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
base/comm/psb_zgather.f90
+8 -23
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
base/comm/psb_zhalo.f90
+3 -18
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
base/comm/psb_zovrl.f90
+3 -18
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
base/comm/psb_zscatter.F90
+2 -12
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
base/comm/psb_zspgather.F90
+2 -6
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
base/modules/psb_c_base_mat_mod.f90
+1 -1
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
base/modules/psb_c_linmap_mod.f90
+3 -4
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
base/modules/psb_check_mod.f90
+3 -18
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
base/modules/psb_d_base_mat_mod.f90
+1 -1
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
base/modules/psb_d_linmap_mod.f90
+3 -4
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
base/modules/psb_desc_mod.F90
+46 -138
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
base/modules/psb_gen_block_map_mod.f90
+10 -16
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
!!$
base/modules/psb_glist_map_mod.f90
+3 -5
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
base/modules/psb_hash_map_mod.f90
+9 -19
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
base/modules/psb_indx_map_mod.f90
+16 -49
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
base/modules/psb_list_map_mod.f90
+2 -5
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
base/modules/psb_realloc_mod.F90
+128 -397
View File
File diff suppressed because it is too large Load Diff
base/modules/psb_repl_map_mod.f90
+2 -5
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
base/modules/psb_s_base_mat_mod.f90
+1 -1
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
base/modules/psb_s_linmap_mod.f90
+3 -4
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
base/modules/psb_serial_mod.f90
-1
View File
@@ -325,7 +325,6 @@ contains
end do
end if
return
return
end subroutine zrot
!
!
base/modules/psb_z_base_mat_mod.f90
+1 -1
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
base/modules/psb_z_linmap_mod.f90
+3 -4
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
base/serial/impl/psb_c_base_mat_impl.F90
+59 -201
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
base/serial/impl/psb_d_base_mat_impl.F90
+59 -201
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
base/serial/impl/psb_s_base_mat_impl.F90
+59 -201
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
base/serial/impl/psb_z_base_mat_impl.F90
+59 -201
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