diff --git a/cbind/base/psb_c_base.h b/cbind/base/psb_c_base.h index 02698686..e61cfa79 100644 --- a/cbind/base/psb_c_base.h +++ b/cbind/base/psb_c_base.h @@ -51,6 +51,9 @@ extern "C" { psb_d_t psb_c_wtime(); 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_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); diff --git a/cbind/base/psb_c_tools_cbind_mod.F90 b/cbind/base/psb_c_tools_cbind_mod.F90 index 2f30b82e..7f1b0cf4 100644 --- a/cbind/base/psb_c_tools_cbind_mod.F90 +++ b/cbind/base/psb_c_tools_cbind_mod.F90 @@ -1,6 +1,7 @@ module psb_c_tools_cbind_mod use iso_c_binding use psb_base_mod + use psb_cpenv_mod use psb_objhandle_mod use psb_base_string_cbind_mod use psb_base_tools_cbind_mod @@ -110,7 +111,7 @@ contains type(psb_desc_type), pointer :: descp type(psb_c_vect_type), pointer :: xp - integer :: info + integer :: ixb, info res = -1 if (c_associated(cdh%item)) then @@ -124,8 +125,15 @@ contains return end if - call psb_geins(nz,irw(1:nz),val(1:nz),& - & xp,descp,info, dupl=psb_dupl_ovwrt_) + ixb = psb_c_get_index_base() + if (ixb == 1) then + call psb_geins(nz,irw(1:nz),val(1:nz),& + & 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) return @@ -144,7 +152,7 @@ contains type(psb_desc_type), pointer :: descp type(psb_c_vect_type), pointer :: xp - integer :: info + integer :: ixb, info res = -1 if (c_associated(cdh%item)) then @@ -158,8 +166,14 @@ contains return end if - call psb_geins(nz,irw(1:nz),val(1:nz),& - & xp,descp,info, dupl=psb_dupl_add_) + ixb = psb_c_get_index_base() + if (ixb == 1) then + call psb_geins(nz,irw(1:nz),val(1:nz),& + & 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) return @@ -308,7 +322,7 @@ contains type(psb_desc_type), pointer :: descp type(psb_cspmat_type), pointer :: ap - integer :: info,n + integer :: ixb,info,n res = -1 if (c_associated(cdh%item)) then @@ -322,8 +336,12 @@ contains return end if - - call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info) + 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) + 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) return end function psb_c_cspins diff --git a/cbind/base/psb_cpenv_mod.f90 b/cbind/base/psb_cpenv_mod.f90 index fea0a7dc..cda907ee 100644 --- a/cbind/base/psb_cpenv_mod.f90 +++ b/cbind/base/psb_cpenv_mod.f90 @@ -1,9 +1,26 @@ module psb_cpenv_mod use iso_c_binding use psb_objhandle_mod + + integer, private :: psb_c_index_base=0 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) use psb_base_mod, only : psb_get_errstatus implicit none diff --git a/cbind/base/psb_d_tools_cbind_mod.F90 b/cbind/base/psb_d_tools_cbind_mod.F90 index 544262c3..7a568352 100644 --- a/cbind/base/psb_d_tools_cbind_mod.F90 +++ b/cbind/base/psb_d_tools_cbind_mod.F90 @@ -1,6 +1,7 @@ module psb_d_tools_cbind_mod use iso_c_binding use psb_base_mod + use psb_cpenv_mod use psb_objhandle_mod use psb_base_string_cbind_mod use psb_base_tools_cbind_mod @@ -110,7 +111,7 @@ contains type(psb_desc_type), pointer :: descp type(psb_d_vect_type), pointer :: xp - integer :: info + integer :: ixb, info res = -1 if (c_associated(cdh%item)) then @@ -124,8 +125,15 @@ contains return end if - call psb_geins(nz,irw(1:nz),val(1:nz),& - & xp,descp,info, dupl=psb_dupl_ovwrt_) + ixb = psb_c_get_index_base() + if (ixb == 1) then + call psb_geins(nz,irw(1:nz),val(1:nz),& + & 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) return @@ -144,7 +152,7 @@ contains type(psb_desc_type), pointer :: descp type(psb_d_vect_type), pointer :: xp - integer :: info + integer :: ixb, info res = -1 if (c_associated(cdh%item)) then @@ -158,8 +166,14 @@ contains return end if - call psb_geins(nz,irw(1:nz),val(1:nz),& - & xp,descp,info, dupl=psb_dupl_add_) + ixb = psb_c_get_index_base() + if (ixb == 1) then + call psb_geins(nz,irw(1:nz),val(1:nz),& + & 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) return @@ -308,7 +322,7 @@ contains type(psb_desc_type), pointer :: descp type(psb_dspmat_type), pointer :: ap - integer :: info,n + integer :: ixb,info,n res = -1 if (c_associated(cdh%item)) then @@ -322,8 +336,12 @@ contains return end if - - call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info) + 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) + 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) return end function psb_c_dspins diff --git a/cbind/base/psb_s_tools_cbind_mod.F90 b/cbind/base/psb_s_tools_cbind_mod.F90 index e3b7fd76..e93bd761 100644 --- a/cbind/base/psb_s_tools_cbind_mod.F90 +++ b/cbind/base/psb_s_tools_cbind_mod.F90 @@ -1,6 +1,7 @@ module psb_s_tools_cbind_mod use iso_c_binding use psb_base_mod + use psb_cpenv_mod use psb_objhandle_mod use psb_base_string_cbind_mod use psb_base_tools_cbind_mod @@ -110,7 +111,7 @@ contains type(psb_desc_type), pointer :: descp type(psb_s_vect_type), pointer :: xp - integer :: info + integer :: ixb, info res = -1 if (c_associated(cdh%item)) then @@ -124,8 +125,15 @@ contains return end if - call psb_geins(nz,irw(1:nz),val(1:nz),& - & xp,descp,info, dupl=psb_dupl_ovwrt_) + ixb = psb_c_get_index_base() + if (ixb == 1) then + call psb_geins(nz,irw(1:nz),val(1:nz),& + & 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) return @@ -144,7 +152,7 @@ contains type(psb_desc_type), pointer :: descp type(psb_s_vect_type), pointer :: xp - integer :: info + integer :: ixb, info res = -1 if (c_associated(cdh%item)) then @@ -158,8 +166,14 @@ contains return end if - call psb_geins(nz,irw(1:nz),val(1:nz),& - & xp,descp,info, dupl=psb_dupl_add_) + ixb = psb_c_get_index_base() + if (ixb == 1) then + call psb_geins(nz,irw(1:nz),val(1:nz),& + & 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) return @@ -308,7 +322,7 @@ contains type(psb_desc_type), pointer :: descp type(psb_sspmat_type), pointer :: ap - integer :: info,n + integer :: ixb,info,n res = -1 if (c_associated(cdh%item)) then @@ -322,8 +336,12 @@ contains return end if - - call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info) + 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) + 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) return end function psb_c_sspins diff --git a/cbind/base/psb_z_tools_cbind_mod.F90 b/cbind/base/psb_z_tools_cbind_mod.F90 index 96e2b9b0..fb0e0045 100644 --- a/cbind/base/psb_z_tools_cbind_mod.F90 +++ b/cbind/base/psb_z_tools_cbind_mod.F90 @@ -1,6 +1,7 @@ module psb_z_tools_cbind_mod use iso_c_binding use psb_base_mod + use psb_cpenv_mod use psb_objhandle_mod use psb_base_string_cbind_mod use psb_base_tools_cbind_mod @@ -110,7 +111,7 @@ contains type(psb_desc_type), pointer :: descp type(psb_z_vect_type), pointer :: xp - integer :: info + integer :: ixb, info res = -1 if (c_associated(cdh%item)) then @@ -124,8 +125,15 @@ contains return end if - call psb_geins(nz,irw(1:nz),val(1:nz),& - & xp,descp,info, dupl=psb_dupl_ovwrt_) + ixb = psb_c_get_index_base() + if (ixb == 1) then + call psb_geins(nz,irw(1:nz),val(1:nz),& + & 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) return @@ -144,7 +152,7 @@ contains type(psb_desc_type), pointer :: descp type(psb_z_vect_type), pointer :: xp - integer :: info + integer :: ixb, info res = -1 if (c_associated(cdh%item)) then @@ -158,8 +166,14 @@ contains return end if - call psb_geins(nz,irw(1:nz),val(1:nz),& - & xp,descp,info, dupl=psb_dupl_add_) + ixb = psb_c_get_index_base() + if (ixb == 1) then + call psb_geins(nz,irw(1:nz),val(1:nz),& + & 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) return @@ -308,7 +322,7 @@ contains type(psb_desc_type), pointer :: descp type(psb_zspmat_type), pointer :: ap - integer :: info,n + integer :: ixb,info,n res = -1 if (c_associated(cdh%item)) then @@ -322,8 +336,12 @@ contains return end if - - call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info) + 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) + 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) return end function psb_c_zspins