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

psblas3:

Browse Source 
base/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

Default implementation for CSNMI/CSNM1 based on ARWSUM/ACLSUM
psblas-3.3.1-1
Salvatore Filippone 10 years ago
parent bfc1198db3
commit 9acfdc0dad
4 changed files with 184 additions and 76 deletions
Show Stats Download Patch File Download Diff File

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

@ -1627,6 +1627,7 @@ function psb_c_base_maxval(a) result(res)
end function psb_c_base_maxval
function psb_c_base_csnmi(a) result(res)
use psb_error_mod
use psb_const_mod
@ -1638,21 +1639,34 @@ function psb_c_base_csnmi(a) result(res)
integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csnmi'
character(len=20) :: name='csnm1'
real(psb_spk_), allocatable :: vt(:)
logical, parameter :: debug=.false.
call psb_get_erraction(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
call psb_erractionsave(err_act)
res = szero
call psb_realloc(a%get_nrows(),vt,info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%arwsum(vt)
res = maxval(vt)
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
end function psb_c_base_csnmi
@ -1669,20 +1683,33 @@ function psb_c_base_csnm1(a) result(res)
integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csnm1'
real(psb_spk_), allocatable :: vt(:)
logical, parameter :: debug=.false.
call psb_get_erraction(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
call psb_erractionsave(err_act)
res = szero
call psb_realloc(a%get_ncols(),vt,info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%aclsum(vt)
res = maxval(vt)
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
end function psb_c_base_csnm1

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

@ -1627,6 +1627,7 @@ function psb_d_base_maxval(a) result(res)
end function psb_d_base_maxval
function psb_d_base_csnmi(a) result(res)
use psb_error_mod
use psb_const_mod
@ -1638,21 +1639,34 @@ function psb_d_base_csnmi(a) result(res)
integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csnmi'
character(len=20) :: name='csnm1'
real(psb_dpk_), allocatable :: vt(:)
logical, parameter :: debug=.false.
call psb_get_erraction(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
call psb_erractionsave(err_act)
res = dzero
call psb_realloc(a%get_nrows(),vt,info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%arwsum(vt)
res = maxval(vt)
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
end function psb_d_base_csnmi
@ -1669,20 +1683,33 @@ function psb_d_base_csnm1(a) result(res)
integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csnm1'
real(psb_dpk_), allocatable :: vt(:)
logical, parameter :: debug=.false.
call psb_get_erraction(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
call psb_erractionsave(err_act)
res = dzero
call psb_realloc(a%get_ncols(),vt,info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%aclsum(vt)
res = maxval(vt)
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
end function psb_d_base_csnm1

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

@ -1627,6 +1627,7 @@ function psb_s_base_maxval(a) result(res)
end function psb_s_base_maxval
function psb_s_base_csnmi(a) result(res)
use psb_error_mod
use psb_const_mod
@ -1638,21 +1639,34 @@ function psb_s_base_csnmi(a) result(res)
integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csnmi'
character(len=20) :: name='csnm1'
real(psb_spk_), allocatable :: vt(:)
logical, parameter :: debug=.false.
call psb_get_erraction(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
call psb_erractionsave(err_act)
res = szero
call psb_realloc(a%get_nrows(),vt,info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%arwsum(vt)
res = maxval(vt)
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
end function psb_s_base_csnmi
@ -1669,20 +1683,33 @@ function psb_s_base_csnm1(a) result(res)
integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csnm1'
real(psb_spk_), allocatable :: vt(:)
logical, parameter :: debug=.false.
call psb_get_erraction(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
call psb_erractionsave(err_act)
res = szero
call psb_realloc(a%get_ncols(),vt,info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%aclsum(vt)
res = maxval(vt)
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
end function psb_s_base_csnm1

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

@ -1627,6 +1627,7 @@ function psb_z_base_maxval(a) result(res)
end function psb_z_base_maxval
function psb_z_base_csnmi(a) result(res)
use psb_error_mod
use psb_const_mod
@ -1638,21 +1639,34 @@ function psb_z_base_csnmi(a) result(res)
integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csnmi'
character(len=20) :: name='csnm1'
real(psb_dpk_), allocatable :: vt(:)
logical, parameter :: debug=.false.
call psb_get_erraction(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
call psb_erractionsave(err_act)
res = dzero
call psb_realloc(a%get_nrows(),vt,info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%arwsum(vt)
res = maxval(vt)
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
end function psb_z_base_csnmi
@ -1669,20 +1683,33 @@ function psb_z_base_csnm1(a) result(res)
integer(psb_ipk_) :: err_act, info
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='csnm1'
real(psb_dpk_), allocatable :: vt(:)
logical, parameter :: debug=.false.
call psb_get_erraction(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
call psb_erractionsave(err_act)
res = dzero
call psb_realloc(a%get_ncols(),vt,info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
call psb_errpush(info,name)
goto 9999
end if
call a%aclsum(vt)
res = maxval(vt)
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
end function psb_z_base_csnm1

Write Preview
Loading…
Cancel
Save