Added c interface for remotebuild

remotebuild
Cirdans-Home 3 years ago
parent fef69bf799
commit 13153e03dc

@ -100,6 +100,47 @@ contains
end function psb_c_cdall_vl
function psb_c_cdall_vl_opt(nl,vl,cctxt,cdh) bind(c,name='psb_c_cdall_vl_opt') result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_object_type), value :: cctxt
integer(psb_c_ipk_), value :: nl
integer(psb_c_lpk_) :: vl(*)
type(psb_c_object_type) :: cdh
type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info, ixb
type(psb_ctxt_type) :: ctxt
ctxt = psb_c2f_ctxt(cctxt)
res = -1
if (nl <=0) then
write(0,*) 'Invalid size'
return
end if
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
call descp%free(info)
if (info == 0) deallocate(descp,stat=info)
if (info /= 0) return
end if
allocate(descp,stat=info)
if (info < 0) return
ixb = psb_c_get_index_base()
if (ixb == 1) then
call psb_cdall(ctxt,descp,info,vl=vl(1:nl),globalcheck=.true.)
else
call psb_cdall(ctxt,descp,info,vl=(vl(1:nl)+(1-ixb)),globalcheck=.true.)
end if
cdh%item = c_loc(descp)
res = info
end function psb_c_cdall_vl_opt
function psb_c_cdall_nl(nl,cctxt,cdh) bind(c,name='psb_c_cdall_nl') result(res)
implicit none

@ -35,6 +35,7 @@ psb_c_t psb_c_cgetelem(psb_c_cvector *xh,psb_l_t index,psb_c_descriptor *cd);
/* sparse matrices*/
psb_c_cspmat* psb_c_new_cspmat();
psb_i_t psb_c_cspall(psb_c_cspmat *mh, psb_c_descriptor *cdh);
psb_i_t psb_c_cspall_remote(psb_c_cspmat *mh, psb_c_descriptor *cdh);
psb_i_t psb_c_cspasb(psb_c_cspmat *mh, psb_c_descriptor *cdh);
psb_i_t psb_c_cspfree(psb_c_cspmat *mh, psb_c_descriptor *cdh);
psb_i_t psb_c_cspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl,

@ -35,6 +35,7 @@ psb_d_t psb_c_dgetelem(psb_c_dvector *xh,psb_l_t index,psb_c_descriptor *cd);
/* sparse matrices*/
psb_c_dspmat* psb_c_new_dspmat();
psb_i_t psb_c_dspall(psb_c_dspmat *mh, psb_c_descriptor *cdh);
psb_i_t psb_c_dspall_remote(psb_c_dspmat *mh, psb_c_descriptor *cdh);
psb_i_t psb_c_dspasb(psb_c_dspmat *mh, psb_c_descriptor *cdh);
psb_i_t psb_c_dspfree(psb_c_dspmat *mh, psb_c_descriptor *cdh);
psb_i_t psb_c_dspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl,

@ -35,6 +35,7 @@ psb_s_t psb_c_sgetelem(psb_c_svector *xh,psb_l_t index,psb_c_descriptor *cd);
/* sparse matrices*/
psb_c_sspmat* psb_c_new_sspmat();
psb_i_t psb_c_sspall(psb_c_sspmat *mh, psb_c_descriptor *cdh);
psb_i_t psb_c_sspall_remote(psb_c_sspmat *mh, psb_c_descriptor *cdh);
psb_i_t psb_c_sspasb(psb_c_sspmat *mh, psb_c_descriptor *cdh);
psb_i_t psb_c_sspfree(psb_c_sspmat *mh, psb_c_descriptor *cdh);
psb_i_t psb_c_sspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl,

@ -212,6 +212,33 @@ contains
end function psb_c_cspall
function psb_c_cspall_remote(mh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_cspmat) :: mh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_cspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info,n
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(mh%item)) then
return
end if
allocate(ap)
call psb_spall(ap,descp,info,bldmode=psb_matbld_remote_)
mh%item = c_loc(ap)
res = min(0,info)
return
end function psb_c_cspall_remote
function psb_c_cspasb(mh,cdh) bind(c) result(res)
@ -241,7 +268,6 @@ contains
return
end function psb_c_cspasb
function psb_c_cspfree(mh,cdh) bind(c) result(res)
implicit none

@ -35,6 +35,7 @@ psb_z_t psb_c_zgetelem(psb_c_zvector *xh,psb_l_t index,psb_c_descriptor *cd);
/* sparse matrices*/
psb_c_zspmat* psb_c_new_zspmat();
psb_i_t psb_c_zspall(psb_c_zspmat *mh, psb_c_descriptor *cdh);
psb_i_t psb_c_zspall_remote(psb_c_zspmat *mh, psb_c_descriptor *cdh);
psb_i_t psb_c_zspasb(psb_c_zspmat *mh, psb_c_descriptor *cdh);
psb_i_t psb_c_zspfree(psb_c_zspmat *mh, psb_c_descriptor *cdh);
psb_i_t psb_c_zspins(psb_i_t nz, const psb_l_t *irw, const psb_l_t *icl,

@ -212,6 +212,33 @@ contains
end function psb_c_dspall
function psb_c_dspall_remote(mh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_dspmat) :: mh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_dspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info,n
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(mh%item)) then
return
end if
allocate(ap)
call psb_spall(ap,descp,info,bldmode=psb_matbld_remote_)
mh%item = c_loc(ap)
res = min(0,info)
return
end function psb_c_dspall_remote
function psb_c_dspasb(mh,cdh) bind(c) result(res)
@ -241,7 +268,6 @@ contains
return
end function psb_c_dspasb
function psb_c_dspfree(mh,cdh) bind(c) result(res)
implicit none

@ -212,6 +212,33 @@ contains
end function psb_c_sspall
function psb_c_sspall_remote(mh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_sspmat) :: mh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_sspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info,n
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(mh%item)) then
return
end if
allocate(ap)
call psb_spall(ap,descp,info,bldmode=psb_matbld_remote_)
mh%item = c_loc(ap)
res = min(0,info)
return
end function psb_c_sspall_remote
function psb_c_sspasb(mh,cdh) bind(c) result(res)
@ -241,7 +268,6 @@ contains
return
end function psb_c_sspasb
function psb_c_sspfree(mh,cdh) bind(c) result(res)
implicit none

@ -212,6 +212,33 @@ contains
end function psb_c_zspall
function psb_c_zspall_remote(mh,cdh) bind(c) result(res)
implicit none
integer(psb_c_ipk_) :: res
type(psb_c_zspmat) :: mh
type(psb_c_descriptor) :: cdh
type(psb_desc_type), pointer :: descp
type(psb_zspmat_type), pointer :: ap
integer(psb_c_ipk_) :: info,n
res = -1
if (c_associated(cdh%item)) then
call c_f_pointer(cdh%item,descp)
else
return
end if
if (c_associated(mh%item)) then
return
end if
allocate(ap)
call psb_spall(ap,descp,info,bldmode=psb_matbld_remote_)
mh%item = c_loc(ap)
res = min(0,info)
return
end function psb_c_zspall_remote
function psb_c_zspasb(mh,cdh) bind(c) result(res)
@ -241,7 +268,6 @@ contains
return
end function psb_c_zspasb
function psb_c_zspfree(mh,cdh) bind(c) result(res)
implicit none

Loading…
Cancel
Save