diff --git a/cbind/base/Makefile b/cbind/base/Makefile index 492526de..f6855808 100644 --- a/cbind/base/Makefile +++ b/cbind/base/Makefile @@ -9,8 +9,11 @@ CINCLUDES=-I$(INCLUDEDIR) FOBJS= psb_objhandle_mod.o psb_base_cbind_mod.o psb_cpenv_mod.o \ psb_base_tools_cbind_mod.o psb_base_string_cbind_mod.o \ - psb_base_psblas_cbind_mod.o psb_d_tools_cbind_mod.o \ - psb_d_serial_cbind_mod.o psb_d_psblas_cbind_mod.o + psb_base_psblas_cbind_mod.o \ + psb_s_tools_cbind_mod.o psb_s_serial_cbind_mod.o psb_s_psblas_cbind_mod.o \ + psb_d_tools_cbind_mod.o psb_d_serial_cbind_mod.o psb_d_psblas_cbind_mod.o \ + psb_c_tools_cbind_mod.o psb_c_serial_cbind_mod.o psb_c_psblas_cbind_mod.o \ + psb_z_tools_cbind_mod.o psb_z_serial_cbind_mod.o psb_z_psblas_cbind_mod.o COBJS= psb_c_base.o psb_c_dbase.o CMOD=psb_base_cbind.h psb_c_base.h psb_c_dbase.h @@ -18,7 +21,10 @@ OBJS=$(FOBJS) $(COBJS) LIBMOD=psb_base_cbind_mod$(.mod) psb_cpenv_mod$(.mod) psb_objhandle_mod$(.mod)\ psb_base_tools_cbind_mod$(.mod) psb_base_string_cbind_mod$(.mod) psb_base_psblas_cbind_mod$(.mod)\ - psb_d_tools_cbind_mod$(.mod) psb_d_serial_cbind_mod$(.mod) psb_d_psblas_cbind_mod$(.mod) + psb_s_tools_cbind_mod$(.mod) psb_s_serial_cbind_mod$(.mod) psb_s_psblas_cbind_mod$(.mod) \ + psb_d_tools_cbind_mod$(.mod) psb_d_serial_cbind_mod$(.mod) psb_d_psblas_cbind_mod$(.mod) \ + psb_c_tools_cbind_mod$(.mod) psb_c_serial_cbind_mod$(.mod) psb_c_psblas_cbind_mod$(.mod) \ + psb_z_tools_cbind_mod$(.mod) psb_z_serial_cbind_mod$(.mod) psb_z_psblas_cbind_mod$(.mod) LOCAL_MODS=$(LIBMOD) LIBNAME=$(CBINDLIBNAME) @@ -33,10 +39,16 @@ $(COBJS): $(CMOD) psb_base_cbind_mod.o: psb_cpenv_mod.o psb_objhandle_mod.o psb_base_tools_cbind_mod.o \ psb_base_string_cbind_mod.o psb_base_psblas_cbind_mod.o psb_base_tools_cbind_mod.o: psb_objhandle_mod.o psb_base_string_cbind_mod.o -psb_d_tools_cbind_mod.o psb_d_serial_cbind_mod.o: psb_base_tools_cbind_mod.o + +psb_s_tools_cbind_mod.o psb_s_serial_cbind_mod.o \ +psb_d_tools_cbind_mod.o psb_d_serial_cbind_mod.o \ +psb_c_tools_cbind_mod.o psb_c_serial_cbind_mod.o \ +psb_z_tools_cbind_mod.o psb_z_serial_cbind_mod.o \ +psb_s_psblas_cbind_mod.o psb_d_psblas_cbind_mod.o \ +psb_c_psblas_cbind_mod.o psb_z_psblas_cbind_mod.o: psb_objhandle_mod.o psb_base_string_cbind_mod.o psb_base_psblas_cbind_mod.o: psb_d_psblas_cbind_mod.o -psb_d_psblas_cbind_mod.o: psb_objhandle_mod.o psb_base_string_cbind_mod.o + psb_cpenv_mod.o: psb_base_string_cbind_mod.o psb_objhandle_mod.o veryclean: clean diff --git a/cbind/base/psb_c_dbase.c b/cbind/base/psb_c_dbase.c index 3e7c968c..6b31d18e 100644 --- a/cbind/base/psb_c_dbase.c +++ b/cbind/base/psb_c_dbase.c @@ -10,9 +10,9 @@ psb_c_dvector* psb_c_new_dvector() return(temp); } -double* psb_c_dvect_get_cpy(psb_c_dvector *xh) +psb_d_t* psb_c_dvect_get_cpy(psb_c_dvector *xh) { - double *temp=NULL; + psb_d_t *temp=NULL; psb_i_t vsize=0; if ((vsize=psb_c_dvect_get_nrows(xh))<0) @@ -21,7 +21,7 @@ double* psb_c_dvect_get_cpy(psb_c_dvector *xh) if (vsize==0) vsize=1; - if ((temp=(double *)malloc(vsize*sizeof(double)))!=NULL) + if ((temp=(psb_d_t *)malloc(vsize*sizeof(psb_d_t)))!=NULL) psb_c_dvect_f_get_cpy(temp,xh); return(temp); diff --git a/cbind/base/psb_c_psblas_cbind_mod.f90 b/cbind/base/psb_c_psblas_cbind_mod.f90 new file mode 100644 index 00000000..809a16db --- /dev/null +++ b/cbind/base/psb_c_psblas_cbind_mod.f90 @@ -0,0 +1,289 @@ +module psb_c_psblas_cbind_mod + use iso_c_binding + +contains + + function psb_c_cgeaxpby(alpha,xh,beta,yh,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + integer(psb_c_int) :: res + + type(psb_c_cvector) :: xh,yh + type(psb_c_descriptor) :: cdh + complex(c_float_complex), value :: alpha,beta + + type(psb_desc_type), pointer :: descp + type(psb_c_vect_type), pointer :: xp,yp + integer :: info + + + res = -1 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + if (c_associated(yh%item)) then + call c_f_pointer(yh%item,yp) + else + return + end if + + call psb_geaxpby(alpha,xp,beta,yp,descp,info) + + res = info + + end function psb_c_cgeaxpby + + function psb_c_cgenrm2(xh,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + real(c_float_complex) :: res + + type(psb_c_cvector) :: xh + type(psb_c_descriptor) :: cdh + type(psb_desc_type), pointer :: descp + type(psb_c_vect_type), pointer :: xp + integer :: info + + res = -1.0 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + res = psb_genrm2(xp,descp,info) + + end function psb_c_cgenrm2 + + function psb_c_cgeamax(xh,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + real(c_float_complex) :: res + + type(psb_c_cvector) :: xh + type(psb_c_descriptor) :: cdh + type(psb_desc_type), pointer :: descp + type(psb_c_vect_type), pointer :: xp + integer :: info + + res = -1.0 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + res = psb_geamax(xp,descp,info) + + end function psb_c_cgeamax + + function psb_c_cgeasum(xh,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + real(c_float_complex) :: res + + type(psb_c_cvector) :: xh + type(psb_c_descriptor) :: cdh + type(psb_desc_type), pointer :: descp + type(psb_c_vect_type), pointer :: xp + integer :: info + + res = -1.0 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + res = psb_geasum(xp,descp,info) + + end function psb_c_cgeasum + + + function psb_c_cspnrmi(ah,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + real(c_float_complex) :: res + + type(psb_c_cspmat) :: ah + type(psb_c_descriptor) :: cdh + type(psb_desc_type), pointer :: descp + type(psb_cspmat_type), pointer :: ap + integer :: info + + res = -1.0 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) + else + return + end if + + res = psb_spnrmi(ap,descp,info) + + end function psb_c_cspnrmi + + function psb_c_cgedot(xh,yh,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + complex(c_float_complex) :: res + + type(psb_c_cvector) :: xh,yh + type(psb_c_descriptor) :: cdh + type(psb_desc_type), pointer :: descp + type(psb_c_vect_type), pointer :: xp,yp + integer :: info + + res = -1.0 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + if (c_associated(yh%item)) then + call c_f_pointer(yh%item,yp) + else + return + end if + res = psb_gedot(xp,yp,descp,info) + + end function psb_c_cgedot + + + function psb_c_cspmm(alpha,ah,xh,beta,yh,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + integer(psb_c_int) :: res + + type(psb_c_cspmat) :: ah + type(psb_c_cvector) :: xh,yh + type(psb_c_descriptor) :: cdh + complex(c_float_complex), value :: alpha, beta + type(psb_desc_type), pointer :: descp + type(psb_c_vect_type), pointer :: xp,yp + type(psb_cspmat_type), pointer :: ap + integer :: info + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + if (c_associated(yh%item)) then + call c_f_pointer(yh%item,yp) + else + return + end if + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) + else + return + end if + + call psb_spmm(alpha,ap,xp,beta,yp,descp,info) + + res = info + + end function psb_c_cspmm + + + function psb_c_cspsm(alpha,ah,xh,beta,yh,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + integer(psb_c_int) :: res + + type(psb_c_cspmat) :: ah + type(psb_c_cvector) :: xh,yh + type(psb_c_descriptor) :: cdh + complex(c_float_complex), value :: alpha, beta + type(psb_desc_type), pointer :: descp + type(psb_c_vect_type), pointer :: xp,yp + type(psb_cspmat_type), pointer :: ap + integer :: info + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + if (c_associated(yh%item)) then + call c_f_pointer(yh%item,yp) + else + return + end if + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) + else + return + end if + + call psb_spsm(alpha,ap,xp,beta,yp,descp,info) + + res = info + + end function psb_c_cspsm + + +end module psb_c_psblas_cbind_mod diff --git a/cbind/base/psb_c_serial_cbind_mod.F90 b/cbind/base/psb_c_serial_cbind_mod.F90 new file mode 100644 index 00000000..8d2eac5a --- /dev/null +++ b/cbind/base/psb_c_serial_cbind_mod.F90 @@ -0,0 +1,119 @@ +module psb_c_serial_cbind_mod + use iso_c_binding + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + use psb_base_tools_cbind_mod + +contains + + + function psb_c_cvect_get_nrows(xh) bind(c) result(res) + implicit none + + integer(psb_c_int) :: res + type(psb_c_cvector) :: xh + + type(psb_c_vect_type), pointer :: vp + integer :: info + + res = -1 + + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,vp) + res = vp%get_nrows() + end if + + end function psb_c_cvect_get_nrows + + function psb_c_cvect_f_get_cpy(v,xh) bind(c) result(res) + implicit none + + integer(psb_c_int) :: res + complex(c_float_complex) :: v(*) + type(psb_c_cvector) :: xh + + type(psb_c_vect_type), pointer :: vp + complex(psb_spk_), allocatable :: fv(:) + integer :: info, sz + + res = -1 + + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,vp) + fv = vp%get_vect() + sz = size(fv) + v(1:sz) = fv(1:sz) + end if + + end function psb_c_cvect_f_get_cpy + + + function psb_c_cvect_zero(xh) bind(c) result(res) + implicit none + + integer(psb_c_int) :: res + type(psb_c_cvector) :: xh + + type(psb_c_vect_type), pointer :: vp + integer :: info + + res = -1 + + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,vp) + call vp%zero() + end if + + end function psb_c_cvect_zero + + + function psb_c_cmat_get_nrows(mh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + integer(psb_c_int) :: res + + type(psb_c_cspmat) :: mh + type(psb_cspmat_type), pointer :: ap + integer :: info + + res = 0 + if (c_associated(mh%item)) then + call c_f_pointer(mh%item,ap) + else + return + end if + + res = ap%get_nrows() + + end function psb_c_cmat_get_nrows + + + function psb_c_cmat_get_ncols(mh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + integer(psb_c_int) :: res + + type(psb_c_cspmat) :: mh + type(psb_cspmat_type), pointer :: ap + integer :: info + + res = 0 + if (c_associated(mh%item)) then + call c_f_pointer(mh%item,ap) + else + return + end if + + res = ap%get_ncols() + + end function psb_c_cmat_get_ncols + + + +end module psb_c_serial_cbind_mod + diff --git a/cbind/base/psb_c_tools_cbind_mod.F90 b/cbind/base/psb_c_tools_cbind_mod.F90 new file mode 100644 index 00000000..2f30b82e --- /dev/null +++ b/cbind/base/psb_c_tools_cbind_mod.F90 @@ -0,0 +1,385 @@ +module psb_c_tools_cbind_mod + use iso_c_binding + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + use psb_base_tools_cbind_mod + +contains + + function psb_c_cgeall(xh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + type(psb_c_cvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_c_vect_type), pointer :: xp + integer :: info + + res = -1 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + return + end if + allocate(xp) + call psb_geall(xp,descp,info) + xh%item = c_loc(xp) + res = min(0,info) + + return + end function psb_c_cgeall + + function psb_c_cgeasb(xh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + type(psb_c_cvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_c_vect_type), pointer :: xp + integer :: info + + res = -1 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + call psb_geasb(xp,descp,info) + res = min(0,info) + + return + end function psb_c_cgeasb + + function psb_c_cgefree(xh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + type(psb_c_cvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_c_vect_type), pointer :: xp + integer :: info + + res = -1 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + call psb_gefree(xp,descp,info) + res = min(0,info) + xh%item = c_null_ptr + + return + end function psb_c_cgefree + + + function psb_c_cgeins(nz,irw,val,xh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + integer(psb_c_int), value :: nz + integer(psb_c_int) :: irw(*) + complex(c_float_complex) :: val(*) + type(psb_c_cvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_c_vect_type), pointer :: xp + integer :: info + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + call psb_geins(nz,irw(1:nz),val(1:nz),& + & xp,descp,info, dupl=psb_dupl_ovwrt_) + res = min(0,info) + + return + end function psb_c_cgeins + + + function psb_c_cgeins_add(nz,irw,val,xh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + integer(psb_c_int), value :: nz + integer(psb_c_int) :: irw(*) + complex(c_float_complex) :: val(*) + type(psb_c_cvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_c_vect_type), pointer :: xp + integer :: info + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + call psb_geins(nz,irw(1:nz),val(1:nz),& + & xp,descp,info, dupl=psb_dupl_add_) + res = min(0,info) + + return + end function psb_c_cgeins_add + + + function psb_c_cspall(mh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + type(psb_c_cspmat) :: mh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_cspmat_type), pointer :: ap + integer :: 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) + mh%item = c_loc(ap) + res = min(0,info) + + return + end function psb_c_cspall + + + + function psb_c_cspasb(mh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + type(psb_c_cspmat) :: mh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_cspmat_type), pointer :: ap + integer :: 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 + call c_f_pointer(mh%item,ap) + else + return + end if + + call psb_spasb(ap,descp,info) + res = min(0,info) + return + end function psb_c_cspasb + + + function psb_c_cspfree(mh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + type(psb_c_cspmat) :: mh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_cspmat_type), pointer :: ap + integer :: 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 + call c_f_pointer(mh%item,ap) + else + return + end if + + call psb_spfree(ap,descp,info) + res = min(0,info) + mh%item=c_null_ptr + return + end function psb_c_cspfree + + +#if 0 + + function psb_c_cspasb_opt(mh,cdh,afmt,upd,dupl) bind(c) result(res) + +#ifdef HAVE_LIBRSB + use psb_c_rsb_mat_mod +#endif + implicit none + integer(psb_c_int) :: res + integer(psb_c_int), value :: cdh, mh,upd,dupl + character(c_char) :: afmt(*) + integer :: info,n, fdupl + character(len=5) :: fafmt +#ifdef HAVE_LIBRSB + type(psb_c_rsb_sparse_mat) :: arsb +#endif + + res = -1 + call psb_check_descriptor_handle(cdh,info) + if (info < 0) return + call psb_check_double_spmat_handle(mh,info) + if (info < 0) return + + call stringc2f(afmt,fafmt) + select case(fafmt) +#ifdef HAVE_LIBRSB + case('RSB') + call psb_spasb(double_spmat_pool(mh)%item,descriptor_pool(cdh)%item,info,& + & upd=upd,dupl=dupl,mold=arsb) +#endif + case default + call psb_spasb(double_spmat_pool(mh)%item,descriptor_pool(cdh)%item,info,& + & afmt=fafmt,upd=upd,dupl=dupl) + end select + + res = min(0,info) + + return + end function psb_c_cspasb_opt +#endif + + function psb_c_cspins(nz,irw,icl,val,mh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + integer(psb_c_int), value :: nz + integer(psb_c_int) :: irw(*), icl(*) + complex(c_float_complex) :: val(*) + type(psb_c_cspmat) :: mh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_cspmat_type), pointer :: ap + integer :: 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 + call c_f_pointer(mh%item,ap) + else + return + end if + + + call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info) + res = min(0,info) + return + end function psb_c_cspins + + + function psb_c_csprn(mh,cdh,clear) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + logical(c_bool), value :: clear + type(psb_c_cspmat) :: mh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_cspmat_type), pointer :: ap + integer :: info + logical :: fclear + + 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 + call c_f_pointer(mh%item,ap) + else + return + end if + + fclear = clear + call psb_sprn(ap,descp,info,clear=fclear) + res = min(0,info) + + return + end function psb_c_csprn +!!$ +!!$ function psb_c_cspprint(mh) bind(c) result(res) +!!$ +!!$ implicit none +!!$ integer(psb_c_int) :: res +!!$ integer(psb_c_int), value :: mh +!!$ integer :: info +!!$ +!!$ +!!$ res = -1 +!!$ call psb_check_double_spmat_handle(mh,info) +!!$ if (info < 0) return +!!$ +!!$ call psb_csprt(0,double_spmat_pool(mh)%item,head='Debug mat') +!!$ +!!$ res = 0 +!!$ +!!$ return +!!$ end function psb_c_cspprint + + +end module psb_c_tools_cbind_mod + diff --git a/cbind/base/psb_d_psblas_cbind_mod.f90 b/cbind/base/psb_d_psblas_cbind_mod.f90 index 2667a114..2557069e 100644 --- a/cbind/base/psb_d_psblas_cbind_mod.f90 +++ b/cbind/base/psb_d_psblas_cbind_mod.f90 @@ -10,7 +10,8 @@ contains implicit none integer(psb_c_int) :: res - type(psb_c_object_type) :: xh,yh, cdh + type(psb_c_dvector) :: xh,yh + type(psb_c_descriptor) :: cdh real(c_double), value :: alpha,beta type(psb_desc_type), pointer :: descp @@ -49,7 +50,8 @@ contains implicit none real(c_double) :: res - type(psb_c_object_type) :: xh,cdh + type(psb_c_dvector) :: xh + type(psb_c_descriptor) :: cdh type(psb_desc_type), pointer :: descp type(psb_d_vect_type), pointer :: xp integer :: info @@ -78,7 +80,8 @@ contains implicit none real(c_double) :: res - type(psb_c_object_type) :: xh,cdh + type(psb_c_dvector) :: xh + type(psb_c_descriptor) :: cdh type(psb_desc_type), pointer :: descp type(psb_d_vect_type), pointer :: xp integer :: info @@ -106,7 +109,8 @@ contains implicit none real(c_double) :: res - type(psb_c_object_type) :: xh,cdh + type(psb_c_dvector) :: xh + type(psb_c_descriptor) :: cdh type(psb_desc_type), pointer :: descp type(psb_d_vect_type), pointer :: xp integer :: info @@ -129,14 +133,15 @@ contains end function psb_c_dgeasum - function psb_c_dspnrmi(mh,cdh) bind(c) result(res) + function psb_c_dspnrmi(ah,cdh) bind(c) result(res) use psb_base_mod use psb_objhandle_mod use psb_base_string_cbind_mod implicit none real(c_double) :: res - type(psb_c_object_type) :: mh,cdh + type(psb_c_dspmat) :: ah + type(psb_c_descriptor) :: cdh type(psb_desc_type), pointer :: descp type(psb_dspmat_type), pointer :: ap integer :: info @@ -147,8 +152,8 @@ contains else return end if - if (c_associated(mh%item)) then - call c_f_pointer(mh%item,ap) + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) else return end if @@ -164,7 +169,8 @@ contains implicit none real(c_double) :: res - type(psb_c_object_type) :: xh,yh,cdh + type(psb_c_dvector) :: xh,yh + type(psb_c_descriptor) :: cdh type(psb_desc_type), pointer :: descp type(psb_d_vect_type), pointer :: xp,yp integer :: info @@ -197,7 +203,9 @@ contains implicit none integer(psb_c_int) :: res - type(psb_c_object_type) :: ah,xh,yh, cdh + type(psb_c_dspmat) :: ah + type(psb_c_dvector) :: xh,yh + type(psb_c_descriptor) :: cdh real(c_double), value :: alpha, beta type(psb_desc_type), pointer :: descp type(psb_d_vect_type), pointer :: xp,yp @@ -240,7 +248,9 @@ contains implicit none integer(psb_c_int) :: res - type(psb_c_object_type) :: ah,xh,yh, cdh + type(psb_c_dspmat) :: ah + type(psb_c_dvector) :: xh,yh + type(psb_c_descriptor) :: cdh real(c_double), value :: alpha, beta type(psb_desc_type), pointer :: descp type(psb_d_vect_type), pointer :: xp,yp diff --git a/cbind/base/psb_d_serial_cbind_mod.F90 b/cbind/base/psb_d_serial_cbind_mod.F90 index ce325144..9b14b898 100644 --- a/cbind/base/psb_d_serial_cbind_mod.F90 +++ b/cbind/base/psb_d_serial_cbind_mod.F90 @@ -62,7 +62,7 @@ contains if (c_associated(xh%item)) then call c_f_pointer(xh%item,vp) - call vp%set(dzero) + call vp%zero() end if end function psb_c_dvect_zero diff --git a/cbind/base/psb_d_tools_cbind_mod.F90 b/cbind/base/psb_d_tools_cbind_mod.F90 index 6d3e5353..544262c3 100644 --- a/cbind/base/psb_d_tools_cbind_mod.F90 +++ b/cbind/base/psb_d_tools_cbind_mod.F90 @@ -11,8 +11,8 @@ contains implicit none integer(psb_c_int) :: res - type(psb_c_object_type) :: xh - type(psb_c_object_type) :: cdh + type(psb_c_dvector) :: xh + type(psb_c_descriptor) :: cdh type(psb_desc_type), pointer :: descp type(psb_d_vect_type), pointer :: xp @@ -40,8 +40,8 @@ contains implicit none integer(psb_c_int) :: res - type(psb_c_object_type) :: xh - type(psb_c_object_type) :: cdh + type(psb_c_dvector) :: xh + type(psb_c_descriptor) :: cdh type(psb_desc_type), pointer :: descp type(psb_d_vect_type), pointer :: xp @@ -70,8 +70,8 @@ contains implicit none integer(psb_c_int) :: res - type(psb_c_object_type) :: xh - type(psb_c_object_type) :: cdh + type(psb_c_dvector) :: xh + type(psb_c_descriptor) :: cdh type(psb_desc_type), pointer :: descp type(psb_d_vect_type), pointer :: xp @@ -105,8 +105,8 @@ contains integer(psb_c_int), value :: nz integer(psb_c_int) :: irw(*) real(c_double) :: val(*) - type(psb_c_object_type) :: xh - type(psb_c_object_type) :: cdh + type(psb_c_dvector) :: xh + type(psb_c_descriptor) :: cdh type(psb_desc_type), pointer :: descp type(psb_d_vect_type), pointer :: xp @@ -139,8 +139,8 @@ contains integer(psb_c_int), value :: nz integer(psb_c_int) :: irw(*) real(c_double) :: val(*) - type(psb_c_object_type) :: xh - type(psb_c_object_type) :: cdh + type(psb_c_dvector) :: xh + type(psb_c_descriptor) :: cdh type(psb_desc_type), pointer :: descp type(psb_d_vect_type), pointer :: xp @@ -170,8 +170,8 @@ contains implicit none integer(psb_c_int) :: res - type(psb_c_object_type) :: mh - type(psb_c_object_type) :: cdh + type(psb_c_dspmat) :: mh + type(psb_c_descriptor) :: cdh type(psb_desc_type), pointer :: descp type(psb_dspmat_type), pointer :: ap @@ -200,8 +200,8 @@ contains implicit none integer(psb_c_int) :: res - type(psb_c_object_type) :: mh - type(psb_c_object_type) :: cdh + type(psb_c_dspmat) :: mh + type(psb_c_descriptor) :: cdh type(psb_desc_type), pointer :: descp type(psb_dspmat_type), pointer :: ap @@ -229,8 +229,8 @@ contains implicit none integer(psb_c_int) :: res - type(psb_c_object_type) :: mh - type(psb_c_object_type) :: cdh + type(psb_c_dspmat) :: mh + type(psb_c_descriptor) :: cdh type(psb_desc_type), pointer :: descp type(psb_dspmat_type), pointer :: ap @@ -303,8 +303,8 @@ contains integer(psb_c_int), value :: nz integer(psb_c_int) :: irw(*), icl(*) real(c_double) :: val(*) - type(psb_c_object_type) :: mh - type(psb_c_object_type) :: cdh + type(psb_c_dspmat) :: mh + type(psb_c_descriptor) :: cdh type(psb_desc_type), pointer :: descp type(psb_dspmat_type), pointer :: ap @@ -334,8 +334,8 @@ contains implicit none integer(psb_c_int) :: res logical(c_bool), value :: clear - type(psb_c_object_type) :: mh - type(psb_c_object_type) :: cdh + type(psb_c_dspmat) :: mh + type(psb_c_descriptor) :: cdh type(psb_desc_type), pointer :: descp type(psb_dspmat_type), pointer :: ap diff --git a/cbind/base/psb_objhandle_mod.F90 b/cbind/base/psb_objhandle_mod.F90 index 17737e2b..b2f1c008 100644 --- a/cbind/base/psb_objhandle_mod.F90 +++ b/cbind/base/psb_objhandle_mod.F90 @@ -6,15 +6,23 @@ module psb_objhandle_mod #else integer, parameter :: psb_c_int = c_int32_t #endif - + type, bind(c) :: psb_c_object_type type(c_ptr) :: item = c_null_ptr end type psb_c_object_type - + type, bind(c) :: psb_c_descriptor type(c_ptr) :: item = c_null_ptr end type psb_c_descriptor - + + type, bind(c) :: psb_c_svector + type(c_ptr) :: item = c_null_ptr + end type psb_c_svector + + type, bind(c) :: psb_c_sspmat + type(c_ptr) :: item = c_null_ptr + end type psb_c_sspmat + type, bind(c) :: psb_c_dvector type(c_ptr) :: item = c_null_ptr end type psb_c_dvector @@ -22,5 +30,21 @@ module psb_objhandle_mod type, bind(c) :: psb_c_dspmat type(c_ptr) :: item = c_null_ptr end type psb_c_dspmat - + + type, bind(c) :: psb_c_cvector + type(c_ptr) :: item = c_null_ptr + end type psb_c_cvector + + type, bind(c) :: psb_c_cspmat + type(c_ptr) :: item = c_null_ptr + end type psb_c_cspmat + + type, bind(c) :: psb_c_zvector + type(c_ptr) :: item = c_null_ptr + end type psb_c_zvector + + type, bind(c) :: psb_c_zspmat + type(c_ptr) :: item = c_null_ptr + end type psb_c_zspmat + end module psb_objhandle_mod diff --git a/cbind/base/psb_s_psblas_cbind_mod.f90 b/cbind/base/psb_s_psblas_cbind_mod.f90 new file mode 100644 index 00000000..5cef1b1c --- /dev/null +++ b/cbind/base/psb_s_psblas_cbind_mod.f90 @@ -0,0 +1,289 @@ +module psb_s_psblas_cbind_mod + use iso_c_binding + +contains + + function psb_c_sgeaxpby(alpha,xh,beta,yh,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + integer(psb_c_int) :: res + + type(psb_c_svector) :: xh,yh + type(psb_c_descriptor) :: cdh + real(c_float), value :: alpha,beta + + type(psb_desc_type), pointer :: descp + type(psb_s_vect_type), pointer :: xp,yp + integer :: info + + + res = -1 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + if (c_associated(yh%item)) then + call c_f_pointer(yh%item,yp) + else + return + end if + + call psb_geaxpby(alpha,xp,beta,yp,descp,info) + + res = info + + end function psb_c_sgeaxpby + + function psb_c_sgenrm2(xh,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + real(c_float) :: res + + type(psb_c_svector) :: xh + type(psb_c_descriptor) :: cdh + type(psb_desc_type), pointer :: descp + type(psb_s_vect_type), pointer :: xp + integer :: info + + res = -1.0 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + res = psb_genrm2(xp,descp,info) + + end function psb_c_sgenrm2 + + function psb_c_sgeamax(xh,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + real(c_float) :: res + + type(psb_c_svector) :: xh + type(psb_c_descriptor) :: cdh + type(psb_desc_type), pointer :: descp + type(psb_s_vect_type), pointer :: xp + integer :: info + + res = -1.0 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + res = psb_geamax(xp,descp,info) + + end function psb_c_sgeamax + + function psb_c_sgeasum(xh,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + real(c_float) :: res + + type(psb_c_svector) :: xh + type(psb_c_descriptor) :: cdh + type(psb_desc_type), pointer :: descp + type(psb_s_vect_type), pointer :: xp + integer :: info + + res = -1.0 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + res = psb_geasum(xp,descp,info) + + end function psb_c_sgeasum + + + function psb_c_sspnrmi(ah,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + real(c_float) :: res + + type(psb_c_sspmat) :: ah + type(psb_c_descriptor) :: cdh + type(psb_desc_type), pointer :: descp + type(psb_sspmat_type), pointer :: ap + integer :: info + + res = -1.0 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) + else + return + end if + + res = psb_spnrmi(ap,descp,info) + + end function psb_c_sspnrmi + + function psb_c_sgedot(xh,yh,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + real(c_float) :: res + + type(psb_c_svector) :: xh,yh + type(psb_c_descriptor) :: cdh + type(psb_desc_type), pointer :: descp + type(psb_s_vect_type), pointer :: xp,yp + integer :: info + + res = -1.0 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + if (c_associated(yh%item)) then + call c_f_pointer(yh%item,yp) + else + return + end if + res = psb_gedot(xp,yp,descp,info) + + end function psb_c_sgedot + + + function psb_c_sspmm(alpha,ah,xh,beta,yh,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + integer(psb_c_int) :: res + + type(psb_c_sspmat) :: ah + type(psb_c_svector) :: xh,yh + type(psb_c_descriptor) :: cdh + real(c_float), value :: alpha, beta + type(psb_desc_type), pointer :: descp + type(psb_s_vect_type), pointer :: xp,yp + type(psb_sspmat_type), pointer :: ap + integer :: info + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + if (c_associated(yh%item)) then + call c_f_pointer(yh%item,yp) + else + return + end if + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) + else + return + end if + + call psb_spmm(alpha,ap,xp,beta,yp,descp,info) + + res = info + + end function psb_c_sspmm + + + function psb_c_sspsm(alpha,ah,xh,beta,yh,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + integer(psb_c_int) :: res + + type(psb_c_sspmat) :: ah + type(psb_c_svector) :: xh,yh + type(psb_c_descriptor) :: cdh + real(c_float), value :: alpha, beta + type(psb_desc_type), pointer :: descp + type(psb_s_vect_type), pointer :: xp,yp + type(psb_sspmat_type), pointer :: ap + integer :: info + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + if (c_associated(yh%item)) then + call c_f_pointer(yh%item,yp) + else + return + end if + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) + else + return + end if + + call psb_spsm(alpha,ap,xp,beta,yp,descp,info) + + res = info + + end function psb_c_sspsm + + +end module psb_s_psblas_cbind_mod diff --git a/cbind/base/psb_s_serial_cbind_mod.F90 b/cbind/base/psb_s_serial_cbind_mod.F90 new file mode 100644 index 00000000..b2bc5f6a --- /dev/null +++ b/cbind/base/psb_s_serial_cbind_mod.F90 @@ -0,0 +1,119 @@ +module psb_s_serial_cbind_mod + use iso_c_binding + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + use psb_base_tools_cbind_mod + +contains + + + function psb_c_svect_get_nrows(xh) bind(c) result(res) + implicit none + + integer(psb_c_int) :: res + type(psb_c_svector) :: xh + + type(psb_s_vect_type), pointer :: vp + integer :: info + + res = -1 + + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,vp) + res = vp%get_nrows() + end if + + end function psb_c_svect_get_nrows + + function psb_c_svect_f_get_cpy(v,xh) bind(c) result(res) + implicit none + + integer(psb_c_int) :: res + real(c_float) :: v(*) + type(psb_c_svector) :: xh + + type(psb_s_vect_type), pointer :: vp + real(psb_spk_), allocatable :: fv(:) + integer :: info, sz + + res = -1 + + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,vp) + fv = vp%get_vect() + sz = size(fv) + v(1:sz) = fv(1:sz) + end if + + end function psb_c_svect_f_get_cpy + + + function psb_c_svect_zero(xh) bind(c) result(res) + implicit none + + integer(psb_c_int) :: res + type(psb_c_svector) :: xh + + type(psb_s_vect_type), pointer :: vp + integer :: info + + res = -1 + + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,vp) + call vp%zero() + end if + + end function psb_c_svect_zero + + + function psb_c_smat_get_nrows(mh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + integer(psb_c_int) :: res + + type(psb_c_sspmat) :: mh + type(psb_sspmat_type), pointer :: ap + integer :: info + + res = 0 + if (c_associated(mh%item)) then + call c_f_pointer(mh%item,ap) + else + return + end if + + res = ap%get_nrows() + + end function psb_c_smat_get_nrows + + + function psb_c_smat_get_ncols(mh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + integer(psb_c_int) :: res + + type(psb_c_sspmat) :: mh + type(psb_sspmat_type), pointer :: ap + integer :: info + + res = 0 + if (c_associated(mh%item)) then + call c_f_pointer(mh%item,ap) + else + return + end if + + res = ap%get_ncols() + + end function psb_c_smat_get_ncols + + + +end module psb_s_serial_cbind_mod + diff --git a/cbind/base/psb_s_tools_cbind_mod.F90 b/cbind/base/psb_s_tools_cbind_mod.F90 new file mode 100644 index 00000000..e3b7fd76 --- /dev/null +++ b/cbind/base/psb_s_tools_cbind_mod.F90 @@ -0,0 +1,385 @@ +module psb_s_tools_cbind_mod + use iso_c_binding + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + use psb_base_tools_cbind_mod + +contains + + function psb_c_sgeall(xh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + type(psb_c_svector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_s_vect_type), pointer :: xp + integer :: info + + res = -1 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + return + end if + allocate(xp) + call psb_geall(xp,descp,info) + xh%item = c_loc(xp) + res = min(0,info) + + return + end function psb_c_sgeall + + function psb_c_sgeasb(xh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + type(psb_c_svector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_s_vect_type), pointer :: xp + integer :: info + + res = -1 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + call psb_geasb(xp,descp,info) + res = min(0,info) + + return + end function psb_c_sgeasb + + function psb_c_sgefree(xh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + type(psb_c_svector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_s_vect_type), pointer :: xp + integer :: info + + res = -1 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + call psb_gefree(xp,descp,info) + res = min(0,info) + xh%item = c_null_ptr + + return + end function psb_c_sgefree + + + function psb_c_sgeins(nz,irw,val,xh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + integer(psb_c_int), value :: nz + integer(psb_c_int) :: irw(*) + real(c_float) :: val(*) + type(psb_c_svector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_s_vect_type), pointer :: xp + integer :: info + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + call psb_geins(nz,irw(1:nz),val(1:nz),& + & xp,descp,info, dupl=psb_dupl_ovwrt_) + res = min(0,info) + + return + end function psb_c_sgeins + + + function psb_c_sgeins_add(nz,irw,val,xh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + integer(psb_c_int), value :: nz + integer(psb_c_int) :: irw(*) + real(c_float) :: val(*) + type(psb_c_svector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_s_vect_type), pointer :: xp + integer :: info + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + call psb_geins(nz,irw(1:nz),val(1:nz),& + & xp,descp,info, dupl=psb_dupl_add_) + res = min(0,info) + + return + end function psb_c_sgeins_add + + + function psb_c_sspall(mh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + type(psb_c_sspmat) :: mh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_sspmat_type), pointer :: ap + integer :: 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) + mh%item = c_loc(ap) + res = min(0,info) + + return + end function psb_c_sspall + + + + function psb_c_sspasb(mh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + type(psb_c_sspmat) :: mh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_sspmat_type), pointer :: ap + integer :: 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 + call c_f_pointer(mh%item,ap) + else + return + end if + + call psb_spasb(ap,descp,info) + res = min(0,info) + return + end function psb_c_sspasb + + + function psb_c_sspfree(mh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + type(psb_c_sspmat) :: mh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_sspmat_type), pointer :: ap + integer :: 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 + call c_f_pointer(mh%item,ap) + else + return + end if + + call psb_spfree(ap,descp,info) + res = min(0,info) + mh%item=c_null_ptr + return + end function psb_c_sspfree + + +#if 0 + + function psb_c_sspasb_opt(mh,cdh,afmt,upd,dupl) bind(c) result(res) + +#ifdef HAVE_LIBRSB + use psb_s_rsb_mat_mod +#endif + implicit none + integer(psb_c_int) :: res + integer(psb_c_int), value :: cdh, mh,upd,dupl + character(c_char) :: afmt(*) + integer :: info,n, fdupl + character(len=5) :: fafmt +#ifdef HAVE_LIBRSB + type(psb_s_rsb_sparse_mat) :: arsb +#endif + + res = -1 + call psb_check_descriptor_handle(cdh,info) + if (info < 0) return + call psb_check_double_spmat_handle(mh,info) + if (info < 0) return + + call stringc2f(afmt,fafmt) + select case(fafmt) +#ifdef HAVE_LIBRSB + case('RSB') + call psb_spasb(double_spmat_pool(mh)%item,descriptor_pool(cdh)%item,info,& + & upd=upd,dupl=dupl,mold=arsb) +#endif + case default + call psb_spasb(double_spmat_pool(mh)%item,descriptor_pool(cdh)%item,info,& + & afmt=fafmt,upd=upd,dupl=dupl) + end select + + res = min(0,info) + + return + end function psb_c_sspasb_opt +#endif + + function psb_c_sspins(nz,irw,icl,val,mh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + integer(psb_c_int), value :: nz + integer(psb_c_int) :: irw(*), icl(*) + real(c_float) :: val(*) + type(psb_c_sspmat) :: mh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_sspmat_type), pointer :: ap + integer :: 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 + call c_f_pointer(mh%item,ap) + else + return + end if + + + call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info) + res = min(0,info) + return + end function psb_c_sspins + + + function psb_c_ssprn(mh,cdh,clear) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + logical(c_bool), value :: clear + type(psb_c_sspmat) :: mh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_sspmat_type), pointer :: ap + integer :: info + logical :: fclear + + 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 + call c_f_pointer(mh%item,ap) + else + return + end if + + fclear = clear + call psb_sprn(ap,descp,info,clear=fclear) + res = min(0,info) + + return + end function psb_c_ssprn +!!$ +!!$ function psb_c_sspprint(mh) bind(c) result(res) +!!$ +!!$ implicit none +!!$ integer(psb_c_int) :: res +!!$ integer(psb_c_int), value :: mh +!!$ integer :: info +!!$ +!!$ +!!$ res = -1 +!!$ call psb_check_double_spmat_handle(mh,info) +!!$ if (info < 0) return +!!$ +!!$ call psb_csprt(0,double_spmat_pool(mh)%item,head='Debug mat') +!!$ +!!$ res = 0 +!!$ +!!$ return +!!$ end function psb_c_sspprint + + +end module psb_s_tools_cbind_mod + diff --git a/cbind/base/psb_z_psblas_cbind_mod.f90 b/cbind/base/psb_z_psblas_cbind_mod.f90 new file mode 100644 index 00000000..43cb6d8f --- /dev/null +++ b/cbind/base/psb_z_psblas_cbind_mod.f90 @@ -0,0 +1,289 @@ +module psb_z_psblas_cbind_mod + use iso_c_binding + +contains + + function psb_c_zgeaxpby(alpha,xh,beta,yh,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + integer(psb_c_int) :: res + + type(psb_c_zvector) :: xh,yh + type(psb_c_descriptor) :: cdh + complex(c_double_complex), value :: alpha,beta + + type(psb_desc_type), pointer :: descp + type(psb_z_vect_type), pointer :: xp,yp + integer :: info + + + res = -1 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + if (c_associated(yh%item)) then + call c_f_pointer(yh%item,yp) + else + return + end if + + call psb_geaxpby(alpha,xp,beta,yp,descp,info) + + res = info + + end function psb_c_zgeaxpby + + function psb_c_zgenrm2(xh,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + real(c_double_complex) :: res + + type(psb_c_zvector) :: xh + type(psb_c_descriptor) :: cdh + type(psb_desc_type), pointer :: descp + type(psb_z_vect_type), pointer :: xp + integer :: info + + res = -1.0 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + res = psb_genrm2(xp,descp,info) + + end function psb_c_zgenrm2 + + function psb_c_zgeamax(xh,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + real(c_double_complex) :: res + + type(psb_c_zvector) :: xh + type(psb_c_descriptor) :: cdh + type(psb_desc_type), pointer :: descp + type(psb_z_vect_type), pointer :: xp + integer :: info + + res = -1.0 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + res = psb_geamax(xp,descp,info) + + end function psb_c_zgeamax + + function psb_c_zgeasum(xh,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + real(c_double_complex) :: res + + type(psb_c_zvector) :: xh + type(psb_c_descriptor) :: cdh + type(psb_desc_type), pointer :: descp + type(psb_z_vect_type), pointer :: xp + integer :: info + + res = -1.0 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + res = psb_geasum(xp,descp,info) + + end function psb_c_zgeasum + + + function psb_c_zspnrmi(ah,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + real(c_double_complex) :: res + + type(psb_c_zspmat) :: ah + type(psb_c_descriptor) :: cdh + type(psb_desc_type), pointer :: descp + type(psb_zspmat_type), pointer :: ap + integer :: info + + res = -1.0 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) + else + return + end if + + res = psb_spnrmi(ap,descp,info) + + end function psb_c_zspnrmi + + function psb_c_zgedot(xh,yh,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + complex(c_double_complex) :: res + + type(psb_c_zvector) :: xh,yh + type(psb_c_descriptor) :: cdh + type(psb_desc_type), pointer :: descp + type(psb_z_vect_type), pointer :: xp,yp + integer :: info + + res = -1.0 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + if (c_associated(yh%item)) then + call c_f_pointer(yh%item,yp) + else + return + end if + res = psb_gedot(xp,yp,descp,info) + + end function psb_c_zgedot + + + function psb_c_zspmm(alpha,ah,xh,beta,yh,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + integer(psb_c_int) :: res + + type(psb_c_zspmat) :: ah + type(psb_c_zvector) :: xh,yh + type(psb_c_descriptor) :: cdh + complex(c_double_complex), value :: alpha, beta + type(psb_desc_type), pointer :: descp + type(psb_z_vect_type), pointer :: xp,yp + type(psb_zspmat_type), pointer :: ap + integer :: info + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + if (c_associated(yh%item)) then + call c_f_pointer(yh%item,yp) + else + return + end if + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) + else + return + end if + + call psb_spmm(alpha,ap,xp,beta,yp,descp,info) + + res = info + + end function psb_c_zspmm + + + function psb_c_zspsm(alpha,ah,xh,beta,yh,cdh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + integer(psb_c_int) :: res + + type(psb_c_zspmat) :: ah + type(psb_c_zvector) :: xh,yh + type(psb_c_descriptor) :: cdh + complex(c_double_complex), value :: alpha, beta + type(psb_desc_type), pointer :: descp + type(psb_z_vect_type), pointer :: xp,yp + type(psb_zspmat_type), pointer :: ap + integer :: info + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + if (c_associated(yh%item)) then + call c_f_pointer(yh%item,yp) + else + return + end if + if (c_associated(ah%item)) then + call c_f_pointer(ah%item,ap) + else + return + end if + + call psb_spsm(alpha,ap,xp,beta,yp,descp,info) + + res = info + + end function psb_c_zspsm + + +end module psb_z_psblas_cbind_mod diff --git a/cbind/base/psb_z_serial_cbind_mod.F90 b/cbind/base/psb_z_serial_cbind_mod.F90 new file mode 100644 index 00000000..ef6285bf --- /dev/null +++ b/cbind/base/psb_z_serial_cbind_mod.F90 @@ -0,0 +1,119 @@ +module psb_z_serial_cbind_mod + use iso_c_binding + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + use psb_base_tools_cbind_mod + +contains + + + function psb_c_zvect_get_nrows(xh) bind(c) result(res) + implicit none + + integer(psb_c_int) :: res + type(psb_c_zvector) :: xh + + type(psb_z_vect_type), pointer :: vp + integer :: info + + res = -1 + + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,vp) + res = vp%get_nrows() + end if + + end function psb_c_zvect_get_nrows + + function psb_c_zvect_f_get_cpy(v,xh) bind(c) result(res) + implicit none + + integer(psb_c_int) :: res + complex(c_double_complex) :: v(*) + type(psb_c_zvector) :: xh + + type(psb_z_vect_type), pointer :: vp + complex(psb_dpk_), allocatable :: fv(:) + integer :: info, sz + + res = -1 + + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,vp) + fv = vp%get_vect() + sz = size(fv) + v(1:sz) = fv(1:sz) + end if + + end function psb_c_zvect_f_get_cpy + + + function psb_c_zvect_zero(xh) bind(c) result(res) + implicit none + + integer(psb_c_int) :: res + type(psb_c_zvector) :: xh + + type(psb_z_vect_type), pointer :: vp + integer :: info + + res = -1 + + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,vp) + call vp%zero() + end if + + end function psb_c_zvect_zero + + + function psb_c_zmat_get_nrows(mh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + integer(psb_c_int) :: res + + type(psb_c_zspmat) :: mh + type(psb_zspmat_type), pointer :: ap + integer :: info + + res = 0 + if (c_associated(mh%item)) then + call c_f_pointer(mh%item,ap) + else + return + end if + + res = ap%get_nrows() + + end function psb_c_zmat_get_nrows + + + function psb_c_zmat_get_ncols(mh) bind(c) result(res) + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + implicit none + integer(psb_c_int) :: res + + type(psb_c_zspmat) :: mh + type(psb_zspmat_type), pointer :: ap + integer :: info + + res = 0 + if (c_associated(mh%item)) then + call c_f_pointer(mh%item,ap) + else + return + end if + + res = ap%get_ncols() + + end function psb_c_zmat_get_ncols + + + +end module psb_z_serial_cbind_mod + diff --git a/cbind/base/psb_z_tools_cbind_mod.F90 b/cbind/base/psb_z_tools_cbind_mod.F90 new file mode 100644 index 00000000..96e2b9b0 --- /dev/null +++ b/cbind/base/psb_z_tools_cbind_mod.F90 @@ -0,0 +1,385 @@ +module psb_z_tools_cbind_mod + use iso_c_binding + use psb_base_mod + use psb_objhandle_mod + use psb_base_string_cbind_mod + use psb_base_tools_cbind_mod + +contains + + function psb_c_zgeall(xh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + type(psb_c_zvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_z_vect_type), pointer :: xp + integer :: info + + res = -1 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + return + end if + allocate(xp) + call psb_geall(xp,descp,info) + xh%item = c_loc(xp) + res = min(0,info) + + return + end function psb_c_zgeall + + function psb_c_zgeasb(xh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + type(psb_c_zvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_z_vect_type), pointer :: xp + integer :: info + + res = -1 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + call psb_geasb(xp,descp,info) + res = min(0,info) + + return + end function psb_c_zgeasb + + function psb_c_zgefree(xh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + type(psb_c_zvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_z_vect_type), pointer :: xp + integer :: info + + res = -1 + + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + call psb_gefree(xp,descp,info) + res = min(0,info) + xh%item = c_null_ptr + + return + end function psb_c_zgefree + + + function psb_c_zgeins(nz,irw,val,xh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + integer(psb_c_int), value :: nz + integer(psb_c_int) :: irw(*) + complex(c_double_complex) :: val(*) + type(psb_c_zvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_z_vect_type), pointer :: xp + integer :: info + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + call psb_geins(nz,irw(1:nz),val(1:nz),& + & xp,descp,info, dupl=psb_dupl_ovwrt_) + res = min(0,info) + + return + end function psb_c_zgeins + + + function psb_c_zgeins_add(nz,irw,val,xh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + integer(psb_c_int), value :: nz + integer(psb_c_int) :: irw(*) + complex(c_double_complex) :: val(*) + type(psb_c_zvector) :: xh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_z_vect_type), pointer :: xp + integer :: info + + res = -1 + if (c_associated(cdh%item)) then + call c_f_pointer(cdh%item,descp) + else + return + end if + if (c_associated(xh%item)) then + call c_f_pointer(xh%item,xp) + else + return + end if + + call psb_geins(nz,irw(1:nz),val(1:nz),& + & xp,descp,info, dupl=psb_dupl_add_) + res = min(0,info) + + return + end function psb_c_zgeins_add + + + function psb_c_zspall(mh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + type(psb_c_zspmat) :: mh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_zspmat_type), pointer :: ap + integer :: 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) + mh%item = c_loc(ap) + res = min(0,info) + + return + end function psb_c_zspall + + + + function psb_c_zspasb(mh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + type(psb_c_zspmat) :: mh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_zspmat_type), pointer :: ap + integer :: 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 + call c_f_pointer(mh%item,ap) + else + return + end if + + call psb_spasb(ap,descp,info) + res = min(0,info) + return + end function psb_c_zspasb + + + function psb_c_zspfree(mh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + type(psb_c_zspmat) :: mh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_zspmat_type), pointer :: ap + integer :: 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 + call c_f_pointer(mh%item,ap) + else + return + end if + + call psb_spfree(ap,descp,info) + res = min(0,info) + mh%item=c_null_ptr + return + end function psb_c_zspfree + + +#if 0 + + function psb_c_zspasb_opt(mh,cdh,afmt,upd,dupl) bind(c) result(res) + +#ifdef HAVE_LIBRSB + use psb_z_rsb_mat_mod +#endif + implicit none + integer(psb_c_int) :: res + integer(psb_c_int), value :: cdh, mh,upd,dupl + character(c_char) :: afmt(*) + integer :: info,n, fdupl + character(len=5) :: fafmt +#ifdef HAVE_LIBRSB + type(psb_z_rsb_sparse_mat) :: arsb +#endif + + res = -1 + call psb_check_descriptor_handle(cdh,info) + if (info < 0) return + call psb_check_double_spmat_handle(mh,info) + if (info < 0) return + + call stringc2f(afmt,fafmt) + select case(fafmt) +#ifdef HAVE_LIBRSB + case('RSB') + call psb_spasb(double_spmat_pool(mh)%item,descriptor_pool(cdh)%item,info,& + & upd=upd,dupl=dupl,mold=arsb) +#endif + case default + call psb_spasb(double_spmat_pool(mh)%item,descriptor_pool(cdh)%item,info,& + & afmt=fafmt,upd=upd,dupl=dupl) + end select + + res = min(0,info) + + return + end function psb_c_zspasb_opt +#endif + + function psb_c_zspins(nz,irw,icl,val,mh,cdh) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + integer(psb_c_int), value :: nz + integer(psb_c_int) :: irw(*), icl(*) + complex(c_double_complex) :: val(*) + type(psb_c_zspmat) :: mh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_zspmat_type), pointer :: ap + integer :: 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 + call c_f_pointer(mh%item,ap) + else + return + end if + + + call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info) + res = min(0,info) + return + end function psb_c_zspins + + + function psb_c_zsprn(mh,cdh,clear) bind(c) result(res) + + implicit none + integer(psb_c_int) :: res + logical(c_bool), value :: clear + type(psb_c_zspmat) :: mh + type(psb_c_descriptor) :: cdh + + type(psb_desc_type), pointer :: descp + type(psb_zspmat_type), pointer :: ap + integer :: info + logical :: fclear + + 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 + call c_f_pointer(mh%item,ap) + else + return + end if + + fclear = clear + call psb_sprn(ap,descp,info,clear=fclear) + res = min(0,info) + + return + end function psb_c_zsprn +!!$ +!!$ function psb_c_zspprint(mh) bind(c) result(res) +!!$ +!!$ implicit none +!!$ integer(psb_c_int) :: res +!!$ integer(psb_c_int), value :: mh +!!$ integer :: info +!!$ +!!$ +!!$ res = -1 +!!$ call psb_check_double_spmat_handle(mh,info) +!!$ if (info < 0) return +!!$ +!!$ call psb_csprt(0,double_spmat_pool(mh)%item,head='Debug mat') +!!$ +!!$ res = 0 +!!$ +!!$ return +!!$ end function psb_c_zspprint + + +end module psb_z_tools_cbind_mod +