psblas3-mcbind
Make.inc.in Makefile cbind cbind/Makefile cbind/base cbind/base/Makefile cbind/base/psb_base_cbind.h cbind/base/psb_base_cbind_mod.f90 cbind/base/psb_base_psblas_cbind_mod.f90 cbind/base/psb_base_string_cbind_mod.f90 cbind/base/psb_base_tools_cbind_mod.F90 cbind/base/psb_c_base.c cbind/base/psb_c_base.h cbind/base/psb_c_dbase.c cbind/base/psb_c_dbase.h cbind/base/psb_cpenv_mod.f90 cbind/base/psb_d_psblas_cbind_mod.f90 cbind/base/psb_d_serial_cbind_mod.F90 cbind/base/psb_d_tools_cbind_mod.F90 cbind/base/psb_objhandle_mod.f90 Branch for C bindings.psblas3-mcbind
Salvatore Filippone
8 years ago
parent
240efbc338
commit
1002d815e3
@ -0,0 +1,23 @@
|
||||
include ../Make.inc
|
||||
|
||||
HERE=.
|
||||
LIBDIR=../lib
|
||||
INCDIR=../include
|
||||
LIBNAME=$(CBINDLIBNAME)
|
||||
|
||||
lib: based
|
||||
/bin/cp -p $(CPUPDFLAG) $(HERE)/$(LIBNAME) $(LIBDIR)
|
||||
/bin/cp -p $(CPUPDFLAG) *$(.mod) *.h $(INCDIR)
|
||||
|
||||
|
||||
|
||||
based:
|
||||
cd base && $(MAKE) lib LIBNAME=$(LIBNAME)
|
||||
|
||||
|
||||
clean:
|
||||
cd base && $(MAKE) clean
|
||||
|
||||
|
||||
veryclean: clean
|
||||
/bin/rm -f $(HERE)/$(LIBNAME) $(LIBMOD) *$(.mod) *.h
|
||||
@ -0,0 +1,44 @@
|
||||
TOP=../..
|
||||
include $(TOP)/Make.inc
|
||||
LIBDIR=$(TOP)lib
|
||||
INCLUDEDIR=$(TOP)/include
|
||||
HERE=..
|
||||
|
||||
FINCLUDES=$(FMFLAG). $(FMFLAG)$(INCLUDEDIR)
|
||||
CINCLUDES=-I$(INCLUDEDIR)
|
||||
|
||||
OBJS= 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_c_base.o \
|
||||
psb_d_serial_cbind_mod.o psb_c_dbase.o psb_d_psblas_cbind_mod.o
|
||||
CMOD=psb_base_cbind.h psb_c_base.h psb_c_dbase.h
|
||||
|
||||
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)
|
||||
LOCAL_MODS=$(LIBMOD)
|
||||
LIBNAME=$(CBINDLIBNAME)
|
||||
|
||||
|
||||
lib: $(OBJS) $(CMOD)
|
||||
$(AR) $(HERE)/$(LIBNAME) $(OBJS)
|
||||
$(RANLIB) $(HERE)/$(LIBNAME)
|
||||
/bin/cp -p $(LIBMOD) $(CMOD) $(HERE)
|
||||
|
||||
|
||||
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_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
|
||||
|
||||
veryclean: clean
|
||||
/bin/rm -f $(HERE)/$(LIBNAME)
|
||||
|
||||
clean:
|
||||
/bin/rm -f $(OBJS) $(LOCAL_MODS)
|
||||
|
||||
veryclean: clean
|
||||
@ -0,0 +1,7 @@
|
||||
#ifndef PSB_BASE_CBIND_
|
||||
#define PSB_BASE_CBIND_
|
||||
|
||||
#include "psb_c_base.h"
|
||||
#include "psb_c_dbase.h"
|
||||
|
||||
#endif
|
||||
@ -0,0 +1,6 @@
|
||||
module psb_base_cbind_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_cpenv_mod
|
||||
use psb_base_tools_cbind_mod
|
||||
use psb_base_psblas_cbind_mod
|
||||
end module psb_base_cbind_mod
|
||||
@ -0,0 +1,6 @@
|
||||
module psb_base_psblas_cbind_mod
|
||||
|
||||
use iso_c_binding
|
||||
use psb_d_psblas_cbind_mod
|
||||
|
||||
end module psb_base_psblas_cbind_mod
|
||||
@ -0,0 +1,38 @@
|
||||
module psb_base_string_cbind_mod
|
||||
use iso_c_binding
|
||||
|
||||
contains
|
||||
|
||||
subroutine stringc2f(cstring,fstring)
|
||||
character(c_char) :: cstring(*)
|
||||
character(len=*) :: fstring
|
||||
integer :: i
|
||||
|
||||
i = 1
|
||||
do
|
||||
if (cstring(i) == c_null_char) exit
|
||||
if (i > len(fstring)) exit
|
||||
fstring(i:i) = cstring(i)
|
||||
i = i + 1
|
||||
end do
|
||||
do
|
||||
if (i > len(fstring)) exit
|
||||
fstring(i:i) = " "
|
||||
i = i + 1
|
||||
end do
|
||||
return
|
||||
end subroutine stringc2f
|
||||
|
||||
subroutine stringf2c(fstring,cstring)
|
||||
character(c_char) :: cstring(*)
|
||||
character(len=*) :: fstring
|
||||
integer :: i
|
||||
|
||||
do i=1, len(fstring)
|
||||
cstring(i) = fstring(i:i)
|
||||
end do
|
||||
cstring(len(fstring)+1) = c_null_char
|
||||
return
|
||||
end subroutine stringf2c
|
||||
|
||||
end module psb_base_string_cbind_mod
|
||||
@ -0,0 +1,295 @@
|
||||
module psb_base_tools_cbind_mod
|
||||
use iso_c_binding
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
|
||||
contains
|
||||
|
||||
function psb_c_error() bind(c) result(res)
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
res = 0
|
||||
call psb_error()
|
||||
end function psb_c_error
|
||||
|
||||
function psb_c_clean_errstack() bind(c) result(res)
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
res = 0
|
||||
call psb_clean_errstack()
|
||||
end function psb_c_clean_errstack
|
||||
|
||||
function psb_c_cdall_vg(ng,vg,ictxt,cdh) bind(c,name='psb_c_cdall_vg') result(res)
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: res
|
||||
integer(c_int), value :: ng, ictxt
|
||||
integer(c_int) :: vg(*)
|
||||
type(psb_c_object_type) :: cdh
|
||||
type(psb_desc_type), pointer :: descp
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
if (ng <=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
|
||||
|
||||
call psb_cdall(ictxt,descp,info,vg=vg(1:ng))
|
||||
cdh%item = c_loc(descp)
|
||||
res = info
|
||||
|
||||
end function psb_c_cdall_vg
|
||||
|
||||
|
||||
function psb_c_cdall_vl(nl,vl,ictxt,cdh) bind(c,name='psb_c_cdall_vl') result(res)
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: res
|
||||
integer(c_int), value :: nl, ictxt
|
||||
integer(c_int) :: vl(*)
|
||||
type(psb_c_object_type) :: cdh
|
||||
type(psb_desc_type), pointer :: descp
|
||||
integer :: info
|
||||
|
||||
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
|
||||
|
||||
call psb_cdall(ictxt,descp,info,vl=vl(1:nl))
|
||||
cdh%item = c_loc(descp)
|
||||
res = info
|
||||
|
||||
end function psb_c_cdall_vl
|
||||
|
||||
function psb_c_cdall_nl(nl,ictxt,cdh) bind(c,name='psb_c_cdall_nl') result(res)
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: res
|
||||
integer(c_int), value :: nl, ictxt
|
||||
type(psb_c_object_type) :: cdh
|
||||
type(psb_desc_type), pointer :: descp
|
||||
integer :: info
|
||||
|
||||
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
|
||||
|
||||
call psb_cdall(ictxt,descp,info,nl=nl)
|
||||
cdh%item = c_loc(descp)
|
||||
res = info
|
||||
|
||||
end function psb_c_cdall_nl
|
||||
|
||||
function psb_c_cdall_repl(n,ictxt,cdh) bind(c,name='psb_c_cdall_repl') result(res)
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: res
|
||||
integer(c_int), value :: n, ictxt
|
||||
type(psb_c_object_type) :: cdh
|
||||
type(psb_desc_type), pointer :: descp
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
if (n <=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
|
||||
|
||||
call psb_cdall(ictxt,descp,info,mg=n,repl=.true.)
|
||||
cdh%item = c_loc(descp)
|
||||
res = info
|
||||
|
||||
end function psb_c_cdall_repl
|
||||
|
||||
function psb_c_cdasb(cdh) bind(c,name='psb_c_cdasb') result(res)
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: res
|
||||
type(psb_c_object_type) :: cdh
|
||||
type(psb_desc_type), pointer :: descp
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
call psb_cdasb(descp,info)
|
||||
res = info
|
||||
end if
|
||||
|
||||
end function psb_c_cdasb
|
||||
|
||||
|
||||
function psb_c_cdfree(cdh) bind(c,name='psb_c_cdfree') result(res)
|
||||
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
type(psb_c_object_type) :: cdh
|
||||
type(psb_desc_type), pointer :: descp
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
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
|
||||
cdh%item = c_null_ptr
|
||||
end if
|
||||
|
||||
res = info
|
||||
return
|
||||
end function psb_c_cdfree
|
||||
|
||||
function psb_c_cdins(nz,ia,ja,cdh) bind(c,name='psb_c_cdins') result(res)
|
||||
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
integer(c_int), value :: nz
|
||||
type(psb_c_object_type) :: cdh
|
||||
integer(c_int) :: ia(*),ja(*)
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
call psb_cdins(nz,ia(1:nz),ja(1:nz),descp,info)
|
||||
res = info
|
||||
end if
|
||||
return
|
||||
end function psb_c_cdins
|
||||
|
||||
|
||||
|
||||
function psb_c_cd_get_local_rows(cdh) bind(c,name='psb_c_cd_get_local_rows') result(res)
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: res
|
||||
type(psb_c_object_type) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
res = descp%get_local_rows()
|
||||
|
||||
end if
|
||||
|
||||
end function psb_c_cd_get_local_rows
|
||||
|
||||
|
||||
|
||||
function psb_c_cd_get_local_cols(cdh) bind(c,name='psb_c_cd_get_local_cols') result(res)
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: res
|
||||
type(psb_c_object_type) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
res = descp%get_local_cols()
|
||||
|
||||
end if
|
||||
|
||||
end function psb_c_cd_get_local_cols
|
||||
|
||||
function psb_c_cd_get_global_rows(cdh) bind(c,name='psb_c_cd_get_global_rows') result(res)
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: res
|
||||
type(psb_c_object_type) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
res = descp%get_global_rows()
|
||||
|
||||
end if
|
||||
|
||||
end function psb_c_cd_get_global_rows
|
||||
|
||||
|
||||
|
||||
function psb_c_cd_get_global_cols(cdh) bind(c,name='psb_c_cd_get_global_cols') result(res)
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: res
|
||||
type(psb_c_object_type) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
res = descp%get_global_cols()
|
||||
|
||||
end if
|
||||
|
||||
end function psb_c_cd_get_global_cols
|
||||
|
||||
|
||||
end module psb_base_tools_cbind_mod
|
||||
|
||||
@ -0,0 +1,39 @@
|
||||
#include <stdlib.h>
|
||||
#include <stdio.h>
|
||||
#include "psb_c_base.h"
|
||||
|
||||
psb_c_descriptor* psb_c_new_descriptor()
|
||||
{
|
||||
psb_c_descriptor* temp;
|
||||
|
||||
temp=(psb_c_descriptor *) malloc(sizeof(psb_c_descriptor));
|
||||
temp->descriptor=NULL;
|
||||
return(temp);
|
||||
}
|
||||
|
||||
|
||||
void psb_c_print_errmsg()
|
||||
{
|
||||
char *mesg;
|
||||
|
||||
for (mesg = psb_c_pop_errmsg(); mesg != NULL; mesg = psb_c_pop_errmsg()) {
|
||||
fprintf(stderr,"%s\n",mesg);
|
||||
free(mesg);
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
|
||||
#define PSB_MAX_ERRLINE_LEN 132
|
||||
#define PSB_MAX_ERR_LINES 4
|
||||
static int maxlen=PSB_MAX_ERR_LINES*(PSB_MAX_ERRLINE_LEN+2);
|
||||
char *psb_c_pop_errmsg()
|
||||
{
|
||||
char *tmp;
|
||||
tmp = (char*) malloc(maxlen*sizeof(char));
|
||||
if (psb_c_f2c_errmsg(tmp,maxlen)<=0) {
|
||||
free(tmp); tmp = NULL;
|
||||
}
|
||||
return(tmp);
|
||||
}
|
||||
|
||||
@ -0,0 +1,80 @@
|
||||
#ifndef PSB_C_BASE__
|
||||
#define PSB_C_BASE__
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
typedef char _Bool;
|
||||
#endif
|
||||
|
||||
typedef int psb_err_t;
|
||||
typedef int psb_ctx_t;
|
||||
#define PSB_ERR_ERROR -1
|
||||
#define PSB_ERR_SUCCESS 0
|
||||
|
||||
|
||||
typedef struct PSB_C_DESCRIPTOR {
|
||||
void *descriptor;
|
||||
} psb_c_descriptor;
|
||||
|
||||
|
||||
|
||||
int psb_c_error();
|
||||
int psb_c_clean_errstack();
|
||||
void psb_c_print_errmsg();
|
||||
char *psb_c_pop_errmsg();
|
||||
int psb_c_f2c_errmsg(char *, int);
|
||||
void psb_c_seterraction_ret();
|
||||
void psb_c_seterraction_print();
|
||||
void psb_c_seterraction_abort();
|
||||
|
||||
/* Environment routines */
|
||||
int psb_c_init();
|
||||
void psb_c_exit_ctxt(int ictxt);
|
||||
void psb_c_exit(int ictxt);
|
||||
void psb_c_abort(int ictxt);
|
||||
void psb_c_barrier(int ictxt);
|
||||
void psb_c_info(int ictxt, int *iam, int *np);
|
||||
double psb_c_wtime();
|
||||
int psb_c_get_errstatus();
|
||||
|
||||
void psb_c_ibcast(int ictxt, int n, int *v, int root);
|
||||
void psb_c_dbcast(int ictxt, int n, double *v, int root);
|
||||
void psb_c_hbcast(int ictxt, const char *v, int root);
|
||||
|
||||
/* Descriptor/integer routines */
|
||||
psb_c_descriptor* psb_c_new_descriptor();
|
||||
int psb_c_cdall_vg(int ng, int *vg, int ictxt, psb_c_descriptor *cd);
|
||||
int psb_c_cdall_vl(int nl, int *vl, int ictxt, psb_c_descriptor *cd);
|
||||
int psb_c_cdall_nl(int nl, int ictxt, psb_c_descriptor *cd);
|
||||
int psb_c_cdall_repl(int n, int ictxt, psb_c_descriptor *cd);
|
||||
int psb_c_cdasb(psb_c_descriptor *cd);
|
||||
int psb_c_cdfree(psb_c_descriptor *cd);
|
||||
int psb_c_cdins(int nz, const int *ia, const int *ja, psb_c_descriptor *cd);
|
||||
|
||||
|
||||
int psb_c_cd_get_local_rows(psb_c_descriptor *cd);
|
||||
int psb_c_cd_get_local_cols(psb_c_descriptor *cd);
|
||||
int psb_c_cd_get_global_rows(psb_c_descriptor *cd);
|
||||
int psb_c_cd_get_global_rows(psb_c_descriptor *cd);
|
||||
|
||||
|
||||
/* legal values for upd argument */
|
||||
#define psb_upd_srch_ 98764
|
||||
#define psb_upd_perm_ 98765
|
||||
#define psb_upd_def_ psb_upd_srch_
|
||||
/* legal values for dupl argument */
|
||||
#define psb_dupl_ovwrt_ 0
|
||||
#define psb_dupl_add_ 1
|
||||
#define psb_dupl_err_ 2
|
||||
#define psb_dupl_def_ psb_dupl_ovwrt_
|
||||
|
||||
/* legal values for afmt */
|
||||
#define PSB_AFMT_CSR "CSR"
|
||||
#define PSB_AFMT_CSC "CSC"
|
||||
#define PSB_AFMT_COO "COO"
|
||||
#define PSB_AFMT_RSB "RSB"
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif /* __cplusplus */
|
||||
|
||||
#endif
|
||||
@ -0,0 +1,39 @@
|
||||
#include <stdlib.h>
|
||||
#include "psb_c_dbase.h"
|
||||
|
||||
psb_c_dvector* psb_c_new_dvector()
|
||||
{
|
||||
psb_c_dvector* temp;
|
||||
|
||||
temp=(psb_c_dvector *) malloc(sizeof(psb_c_dvector));
|
||||
temp->dvector=NULL;
|
||||
return(temp);
|
||||
}
|
||||
|
||||
double* psb_c_dvect_get_cpy(psb_c_dvector *xh)
|
||||
{
|
||||
double *temp=NULL;
|
||||
int vsize=0;
|
||||
|
||||
if ((vsize=psb_c_dvect_get_nrows(xh))<0)
|
||||
return(temp);
|
||||
|
||||
if (vsize==0)
|
||||
vsize=1;
|
||||
|
||||
if ((temp=(double *)malloc(vsize*sizeof(double)))!=NULL)
|
||||
psb_c_dvect_f_get_cpy(temp,xh);
|
||||
|
||||
return(temp);
|
||||
|
||||
}
|
||||
|
||||
|
||||
psb_c_dspmat* psb_c_new_dspmat()
|
||||
{
|
||||
psb_c_dspmat* temp;
|
||||
|
||||
temp=(psb_c_dspmat *) malloc(sizeof(psb_c_dspmat));
|
||||
temp->dspmat=NULL;
|
||||
return(temp);
|
||||
}
|
||||
@ -0,0 +1,64 @@
|
||||
#ifndef PSB_C_DBASE_
|
||||
#define PSB_C_DBASE_
|
||||
#include "psb_c_base.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
typedef struct PSB_C_DVECTOR {
|
||||
void *dvector;
|
||||
} psb_c_dvector;
|
||||
|
||||
typedef struct PSB_C_DSPMAT {
|
||||
void *dspmat;
|
||||
} psb_c_dspmat;
|
||||
|
||||
|
||||
/* dense vectors */
|
||||
psb_c_dvector* psb_c_new_dvector();
|
||||
int psb_c_dvect_get_nrows(psb_c_dvector *xh);
|
||||
double *psb_c_dvect_get_cpy( psb_c_dvector *xh);
|
||||
int psb_c_dvect_f_get_cpy(double *v, psb_c_dvector *xh);
|
||||
int psb_c_dvect_zero(psb_c_dvector *xh);
|
||||
|
||||
int psb_c_dgeall(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
int psb_c_dgeins(int nz, const int *irw, const double *val,
|
||||
psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
int psb_c_dgeins_add(int nz, const int *irw, const double *val,
|
||||
psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
int psb_c_dgeasb(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
int psb_c_dgefree(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
|
||||
/* sparse matrices*/
|
||||
psb_c_dspmat* psb_c_new_dspmat();
|
||||
int psb_c_dspall(psb_c_dspmat *mh, psb_c_descriptor *cdh);
|
||||
int psb_c_dspasb(psb_c_dspmat *mh, psb_c_descriptor *cdh);
|
||||
int psb_c_dspfree(psb_c_dspmat *mh, psb_c_descriptor *cdh);
|
||||
int psb_c_dspins(int nz, const int *irw, const int *icl, const double *val,
|
||||
psb_c_dspmat *mh, psb_c_descriptor *cdh);
|
||||
int psb_c_dmat_get_nrows(psb_c_dspmat *mh);
|
||||
int psb_c_dmat_get_ncols(psb_c_dspmat *mh);
|
||||
|
||||
/* int psb_c_dspasb_opt(psb_c_dspmat *mh, psb_c_descriptor *cdh, */
|
||||
/* const char *afmt, int upd, int dupl); */
|
||||
int psb_c_dsprn(psb_c_dspmat *mh, psb_c_descriptor *cdh, _Bool clear);
|
||||
/* int psb_c_dspprint(psb_c_dspmat *mh); */
|
||||
|
||||
/* psblas computational routines */
|
||||
double psb_c_dgedot(psb_c_dvector *xh, psb_c_dvector *yh, psb_c_descriptor *cdh);
|
||||
double psb_c_dgenrm2(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
double psb_c_dgeamax(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
double psb_c_dgeasum(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
double psb_c_dspnrmi(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
int psb_c_dgeaxpby(double alpha, psb_c_dvector *xh,
|
||||
double beta, psb_c_dvector *yh, psb_c_descriptor *cdh);
|
||||
int psb_c_dspmm(double alpha, psb_c_dspmat *ah, psb_c_dvector *xh,
|
||||
double beta, psb_c_dvector *yh, psb_c_descriptor *cdh);
|
||||
int psb_c_dspsm(double alpha, psb_c_dspmat *th, psb_c_dvector *xh,
|
||||
double beta, psb_c_dvector *yh, psb_c_descriptor *cdh);
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif /* __cplusplus */
|
||||
|
||||
#endif
|
||||
@ -0,0 +1,170 @@
|
||||
module psb_cpenv_mod
|
||||
use iso_c_binding
|
||||
|
||||
contains
|
||||
|
||||
function psb_c_get_errstatus() bind(c) result(res)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: res
|
||||
|
||||
res = psb_get_errstatus()
|
||||
end function psb_c_get_errstatus
|
||||
|
||||
function psb_c_init() bind(c)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: psb_c_init
|
||||
|
||||
integer :: ictxt
|
||||
|
||||
call psb_init(ictxt)
|
||||
psb_c_init = ictxt
|
||||
end function psb_c_init
|
||||
|
||||
subroutine psb_c_exit_ctxt(ictxt) bind(c)
|
||||
use psb_base_mod
|
||||
integer(c_int), value :: ictxt
|
||||
|
||||
call psb_exit(ictxt,close=.false.)
|
||||
return
|
||||
end subroutine psb_c_exit_ctxt
|
||||
|
||||
subroutine psb_c_exit(ictxt) bind(c)
|
||||
use psb_base_mod
|
||||
integer(c_int), value :: ictxt
|
||||
|
||||
call psb_exit(ictxt)
|
||||
return
|
||||
end subroutine psb_c_exit
|
||||
|
||||
subroutine psb_c_abort(ictxt) bind(c)
|
||||
use psb_base_mod
|
||||
integer(c_int), value :: ictxt
|
||||
|
||||
call psb_abort(ictxt)
|
||||
return
|
||||
end subroutine psb_c_abort
|
||||
|
||||
|
||||
subroutine psb_c_info(ictxt,iam,np) bind(c)
|
||||
use psb_base_mod
|
||||
integer(c_int), value :: ictxt
|
||||
integer(c_int) :: iam,np
|
||||
|
||||
call psb_info(ictxt,iam,np)
|
||||
return
|
||||
end subroutine psb_c_info
|
||||
|
||||
subroutine psb_c_barrier(ictxt) bind(c)
|
||||
use psb_base_mod
|
||||
integer(c_int), value :: ictxt
|
||||
|
||||
call psb_barrier(ictxt)
|
||||
end subroutine psb_c_barrier
|
||||
|
||||
real(c_double) function psb_c_wtime() bind(c)
|
||||
use psb_base_mod
|
||||
|
||||
psb_c_wtime = psb_wtime()
|
||||
end function psb_c_wtime
|
||||
|
||||
subroutine psb_c_ibcast(ictxt,n,v,root) bind(c)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
integer(c_int), value :: ictxt,n, root
|
||||
integer(c_int) :: v(*)
|
||||
|
||||
if (n < 0) then
|
||||
write(0,*) 'Wrong size in BCAST'
|
||||
return
|
||||
end if
|
||||
if (n==0) return
|
||||
|
||||
call psb_bcast(ictxt,v(1:n),root=root)
|
||||
end subroutine psb_c_ibcast
|
||||
|
||||
subroutine psb_c_dbcast(ictxt,n,v,root) bind(c)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
integer(c_int), value :: ictxt,n, root
|
||||
real(c_double) :: v(*)
|
||||
|
||||
if (n < 0) then
|
||||
write(0,*) 'Wrong size in BCAST'
|
||||
return
|
||||
end if
|
||||
if (n==0) return
|
||||
|
||||
call psb_bcast(ictxt,v(1:n),root=root)
|
||||
end subroutine psb_c_dbcast
|
||||
|
||||
subroutine psb_c_hbcast(ictxt,v,root) bind(c)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
integer(c_int), value :: ictxt, root
|
||||
character(c_char) :: v(*)
|
||||
integer :: n, iam, np
|
||||
|
||||
call psb_info(ictxt,iam,np)
|
||||
|
||||
if (iam==root) then
|
||||
n = 1
|
||||
do
|
||||
if (v(n) == c_null_char) exit
|
||||
n = n + 1
|
||||
end do
|
||||
end if
|
||||
call psb_bcast(ictxt,n,root=root)
|
||||
call psb_bcast(ictxt,v(1:n),root=root)
|
||||
end subroutine psb_c_hbcast
|
||||
|
||||
function psb_c_f2c_errmsg(cmesg,len) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
character(c_char), intent(inout) :: cmesg(*)
|
||||
integer(c_int), intent(in), value :: len
|
||||
integer(c_int) :: res
|
||||
character(len=psb_max_errmsg_len_), allocatable :: fmesg(:)
|
||||
character(len=psb_max_errmsg_len_) :: tmp
|
||||
integer :: i, j, ll, il
|
||||
|
||||
res = 0
|
||||
call psb_errpop(fmesg)
|
||||
ll = 1
|
||||
if (allocated(fmesg)) then
|
||||
res = size(fmesg)
|
||||
do i=1, size(fmesg)
|
||||
tmp = fmesg(i)
|
||||
il = len_trim(tmp)
|
||||
il = min(il,len-ll)
|
||||
!write(0,*) 'loop f2c_errmsg: ', ll,il
|
||||
call stringf2c(tmp(1:il),cmesg(ll:ll+il))
|
||||
cmesg(ll+il)=c_new_line
|
||||
ll = ll+il+1
|
||||
end do
|
||||
!write(0,*) 'From f2c_errmsg: ', ll,len
|
||||
end if
|
||||
cmesg(ll) = c_null_char
|
||||
end function psb_c_f2c_errmsg
|
||||
|
||||
subroutine psb_c_seterraction_ret() bind(c)
|
||||
use psb_base_mod
|
||||
call psb_set_erraction(psb_act_ret_)
|
||||
end subroutine psb_c_seterraction_ret
|
||||
|
||||
subroutine psb_c_seterraction_print() bind(c)
|
||||
use psb_base_mod
|
||||
call psb_set_erraction(psb_act_print_)
|
||||
end subroutine psb_c_seterraction_print
|
||||
|
||||
subroutine psb_c_seterraction_abort() bind(c)
|
||||
use psb_base_mod
|
||||
call psb_set_erraction(psb_act_abort_)
|
||||
end subroutine psb_c_seterraction_abort
|
||||
|
||||
|
||||
end module psb_cpenv_mod
|
||||
@ -0,0 +1,279 @@
|
||||
module psb_d_psblas_cbind_mod
|
||||
use iso_c_binding
|
||||
|
||||
contains
|
||||
|
||||
function psb_c_dgeaxpby(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(c_int) :: res
|
||||
|
||||
type(psb_c_object_type) :: xh,yh, cdh
|
||||
real(c_double), value :: alpha,beta
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_d_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_dgeaxpby
|
||||
|
||||
function psb_c_dgenrm2(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) :: res
|
||||
|
||||
type(psb_c_object_type) :: xh,cdh
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_d_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_dgenrm2
|
||||
|
||||
function psb_c_dgeamax(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) :: res
|
||||
|
||||
type(psb_c_object_type) :: xh,cdh
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_d_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_dgeamax
|
||||
|
||||
function psb_c_dgeasum(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) :: res
|
||||
|
||||
type(psb_c_object_type) :: xh,cdh
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_d_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_dgeasum
|
||||
|
||||
|
||||
function psb_c_dspnrmi(mh,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_desc_type), pointer :: descp
|
||||
type(psb_dspmat_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(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
res = psb_spnrmi(ap,descp,info)
|
||||
|
||||
end function psb_c_dspnrmi
|
||||
|
||||
function psb_c_dgedot(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_double) :: res
|
||||
|
||||
type(psb_c_object_type) :: xh,yh,cdh
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_d_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_dgedot
|
||||
|
||||
|
||||
function psb_c_dspmm(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(c_int) :: res
|
||||
|
||||
type(psb_c_object_type) :: ah,xh,yh, cdh
|
||||
real(c_double), value :: alpha, beta
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_d_vect_type), pointer :: xp,yp
|
||||
type(psb_dspmat_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_dspmm
|
||||
|
||||
|
||||
function psb_c_dspsm(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(c_int) :: res
|
||||
|
||||
type(psb_c_object_type) :: ah,xh,yh, cdh
|
||||
real(c_double), value :: alpha, beta
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_d_vect_type), pointer :: xp,yp
|
||||
type(psb_dspmat_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_dspsm
|
||||
|
||||
|
||||
end module psb_d_psblas_cbind_mod
|
||||
@ -0,0 +1,119 @@
|
||||
module psb_d_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_dvect_get_nrows(xh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: res
|
||||
type(psb_c_object_type) :: xh
|
||||
|
||||
type(psb_d_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_dvect_get_nrows
|
||||
|
||||
function psb_c_dvect_f_get_cpy(v,xh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: res
|
||||
real(c_double) :: v(*)
|
||||
type(psb_c_object_type) :: xh
|
||||
|
||||
type(psb_d_vect_type), pointer :: vp
|
||||
real(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_dvect_f_get_cpy
|
||||
|
||||
|
||||
function psb_c_dvect_zero(xh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: res
|
||||
type(psb_c_object_type) :: xh
|
||||
|
||||
type(psb_d_vect_type), pointer :: vp
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(xh%item)) then
|
||||
call c_f_pointer(xh%item,vp)
|
||||
call vp%set(dzero)
|
||||
end if
|
||||
|
||||
end function psb_c_dvect_zero
|
||||
|
||||
|
||||
function psb_c_dmat_get_nrows(mh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
|
||||
type(psb_c_object_type) :: mh
|
||||
type(psb_dspmat_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_dmat_get_nrows
|
||||
|
||||
|
||||
function psb_c_dmat_get_ncols(mh) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
|
||||
type(psb_c_object_type) :: mh
|
||||
type(psb_dspmat_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_dmat_get_ncols
|
||||
|
||||
|
||||
|
||||
end module psb_d_serial_cbind_mod
|
||||
|
||||
@ -0,0 +1,385 @@
|
||||
module psb_d_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_dgeall(xh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
type(psb_c_object_type) :: xh
|
||||
type(psb_c_object_type) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_d_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_dgeall
|
||||
|
||||
function psb_c_dgeasb(xh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
type(psb_c_object_type) :: xh
|
||||
type(psb_c_object_type) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_d_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_dgeasb
|
||||
|
||||
function psb_c_dgefree(xh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
type(psb_c_object_type) :: xh
|
||||
type(psb_c_object_type) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_d_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_dgefree
|
||||
|
||||
|
||||
function psb_c_dgeins(nz,irw,val,xh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
integer(c_int), value :: nz
|
||||
integer(c_int) :: irw(*)
|
||||
real(c_double) :: val(*)
|
||||
type(psb_c_object_type) :: xh
|
||||
type(psb_c_object_type) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_d_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_dgeins
|
||||
|
||||
|
||||
function psb_c_dgeins_add(nz,irw,val,xh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
integer(c_int), value :: nz
|
||||
integer(c_int) :: irw(*)
|
||||
real(c_double) :: val(*)
|
||||
type(psb_c_object_type) :: xh
|
||||
type(psb_c_object_type) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_d_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_dgeins_add
|
||||
|
||||
|
||||
function psb_c_dspall(mh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
type(psb_c_object_type) :: mh
|
||||
type(psb_c_object_type) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_dspmat_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_dspall
|
||||
|
||||
|
||||
|
||||
function psb_c_dspasb(mh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
type(psb_c_object_type) :: mh
|
||||
type(psb_c_object_type) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_dspmat_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_dspasb
|
||||
|
||||
|
||||
function psb_c_dspfree(mh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
type(psb_c_object_type) :: mh
|
||||
type(psb_c_object_type) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_dspmat_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_dspfree
|
||||
|
||||
|
||||
#if 0
|
||||
|
||||
function psb_c_dspasb_opt(mh,cdh,afmt,upd,dupl) bind(c) result(res)
|
||||
|
||||
#ifdef HAVE_LIBRSB
|
||||
use psb_d_rsb_mat_mod
|
||||
#endif
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
integer(c_int), value :: cdh, mh,upd,dupl
|
||||
character(c_char) :: afmt(*)
|
||||
integer :: info,n, fdupl
|
||||
character(len=5) :: fafmt
|
||||
#ifdef HAVE_LIBRSB
|
||||
type(psb_d_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_dspasb_opt
|
||||
#endif
|
||||
|
||||
function psb_c_dspins(nz,irw,icl,val,mh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
integer(c_int), value :: nz
|
||||
integer(c_int) :: irw(*), icl(*)
|
||||
real(c_double) :: val(*)
|
||||
type(psb_c_object_type) :: mh
|
||||
type(psb_c_object_type) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_dspmat_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_dspins
|
||||
|
||||
|
||||
function psb_c_dsprn(mh,cdh,clear) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
logical(c_bool), value :: clear
|
||||
type(psb_c_object_type) :: mh
|
||||
type(psb_c_object_type) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_dspmat_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_dsprn
|
||||
!!$
|
||||
!!$ function psb_c_dspprint(mh) bind(c) result(res)
|
||||
!!$
|
||||
!!$ implicit none
|
||||
!!$ integer(c_int) :: res
|
||||
!!$ integer(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_dspprint
|
||||
|
||||
|
||||
end module psb_d_tools_cbind_mod
|
||||
|
||||
@ -0,0 +1,20 @@
|
||||
module psb_objhandle_mod
|
||||
use iso_c_binding
|
||||
|
||||
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_dvector
|
||||
type(c_ptr) :: item = c_null_ptr
|
||||
end type psb_c_dvector
|
||||
|
||||
type, bind(c) :: psb_c_dspmat
|
||||
type(c_ptr) :: item = c_null_ptr
|
||||
end type psb_c_dspmat
|
||||
|
||||
end module psb_objhandle_mod
|
||||
Loading…
Reference in New Issue