psblas3-mcbind:

cbind/base/psb_c_base.h
 cbind/base/psb_c_tools_cbind_mod.F90
 cbind/base/psb_cpenv_mod.f90
 cbind/base/psb_d_tools_cbind_mod.F90
 cbind/base/psb_s_tools_cbind_mod.F90
 cbind/base/psb_z_tools_cbind_mod.F90

Added index base internal and accessors. 
Added adjustment for index base other than 1.
psblas3-mcbind
Salvatore Filippone 8 years ago
parent bd344478ce
commit e30cafaf11

@ -51,6 +51,9 @@ extern "C" {
psb_d_t psb_c_wtime(); psb_d_t psb_c_wtime();
psb_i_t psb_c_get_errstatus(); psb_i_t psb_c_get_errstatus();
psb_i_t psb_c_get_index_base();
void psb_c_set_index_base(psb_i_t base);
void psb_c_ibcast(psb_i_t ictxt, psb_i_t n, psb_i_t *v, psb_i_t root); void psb_c_ibcast(psb_i_t ictxt, psb_i_t n, psb_i_t *v, psb_i_t root);
void psb_c_sbcast(psb_i_t ictxt, psb_i_t n, psb_s_t *v, psb_i_t root); void psb_c_sbcast(psb_i_t ictxt, psb_i_t n, psb_s_t *v, psb_i_t root);
void psb_c_dbcast(psb_i_t ictxt, psb_i_t n, psb_d_t *v, psb_i_t root); void psb_c_dbcast(psb_i_t ictxt, psb_i_t n, psb_d_t *v, psb_i_t root);

@ -1,6 +1,7 @@
module psb_c_tools_cbind_mod module psb_c_tools_cbind_mod
use iso_c_binding use iso_c_binding
use psb_base_mod use psb_base_mod
use psb_cpenv_mod
use psb_objhandle_mod use psb_objhandle_mod
use psb_base_string_cbind_mod use psb_base_string_cbind_mod
use psb_base_tools_cbind_mod use psb_base_tools_cbind_mod
@ -110,7 +111,7 @@ contains
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
type(psb_c_vect_type), pointer :: xp type(psb_c_vect_type), pointer :: xp
integer :: info integer :: ixb, info
res = -1 res = -1
if (c_associated(cdh%item)) then if (c_associated(cdh%item)) then
@ -124,8 +125,15 @@ contains
return return
end if end if
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_geins(nz,irw(1:nz),val(1:nz),& call psb_geins(nz,irw(1:nz),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_ovwrt_) & xp,descp,info, dupl=psb_dupl_ovwrt_)
else
call psb_geins(nz,(irw(1:nz)-(1-ixb)),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_ovwrt_)
end if
res = min(0,info) res = min(0,info)
return return
@ -144,7 +152,7 @@ contains
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
type(psb_c_vect_type), pointer :: xp type(psb_c_vect_type), pointer :: xp
integer :: info integer :: ixb, info
res = -1 res = -1
if (c_associated(cdh%item)) then if (c_associated(cdh%item)) then
@ -158,8 +166,14 @@ contains
return return
end if end if
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_geins(nz,irw(1:nz),val(1:nz),& call psb_geins(nz,irw(1:nz),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_add_) & xp,descp,info, dupl=psb_dupl_add_)
else
call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_add_)
end if
res = min(0,info) res = min(0,info)
return return
@ -308,7 +322,7 @@ contains
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
type(psb_cspmat_type), pointer :: ap type(psb_cspmat_type), pointer :: ap
integer :: info,n integer :: ixb,info,n
res = -1 res = -1
if (c_associated(cdh%item)) then if (c_associated(cdh%item)) then
@ -322,8 +336,12 @@ contains
return return
end if end if
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info) call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info)
else
call psb_spins(nz,(irw(1:nz)+(1-ixb)),(icl(1:nz)+(1-ixb)),val(1:nz),ap,descp,info)
end if
res = min(0,info) res = min(0,info)
return return
end function psb_c_cspins end function psb_c_cspins

@ -2,8 +2,25 @@ module psb_cpenv_mod
use iso_c_binding use iso_c_binding
use psb_objhandle_mod use psb_objhandle_mod
integer, private :: psb_c_index_base=0
contains contains
function psb_c_get_index_base() bind(c) result(res)
implicit none
integer(psb_c_int) :: res
res = psb_c_index_base
end function psb_c_get_index_base
subroutine psb_c_set_index_base(base) bind(c)
implicit none
integer(psb_c_int) :: base
psb_c_index_base = base
end subroutine psb_c_set_index_base
function psb_c_get_errstatus() bind(c) result(res) function psb_c_get_errstatus() bind(c) result(res)
use psb_base_mod, only : psb_get_errstatus use psb_base_mod, only : psb_get_errstatus
implicit none implicit none

@ -1,6 +1,7 @@
module psb_d_tools_cbind_mod module psb_d_tools_cbind_mod
use iso_c_binding use iso_c_binding
use psb_base_mod use psb_base_mod
use psb_cpenv_mod
use psb_objhandle_mod use psb_objhandle_mod
use psb_base_string_cbind_mod use psb_base_string_cbind_mod
use psb_base_tools_cbind_mod use psb_base_tools_cbind_mod
@ -110,7 +111,7 @@ contains
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
type(psb_d_vect_type), pointer :: xp type(psb_d_vect_type), pointer :: xp
integer :: info integer :: ixb, info
res = -1 res = -1
if (c_associated(cdh%item)) then if (c_associated(cdh%item)) then
@ -124,8 +125,15 @@ contains
return return
end if end if
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_geins(nz,irw(1:nz),val(1:nz),& call psb_geins(nz,irw(1:nz),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_ovwrt_) & xp,descp,info, dupl=psb_dupl_ovwrt_)
else
call psb_geins(nz,(irw(1:nz)-(1-ixb)),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_ovwrt_)
end if
res = min(0,info) res = min(0,info)
return return
@ -144,7 +152,7 @@ contains
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
type(psb_d_vect_type), pointer :: xp type(psb_d_vect_type), pointer :: xp
integer :: info integer :: ixb, info
res = -1 res = -1
if (c_associated(cdh%item)) then if (c_associated(cdh%item)) then
@ -158,8 +166,14 @@ contains
return return
end if end if
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_geins(nz,irw(1:nz),val(1:nz),& call psb_geins(nz,irw(1:nz),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_add_) & xp,descp,info, dupl=psb_dupl_add_)
else
call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_add_)
end if
res = min(0,info) res = min(0,info)
return return
@ -308,7 +322,7 @@ contains
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap type(psb_dspmat_type), pointer :: ap
integer :: info,n integer :: ixb,info,n
res = -1 res = -1
if (c_associated(cdh%item)) then if (c_associated(cdh%item)) then
@ -322,8 +336,12 @@ contains
return return
end if end if
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info) call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info)
else
call psb_spins(nz,(irw(1:nz)+(1-ixb)),(icl(1:nz)+(1-ixb)),val(1:nz),ap,descp,info)
end if
res = min(0,info) res = min(0,info)
return return
end function psb_c_dspins end function psb_c_dspins

@ -1,6 +1,7 @@
module psb_s_tools_cbind_mod module psb_s_tools_cbind_mod
use iso_c_binding use iso_c_binding
use psb_base_mod use psb_base_mod
use psb_cpenv_mod
use psb_objhandle_mod use psb_objhandle_mod
use psb_base_string_cbind_mod use psb_base_string_cbind_mod
use psb_base_tools_cbind_mod use psb_base_tools_cbind_mod
@ -110,7 +111,7 @@ contains
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
type(psb_s_vect_type), pointer :: xp type(psb_s_vect_type), pointer :: xp
integer :: info integer :: ixb, info
res = -1 res = -1
if (c_associated(cdh%item)) then if (c_associated(cdh%item)) then
@ -124,8 +125,15 @@ contains
return return
end if end if
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_geins(nz,irw(1:nz),val(1:nz),& call psb_geins(nz,irw(1:nz),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_ovwrt_) & xp,descp,info, dupl=psb_dupl_ovwrt_)
else
call psb_geins(nz,(irw(1:nz)-(1-ixb)),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_ovwrt_)
end if
res = min(0,info) res = min(0,info)
return return
@ -144,7 +152,7 @@ contains
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
type(psb_s_vect_type), pointer :: xp type(psb_s_vect_type), pointer :: xp
integer :: info integer :: ixb, info
res = -1 res = -1
if (c_associated(cdh%item)) then if (c_associated(cdh%item)) then
@ -158,8 +166,14 @@ contains
return return
end if end if
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_geins(nz,irw(1:nz),val(1:nz),& call psb_geins(nz,irw(1:nz),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_add_) & xp,descp,info, dupl=psb_dupl_add_)
else
call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_add_)
end if
res = min(0,info) res = min(0,info)
return return
@ -308,7 +322,7 @@ contains
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
type(psb_sspmat_type), pointer :: ap type(psb_sspmat_type), pointer :: ap
integer :: info,n integer :: ixb,info,n
res = -1 res = -1
if (c_associated(cdh%item)) then if (c_associated(cdh%item)) then
@ -322,8 +336,12 @@ contains
return return
end if end if
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info) call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info)
else
call psb_spins(nz,(irw(1:nz)+(1-ixb)),(icl(1:nz)+(1-ixb)),val(1:nz),ap,descp,info)
end if
res = min(0,info) res = min(0,info)
return return
end function psb_c_sspins end function psb_c_sspins

@ -1,6 +1,7 @@
module psb_z_tools_cbind_mod module psb_z_tools_cbind_mod
use iso_c_binding use iso_c_binding
use psb_base_mod use psb_base_mod
use psb_cpenv_mod
use psb_objhandle_mod use psb_objhandle_mod
use psb_base_string_cbind_mod use psb_base_string_cbind_mod
use psb_base_tools_cbind_mod use psb_base_tools_cbind_mod
@ -110,7 +111,7 @@ contains
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
type(psb_z_vect_type), pointer :: xp type(psb_z_vect_type), pointer :: xp
integer :: info integer :: ixb, info
res = -1 res = -1
if (c_associated(cdh%item)) then if (c_associated(cdh%item)) then
@ -124,8 +125,15 @@ contains
return return
end if end if
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_geins(nz,irw(1:nz),val(1:nz),& call psb_geins(nz,irw(1:nz),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_ovwrt_) & xp,descp,info, dupl=psb_dupl_ovwrt_)
else
call psb_geins(nz,(irw(1:nz)-(1-ixb)),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_ovwrt_)
end if
res = min(0,info) res = min(0,info)
return return
@ -144,7 +152,7 @@ contains
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
type(psb_z_vect_type), pointer :: xp type(psb_z_vect_type), pointer :: xp
integer :: info integer :: ixb, info
res = -1 res = -1
if (c_associated(cdh%item)) then if (c_associated(cdh%item)) then
@ -158,8 +166,14 @@ contains
return return
end if end if
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_geins(nz,irw(1:nz),val(1:nz),& call psb_geins(nz,irw(1:nz),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_add_) & xp,descp,info, dupl=psb_dupl_add_)
else
call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
& xp,descp,info, dupl=psb_dupl_add_)
end if
res = min(0,info) res = min(0,info)
return return
@ -308,7 +322,7 @@ contains
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
type(psb_zspmat_type), pointer :: ap type(psb_zspmat_type), pointer :: ap
integer :: info,n integer :: ixb,info,n
res = -1 res = -1
if (c_associated(cdh%item)) then if (c_associated(cdh%item)) then
@ -322,8 +336,12 @@ contains
return return
end if end if
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info) call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info)
else
call psb_spins(nz,(irw(1:nz)+(1-ixb)),(icl(1:nz)+(1-ixb)),val(1:nz),ap,descp,info)
end if
res = min(0,info) res = min(0,info)
return return
end function psb_c_zspins end function psb_c_zspins

Loading…
Cancel
Save