Merge remote-tracking branch 'origin/psblas3-mcbind'
Salvatore Filippone
7 years ago
commit
0cad33cb68
@ -0,0 +1,32 @@
|
||||
include ../Make.inc
|
||||
|
||||
HERE=.
|
||||
LIBDIR=../lib
|
||||
INCDIR=../include
|
||||
MODDIR=../modules/
|
||||
LIBNAME=$(CBINDLIBNAME)
|
||||
|
||||
lib: based precd krylovd
|
||||
/bin/cp -p $(CPUPDFLAG) $(HERE)/$(LIBNAME) $(LIBDIR)
|
||||
/bin/cp -p $(CPUPDFLAG) *.h $(INCDIR)
|
||||
/bin/cp -p $(CPUPDFLAG) *$(.mod) $(MODDIR)
|
||||
|
||||
|
||||
|
||||
based:
|
||||
cd base && $(MAKE) lib LIBNAME=$(LIBNAME)
|
||||
precd: based
|
||||
cd prec && $(MAKE) lib LIBNAME=$(LIBNAME)
|
||||
krylovd: based precd
|
||||
cd krylov && $(MAKE) lib LIBNAME=$(LIBNAME)
|
||||
|
||||
|
||||
clean:
|
||||
cd base && $(MAKE) clean
|
||||
cd prec && $(MAKE) clean
|
||||
cd krylov && $(MAKE) clean
|
||||
|
||||
|
||||
veryclean: clean
|
||||
cd test/pargen && $(MAKE) clean
|
||||
/bin/rm -f $(HERE)/$(LIBNAME) $(LIBMOD) *$(.mod) *.h
|
||||
@ -0,0 +1,76 @@
|
||||
TOP=../..
|
||||
include $(TOP)/Make.inc
|
||||
LIBDIR=$(TOP)lib
|
||||
INCLUDEDIR=$(TOP)/include
|
||||
MODDIR=$(TOP)/modules
|
||||
HERE=..
|
||||
|
||||
FINCLUDES=$(FMFLAG). $(FMFLAG)$(HERE) $(FMFLAG)$(MODDIR)
|
||||
CINCLUDES=-I. -I$(HERE) -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_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 \
|
||||
psb_s_comm_cbind_mod.o psb_d_comm_cbind_mod.o \
|
||||
psb_c_comm_cbind_mod.o psb_z_comm_cbind_mod.o
|
||||
|
||||
COBJS= psb_c_base.o psb_c_sbase.o psb_c_dbase.o psb_c_cbase.o psb_c_zbase.o \
|
||||
psb_c_scomm.o psb_c_dcomm.o psb_c_ccomm.o psb_c_zcomm.o
|
||||
CMOD=psb_base_cbind.h psb_c_base.h psb_c_sbase.h psb_c_dbase.h psb_c_cbase.h psb_c_zbase.h \
|
||||
psb_c_scomm.h psb_c_dcomm.h psb_c_ccomm.h psb_c_zcomm.h
|
||||
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_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) \
|
||||
psb_s_comm_cbind_mod$(.mod) psb_d_comm_cbind_mod$(.mod) \
|
||||
psb_c_comm_cbind_mod$(.mod) psb_z_comm_cbind_mod$(.mod)
|
||||
|
||||
LOCAL_MODS=$(LIBMOD)
|
||||
LIBNAME=$(CBINDLIBNAME)
|
||||
|
||||
|
||||
lib: $(OBJS) $(CMOD)
|
||||
$(AR) $(HERE)/$(LIBNAME) $(OBJS)
|
||||
$(RANLIB) $(HERE)/$(LIBNAME)
|
||||
/bin/cp -p $(LIBMOD) $(CMOD) $(HERE)
|
||||
|
||||
$(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_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 \
|
||||
psb_s_comm_cbind_mod.o psb_d_comm_cbind_mod.o \
|
||||
psb_c_comm_cbind_mod.o psb_z_comm_cbind_mod.o
|
||||
|
||||
psb_base_tools_cbind_mod.o: psb_cpenv_mod.o psb_objhandle_mod.o psb_base_string_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_d_comm_cbind_mod.o : psb_base_tools_cbind_mod.o psb_objhandle_mod.o psb_base_string_cbind_mod.o
|
||||
|
||||
psb_base_psblas_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_cpenv_mod.o: psb_base_string_cbind_mod.o psb_objhandle_mod.o
|
||||
|
||||
veryclean: clean
|
||||
/bin/rm -f $(HERE)/$(LIBNAME)
|
||||
|
||||
clean:
|
||||
/bin/rm -f $(OBJS) $(LOCAL_MODS)
|
||||
|
||||
veryclean: clean
|
||||
@ -0,0 +1,11 @@
|
||||
#ifndef PSB_BASE_CBIND_
|
||||
#define PSB_BASE_CBIND_
|
||||
|
||||
#include "psb_c_base.h"
|
||||
#include "psb_c_sbase.h"
|
||||
#include "psb_c_dbase.h"
|
||||
#include "psb_c_cbase.h"
|
||||
#include "psb_c_zbase.h"
|
||||
|
||||
|
||||
#endif
|
||||
@ -0,0 +1,14 @@
|
||||
module psb_base_cbind_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_cpenv_mod
|
||||
use psb_base_tools_cbind_mod
|
||||
use psb_s_tools_cbind_mod
|
||||
use psb_d_tools_cbind_mod
|
||||
use psb_c_tools_cbind_mod
|
||||
use psb_z_tools_cbind_mod
|
||||
use psb_s_comm_cbind_mod
|
||||
use psb_d_comm_cbind_mod
|
||||
use psb_c_comm_cbind_mod
|
||||
use psb_z_comm_cbind_mod
|
||||
use psb_base_psblas_cbind_mod
|
||||
end module psb_base_cbind_mod
|
||||
@ -0,0 +1,9 @@
|
||||
module psb_base_psblas_cbind_mod
|
||||
|
||||
use iso_c_binding
|
||||
use psb_s_psblas_cbind_mod
|
||||
use psb_d_psblas_cbind_mod
|
||||
use psb_c_psblas_cbind_mod
|
||||
use psb_z_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(psb_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(psb_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(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: ng, ictxt
|
||||
integer(psb_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(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: nl, ictxt
|
||||
integer(psb_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(psb_c_int) :: res
|
||||
integer(psb_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(psb_c_int) :: res
|
||||
integer(psb_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(psb_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(psb_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(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: nz
|
||||
type(psb_c_object_type) :: cdh
|
||||
integer(psb_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(psb_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(psb_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(psb_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(psb_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,121 @@
|
||||
#ifndef PSB_C_BASE__
|
||||
#define PSB_C_BASE__
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
/*typedef char _Bool;*/
|
||||
#endif
|
||||
|
||||
#include <float.h>
|
||||
#include <complex.h>
|
||||
#include <stdint.h>
|
||||
#include <stddef.h>
|
||||
#include <stdlib.h>
|
||||
#include <stdio.h>
|
||||
#include <stdbool.h>
|
||||
|
||||
|
||||
#if defined(LONG_INTEGERS_)
|
||||
typedef int64_t psb_i_t;
|
||||
#else
|
||||
typedef int32_t psb_i_t;
|
||||
#endif
|
||||
typedef float psb_s_t;
|
||||
typedef double psb_d_t;
|
||||
typedef float complex psb_c_t;
|
||||
typedef double complex psb_z_t;
|
||||
#define PSB_ERR_ERROR -1
|
||||
#define PSB_ERR_SUCCESS 0
|
||||
|
||||
|
||||
typedef struct PSB_C_DESCRIPTOR {
|
||||
void *descriptor;
|
||||
} psb_c_descriptor;
|
||||
|
||||
|
||||
|
||||
psb_i_t psb_c_error();
|
||||
psb_i_t psb_c_clean_errstack();
|
||||
void psb_c_print_errmsg();
|
||||
char *psb_c_pop_errmsg();
|
||||
psb_i_t psb_c_f2c_errmsg(char *, psb_i_t);
|
||||
void psb_c_seterraction_ret();
|
||||
void psb_c_seterraction_print();
|
||||
void psb_c_seterraction_abort();
|
||||
|
||||
/* Environment routines */
|
||||
psb_i_t psb_c_init();
|
||||
void psb_c_exit_ctxt(psb_i_t ictxt);
|
||||
void psb_c_exit(psb_i_t ictxt);
|
||||
void psb_c_abort(psb_i_t ictxt);
|
||||
void psb_c_barrier(psb_i_t ictxt);
|
||||
void psb_c_info(psb_i_t ictxt, psb_i_t *iam, psb_i_t *np);
|
||||
psb_d_t psb_c_wtime();
|
||||
psb_i_t psb_c_get_errstatus();
|
||||
|
||||
psb_i_t psb_c_get_index_base();
|
||||
void psb_c_set_index_base(psb_i_t base);
|
||||
|
||||
void psb_c_ibcast(psb_i_t ictxt, psb_i_t n, psb_i_t *v, psb_i_t root);
|
||||
void psb_c_sbcast(psb_i_t ictxt, psb_i_t n, psb_s_t *v, psb_i_t root);
|
||||
void psb_c_dbcast(psb_i_t ictxt, psb_i_t n, psb_d_t *v, psb_i_t root);
|
||||
void psb_c_cbcast(psb_i_t ictxt, psb_i_t n, psb_c_t *v, psb_i_t root);
|
||||
void psb_c_zbcast(psb_i_t ictxt, psb_i_t n, psb_z_t *v, psb_i_t root);
|
||||
void psb_c_hbcast(psb_i_t ictxt, const char *v, psb_i_t root);
|
||||
|
||||
/* Descriptor/integer routines */
|
||||
psb_c_descriptor* psb_c_new_descriptor();
|
||||
psb_i_t psb_c_cdall_vg(psb_i_t ng, psb_i_t *vg, psb_i_t ictxt, psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_cdall_vl(psb_i_t nl, psb_i_t *vl, psb_i_t ictxt, psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_cdall_nl(psb_i_t nl, psb_i_t ictxt, psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_cdall_repl(psb_i_t n, psb_i_t ictxt, psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_cdasb(psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_cdfree(psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_cdins(psb_i_t nz, const psb_i_t *ia, const psb_i_t *ja, psb_c_descriptor *cd);
|
||||
|
||||
|
||||
psb_i_t psb_c_cd_get_local_rows(psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_cd_get_local_cols(psb_c_descriptor *cd);
|
||||
psb_i_t psb_c_cd_get_global_rows(psb_c_descriptor *cd);
|
||||
psb_i_t 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"
|
||||
|
||||
/* Transpose argument */
|
||||
#define psb_NoTrans_ "N"
|
||||
#define psb_Trans_ "T"
|
||||
#define psb_ConjTrans_ "C"
|
||||
|
||||
/* legal values for halo swap modes argument */
|
||||
#define psb_swap_send_ 1
|
||||
#define psb_swap_recv_ 2
|
||||
#define psb_swap_sync_ 4
|
||||
#define psb_swap_mpi_ 8
|
||||
|
||||
/* legal values for ovrl update argument */
|
||||
#define psb_none_ 0
|
||||
#define psb_sum_ 1
|
||||
#define psb_avg_ 2
|
||||
#define psb_square_root_ 3
|
||||
#define psb_setzero_ 4
|
||||
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif /* __cplusplus */
|
||||
|
||||
#endif
|
||||
@ -0,0 +1,39 @@
|
||||
#include <stdlib.h>
|
||||
#include "psb_c_cbase.h"
|
||||
|
||||
psb_c_cvector* psb_c_new_cvector()
|
||||
{
|
||||
psb_c_cvector* temp;
|
||||
|
||||
temp=(psb_c_cvector *) malloc(sizeof(psb_c_cvector));
|
||||
temp->cvector=NULL;
|
||||
return(temp);
|
||||
}
|
||||
|
||||
psb_c_t* psb_c_cvect_get_cpy(psb_c_cvector *xh)
|
||||
{
|
||||
psb_c_t *temp=NULL;
|
||||
psb_i_t vsize=0;
|
||||
|
||||
if ((vsize=psb_c_cvect_get_nrows(xh))<0)
|
||||
return(temp);
|
||||
|
||||
if (vsize==0)
|
||||
vsize=1;
|
||||
|
||||
if ((temp=(psb_c_t *)malloc(vsize*sizeof(psb_c_t)))!=NULL)
|
||||
psb_c_cvect_f_get_cpy(temp,xh);
|
||||
|
||||
return(temp);
|
||||
|
||||
}
|
||||
|
||||
|
||||
psb_c_cspmat* psb_c_new_cspmat()
|
||||
{
|
||||
psb_c_cspmat* temp;
|
||||
|
||||
temp=(psb_c_cspmat *) malloc(sizeof(psb_c_cspmat));
|
||||
temp->cspmat=NULL;
|
||||
return(temp);
|
||||
}
|
||||
@ -0,0 +1,67 @@
|
||||
#ifndef PSB_C_CBASE_
|
||||
#define PSB_C_CBASE_
|
||||
#include "psb_c_base.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
typedef struct PSB_C_CVECTOR {
|
||||
void *cvector;
|
||||
} psb_c_cvector;
|
||||
|
||||
typedef struct PSB_C_CSPMAT {
|
||||
void *cspmat;
|
||||
} psb_c_cspmat;
|
||||
|
||||
|
||||
/* dense vectors */
|
||||
psb_c_cvector* psb_c_new_cvector();
|
||||
psb_i_t psb_c_cvect_get_nrows(psb_c_cvector *xh);
|
||||
psb_c_t *psb_c_cvect_get_cpy( psb_c_cvector *xh);
|
||||
psb_i_t psb_c_cvect_f_get_cpy(psb_c_t *v, psb_c_cvector *xh);
|
||||
psb_i_t psb_c_cvect_zero(psb_c_cvector *xh);
|
||||
|
||||
psb_i_t psb_c_cgeall(psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgeins(psb_i_t nz, const psb_i_t *irw, const psb_c_t *val,
|
||||
psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgeins_add(psb_i_t nz, const psb_i_t *irw, const psb_c_t *val,
|
||||
psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgeasb(psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgefree(psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
|
||||
/* sparse matrices*/
|
||||
psb_c_cspmat* psb_c_new_cspmat();
|
||||
psb_i_t psb_c_cspall(psb_c_cspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cspasb(psb_c_cspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cspfree(psb_c_cspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cspins(psb_i_t nz, const psb_i_t *irw, const psb_i_t *icl, const psb_c_t *val,
|
||||
psb_c_cspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cmat_get_nrows(psb_c_cspmat *mh);
|
||||
psb_i_t psb_c_cmat_get_ncols(psb_c_cspmat *mh);
|
||||
|
||||
/* psb_i_t psb_c_cspasb_opt(psb_c_cspmat *mh, psb_c_descriptor *cdh, */
|
||||
/* const char *afmt, psb_i_t upd, psb_i_t dupl); */
|
||||
psb_i_t psb_c_csprn(psb_c_cspmat *mh, psb_c_descriptor *cdh, _Bool clear);
|
||||
psb_i_t psb_c_cmat_name_print(psb_c_cspmat *mh, char *name);
|
||||
|
||||
/* psblas computational routines */
|
||||
psb_c_t psb_c_cgedot(psb_c_cvector *xh, psb_c_cvector *yh, psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_cgenrm2(psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_cgeamax(psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_cgeasum(psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_cspnrmi(psb_c_cspmat *ah, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cgeaxpby(psb_c_t alpha, psb_c_cvector *xh,
|
||||
psb_c_t beta, psb_c_cvector *yh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cspmm(psb_c_t alpha, psb_c_cspmat *ah, psb_c_cvector *xh,
|
||||
psb_c_t beta, psb_c_cvector *yh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cspmm_opt(psb_c_t alpha, psb_c_cspmat *ah, psb_c_cvector *xh,
|
||||
psb_c_t beta, psb_c_cvector *yh, psb_c_descriptor *cdh,
|
||||
char *trans, bool doswap);
|
||||
psb_i_t psb_c_cspsm(psb_c_t alpha, psb_c_cspmat *th, psb_c_cvector *xh,
|
||||
psb_c_t beta, psb_c_cvector *yh, psb_c_descriptor *cdh);
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif /* __cplusplus */
|
||||
|
||||
#endif
|
||||
@ -0,0 +1,34 @@
|
||||
#include <stdlib.h>
|
||||
#include "psb_c_ccomm.h"
|
||||
#include "psb_c_cbase.h"
|
||||
|
||||
|
||||
psb_c_t* psb_c_cvgather(psb_c_cvector *xh, psb_c_descriptor *cdh)
|
||||
{
|
||||
psb_c_t *temp=NULL;
|
||||
psb_i_t vsize=0;
|
||||
|
||||
if ((vsize=psb_c_cd_get_global_rows(cdh))<0)
|
||||
return(temp);
|
||||
|
||||
if (vsize==0)
|
||||
vsize=1;
|
||||
|
||||
if ((temp=(psb_c_t *)malloc(vsize*sizeof(psb_c_t)))!=NULL)
|
||||
psb_c_cvgather_f(temp,xh,cdh);
|
||||
|
||||
return(temp);
|
||||
|
||||
}
|
||||
|
||||
|
||||
psb_c_cspmat* psb_c_cspgather(psb_c_cspmat *ah, psb_c_descriptor *cdh)
|
||||
{
|
||||
psb_c_cspmat* temp=psb_c_new_cspmat();
|
||||
|
||||
if (temp != NULL)
|
||||
psb_c_cspgather_f(temp, ah, cdh);
|
||||
return(temp);
|
||||
}
|
||||
|
||||
|
||||
@ -0,0 +1,28 @@
|
||||
#ifndef PSB_C_CCOMM_
|
||||
#define PSB_C_CCOMM_
|
||||
#include "psb_c_cbase.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
psb_i_t psb_c_chalo(psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_chalo_opt(psb_c_cvector *xh, psb_c_descriptor *cdh,
|
||||
char *trans, psb_i_t mode);
|
||||
psb_i_t psb_c_covrl(psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_covrl_opt(psb_c_cvector *xh, psb_c_descriptor *cdh,
|
||||
psb_i_t update, psb_i_t mode);
|
||||
psb_i_t psb_c_cvscatter(psb_i_t ng, psb_c_t *gx, psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
|
||||
psb_c_t* psb_c_cvgather(psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_c_cspmat* psb_c_cspgather(psb_c_cspmat *ah, psb_c_descriptor *cdh);
|
||||
|
||||
psb_i_t psb_c_cvgather_f(psb_c_t* gv, psb_c_cvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_cspgather_f(psb_c_cspmat* ga, psb_c_cspmat *ah, psb_c_descriptor *cdh);
|
||||
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif /* __cplusplus */
|
||||
|
||||
#endif
|
||||
@ -0,0 +1,239 @@
|
||||
module psb_c_comm_cbind_mod
|
||||
use iso_c_binding
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
|
||||
contains
|
||||
|
||||
function psb_c_c_ovrl(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_ovrl(xp,descp,info)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_c_ovrl
|
||||
|
||||
function psb_c_c_ovrl_opt(xh,cdh,update,mode) bind(c) result(res)
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: update, mode
|
||||
|
||||
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_ovrl(xp,descp,info,update=update,mode=mode)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_c_ovrl_opt
|
||||
|
||||
|
||||
function psb_c_c_halo(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_halo(xp,descp,info)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_c_halo
|
||||
|
||||
function psb_c_c_halo_opt(xh,cdh,tran,data,mode) bind(c) result(res)
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: data, mode
|
||||
character(c_char) :: tran
|
||||
|
||||
|
||||
type(psb_c_cvector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_c_vect_type), pointer :: xp
|
||||
character :: ftran
|
||||
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
|
||||
|
||||
ftran = tran
|
||||
call psb_halo(xp,descp,info,data=data,mode=mode,tran=ftran)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_c_halo_opt
|
||||
|
||||
|
||||
function psb_c_c_vscatter(ng,gx,xh,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: ng
|
||||
complex(c_float_complex), target :: gx(*)
|
||||
type(psb_c_cvector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_c_vect_type), pointer :: vp
|
||||
complex(psb_spk_), pointer :: pgx(:)
|
||||
integer :: info, sz
|
||||
|
||||
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,vp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
pgx => gx(1:ng)
|
||||
|
||||
call psb_scatter(pgx,vp,descp,info)
|
||||
res = info
|
||||
|
||||
end function psb_c_c_vscatter
|
||||
|
||||
function psb_c_cvgather(v,xh,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
complex(c_float_complex), target :: v(*)
|
||||
type(psb_c_cvector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_c_vect_type), pointer :: vp
|
||||
complex(psb_spk_), allocatable :: fv(:)
|
||||
integer :: info, sz
|
||||
|
||||
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,vp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_gather(fv,vp,descp,info)
|
||||
res = info
|
||||
if (res /=0) return
|
||||
sz = size(fv)
|
||||
v(1:sz) = fv(1:sz)
|
||||
end function psb_c_cvgather
|
||||
|
||||
function psb_c_cspgather(gah,ah,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
type(psb_c_cspmat) :: ah, gah
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_cspmat_type), pointer :: ap, gap
|
||||
integer :: info, sz
|
||||
|
||||
res = -1
|
||||
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
|
||||
if (c_associated(gah%item)) then
|
||||
call c_f_pointer(gah%item,gap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
call psb_gather(gap,ap,descp,info)
|
||||
res = info
|
||||
end function psb_c_cspgather
|
||||
|
||||
end module psb_c_comm_cbind_mod
|
||||
@ -0,0 +1,40 @@
|
||||
#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);
|
||||
}
|
||||
|
||||
psb_d_t* psb_c_dvect_get_cpy(psb_c_dvector *xh)
|
||||
{
|
||||
psb_d_t *temp=NULL;
|
||||
psb_i_t vsize=0;
|
||||
|
||||
if ((vsize=psb_c_dvect_get_nrows(xh))<0)
|
||||
return(temp);
|
||||
|
||||
if (vsize==0)
|
||||
vsize=1;
|
||||
|
||||
if ((temp=(psb_d_t *)malloc(vsize*sizeof(psb_d_t)))!=NULL)
|
||||
psb_c_dvect_f_get_cpy(temp,xh);
|
||||
|
||||
fprintf(stderr,"dvect_get_cpy: %lf\n",temp[0]);
|
||||
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,67 @@
|
||||
#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();
|
||||
psb_i_t psb_c_dvect_get_nrows(psb_c_dvector *xh);
|
||||
psb_d_t *psb_c_dvect_get_cpy( psb_c_dvector *xh);
|
||||
psb_i_t psb_c_dvect_f_get_cpy(psb_d_t *v, psb_c_dvector *xh);
|
||||
psb_i_t psb_c_dvect_zero(psb_c_dvector *xh);
|
||||
|
||||
psb_i_t psb_c_dgeall(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgeins(psb_i_t nz, const psb_i_t *irw, const psb_d_t *val,
|
||||
psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgeins_add(psb_i_t nz, const psb_i_t *irw, const psb_d_t *val,
|
||||
psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgeasb(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgefree(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
|
||||
/* sparse matrices*/
|
||||
psb_c_dspmat* psb_c_new_dspmat();
|
||||
psb_i_t psb_c_dspall(psb_c_dspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dspasb(psb_c_dspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dspfree(psb_c_dspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dspins(psb_i_t nz, const psb_i_t *irw, const psb_i_t *icl, const psb_d_t *val,
|
||||
psb_c_dspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dmat_get_nrows(psb_c_dspmat *mh);
|
||||
psb_i_t psb_c_dmat_get_ncols(psb_c_dspmat *mh);
|
||||
|
||||
/* psb_i_t psb_c_dspasb_opt(psb_c_dspmat *mh, psb_c_descriptor *cdh, */
|
||||
/* const char *afmt, psb_i_t upd, psb_i_t dupl); */
|
||||
psb_i_t psb_c_dsprn(psb_c_dspmat *mh, psb_c_descriptor *cdh, _Bool clear);
|
||||
psb_i_t psb_c_dmat_name_print(psb_c_dspmat *mh, char *name);
|
||||
|
||||
/* psblas computational routines */
|
||||
psb_d_t psb_c_dgedot(psb_c_dvector *xh, psb_c_dvector *yh, psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_dgenrm2(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_dgeamax(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_dgeasum(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_dspnrmi(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dgeaxpby(psb_d_t alpha, psb_c_dvector *xh,
|
||||
psb_d_t beta, psb_c_dvector *yh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dspmm(psb_d_t alpha, psb_c_dspmat *ah, psb_c_dvector *xh,
|
||||
psb_d_t beta, psb_c_dvector *yh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dspmm_opt(psb_d_t alpha, psb_c_dspmat *ah, psb_c_dvector *xh,
|
||||
psb_d_t beta, psb_c_dvector *yh, psb_c_descriptor *cdh,
|
||||
char *trans, bool doswap);
|
||||
psb_i_t psb_c_dspsm(psb_d_t alpha, psb_c_dspmat *th, psb_c_dvector *xh,
|
||||
psb_d_t beta, psb_c_dvector *yh, psb_c_descriptor *cdh);
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif /* __cplusplus */
|
||||
|
||||
#endif
|
||||
@ -0,0 +1,34 @@
|
||||
#include <stdlib.h>
|
||||
#include "psb_c_dcomm.h"
|
||||
#include "psb_c_dbase.h"
|
||||
|
||||
|
||||
psb_d_t* psb_c_dvgather(psb_c_dvector *xh, psb_c_descriptor *cdh)
|
||||
{
|
||||
psb_d_t *temp=NULL;
|
||||
psb_i_t vsize=0;
|
||||
|
||||
if ((vsize=psb_c_cd_get_global_rows(cdh))<0)
|
||||
return(temp);
|
||||
|
||||
if (vsize==0)
|
||||
vsize=1;
|
||||
|
||||
if ((temp=(psb_d_t *)malloc(vsize*sizeof(psb_d_t)))!=NULL)
|
||||
psb_c_dvgather_f(temp,xh,cdh);
|
||||
|
||||
return(temp);
|
||||
|
||||
}
|
||||
|
||||
|
||||
psb_c_dspmat* psb_c_dspgather(psb_c_dspmat *ah, psb_c_descriptor *cdh)
|
||||
{
|
||||
psb_c_dspmat* temp=psb_c_new_dspmat();
|
||||
|
||||
if (temp != NULL)
|
||||
psb_c_dspgather_f(temp, ah, cdh);
|
||||
return(temp);
|
||||
}
|
||||
|
||||
|
||||
@ -0,0 +1,28 @@
|
||||
#ifndef PSB_C_DCOMM_
|
||||
#define PSB_C_DCOMM_
|
||||
#include "psb_c_dbase.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
psb_i_t psb_c_dhalo(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dhalo_opt(psb_c_dvector *xh, psb_c_descriptor *cdh,
|
||||
char *trans, psb_i_t mode);
|
||||
psb_i_t psb_c_dovrl(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dovrl_opt(psb_c_dvector *xh, psb_c_descriptor *cdh,
|
||||
psb_i_t update, psb_i_t mode);
|
||||
psb_i_t psb_c_dvscatter(psb_i_t ng, psb_d_t *gx, psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
|
||||
psb_d_t* psb_c_dvgather(psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_c_dspmat* psb_c_dspgather(psb_c_dspmat *ah, psb_c_descriptor *cdh);
|
||||
|
||||
psb_i_t psb_c_dvgather_f(psb_d_t* gv, psb_c_dvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_dspgather_f(psb_c_dspmat* ga, psb_c_dspmat *ah, psb_c_descriptor *cdh);
|
||||
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif /* __cplusplus */
|
||||
|
||||
#endif
|
||||
@ -0,0 +1,341 @@
|
||||
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_cspmm_opt(alpha,ah,xh,beta,yh,cdh,trans,doswap) 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
|
||||
character(c_char) :: trans
|
||||
logical(c_bool), value :: doswap
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_c_vect_type), pointer :: xp,yp
|
||||
type(psb_cspmat_type), pointer :: ap
|
||||
character :: ftrans
|
||||
logical :: fdoswap
|
||||
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
|
||||
|
||||
fdoswap = doswap
|
||||
ftrans = trans
|
||||
call psb_spmm(alpha,ap,xp,beta,yp,descp,info,trans=ftrans,doswap=fdoswap)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_cspmm_opt
|
||||
|
||||
|
||||
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
|
||||
@ -0,0 +1,39 @@
|
||||
#include <stdlib.h>
|
||||
#include "psb_c_sbase.h"
|
||||
|
||||
psb_c_svector* psb_c_new_svector()
|
||||
{
|
||||
psb_c_svector* temp;
|
||||
|
||||
temp=(psb_c_svector *) malloc(sizeof(psb_c_svector));
|
||||
temp->svector=NULL;
|
||||
return(temp);
|
||||
}
|
||||
|
||||
psb_s_t* psb_c_svect_get_cpy(psb_c_svector *xh)
|
||||
{
|
||||
psb_s_t *temp=NULL;
|
||||
psb_i_t vsize=0;
|
||||
|
||||
if ((vsize=psb_c_svect_get_nrows(xh))<0)
|
||||
return(temp);
|
||||
|
||||
if (vsize==0)
|
||||
vsize=1;
|
||||
|
||||
if ((temp=(psb_s_t *)malloc(vsize*sizeof(psb_s_t)))!=NULL)
|
||||
psb_c_svect_f_get_cpy(temp,xh);
|
||||
|
||||
return(temp);
|
||||
|
||||
}
|
||||
|
||||
|
||||
psb_c_sspmat* psb_c_new_sspmat()
|
||||
{
|
||||
psb_c_sspmat* temp;
|
||||
|
||||
temp=(psb_c_sspmat *) malloc(sizeof(psb_c_sspmat));
|
||||
temp->sspmat=NULL;
|
||||
return(temp);
|
||||
}
|
||||
@ -0,0 +1,67 @@
|
||||
#ifndef PSB_C_SBASE_
|
||||
#define PSB_C_SBASE_
|
||||
#include "psb_c_base.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
typedef struct PSB_C_SVECTOR {
|
||||
void *svector;
|
||||
} psb_c_svector;
|
||||
|
||||
typedef struct PSB_C_SSPMAT {
|
||||
void *sspmat;
|
||||
} psb_c_sspmat;
|
||||
|
||||
|
||||
/* dense vectors */
|
||||
psb_c_svector* psb_c_new_svector();
|
||||
psb_i_t psb_c_svect_get_nrows(psb_c_svector *xh);
|
||||
psb_s_t *psb_c_svect_get_cpy( psb_c_svector *xh);
|
||||
psb_i_t psb_c_svect_f_get_cpy(psb_s_t *v, psb_c_svector *xh);
|
||||
psb_i_t psb_c_svect_zero(psb_c_svector *xh);
|
||||
|
||||
psb_i_t psb_c_sgeall(psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgeins(psb_i_t nz, const psb_i_t *irw, const psb_s_t *val,
|
||||
psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgeins_add(psb_i_t nz, const psb_i_t *irw, const psb_s_t *val,
|
||||
psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgeasb(psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgefree(psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
|
||||
/* sparse matrices*/
|
||||
psb_c_sspmat* psb_c_new_sspmat();
|
||||
psb_i_t psb_c_sspall(psb_c_sspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sspasb(psb_c_sspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sspfree(psb_c_sspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sspins(psb_i_t nz, const psb_i_t *irw, const psb_i_t *icl, const psb_s_t *val,
|
||||
psb_c_sspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_smat_get_nrows(psb_c_sspmat *mh);
|
||||
psb_i_t psb_c_smat_get_ncols(psb_c_sspmat *mh);
|
||||
|
||||
/* psb_i_t psb_c_sspasb_opt(psb_c_sspmat *mh, psb_c_descriptor *cdh, */
|
||||
/* const char *afmt, psb_i_t upd, psb_i_t dupl); */
|
||||
psb_i_t psb_c_ssprn(psb_c_sspmat *mh, psb_c_descriptor *cdh, _Bool clear);
|
||||
psb_i_t psb_c_smat_name_print(psb_c_sspmat *mh, char *name);
|
||||
|
||||
/* psblas computational routines */
|
||||
psb_s_t psb_c_sgedot(psb_c_svector *xh, psb_c_svector *yh, psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_sgenrm2(psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_sgeamax(psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_sgeasum(psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_s_t psb_c_sspnrmi(psb_c_sspmat *ah, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sgeaxpby(psb_s_t alpha, psb_c_svector *xh,
|
||||
psb_s_t beta, psb_c_svector *yh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sspmm(psb_s_t alpha, psb_c_sspmat *ah, psb_c_svector *xh,
|
||||
psb_s_t beta, psb_c_svector *yh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sspmm_opt(psb_s_t alpha, psb_c_sspmat *ah, psb_c_svector *xh,
|
||||
psb_s_t beta, psb_c_svector *yh, psb_c_descriptor *cdh,
|
||||
char *trans, bool doswap);
|
||||
psb_i_t psb_c_sspsm(psb_s_t alpha, psb_c_sspmat *th, psb_c_svector *xh,
|
||||
psb_s_t beta, psb_c_svector *yh, psb_c_descriptor *cdh);
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif /* __cplusplus */
|
||||
|
||||
#endif
|
||||
@ -0,0 +1,34 @@
|
||||
#include <stdlib.h>
|
||||
#include "psb_c_scomm.h"
|
||||
#include "psb_c_sbase.h"
|
||||
|
||||
|
||||
psb_s_t* psb_c_svgather(psb_c_svector *xh, psb_c_descriptor *cdh)
|
||||
{
|
||||
psb_s_t *temp=NULL;
|
||||
psb_i_t vsize=0;
|
||||
|
||||
if ((vsize=psb_c_cd_get_global_rows(cdh))<0)
|
||||
return(temp);
|
||||
|
||||
if (vsize==0)
|
||||
vsize=1;
|
||||
|
||||
if ((temp=(psb_s_t *)malloc(vsize*sizeof(psb_s_t)))!=NULL)
|
||||
psb_c_svgather_f(temp,xh,cdh);
|
||||
|
||||
return(temp);
|
||||
|
||||
}
|
||||
|
||||
|
||||
psb_c_sspmat* psb_c_sspgather(psb_c_sspmat *ah, psb_c_descriptor *cdh)
|
||||
{
|
||||
psb_c_sspmat* temp=psb_c_new_sspmat();
|
||||
|
||||
if (temp != NULL)
|
||||
psb_c_sspgather_f(temp, ah, cdh);
|
||||
return(temp);
|
||||
}
|
||||
|
||||
|
||||
@ -0,0 +1,28 @@
|
||||
#ifndef PSB_C_SCOMM_
|
||||
#define PSB_C_SCOMM_
|
||||
#include "psb_c_sbase.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
psb_i_t psb_c_shalo(psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_shalo_opt(psb_c_svector *xh, psb_c_descriptor *cdh,
|
||||
char *trans, psb_i_t mode);
|
||||
psb_i_t psb_c_sovrl(psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sovrl_opt(psb_c_svector *xh, psb_c_descriptor *cdh,
|
||||
psb_i_t update, psb_i_t mode);
|
||||
psb_i_t psb_c_svscatter(psb_i_t ng, psb_s_t *gx, psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
|
||||
psb_s_t* psb_c_svgather(psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_c_sspmat* psb_c_sspgather(psb_c_sspmat *ah, psb_c_descriptor *cdh);
|
||||
|
||||
psb_i_t psb_c_svgather_f(psb_s_t* gv, psb_c_svector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_sspgather_f(psb_c_sspmat* ga, psb_c_sspmat *ah, psb_c_descriptor *cdh);
|
||||
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif /* __cplusplus */
|
||||
|
||||
#endif
|
||||
@ -0,0 +1,144 @@
|
||||
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
|
||||
|
||||
|
||||
function psb_c_cmat_name_print(mh,name) 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
|
||||
|
||||
character(c_char) :: name(*)
|
||||
type(psb_c_cspmat) :: mh
|
||||
type(psb_cspmat_type), pointer :: ap
|
||||
integer :: info
|
||||
character(1024) :: fname
|
||||
|
||||
res = 0
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
call stringc2f(name,fname)
|
||||
|
||||
call ap%print(fname,head='PSBLAS Cbinding Interface')
|
||||
|
||||
end function psb_c_cmat_name_print
|
||||
|
||||
|
||||
end module psb_c_serial_cbind_mod
|
||||
|
||||
@ -0,0 +1,403 @@
|
||||
module psb_c_tools_cbind_mod
|
||||
use iso_c_binding
|
||||
use psb_base_mod
|
||||
use psb_cpenv_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
use psb_base_tools_cbind_mod
|
||||
|
||||
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 :: ixb, 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
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
if (ixb == 1) then
|
||||
call psb_geins(nz,irw(1:nz),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_ovwrt_)
|
||||
else
|
||||
call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_ovwrt_)
|
||||
end if
|
||||
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
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 :: ixb, 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
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
if (ixb == 1) then
|
||||
call psb_geins(nz,irw(1:nz),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_add_)
|
||||
else
|
||||
call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_add_)
|
||||
end if
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
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 :: ixb,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
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
if (ixb == 1) then
|
||||
call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info)
|
||||
else
|
||||
call psb_spins(nz,(irw(1:nz)+(1-ixb)),(icl(1:nz)+(1-ixb)),val(1:nz),ap,descp,info)
|
||||
end if
|
||||
res = min(0,info)
|
||||
return
|
||||
end function psb_c_cspins
|
||||
|
||||
|
||||
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
|
||||
|
||||
@ -0,0 +1,39 @@
|
||||
#include <stdlib.h>
|
||||
#include "psb_c_zbase.h"
|
||||
|
||||
psb_c_zvector* psb_c_new_zvector()
|
||||
{
|
||||
psb_c_zvector* temp;
|
||||
|
||||
temp=(psb_c_zvector *) malloc(sizeof(psb_c_zvector));
|
||||
temp->zvector=NULL;
|
||||
return(temp);
|
||||
}
|
||||
|
||||
psb_z_t* psb_c_zvect_get_cpy(psb_c_zvector *xh)
|
||||
{
|
||||
psb_z_t *temp=NULL;
|
||||
psb_i_t vsize=0;
|
||||
|
||||
if ((vsize=psb_c_zvect_get_nrows(xh))<0)
|
||||
return(temp);
|
||||
|
||||
if (vsize==0)
|
||||
vsize=1;
|
||||
|
||||
if ((temp=(psb_z_t *)malloc(vsize*sizeof(psb_z_t)))!=NULL)
|
||||
psb_c_zvect_f_get_cpy(temp,xh);
|
||||
|
||||
return(temp);
|
||||
|
||||
}
|
||||
|
||||
|
||||
psb_c_zspmat* psb_c_new_zspmat()
|
||||
{
|
||||
psb_c_zspmat* temp;
|
||||
|
||||
temp=(psb_c_zspmat *) malloc(sizeof(psb_c_zspmat));
|
||||
temp->zspmat=NULL;
|
||||
return(temp);
|
||||
}
|
||||
@ -0,0 +1,67 @@
|
||||
#ifndef PSB_C_ZBASE_
|
||||
#define PSB_C_ZBASE_
|
||||
#include "psb_c_base.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
typedef struct PSB_C_ZVECTOR {
|
||||
void *zvector;
|
||||
} psb_c_zvector;
|
||||
|
||||
typedef struct PSB_C_ZSPMAT {
|
||||
void *zspmat;
|
||||
} psb_c_zspmat;
|
||||
|
||||
|
||||
/* dense vectors */
|
||||
psb_c_zvector* psb_c_new_zvector();
|
||||
psb_i_t psb_c_zvect_get_nrows(psb_c_zvector *xh);
|
||||
psb_z_t *psb_c_zvect_get_cpy( psb_c_zvector *xh);
|
||||
psb_i_t psb_c_zvect_f_get_cpy(psb_z_t *v, psb_c_zvector *xh);
|
||||
psb_i_t psb_c_zvect_zero(psb_c_zvector *xh);
|
||||
|
||||
psb_i_t psb_c_zgeall(psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgeins(psb_i_t nz, const psb_i_t *irw, const psb_z_t *val,
|
||||
psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgeins_add(psb_i_t nz, const psb_i_t *irw, const psb_z_t *val,
|
||||
psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgeasb(psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgefree(psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
|
||||
/* sparse matrices*/
|
||||
psb_c_zspmat* psb_c_new_zspmat();
|
||||
psb_i_t psb_c_zspall(psb_c_zspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zspasb(psb_c_zspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zspfree(psb_c_zspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zspins(psb_i_t nz, const psb_i_t *irw, const psb_i_t *icl, const psb_z_t *val,
|
||||
psb_c_zspmat *mh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zmat_get_nrows(psb_c_zspmat *mh);
|
||||
psb_i_t psb_c_zmat_get_ncols(psb_c_zspmat *mh);
|
||||
|
||||
/* psb_i_t psb_c_zspasb_opt(psb_c_zspmat *mh, psb_c_descriptor *cdh, */
|
||||
/* const char *afmt, psb_i_t upd, psb_i_t dupl); */
|
||||
psb_i_t psb_c_zsprn(psb_c_zspmat *mh, psb_c_descriptor *cdh, _Bool clear);
|
||||
psb_i_t psb_c_zmat_name_print(psb_c_zspmat *mh, char *name);
|
||||
|
||||
/* psblas computational routines */
|
||||
psb_z_t psb_c_zgedot(psb_c_zvector *xh, psb_c_zvector *yh, psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_zgenrm2(psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_zgeamax(psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_zgeasum(psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_d_t psb_c_zspnrmi(psb_c_zspmat *ah, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zgeaxpby(psb_z_t alpha, psb_c_zvector *xh,
|
||||
psb_z_t beta, psb_c_zvector *yh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zspmm(psb_z_t alpha, psb_c_zspmat *ah, psb_c_zvector *xh,
|
||||
psb_z_t beta, psb_c_zvector *yh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zspmm_opt(psb_z_t alpha, psb_c_zspmat *ah, psb_c_zvector *xh,
|
||||
psb_z_t beta, psb_c_zvector *yh, psb_c_descriptor *cdh,
|
||||
char *trans, bool doswap);
|
||||
psb_i_t psb_c_zspsm(psb_z_t alpha, psb_c_zspmat *th, psb_c_zvector *xh,
|
||||
psb_z_t beta, psb_c_zvector *yh, psb_c_descriptor *cdh);
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif /* __cplusplus */
|
||||
|
||||
#endif
|
||||
@ -0,0 +1,34 @@
|
||||
#include <stdlib.h>
|
||||
#include "psb_c_zcomm.h"
|
||||
#include "psb_c_zbase.h"
|
||||
|
||||
|
||||
psb_z_t* psb_c_zvgather(psb_c_zvector *xh, psb_c_descriptor *cdh)
|
||||
{
|
||||
psb_z_t *temp=NULL;
|
||||
psb_i_t vsize=0;
|
||||
|
||||
if ((vsize=psb_c_cd_get_global_rows(cdh))<0)
|
||||
return(temp);
|
||||
|
||||
if (vsize==0)
|
||||
vsize=1;
|
||||
|
||||
if ((temp=(psb_z_t *)malloc(vsize*sizeof(psb_z_t)))!=NULL)
|
||||
psb_c_zvgather_f(temp,xh,cdh);
|
||||
|
||||
return(temp);
|
||||
|
||||
}
|
||||
|
||||
|
||||
psb_c_zspmat* psb_c_zspgather(psb_c_zspmat *ah, psb_c_descriptor *cdh)
|
||||
{
|
||||
psb_c_zspmat* temp=psb_c_new_zspmat();
|
||||
|
||||
if (temp != NULL)
|
||||
psb_c_zspgather_f(temp, ah, cdh);
|
||||
return(temp);
|
||||
}
|
||||
|
||||
|
||||
@ -0,0 +1,28 @@
|
||||
#ifndef PSB_C_ZCOMM_
|
||||
#define PSB_C_ZCOMM_
|
||||
#include "psb_c_zbase.h"
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
psb_i_t psb_c_zhalo(psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zhalo_opt(psb_c_zvector *xh, psb_c_descriptor *cdh,
|
||||
char *trans, psb_i_t mode);
|
||||
psb_i_t psb_c_zovrl(psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zovrl_opt(psb_c_zvector *xh, psb_c_descriptor *cdh,
|
||||
psb_i_t update, psb_i_t mode);
|
||||
psb_i_t psb_c_zvscatter(psb_i_t ng, psb_z_t *gx, psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
|
||||
psb_z_t* psb_c_zvgather(psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_c_zspmat* psb_c_zspgather(psb_c_zspmat *ah, psb_c_descriptor *cdh);
|
||||
|
||||
psb_i_t psb_c_zvgather_f(psb_z_t* gv, psb_c_zvector *xh, psb_c_descriptor *cdh);
|
||||
psb_i_t psb_c_zspgather_f(psb_c_zspmat* ga, psb_c_zspmat *ah, psb_c_descriptor *cdh);
|
||||
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif /* __cplusplus */
|
||||
|
||||
#endif
|
||||
@ -0,0 +1,234 @@
|
||||
module psb_cpenv_mod
|
||||
use iso_c_binding
|
||||
use psb_objhandle_mod
|
||||
|
||||
integer, private :: psb_c_index_base=0
|
||||
|
||||
contains
|
||||
|
||||
function psb_c_get_index_base() bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
|
||||
res = psb_c_index_base
|
||||
end function psb_c_get_index_base
|
||||
|
||||
subroutine psb_c_set_index_base(base) bind(c)
|
||||
implicit none
|
||||
integer(psb_c_int), value :: base
|
||||
|
||||
psb_c_index_base = base
|
||||
end subroutine psb_c_set_index_base
|
||||
|
||||
function psb_c_get_errstatus() bind(c) result(res)
|
||||
use psb_base_mod, only : psb_get_errstatus
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
|
||||
res = psb_get_errstatus()
|
||||
end function psb_c_get_errstatus
|
||||
|
||||
function psb_c_init() bind(c)
|
||||
use psb_base_mod, only : psb_init
|
||||
implicit none
|
||||
|
||||
integer(psb_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, only : psb_exit
|
||||
integer(psb_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, only : psb_exit
|
||||
integer(psb_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, only : psb_abort
|
||||
integer(psb_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, only : psb_info
|
||||
integer(psb_c_int), value :: ictxt
|
||||
integer(psb_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, only : psb_barrier
|
||||
integer(psb_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, only : psb_wtime
|
||||
|
||||
psb_c_wtime = psb_wtime()
|
||||
end function psb_c_wtime
|
||||
|
||||
subroutine psb_c_ibcast(ictxt,n,v,root) bind(c)
|
||||
use psb_base_mod, only : psb_bcast
|
||||
implicit none
|
||||
integer(psb_c_int), value :: ictxt,n, root
|
||||
integer(psb_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_sbcast(ictxt,n,v,root) bind(c)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
integer(psb_c_int), value :: ictxt,n, root
|
||||
real(c_float) :: 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_sbcast
|
||||
|
||||
subroutine psb_c_dbcast(ictxt,n,v,root) bind(c)
|
||||
use psb_base_mod, only : psb_bcast
|
||||
implicit none
|
||||
integer(psb_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_cbcast(ictxt,n,v,root) bind(c)
|
||||
use psb_base_mod, only : psb_bcast
|
||||
implicit none
|
||||
integer(psb_c_int), value :: ictxt,n, root
|
||||
complex(c_float_complex) :: 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_cbcast
|
||||
|
||||
subroutine psb_c_zbcast(ictxt,n,v,root) bind(c)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
integer(psb_c_int), value :: ictxt,n, root
|
||||
complex(c_double_complex) :: 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_zbcast
|
||||
|
||||
subroutine psb_c_hbcast(ictxt,v,root) bind(c)
|
||||
use psb_base_mod, only : psb_bcast, psb_info
|
||||
implicit none
|
||||
integer(psb_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, only : psb_errpop,psb_max_errmsg_len_
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
character(c_char), intent(inout) :: cmesg(*)
|
||||
integer(psb_c_int), intent(in), value :: len
|
||||
integer(psb_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, only : psb_set_erraction, psb_act_ret_
|
||||
call psb_set_erraction(psb_act_ret_)
|
||||
end subroutine psb_c_seterraction_ret
|
||||
|
||||
subroutine psb_c_seterraction_print() bind(c)
|
||||
use psb_base_mod, only : psb_set_erraction, psb_act_print_
|
||||
call psb_set_erraction(psb_act_print_)
|
||||
end subroutine psb_c_seterraction_print
|
||||
|
||||
subroutine psb_c_seterraction_abort() bind(c)
|
||||
use psb_base_mod, only : psb_set_erraction, psb_act_abort_
|
||||
call psb_set_erraction(psb_act_abort_)
|
||||
end subroutine psb_c_seterraction_abort
|
||||
|
||||
|
||||
end module psb_cpenv_mod
|
||||
@ -0,0 +1,239 @@
|
||||
module psb_d_comm_cbind_mod
|
||||
use iso_c_binding
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
|
||||
contains
|
||||
|
||||
function psb_c_d_ovrl(xh,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
|
||||
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
|
||||
|
||||
|
||||
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_ovrl(xp,descp,info)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_d_ovrl
|
||||
|
||||
function psb_c_d_ovrl_opt(xh,cdh,update,mode) bind(c) result(res)
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: update, mode
|
||||
|
||||
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
|
||||
|
||||
|
||||
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_ovrl(xp,descp,info,update=update,mode=mode)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_d_ovrl_opt
|
||||
|
||||
|
||||
function psb_c_d_halo(xh,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
|
||||
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
|
||||
|
||||
|
||||
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_halo(xp,descp,info)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_d_halo
|
||||
|
||||
function psb_c_d_halo_opt(xh,cdh,tran,data,mode) bind(c) result(res)
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: data, mode
|
||||
character(c_char) :: tran
|
||||
|
||||
|
||||
type(psb_c_dvector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_d_vect_type), pointer :: xp
|
||||
character :: ftran
|
||||
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
|
||||
|
||||
ftran = tran
|
||||
call psb_halo(xp,descp,info,data=data,mode=mode,tran=ftran)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_d_halo_opt
|
||||
|
||||
|
||||
function psb_c_d_vscatter(ng,gx,xh,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: ng
|
||||
real(c_double), target :: gx(*)
|
||||
type(psb_c_dvector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_d_vect_type), pointer :: vp
|
||||
real(psb_dpk_), pointer :: pgx(:)
|
||||
integer :: info, sz
|
||||
|
||||
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,vp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
pgx => gx(1:ng)
|
||||
|
||||
call psb_scatter(pgx,vp,descp,info)
|
||||
res = info
|
||||
|
||||
end function psb_c_d_vscatter
|
||||
|
||||
function psb_c_dvgather(v,xh,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
real(c_double), target :: v(*)
|
||||
type(psb_c_dvector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_d_vect_type), pointer :: vp
|
||||
real(psb_dpk_), allocatable :: fv(:)
|
||||
integer :: info, sz
|
||||
|
||||
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,vp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_gather(fv,vp,descp,info)
|
||||
res = info
|
||||
if (res /=0) return
|
||||
sz = size(fv)
|
||||
v(1:sz) = fv(1:sz)
|
||||
end function psb_c_dvgather
|
||||
|
||||
function psb_c_dspgather(gah,ah,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
type(psb_c_dspmat) :: ah, gah
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_dspmat_type), pointer :: ap, gap
|
||||
integer :: info, sz
|
||||
|
||||
res = -1
|
||||
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
|
||||
if (c_associated(gah%item)) then
|
||||
call c_f_pointer(gah%item,gap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
call psb_gather(gap,ap,descp,info)
|
||||
res = info
|
||||
end function psb_c_dspgather
|
||||
|
||||
end module psb_d_comm_cbind_mod
|
||||
@ -0,0 +1,341 @@
|
||||
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(psb_c_int) :: res
|
||||
|
||||
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
|
||||
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_dvector) :: xh
|
||||
type(psb_c_descriptor) :: 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_dvector) :: xh
|
||||
type(psb_c_descriptor) :: 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_dvector) :: xh
|
||||
type(psb_c_descriptor) :: 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(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_dspmat) :: ah
|
||||
type(psb_c_descriptor) :: 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(ah%item)) then
|
||||
call c_f_pointer(ah%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_dvector) :: xh,yh
|
||||
type(psb_c_descriptor) :: 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(psb_c_int) :: res
|
||||
|
||||
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
|
||||
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_dspmm_opt(alpha,ah,xh,beta,yh,cdh,trans,doswap) 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_dspmat) :: ah
|
||||
type(psb_c_dvector) :: xh,yh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
real(c_double), value :: alpha, beta
|
||||
character(c_char) :: trans
|
||||
logical(c_bool), value :: doswap
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_d_vect_type), pointer :: xp,yp
|
||||
type(psb_dspmat_type), pointer :: ap
|
||||
character :: ftrans
|
||||
logical :: fdoswap
|
||||
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
|
||||
|
||||
fdoswap = doswap
|
||||
ftrans = trans
|
||||
call psb_spmm(alpha,ap,xp,beta,yp,descp,info,trans=ftrans,doswap=fdoswap)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_dspmm_opt
|
||||
|
||||
|
||||
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(psb_c_int) :: res
|
||||
|
||||
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
|
||||
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,146 @@
|
||||
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(psb_c_int) :: res
|
||||
type(psb_c_dvector) :: 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(psb_c_int) :: res
|
||||
real(c_double) :: v(*)
|
||||
type(psb_c_dvector) :: xh
|
||||
|
||||
type(psb_d_vect_type), pointer :: vp
|
||||
real(psb_dpk_), allocatable :: fv(:)
|
||||
integer :: info, sz
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(xh%item)) then
|
||||
res = 0
|
||||
call c_f_pointer(xh%item,vp)
|
||||
fv = vp%get_vect()
|
||||
sz = size(fv)
|
||||
v(1:sz) = fv(1:sz)
|
||||
write(0,*) 'In dvect_f_get_cpy:',v(1),fv(1)
|
||||
end if
|
||||
|
||||
end function psb_c_dvect_f_get_cpy
|
||||
|
||||
|
||||
function psb_c_dvect_zero(xh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
type(psb_c_dvector) :: 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%zero()
|
||||
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(psb_c_int) :: res
|
||||
|
||||
type(psb_c_dspmat) :: 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(psb_c_int) :: res
|
||||
|
||||
type(psb_c_dspmat) :: 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
|
||||
|
||||
|
||||
function psb_c_dmat_name_print(mh,name) 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
|
||||
|
||||
character(c_char) :: name(*)
|
||||
type(psb_c_dspmat) :: mh
|
||||
type(psb_dspmat_type), pointer :: ap
|
||||
integer :: info
|
||||
character(1024) :: fname
|
||||
|
||||
res = 0
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
call stringc2f(name,fname)
|
||||
|
||||
call ap%print(fname,head='PSBLAS Cbinding Interface')
|
||||
|
||||
end function psb_c_dmat_name_print
|
||||
|
||||
|
||||
end module psb_d_serial_cbind_mod
|
||||
|
||||
@ -0,0 +1,403 @@
|
||||
module psb_d_tools_cbind_mod
|
||||
use iso_c_binding
|
||||
use psb_base_mod
|
||||
use psb_cpenv_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
use psb_base_tools_cbind_mod
|
||||
|
||||
contains
|
||||
|
||||
function psb_c_dgeall(xh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
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
|
||||
|
||||
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(psb_c_int) :: res
|
||||
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
|
||||
|
||||
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(psb_c_int) :: res
|
||||
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
|
||||
|
||||
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(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: nz
|
||||
integer(psb_c_int) :: irw(*)
|
||||
real(c_double) :: val(*)
|
||||
type(psb_c_dvector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_d_vect_type), pointer :: xp
|
||||
integer :: ixb, 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
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
if (ixb == 1) then
|
||||
call psb_geins(nz,irw(1:nz),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_ovwrt_)
|
||||
else
|
||||
call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_ovwrt_)
|
||||
end if
|
||||
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_dgeins
|
||||
|
||||
|
||||
function psb_c_dgeins_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_double) :: val(*)
|
||||
type(psb_c_dvector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_d_vect_type), pointer :: xp
|
||||
integer :: ixb, 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
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
if (ixb == 1) then
|
||||
call psb_geins(nz,irw(1:nz),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_add_)
|
||||
else
|
||||
call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_add_)
|
||||
end if
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_dgeins_add
|
||||
|
||||
|
||||
function psb_c_dspall(mh,cdh) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
type(psb_c_dspmat) :: mh
|
||||
type(psb_c_descriptor) :: 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(psb_c_int) :: res
|
||||
type(psb_c_dspmat) :: mh
|
||||
type(psb_c_descriptor) :: 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(psb_c_int) :: res
|
||||
type(psb_c_dspmat) :: mh
|
||||
type(psb_c_descriptor) :: 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(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_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(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: nz
|
||||
integer(psb_c_int) :: irw(*), icl(*)
|
||||
real(c_double) :: val(*)
|
||||
type(psb_c_dspmat) :: mh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_dspmat_type), pointer :: ap
|
||||
integer :: ixb,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
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
if (ixb == 1) then
|
||||
call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info)
|
||||
else
|
||||
call psb_spins(nz,(irw(1:nz)+(1-ixb)),(icl(1:nz)+(1-ixb)),val(1:nz),ap,descp,info)
|
||||
end if
|
||||
res = min(0,info)
|
||||
return
|
||||
end function psb_c_dspins
|
||||
|
||||
|
||||
function psb_c_dsprn(mh,cdh,clear) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
logical(c_bool), value :: clear
|
||||
type(psb_c_dspmat) :: mh
|
||||
type(psb_c_descriptor) :: 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(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_dspprint
|
||||
|
||||
|
||||
end module psb_d_tools_cbind_mod
|
||||
|
||||
@ -0,0 +1,50 @@
|
||||
module psb_objhandle_mod
|
||||
use iso_c_binding
|
||||
|
||||
#if defined(LONG_INTEGERS)
|
||||
integer, parameter :: psb_c_int = c_int64_t
|
||||
#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
|
||||
|
||||
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
|
||||
@ -0,0 +1,239 @@
|
||||
module psb_s_comm_cbind_mod
|
||||
use iso_c_binding
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
|
||||
contains
|
||||
|
||||
function psb_c_s_ovrl(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_ovrl(xp,descp,info)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_s_ovrl
|
||||
|
||||
function psb_c_s_ovrl_opt(xh,cdh,update,mode) bind(c) result(res)
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: update, mode
|
||||
|
||||
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_ovrl(xp,descp,info,update=update,mode=mode)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_s_ovrl_opt
|
||||
|
||||
|
||||
function psb_c_s_halo(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_halo(xp,descp,info)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_s_halo
|
||||
|
||||
function psb_c_s_halo_opt(xh,cdh,tran,data,mode) bind(c) result(res)
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: data, mode
|
||||
character(c_char) :: tran
|
||||
|
||||
|
||||
type(psb_c_svector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_s_vect_type), pointer :: xp
|
||||
character :: ftran
|
||||
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
|
||||
|
||||
ftran = tran
|
||||
call psb_halo(xp,descp,info,data=data,mode=mode,tran=ftran)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_s_halo_opt
|
||||
|
||||
|
||||
function psb_c_s_vscatter(ng,gx,xh,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: ng
|
||||
real(c_float), target :: gx(*)
|
||||
type(psb_c_svector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_s_vect_type), pointer :: vp
|
||||
real(psb_spk_), pointer :: pgx(:)
|
||||
integer :: info, sz
|
||||
|
||||
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,vp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
pgx => gx(1:ng)
|
||||
|
||||
call psb_scatter(pgx,vp,descp,info)
|
||||
res = info
|
||||
|
||||
end function psb_c_s_vscatter
|
||||
|
||||
function psb_c_svgather(v,xh,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
real(c_float), target :: v(*)
|
||||
type(psb_c_svector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_s_vect_type), pointer :: vp
|
||||
real(psb_spk_), allocatable :: fv(:)
|
||||
integer :: info, sz
|
||||
|
||||
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,vp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_gather(fv,vp,descp,info)
|
||||
res = info
|
||||
if (res /=0) return
|
||||
sz = size(fv)
|
||||
v(1:sz) = fv(1:sz)
|
||||
end function psb_c_svgather
|
||||
|
||||
function psb_c_sspgather(gah,ah,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
type(psb_c_sspmat) :: ah, gah
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_sspmat_type), pointer :: ap, gap
|
||||
integer :: info, sz
|
||||
|
||||
res = -1
|
||||
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
|
||||
if (c_associated(gah%item)) then
|
||||
call c_f_pointer(gah%item,gap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
call psb_gather(gap,ap,descp,info)
|
||||
res = info
|
||||
end function psb_c_sspgather
|
||||
|
||||
end module psb_s_comm_cbind_mod
|
||||
@ -0,0 +1,341 @@
|
||||
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_sspmm_opt(alpha,ah,xh,beta,yh,cdh,trans,doswap) 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
|
||||
character(c_char) :: trans
|
||||
logical(c_bool), value :: doswap
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_s_vect_type), pointer :: xp,yp
|
||||
type(psb_sspmat_type), pointer :: ap
|
||||
character :: ftrans
|
||||
logical :: fdoswap
|
||||
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
|
||||
|
||||
fdoswap = doswap
|
||||
ftrans = trans
|
||||
call psb_spmm(alpha,ap,xp,beta,yp,descp,info,trans=ftrans,doswap=fdoswap)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_sspmm_opt
|
||||
|
||||
|
||||
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
|
||||
@ -0,0 +1,144 @@
|
||||
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
|
||||
|
||||
|
||||
function psb_c_smat_name_print(mh,name) 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
|
||||
|
||||
character(c_char) :: name(*)
|
||||
type(psb_c_sspmat) :: mh
|
||||
type(psb_sspmat_type), pointer :: ap
|
||||
integer :: info
|
||||
character(1024) :: fname
|
||||
|
||||
res = 0
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
call stringc2f(name,fname)
|
||||
|
||||
call ap%print(fname,head='PSBLAS Cbinding Interface')
|
||||
|
||||
end function psb_c_smat_name_print
|
||||
|
||||
|
||||
end module psb_s_serial_cbind_mod
|
||||
|
||||
@ -0,0 +1,403 @@
|
||||
module psb_s_tools_cbind_mod
|
||||
use iso_c_binding
|
||||
use psb_base_mod
|
||||
use psb_cpenv_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
use psb_base_tools_cbind_mod
|
||||
|
||||
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 :: ixb, 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
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
if (ixb == 1) then
|
||||
call psb_geins(nz,irw(1:nz),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_ovwrt_)
|
||||
else
|
||||
call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_ovwrt_)
|
||||
end if
|
||||
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
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 :: ixb, 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
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
if (ixb == 1) then
|
||||
call psb_geins(nz,irw(1:nz),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_add_)
|
||||
else
|
||||
call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_add_)
|
||||
end if
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
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 :: ixb,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
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
if (ixb == 1) then
|
||||
call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info)
|
||||
else
|
||||
call psb_spins(nz,(irw(1:nz)+(1-ixb)),(icl(1:nz)+(1-ixb)),val(1:nz),ap,descp,info)
|
||||
end if
|
||||
res = min(0,info)
|
||||
return
|
||||
end function psb_c_sspins
|
||||
|
||||
|
||||
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
|
||||
|
||||
@ -0,0 +1,239 @@
|
||||
module psb_z_comm_cbind_mod
|
||||
use iso_c_binding
|
||||
use psb_base_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
|
||||
contains
|
||||
|
||||
function psb_c_z_ovrl(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_ovrl(xp,descp,info)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_z_ovrl
|
||||
|
||||
function psb_c_z_ovrl_opt(xh,cdh,update,mode) bind(c) result(res)
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: update, mode
|
||||
|
||||
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_ovrl(xp,descp,info,update=update,mode=mode)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_z_ovrl_opt
|
||||
|
||||
|
||||
function psb_c_z_halo(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_halo(xp,descp,info)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_z_halo
|
||||
|
||||
function psb_c_z_halo_opt(xh,cdh,tran,data,mode) bind(c) result(res)
|
||||
implicit none
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: data, mode
|
||||
character(c_char) :: tran
|
||||
|
||||
|
||||
type(psb_c_zvector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_z_vect_type), pointer :: xp
|
||||
character :: ftran
|
||||
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
|
||||
|
||||
ftran = tran
|
||||
call psb_halo(xp,descp,info,data=data,mode=mode,tran=ftran)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_z_halo_opt
|
||||
|
||||
|
||||
function psb_c_z_vscatter(ng,gx,xh,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
integer(psb_c_int), value :: ng
|
||||
complex(c_double_complex), target :: gx(*)
|
||||
type(psb_c_zvector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_z_vect_type), pointer :: vp
|
||||
complex(psb_dpk_), pointer :: pgx(:)
|
||||
integer :: info, sz
|
||||
|
||||
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,vp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
pgx => gx(1:ng)
|
||||
|
||||
call psb_scatter(pgx,vp,descp,info)
|
||||
res = info
|
||||
|
||||
end function psb_c_z_vscatter
|
||||
|
||||
function psb_c_zvgather(v,xh,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
complex(c_double_complex), target :: v(*)
|
||||
type(psb_c_zvector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_z_vect_type), pointer :: vp
|
||||
complex(psb_dpk_), allocatable :: fv(:)
|
||||
integer :: info, sz
|
||||
|
||||
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,vp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_gather(fv,vp,descp,info)
|
||||
res = info
|
||||
if (res /=0) return
|
||||
sz = size(fv)
|
||||
v(1:sz) = fv(1:sz)
|
||||
end function psb_c_zvgather
|
||||
|
||||
function psb_c_zspgather(gah,ah,cdh) bind(c) result(res)
|
||||
implicit none
|
||||
|
||||
integer(psb_c_int) :: res
|
||||
type(psb_c_zspmat) :: ah, gah
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_zspmat_type), pointer :: ap, gap
|
||||
integer :: info, sz
|
||||
|
||||
res = -1
|
||||
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
|
||||
if (c_associated(gah%item)) then
|
||||
call c_f_pointer(gah%item,gap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
call psb_gather(gap,ap,descp,info)
|
||||
res = info
|
||||
end function psb_c_zspgather
|
||||
|
||||
end module psb_z_comm_cbind_mod
|
||||
@ -0,0 +1,341 @@
|
||||
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_zspmm_opt(alpha,ah,xh,beta,yh,cdh,trans,doswap) 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
|
||||
character(c_char) :: trans
|
||||
logical(c_bool), value :: doswap
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_z_vect_type), pointer :: xp,yp
|
||||
type(psb_zspmat_type), pointer :: ap
|
||||
character :: ftrans
|
||||
logical :: fdoswap
|
||||
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
|
||||
|
||||
fdoswap = doswap
|
||||
ftrans = trans
|
||||
call psb_spmm(alpha,ap,xp,beta,yp,descp,info,trans=ftrans,doswap=fdoswap)
|
||||
|
||||
res = info
|
||||
|
||||
end function psb_c_zspmm_opt
|
||||
|
||||
|
||||
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
|
||||
@ -0,0 +1,144 @@
|
||||
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
|
||||
|
||||
|
||||
function psb_c_zmat_name_print(mh,name) 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
|
||||
|
||||
character(c_char) :: name(*)
|
||||
type(psb_c_zspmat) :: mh
|
||||
type(psb_zspmat_type), pointer :: ap
|
||||
integer :: info
|
||||
character(1024) :: fname
|
||||
|
||||
res = 0
|
||||
if (c_associated(mh%item)) then
|
||||
call c_f_pointer(mh%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
call stringc2f(name,fname)
|
||||
|
||||
call ap%print(fname,head='PSBLAS Cbinding Interface')
|
||||
|
||||
end function psb_c_zmat_name_print
|
||||
|
||||
|
||||
end module psb_z_serial_cbind_mod
|
||||
|
||||
@ -0,0 +1,403 @@
|
||||
module psb_z_tools_cbind_mod
|
||||
use iso_c_binding
|
||||
use psb_base_mod
|
||||
use psb_cpenv_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
use psb_base_tools_cbind_mod
|
||||
|
||||
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 :: ixb, 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
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
if (ixb == 1) then
|
||||
call psb_geins(nz,irw(1:nz),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_ovwrt_)
|
||||
else
|
||||
call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_ovwrt_)
|
||||
end if
|
||||
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
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 :: ixb, 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
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
if (ixb == 1) then
|
||||
call psb_geins(nz,irw(1:nz),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_add_)
|
||||
else
|
||||
call psb_geins(nz,(irw(1:nz)+(1-ixb)),val(1:nz),&
|
||||
& xp,descp,info, dupl=psb_dupl_add_)
|
||||
end if
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
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 :: ixb,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
|
||||
|
||||
ixb = psb_c_get_index_base()
|
||||
if (ixb == 1) then
|
||||
call psb_spins(nz,irw(1:nz),icl(1:nz),val(1:nz),ap,descp,info)
|
||||
else
|
||||
call psb_spins(nz,(irw(1:nz)+(1-ixb)),(icl(1:nz)+(1-ixb)),val(1:nz),ap,descp,info)
|
||||
end if
|
||||
res = min(0,info)
|
||||
return
|
||||
end function psb_c_zspins
|
||||
|
||||
|
||||
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
|
||||
|
||||
@ -0,0 +1,37 @@
|
||||
TOP=../..
|
||||
include $(TOP)/Make.inc
|
||||
LIBDIR=$(TOP)/lib
|
||||
INCLUDEDIR=$(TOP)/include
|
||||
MODDIR=$(TOP)/modules
|
||||
HERE=..
|
||||
|
||||
FINCLUDES=$(FMFLAG). $(FMFLAG)$(HERE) $(FMFLAG)$(MODDIR)
|
||||
CINCLUDES=-I. -I$(HERE) -I$(INCLUDEDIR)
|
||||
|
||||
OBJS=psb_base_krylov_cbind_mod.o \
|
||||
psb_skrylov_cbind_mod.o psb_dkrylov_cbind_mod.o psb_ckrylov_cbind_mod.o psb_zkrylov_cbind_mod.o
|
||||
CMOD=psb_krylov_cbind.h
|
||||
|
||||
|
||||
LIBMOD=psb_base_krylov_cbind_mod$(.mod) \
|
||||
psb_skrylov_cbind_mod$(.mod) psb_dkrylov_cbind_mod$(.mod) \
|
||||
psb_ckrylov_cbind_mod$(.mod) psb_zkrylov_cbind_mod$(.mod)
|
||||
|
||||
LOCAL_MODS=$(LIBMOD)
|
||||
LIBNAME=$(CKRYLOVLIBNAME)
|
||||
|
||||
|
||||
lib: $(OBJS) $(CMOD)
|
||||
$(AR) $(HERE)/$(LIBNAME) $(OBJS)
|
||||
$(RANLIB) $(HERE)/$(LIBNAME)
|
||||
/bin/cp -p $(HERE)/$(LIBNAME) $(LIBDIR)
|
||||
/bin/cp -p $(LIBMOD) $(CMOD) $(HERE)
|
||||
|
||||
psb_skrylov_cbind_mod.o psb_dkrylov_cbind_mod.o psb_ckrylov_cbind_mod.o psb_zkrylov_cbind_mod.o: psb_base_krylov_cbind_mod.o
|
||||
veryclean: clean
|
||||
/bin/rm -f $(HERE)/$(LIBNAME)
|
||||
|
||||
clean:
|
||||
/bin/rm -f $(OBJS) $(LOCAL_MODS)
|
||||
|
||||
veryclean: clean
|
||||
@ -0,0 +1,27 @@
|
||||
module psb_base_krylov_cbind_mod
|
||||
|
||||
use iso_c_binding
|
||||
type, bind(c) :: solveroptions
|
||||
integer(c_int) :: iter, itmax, itrace, irst, istop
|
||||
real(c_double) :: eps, err
|
||||
end type solveroptions
|
||||
|
||||
contains
|
||||
|
||||
function psb_c_DefaultSolverOptions(options)&
|
||||
& bind(c,name='psb_c_DefaultSolverOptions') result(res)
|
||||
implicit none
|
||||
type(solveroptions) :: options
|
||||
integer(c_int) :: res
|
||||
|
||||
options%itmax = 1000
|
||||
options%itrace = 0
|
||||
options%istop = 2
|
||||
options%irst = 10
|
||||
options%eps = 1.d-6
|
||||
|
||||
res = 0
|
||||
end function psb_c_DefaultSolverOptions
|
||||
|
||||
|
||||
end module psb_base_krylov_cbind_mod
|
||||
@ -0,0 +1,106 @@
|
||||
module psb_ckrylov_cbind_mod
|
||||
|
||||
use psb_base_krylov_cbind_mod
|
||||
|
||||
contains
|
||||
|
||||
function psb_c_ckrylov(methd,&
|
||||
& ah,ph,bh,xh,cdh,options) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_krylov_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_prec_cbind_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
type(psb_c_cspmat) :: ah
|
||||
type(psb_c_descriptor) :: cdh
|
||||
type(psb_c_cprec) :: ph
|
||||
type(psb_c_cvector) :: bh,xh
|
||||
character(c_char) :: methd(*)
|
||||
type(solveroptions) :: options
|
||||
|
||||
res= psb_c_ckrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh, &
|
||||
& itmax=options%itmax, iter=options%iter,&
|
||||
& itrace=options%itrace, istop=options%istop,&
|
||||
& irst=options%irst, err=options%err)
|
||||
|
||||
end function psb_c_ckrylov
|
||||
|
||||
|
||||
function psb_c_ckrylov_opt(methd,&
|
||||
& ah,ph,bh,xh,eps,cdh,itmax,iter,err,itrace,irst,istop) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_krylov_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_prec_cbind_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
type(psb_c_cspmat) :: ah
|
||||
type(psb_c_descriptor) :: cdh
|
||||
type(psb_c_cprec) :: ph
|
||||
type(psb_c_cvector) :: bh,xh
|
||||
integer(c_int), value :: itmax,itrace,irst,istop
|
||||
real(c_double), value :: eps
|
||||
integer(c_int) :: iter
|
||||
real(c_double) :: err
|
||||
character(c_char) :: methd(*)
|
||||
type(solveroptions) :: options
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_cspmat_type), pointer :: ap
|
||||
type(psb_cprec_type), pointer :: precp
|
||||
type(psb_c_vect_type), pointer :: xp, bp
|
||||
|
||||
integer :: info,fitmax,fitrace,first,fistop,fiter
|
||||
character(len=20) :: fmethd
|
||||
real(psb_spk_) :: feps,ferr
|
||||
|
||||
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(bh%item)) then
|
||||
call c_f_pointer(bh%item,bp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
|
||||
call stringc2f(methd,fmethd)
|
||||
feps = eps
|
||||
fitmax = itmax
|
||||
fitrace = itrace
|
||||
first = irst
|
||||
fistop = istop
|
||||
|
||||
call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
|
||||
& descp, info,&
|
||||
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
|
||||
& irst=first, err=ferr)
|
||||
iter = fiter
|
||||
err = ferr
|
||||
res = info
|
||||
|
||||
end function psb_c_ckrylov_opt
|
||||
|
||||
end module psb_ckrylov_cbind_mod
|
||||
@ -0,0 +1,108 @@
|
||||
module psb_dkrylov_cbind_mod
|
||||
|
||||
use psb_base_krylov_cbind_mod
|
||||
|
||||
contains
|
||||
|
||||
function psb_c_dkrylov(methd,&
|
||||
& ah,ph,bh,xh,cdh,options) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_krylov_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_prec_cbind_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
type(psb_c_dspmat) :: ah
|
||||
type(psb_c_descriptor) :: cdh
|
||||
type(psb_c_dprec) :: ph
|
||||
type(psb_c_dvector) :: bh,xh
|
||||
character(c_char) :: methd(*)
|
||||
type(solveroptions) :: options
|
||||
|
||||
write(0,*) 'psb_c_dkrylov options ', options%eps
|
||||
res= psb_c_dkrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh, &
|
||||
& itmax=options%itmax, iter=options%iter,&
|
||||
& itrace=options%itrace, istop=options%istop,&
|
||||
& irst=options%irst, err=options%err)
|
||||
|
||||
end function psb_c_dkrylov
|
||||
|
||||
|
||||
function psb_c_dkrylov_opt(methd,&
|
||||
& ah,ph,bh,xh,eps,cdh,itmax,iter,err,itrace,irst,istop) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_krylov_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_prec_cbind_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
type(psb_c_dspmat) :: ah
|
||||
type(psb_c_descriptor) :: cdh
|
||||
type(psb_c_dprec) :: ph
|
||||
type(psb_c_dvector) :: bh,xh
|
||||
integer(c_int), value :: itmax,itrace,irst,istop
|
||||
real(c_double), value :: eps
|
||||
integer(c_int) :: iter
|
||||
real(c_double) :: err
|
||||
character(c_char) :: methd(*)
|
||||
type(solveroptions) :: options
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_dspmat_type), pointer :: ap
|
||||
type(psb_dprec_type), pointer :: precp
|
||||
type(psb_d_vect_type), pointer :: xp, bp
|
||||
|
||||
integer :: info,fitmax,fitrace,first,fistop,fiter
|
||||
character(len=20) :: fmethd
|
||||
real(psb_dpk_) :: feps,ferr
|
||||
|
||||
write(0,*) 'psb_c_dkrylov_opt options ', eps
|
||||
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(bh%item)) then
|
||||
call c_f_pointer(bh%item,bp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
|
||||
call stringc2f(methd,fmethd)
|
||||
feps = eps
|
||||
fitmax = itmax
|
||||
fitrace = itrace
|
||||
first = irst
|
||||
fistop = istop
|
||||
|
||||
call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
|
||||
& descp, info,&
|
||||
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
|
||||
& irst=first, err=ferr)
|
||||
iter = fiter
|
||||
err = ferr
|
||||
res = info
|
||||
|
||||
end function psb_c_dkrylov_opt
|
||||
|
||||
end module psb_dkrylov_cbind_mod
|
||||
@ -0,0 +1,51 @@
|
||||
#ifndef PSB_KRYL_CBIND_
|
||||
#define PSB_KRYL_CBIND_
|
||||
|
||||
#include "psb_base_cbind.h"
|
||||
#include "psb_prec_cbind.h"
|
||||
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
/* Object handle related routines */
|
||||
/* No new handles for Krylov methods. */
|
||||
/* Here's a choice: define a struct to hold the options */
|
||||
/* Drawback: we end up defining defaults in two places */
|
||||
/* Note: must be interoperable */
|
||||
typedef struct psb_c_solveroptions {
|
||||
int iter; /* On exit how many iterations were performed */
|
||||
int itmax; /* On entry maximum number of iterations */
|
||||
int itrace; /* On entry print an info message every itrace iterations */
|
||||
int irst; /* Restart depth for RGMRES or BiCGSTAB(L) */
|
||||
int istop; /* Stopping criterion: 1:backward error 2: ||r||_2/||b||_2 */
|
||||
double eps; /* Stopping tolerance */
|
||||
double err; /* Convergence indicator on exit */
|
||||
} psb_c_SolverOptions;
|
||||
|
||||
int psb_c_DefaultSolverOptions(psb_c_SolverOptions *opt);
|
||||
|
||||
int psb_c_skrylov(const char *method, psb_c_sspmat *ah, psb_c_sprec *ph,
|
||||
psb_c_svector *bh, psb_c_svector *xh,
|
||||
psb_c_descriptor *cdh, psb_c_SolverOptions *opt);
|
||||
|
||||
int psb_c_dkrylov(const char *method, psb_c_dspmat *ah, psb_c_dprec *ph,
|
||||
psb_c_dvector *bh, psb_c_dvector *xh,
|
||||
psb_c_descriptor *cdh, psb_c_SolverOptions *opt);
|
||||
|
||||
int psb_c_ckrylov(const char *method, psb_c_cspmat *ah, psb_c_cprec *ph,
|
||||
psb_c_cvector *bh, psb_c_cvector *xh,
|
||||
psb_c_descriptor *cdh, psb_c_SolverOptions *opt);
|
||||
|
||||
int psb_c_zkrylov(const char *method, psb_c_zspmat *ah, psb_c_zprec *ph,
|
||||
psb_c_zvector *bh, psb_c_zvector *xh,
|
||||
psb_c_descriptor *cdh, psb_c_SolverOptions *opt);
|
||||
|
||||
#define PSB_VALID_KRYLOV_METHODS_STRINGS "CG","CGS","BICG","BICGSTAB","RGMRES","BICGSTABL","FCG","GCR"
|
||||
#define PSB_VALID_KRYLOV_METHODS_STRING "CG CGS BICG BICGSTAB RGMRES BICGSTABL FCG GCR"
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif /* __cplusplus */
|
||||
#endif
|
||||
@ -0,0 +1,106 @@
|
||||
module psb_skrylov_cbind_mod
|
||||
|
||||
use psb_base_krylov_cbind_mod
|
||||
|
||||
contains
|
||||
|
||||
function psb_c_skrylov(methd,&
|
||||
& ah,ph,bh,xh,cdh,options) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_krylov_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_prec_cbind_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
type(psb_c_sspmat) :: ah
|
||||
type(psb_c_descriptor) :: cdh
|
||||
type(psb_c_sprec) :: ph
|
||||
type(psb_c_svector) :: bh,xh
|
||||
character(c_char) :: methd(*)
|
||||
type(solveroptions) :: options
|
||||
|
||||
res= psb_c_skrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh, &
|
||||
& itmax=options%itmax, iter=options%iter,&
|
||||
& itrace=options%itrace, istop=options%istop,&
|
||||
& irst=options%irst, err=options%err)
|
||||
|
||||
end function psb_c_skrylov
|
||||
|
||||
|
||||
function psb_c_skrylov_opt(methd,&
|
||||
& ah,ph,bh,xh,eps,cdh,itmax,iter,err,itrace,irst,istop) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_krylov_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_prec_cbind_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
type(psb_c_sspmat) :: ah
|
||||
type(psb_c_descriptor) :: cdh
|
||||
type(psb_c_sprec) :: ph
|
||||
type(psb_c_svector) :: bh,xh
|
||||
integer(c_int), value :: itmax,itrace,irst,istop
|
||||
real(c_double), value :: eps
|
||||
integer(c_int) :: iter
|
||||
real(c_double) :: err
|
||||
character(c_char) :: methd(*)
|
||||
type(solveroptions) :: options
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_sspmat_type), pointer :: ap
|
||||
type(psb_sprec_type), pointer :: precp
|
||||
type(psb_s_vect_type), pointer :: xp, bp
|
||||
|
||||
integer :: info,fitmax,fitrace,first,fistop,fiter
|
||||
character(len=20) :: fmethd
|
||||
real(psb_spk_) :: feps,ferr
|
||||
|
||||
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(bh%item)) then
|
||||
call c_f_pointer(bh%item,bp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
|
||||
call stringc2f(methd,fmethd)
|
||||
feps = eps
|
||||
fitmax = itmax
|
||||
fitrace = itrace
|
||||
first = irst
|
||||
fistop = istop
|
||||
|
||||
call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
|
||||
& descp, info,&
|
||||
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
|
||||
& irst=first, err=ferr)
|
||||
iter = fiter
|
||||
err = ferr
|
||||
res = info
|
||||
|
||||
end function psb_c_skrylov_opt
|
||||
|
||||
end module psb_skrylov_cbind_mod
|
||||
@ -0,0 +1,106 @@
|
||||
module psb_zkrylov_cbind_mod
|
||||
|
||||
use psb_base_krylov_cbind_mod
|
||||
|
||||
contains
|
||||
|
||||
function psb_c_zkrylov(methd,&
|
||||
& ah,ph,bh,xh,cdh,options) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_krylov_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_prec_cbind_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
type(psb_c_zspmat) :: ah
|
||||
type(psb_c_descriptor) :: cdh
|
||||
type(psb_c_zprec) :: ph
|
||||
type(psb_c_zvector) :: bh,xh
|
||||
character(c_char) :: methd(*)
|
||||
type(solveroptions) :: options
|
||||
|
||||
res= psb_c_zkrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh, &
|
||||
& itmax=options%itmax, iter=options%iter,&
|
||||
& itrace=options%itrace, istop=options%istop,&
|
||||
& irst=options%irst, err=options%err)
|
||||
|
||||
end function psb_c_zkrylov
|
||||
|
||||
|
||||
function psb_c_zkrylov_opt(methd,&
|
||||
& ah,ph,bh,xh,eps,cdh,itmax,iter,err,itrace,irst,istop) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_krylov_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_prec_cbind_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
type(psb_c_zspmat) :: ah
|
||||
type(psb_c_descriptor) :: cdh
|
||||
type(psb_c_zprec) :: ph
|
||||
type(psb_c_zvector) :: bh,xh
|
||||
integer(c_int), value :: itmax,itrace,irst,istop
|
||||
real(c_double), value :: eps
|
||||
integer(c_int) :: iter
|
||||
real(c_double) :: err
|
||||
character(c_char) :: methd(*)
|
||||
type(solveroptions) :: options
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_zspmat_type), pointer :: ap
|
||||
type(psb_zprec_type), pointer :: precp
|
||||
type(psb_z_vect_type), pointer :: xp, bp
|
||||
|
||||
integer :: info,fitmax,fitrace,first,fistop,fiter
|
||||
character(len=20) :: fmethd
|
||||
real(psb_dpk_) :: feps,ferr
|
||||
|
||||
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(bh%item)) then
|
||||
call c_f_pointer(bh%item,bp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
end if
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
|
||||
call stringc2f(methd,fmethd)
|
||||
feps = eps
|
||||
fitmax = itmax
|
||||
fitrace = itrace
|
||||
first = irst
|
||||
fistop = istop
|
||||
|
||||
call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
|
||||
& descp, info,&
|
||||
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
|
||||
& irst=first, err=ferr)
|
||||
iter = fiter
|
||||
err = ferr
|
||||
res = info
|
||||
|
||||
end function psb_c_zkrylov_opt
|
||||
|
||||
end module psb_zkrylov_cbind_mod
|
||||
@ -0,0 +1,38 @@
|
||||
TOP=../..
|
||||
include $(TOP)/Make.inc
|
||||
LIBDIR=$(TOP)/lib
|
||||
INCLUDEDIR=$(TOP)/include
|
||||
MODDIR=$(TOP)/modules
|
||||
HERE=..
|
||||
|
||||
FINCLUDES=$(FMFLAG). $(FMFLAG)$(HERE) $(FMFLAG)$(MODDIR)
|
||||
CINCLUDES=-I. -I$(HERE) -I$(INCLUDEDIR)
|
||||
|
||||
OBJS=psb_prec_cbind_mod.o \
|
||||
psb_sprec_cbind_mod.o psb_dprec_cbind_mod.o psb_cprec_cbind_mod.o psb_zprec_cbind_mod.o \
|
||||
psb_c_sprec.o psb_c_dprec.o psb_c_cprec.o psb_c_zprec.o
|
||||
CMOD=psb_prec_cbind.h psb_c_sprec.h psb_c_dprec.h psb_c_cprec.h psb_c_zprec.h
|
||||
|
||||
|
||||
LIBMOD=psb_prec_cbind_mod$(.mod) \
|
||||
psb_sprec_cbind_mod$(.mod) psb_dprec_cbind_mod$(.mod) \
|
||||
psb_cprec_cbind_mod$(.mod) psb_zprec_cbind_mod$(.mod)
|
||||
|
||||
LOCAL_MODS=$(LIBMOD)
|
||||
LIBNAME=$(CPRECLIBNAME)
|
||||
|
||||
|
||||
lib: $(OBJS) $(CMOD)
|
||||
$(AR) $(HERE)/$(LIBNAME) $(OBJS)
|
||||
$(RANLIB) $(HERE)/$(LIBNAME)
|
||||
/bin/cp -p $(HERE)/$(LIBNAME) $(LIBDIR)
|
||||
/bin/cp -p $(LIBMOD) $(CMOD) $(HERE)
|
||||
|
||||
psb_prec_cbind_mod.o: psb_sprec_cbind_mod.o psb_dprec_cbind_mod.o psb_cprec_cbind_mod.o psb_zprec_cbind_mod.o
|
||||
veryclean: clean
|
||||
/bin/rm -f $(HERE)/$(LIBNAME)
|
||||
|
||||
clean:
|
||||
/bin/rm -f $(OBJS) $(LOCAL_MODS)
|
||||
|
||||
veryclean: clean
|
||||
@ -0,0 +1,12 @@
|
||||
#include <stdlib.h>
|
||||
#include "psb_c_cprec.h"
|
||||
|
||||
psb_c_cprec* psb_c_new_cprec()
|
||||
{
|
||||
psb_c_cprec* temp;
|
||||
|
||||
temp=(psb_c_cprec *) malloc(sizeof(psb_c_cprec));
|
||||
temp->cprec=NULL;
|
||||
return(temp);
|
||||
}
|
||||
|
||||
@ -0,0 +1,24 @@
|
||||
#ifndef PSB_C_CPREC_
|
||||
#define PSB_C_CPREC_
|
||||
#include "psb_base_cbind.h"
|
||||
/* Object handle related routines */
|
||||
/* Note: psb_get_XXX_handle returns: <= 0 unsuccessful */
|
||||
/* >0 valid handle */
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
typedef struct PSB_C_CPREC {
|
||||
void *cprec;
|
||||
} psb_c_cprec;
|
||||
|
||||
psb_c_cprec* psb_c_new_cprec();
|
||||
|
||||
psb_i_t psb_c_cprecinit(psb_c_cprec *ph, const char *ptype);
|
||||
psb_i_t psb_c_cprecbld(psb_c_cspmat *ah, psb_c_descriptor *cdh, psb_c_cprec *ph);
|
||||
psb_i_t psb_c_cprecfree(psb_c_cprec *ph);
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#endif
|
||||
@ -0,0 +1,12 @@
|
||||
#include <stdlib.h>
|
||||
#include "psb_c_dprec.h"
|
||||
|
||||
psb_c_dprec* psb_c_new_dprec()
|
||||
{
|
||||
psb_c_dprec* temp;
|
||||
|
||||
temp=(psb_c_dprec *) malloc(sizeof(psb_c_dprec));
|
||||
temp->dprec=NULL;
|
||||
return(temp);
|
||||
}
|
||||
|
||||
@ -0,0 +1,24 @@
|
||||
#ifndef PSB_C_DPREC_
|
||||
#define PSB_C_DPREC_
|
||||
#include "psb_base_cbind.h"
|
||||
/* Object handle related routines */
|
||||
/* Note: psb_get_XXX_handle returns: <= 0 unsuccessful */
|
||||
/* >0 valid handle */
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
typedef struct PSB_C_DPREC {
|
||||
void *dprec;
|
||||
} psb_c_dprec;
|
||||
|
||||
psb_c_dprec* psb_c_new_dprec();
|
||||
|
||||
psb_i_t psb_c_dprecinit(psb_c_dprec *ph, const char *ptype);
|
||||
psb_i_t psb_c_dprecbld(psb_c_dspmat *ah, psb_c_descriptor *cdh, psb_c_dprec *ph);
|
||||
psb_i_t psb_c_dprecfree(psb_c_dprec *ph);
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#endif
|
||||
@ -0,0 +1,12 @@
|
||||
#include <stdlib.h>
|
||||
#include "psb_c_sprec.h"
|
||||
|
||||
psb_c_sprec* psb_c_new_sprec()
|
||||
{
|
||||
psb_c_sprec* temp;
|
||||
|
||||
temp=(psb_c_sprec *) malloc(sizeof(psb_c_sprec));
|
||||
temp->sprec=NULL;
|
||||
return(temp);
|
||||
}
|
||||
|
||||
@ -0,0 +1,24 @@
|
||||
#ifndef PSB_C_SPREC_
|
||||
#define PSB_C_SPREC_
|
||||
#include "psb_base_cbind.h"
|
||||
/* Object handle related routines */
|
||||
/* Note: psb_get_XXX_handle returns: <= 0 unsuccessful */
|
||||
/* >0 valid handle */
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
typedef struct PSB_C_SPREC {
|
||||
void *sprec;
|
||||
} psb_c_sprec;
|
||||
|
||||
psb_c_sprec* psb_c_new_sprec();
|
||||
|
||||
psb_i_t psb_c_sprecinit(psb_c_sprec *ph, const char *ptype);
|
||||
psb_i_t psb_c_sprecbld(psb_c_sspmat *ah, psb_c_descriptor *cdh, psb_c_sprec *ph);
|
||||
psb_i_t psb_c_sprecfree(psb_c_sprec *ph);
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#endif
|
||||
@ -0,0 +1,12 @@
|
||||
#include <stdlib.h>
|
||||
#include "psb_c_zprec.h"
|
||||
|
||||
psb_c_zprec* psb_c_new_zprec()
|
||||
{
|
||||
psb_c_zprec* temp;
|
||||
|
||||
temp=(psb_c_zprec *) malloc(sizeof(psb_c_zprec));
|
||||
temp->zprec=NULL;
|
||||
return(temp);
|
||||
}
|
||||
|
||||
@ -0,0 +1,24 @@
|
||||
#ifndef PSB_C_ZPREC_
|
||||
#define PSB_C_ZPREC_
|
||||
#include "psb_base_cbind.h"
|
||||
/* Object handle related routines */
|
||||
/* Note: psb_get_XXX_handle returns: <= 0 unsuccessful */
|
||||
/* >0 valid handle */
|
||||
#ifdef __cplusplus
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
typedef struct PSB_C_ZPREC {
|
||||
void *zprec;
|
||||
} psb_c_zprec;
|
||||
|
||||
psb_c_zprec* psb_c_new_zprec();
|
||||
|
||||
psb_i_t psb_c_zprecinit(psb_c_zprec *ph, const char *ptype);
|
||||
psb_i_t psb_c_zprecbld(psb_c_zspmat *ah, psb_c_descriptor *cdh, psb_c_zprec *ph);
|
||||
psb_i_t psb_c_zprecfree(psb_c_zprec *ph);
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
#endif
|
||||
@ -0,0 +1,118 @@
|
||||
module psb_cprec_cbind_mod
|
||||
|
||||
use iso_c_binding
|
||||
use psb_prec_mod, only : psb_cprec_type
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
|
||||
type, bind(c) :: psb_c_cprec
|
||||
type(c_ptr) :: item = c_null_ptr
|
||||
end type psb_c_cprec
|
||||
|
||||
|
||||
contains
|
||||
|
||||
|
||||
function psb_c_cprecinit(ph,ptype) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
type(psb_c_cprec) :: ph
|
||||
character(c_char) :: ptype(*)
|
||||
type(psb_cprec_type), pointer :: precp
|
||||
integer :: info
|
||||
character(len=80) :: fptype
|
||||
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
return
|
||||
end if
|
||||
|
||||
allocate(precp,stat=info)
|
||||
if (info /= 0) return
|
||||
ph%item = c_loc(precp)
|
||||
|
||||
call stringc2f(ptype,fptype)
|
||||
|
||||
call psb_precinit(precp,fptype,info)
|
||||
|
||||
res = min(0,info)
|
||||
return
|
||||
end function psb_c_cprecinit
|
||||
|
||||
|
||||
|
||||
function psb_c_cprecbld(ah,cdh,ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: res
|
||||
type(psb_c_cspmat) :: ah
|
||||
type(psb_c_cprec) :: ph
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_cspmat_type), pointer :: ap
|
||||
type(psb_cprec_type), pointer :: precp
|
||||
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
!!$ write(*,*) 'Entry: ', psb_c_cd_get_local_rows(cdh)
|
||||
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
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_precbld(ap,descp, precp, info)
|
||||
|
||||
res = min(info,0)
|
||||
|
||||
end function psb_c_cprecbld
|
||||
|
||||
|
||||
function psb_c_cprecfree(ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: res
|
||||
type(psb_c_cprec) :: ph
|
||||
|
||||
type(psb_cprec_type), pointer :: precp
|
||||
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_precfree(precp, info)
|
||||
|
||||
res = min(info,0)
|
||||
|
||||
end function psb_c_cprecfree
|
||||
|
||||
|
||||
end module psb_cprec_cbind_mod
|
||||
@ -0,0 +1,118 @@
|
||||
module psb_dprec_cbind_mod
|
||||
|
||||
use iso_c_binding
|
||||
use psb_prec_mod, only : psb_dprec_type
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
|
||||
type, bind(c) :: psb_c_dprec
|
||||
type(c_ptr) :: item = c_null_ptr
|
||||
end type psb_c_dprec
|
||||
|
||||
|
||||
contains
|
||||
|
||||
|
||||
function psb_c_dprecinit(ph,ptype) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
type(psb_c_dprec) :: ph
|
||||
character(c_char) :: ptype(*)
|
||||
type(psb_dprec_type), pointer :: precp
|
||||
integer :: info
|
||||
character(len=80) :: fptype
|
||||
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
return
|
||||
end if
|
||||
|
||||
allocate(precp,stat=info)
|
||||
if (info /= 0) return
|
||||
ph%item = c_loc(precp)
|
||||
|
||||
call stringc2f(ptype,fptype)
|
||||
|
||||
call psb_precinit(precp,fptype,info)
|
||||
|
||||
res = min(0,info)
|
||||
return
|
||||
end function psb_c_dprecinit
|
||||
|
||||
|
||||
|
||||
function psb_c_dprecbld(ah,cdh,ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: res
|
||||
type(psb_c_dspmat) :: ah
|
||||
type(psb_c_dprec) :: ph
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_dspmat_type), pointer :: ap
|
||||
type(psb_dprec_type), pointer :: precp
|
||||
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
!!$ write(*,*) 'Entry: ', psb_c_cd_get_local_rows(cdh)
|
||||
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
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_precbld(ap,descp, precp, info)
|
||||
|
||||
res = min(info,0)
|
||||
|
||||
end function psb_c_dprecbld
|
||||
|
||||
|
||||
function psb_c_dprecfree(ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: res
|
||||
type(psb_c_dprec) :: ph
|
||||
|
||||
type(psb_dprec_type), pointer :: precp
|
||||
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_precfree(precp, info)
|
||||
|
||||
res = min(info,0)
|
||||
|
||||
end function psb_c_dprecfree
|
||||
|
||||
|
||||
end module psb_dprec_cbind_mod
|
||||
@ -0,0 +1,9 @@
|
||||
#ifndef PSB_PREC_CBIND_
|
||||
#define PSB_PREC_CBIND_
|
||||
|
||||
#include "psb_c_sprec.h"
|
||||
#include "psb_c_dprec.h"
|
||||
#include "psb_c_cprec.h"
|
||||
#include "psb_c_zprec.h"
|
||||
|
||||
#endif
|
||||
@ -0,0 +1,6 @@
|
||||
module psb_prec_cbind_mod
|
||||
use psb_sprec_cbind_mod
|
||||
use psb_dprec_cbind_mod
|
||||
use psb_cprec_cbind_mod
|
||||
use psb_zprec_cbind_mod
|
||||
end module psb_prec_cbind_mod
|
||||
@ -0,0 +1,118 @@
|
||||
module psb_sprec_cbind_mod
|
||||
|
||||
use iso_c_binding
|
||||
use psb_prec_mod, only : psb_sprec_type
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
|
||||
type, bind(c) :: psb_c_sprec
|
||||
type(c_ptr) :: item = c_null_ptr
|
||||
end type psb_c_sprec
|
||||
|
||||
|
||||
contains
|
||||
|
||||
|
||||
function psb_c_sprecinit(ph,ptype) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
type(psb_c_sprec) :: ph
|
||||
character(c_char) :: ptype(*)
|
||||
type(psb_sprec_type), pointer :: precp
|
||||
integer :: info
|
||||
character(len=80) :: fptype
|
||||
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
return
|
||||
end if
|
||||
|
||||
allocate(precp,stat=info)
|
||||
if (info /= 0) return
|
||||
ph%item = c_loc(precp)
|
||||
|
||||
call stringc2f(ptype,fptype)
|
||||
|
||||
call psb_precinit(precp,fptype,info)
|
||||
|
||||
res = min(0,info)
|
||||
return
|
||||
end function psb_c_sprecinit
|
||||
|
||||
|
||||
|
||||
function psb_c_sprecbld(ah,cdh,ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: res
|
||||
type(psb_c_sspmat) :: ah
|
||||
type(psb_c_sprec) :: ph
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_sspmat_type), pointer :: ap
|
||||
type(psb_sprec_type), pointer :: precp
|
||||
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
!!$ write(*,*) 'Entry: ', psb_c_cd_get_local_rows(cdh)
|
||||
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
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_precbld(ap,descp, precp, info)
|
||||
|
||||
res = min(info,0)
|
||||
|
||||
end function psb_c_sprecbld
|
||||
|
||||
|
||||
function psb_c_sprecfree(ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: res
|
||||
type(psb_c_sprec) :: ph
|
||||
|
||||
type(psb_sprec_type), pointer :: precp
|
||||
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_precfree(precp, info)
|
||||
|
||||
res = min(info,0)
|
||||
|
||||
end function psb_c_sprecfree
|
||||
|
||||
|
||||
end module psb_sprec_cbind_mod
|
||||
@ -0,0 +1,118 @@
|
||||
module psb_zprec_cbind_mod
|
||||
|
||||
use iso_c_binding
|
||||
use psb_prec_mod, only : psb_zprec_type
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
|
||||
type, bind(c) :: psb_c_zprec
|
||||
type(c_ptr) :: item = c_null_ptr
|
||||
end type psb_c_zprec
|
||||
|
||||
|
||||
contains
|
||||
|
||||
|
||||
function psb_c_zprecinit(ph,ptype) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
integer(c_int) :: res
|
||||
type(psb_c_zprec) :: ph
|
||||
character(c_char) :: ptype(*)
|
||||
type(psb_zprec_type), pointer :: precp
|
||||
integer :: info
|
||||
character(len=80) :: fptype
|
||||
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
return
|
||||
end if
|
||||
|
||||
allocate(precp,stat=info)
|
||||
if (info /= 0) return
|
||||
ph%item = c_loc(precp)
|
||||
|
||||
call stringc2f(ptype,fptype)
|
||||
|
||||
call psb_precinit(precp,fptype,info)
|
||||
|
||||
res = min(0,info)
|
||||
return
|
||||
end function psb_c_zprecinit
|
||||
|
||||
|
||||
|
||||
function psb_c_zprecbld(ah,cdh,ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: res
|
||||
type(psb_c_zspmat) :: ah
|
||||
type(psb_c_zprec) :: ph
|
||||
type(psb_c_descriptor) :: cdh
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_zspmat_type), pointer :: ap
|
||||
type(psb_zprec_type), pointer :: precp
|
||||
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
!!$ write(*,*) 'Entry: ', psb_c_cd_get_local_rows(cdh)
|
||||
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
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_precbld(ap,descp, precp, info)
|
||||
|
||||
res = min(info,0)
|
||||
|
||||
end function psb_c_zprecbld
|
||||
|
||||
|
||||
function psb_c_zprecfree(ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_objhandle_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
|
||||
integer(c_int) :: res
|
||||
type(psb_c_zprec) :: ph
|
||||
|
||||
type(psb_zprec_type), pointer :: precp
|
||||
|
||||
integer :: info
|
||||
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
end if
|
||||
|
||||
call psb_precfree(precp, info)
|
||||
|
||||
res = min(info,0)
|
||||
|
||||
end function psb_c_zprecfree
|
||||
|
||||
|
||||
end module psb_zprec_cbind_mod
|
||||
@ -0,0 +1,48 @@
|
||||
TOP=../../..
|
||||
include $(TOP)/Make.inc
|
||||
LIBDIR=$(TOP)/lib
|
||||
INCLUDEDIR=$(TOP)/include
|
||||
MODDIR=$(TOP)/modules/
|
||||
HERE=../..
|
||||
|
||||
FINCLUDES=$(FMFLAG). $(FMFLAG)$(HERE) $(FMFLAG)$(MODDIR)
|
||||
CINCLUDES=-I. -I$(HERE) -I$(INCLUDEDIR)
|
||||
|
||||
PSBC_LIBS= -L$(LIBDIR) -lpsb_cbind
|
||||
PSB_LIBS=-lpsb_krylov -lpsb_prec -lpsb_base -L$(LIBDIR)
|
||||
# -lpsb_krylov_cbind
|
||||
|
||||
#
|
||||
# Compilers and such
|
||||
#
|
||||
#CCOPT= -g
|
||||
#FINCLUDES=$(FMFLAG)$(LIBDIR) $(FMFLAG).
|
||||
CINCLUDES=-I$(LIBDIR) $(FIFLAG)$(INCLUDEDIR) $(FIFLAG)$(PSBLAS_INCDIR)
|
||||
|
||||
EXEDIR=./runs
|
||||
|
||||
all: ppdec
|
||||
|
||||
ppdec: ppdec.o
|
||||
$(MPFC) ppdec.o -o ppdec $(PSBC_LIBS) $(PSB_LIBS) $(PSBLDLIBS) -lm -lgfortran
|
||||
# \
|
||||
# -lifcore -lifcoremt -lguide -limf -lirc -lintlc -lcxaguard -L/opt/intel/fc/10.0.023/lib/ -lm
|
||||
/bin/mv ppdec $(EXEDIR)
|
||||
|
||||
.f90.o:
|
||||
$(MPFC) $(FCOPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
.c.o:
|
||||
$(MPCC) $(CCOPT) $(CINCLUDES) $(CDEFINES) -c $<
|
||||
|
||||
|
||||
clean:
|
||||
/bin/rm -f ppdec.o $(EXEDIR)/ppdec
|
||||
verycleanlib:
|
||||
(cd ../..; make veryclean)
|
||||
lib:
|
||||
(cd ../../; make library)
|
||||
|
||||
tests: all
|
||||
cd runs ; ./ppdec < ppde.inp
|
||||
|
||||
|
||||
@ -0,0 +1,413 @@
|
||||
/*----------------------------------------------------------------------------------*/
|
||||
/* Parallel Sparse BLAS v 3.5.0 */
|
||||
/* (C) Copyright 2017 Salvatore Filippone Cranfield University */
|
||||
/* */
|
||||
/* Redistribution and use in source and binary forms, with or without */
|
||||
/* modification, are permitted provided that the following conditions */
|
||||
/* are met: */
|
||||
/* 1. Redistributions of source code must retain the above copyright */
|
||||
/* notice, this list of conditions and the following disclaimer. */
|
||||
/* 2. Redistributions in binary form must reproduce the above copyright */
|
||||
/* notice, this list of conditions, and the following disclaimer in the */
|
||||
/* documentation and/or other materials provided with the distribution. */
|
||||
/* 3. The name of the PSBLAS group or the names of its contributors may */
|
||||
/* not be used to endorse or promote products derived from this */
|
||||
/* software without specific written permission. */
|
||||
/* */
|
||||
/* THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS */
|
||||
/* ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED */
|
||||
/* TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR */
|
||||
/* PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS */
|
||||
/* BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR */
|
||||
/* CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF */
|
||||
/* SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS */
|
||||
/* INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN */
|
||||
/* CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) */
|
||||
/* ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE */
|
||||
/* POSSIBILITY OF SUCH DAMAGE. */
|
||||
/* */
|
||||
/* */
|
||||
/* File: ppdec.c */
|
||||
/* */
|
||||
/* Program: ppdec */
|
||||
/* This sample program shows how to build and solve a sparse linear */
|
||||
/* */
|
||||
/* The program solves a linear system based on the partial differential */
|
||||
/* equation */
|
||||
/* */
|
||||
/* */
|
||||
/* */
|
||||
/* The equation generated is */
|
||||
/* */
|
||||
/* b1 d d (u) b2 d d (u) a1 d (u)) a2 d (u))) */
|
||||
/* - ------ - ------ + ----- + ------ + a3 u = 0 */
|
||||
/* dx dx dy dy dx dy */
|
||||
/* */
|
||||
/* */
|
||||
/* with Dirichlet boundary conditions on the unit cube */
|
||||
/* */
|
||||
/* 0<=x,y,z<=1 */
|
||||
/* */
|
||||
/* The equation is discretized with finite differences and uniform stepsize; */
|
||||
/* the resulting discrete equation is */
|
||||
/* */
|
||||
/* ( u(x,y,z)(2b1+2b2+a1+a2)+u(x-1,y)(-b1-a1)+u(x,y-1)(-b2-a2)+ */
|
||||
/* -u(x+1,y)b1-u(x,y+1)b2)*(1/h**2) */
|
||||
/* */
|
||||
/* Example adapted from: C.T.Kelley */
|
||||
/* Iterative Methods for Linear and Nonlinear Equations */
|
||||
/* SIAM 1995 */
|
||||
/* */
|
||||
/* */
|
||||
/* In this sample program the index space of the discretized */
|
||||
/* computational domain is first numbered sequentially in a standard way, */
|
||||
/* then the corresponding vector is distributed according to an HPF BLOCK */
|
||||
/* distribution directive. The discretization ensures there are IDIM */
|
||||
/* *internal* points in each direction. */
|
||||
/* */
|
||||
/*----------------------------------------------------------------------------------*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <math.h>
|
||||
|
||||
#include "psb_base_cbind.h"
|
||||
#include "psb_prec_cbind.h"
|
||||
#include "psb_krylov_cbind.h"
|
||||
|
||||
#define LINEBUFSIZE 1024
|
||||
#define NBMAX 20
|
||||
#define DUMPMATRIX 0
|
||||
|
||||
double a1(double x, double y, double z)
|
||||
{
|
||||
return(1.0/80.0);
|
||||
}
|
||||
double a2(double x, double y, double z)
|
||||
{
|
||||
return(1.0/80.0);
|
||||
}
|
||||
double a3(double x, double y, double z)
|
||||
{
|
||||
return(1.0/80.0);
|
||||
}
|
||||
double c(double x, double y, double z)
|
||||
{
|
||||
return(0.0);
|
||||
}
|
||||
double b1(double x, double y, double z)
|
||||
{
|
||||
return(1.0/sqrt(3.0));
|
||||
}
|
||||
double b2(double x, double y, double z)
|
||||
{
|
||||
return(1.0/sqrt(3.0));
|
||||
}
|
||||
double b3(double x, double y, double z)
|
||||
{
|
||||
return(1.0/sqrt(3.0));
|
||||
}
|
||||
|
||||
double g(double x, double y, double z)
|
||||
{
|
||||
if (x == 1.0) {
|
||||
return(1.0);
|
||||
} else if (x == 0.0) {
|
||||
return( exp(-y*y-z*z));
|
||||
} else {
|
||||
return(0.0);
|
||||
}
|
||||
}
|
||||
|
||||
int matgen(int ictxt, int ng,int idim,int vg[],psb_c_dspmat *ah,psb_c_descriptor *cdh,
|
||||
psb_c_dvector *xh, psb_c_dvector *bh, psb_c_dvector *rh)
|
||||
{
|
||||
int iam, np;
|
||||
int ix, iy, iz, el,glob_row,i,info,ret;
|
||||
double x, y, z, deltah, sqdeltah, deltah2;
|
||||
double val[10*NBMAX], zt[NBMAX];
|
||||
int irow[10*NBMAX], icol[10*NBMAX];
|
||||
|
||||
info = 0;
|
||||
psb_c_info(ictxt,&iam,&np);
|
||||
deltah = (double) 1.0/(idim+2);
|
||||
sqdeltah = deltah*deltah;
|
||||
deltah2 = 2.0* deltah;
|
||||
psb_c_set_index_base(0);
|
||||
for (glob_row=0; glob_row < ng; glob_row++) {
|
||||
|
||||
/* Check if I have to do something about this entry */
|
||||
if (vg[glob_row] == iam) {
|
||||
el=0;
|
||||
ix = glob_row/(idim*idim);
|
||||
iy = (glob_row-ix*idim*idim)/idim;
|
||||
iz = glob_row-ix*idim*idim-iy*idim;
|
||||
x=(ix+1)*deltah;
|
||||
y=(iy+1)*deltah;
|
||||
z=(iz+1)*deltah;
|
||||
zt[0] = 0.0;
|
||||
/* internal point: build discretization */
|
||||
/* term depending on (x-1,y,z) */
|
||||
val[el] = -a1(x,y,z)/sqdeltah-b1(x,y,z)/deltah2;
|
||||
if (ix==0) {
|
||||
zt[0] += g(0.0,y,z)*(-val[el]);
|
||||
} else {
|
||||
icol[el]=(ix-1)*idim*idim+(iy)*idim+(iz);
|
||||
el=el+1;
|
||||
}
|
||||
/* term depending on (x,y-1,z) */
|
||||
val[el] = -a2(x,y,z)/sqdeltah-b2(x,y,z)/deltah2;
|
||||
if (iy==0) {
|
||||
zt[0] += g(x,0.0,z)*(-val[el]);
|
||||
} else {
|
||||
icol[el]=(ix)*idim*idim+(iy-1)*idim+(iz);
|
||||
el=el+1;
|
||||
}
|
||||
/* term depending on (x,y,z-1)*/
|
||||
val[el]=-a3(x,y,z)/sqdeltah-b3(x,y,z)/deltah2;
|
||||
if (iz==0) {
|
||||
zt[0] += g(x,y,0.0)*(-val[el]);
|
||||
} else {
|
||||
icol[el]=(ix)*idim*idim+(iy)*idim+(iz-1);
|
||||
el=el+1;
|
||||
}
|
||||
/* term depending on (x,y,z)*/
|
||||
val[el]=2.0*(a1(x,y,z)+a2(x,y,z)+a3(x,y,z))/sqdeltah + c(x,y,z);
|
||||
icol[el]=(ix)*idim*idim+(iy)*idim+(iz);
|
||||
el=el+1;
|
||||
/* term depending on (x,y,z+1) */
|
||||
val[el] = -a3(x,y,z)/sqdeltah+b3(x,y,z)/deltah2;
|
||||
if (iz==idim-1) {
|
||||
zt[0] += g(x,y,1.0)*(-val[el]);
|
||||
} else {
|
||||
icol[el]=(ix)*idim*idim+(iy)*idim+(iz+1);
|
||||
el=el+1;
|
||||
}
|
||||
/* term depending on (x,y+1,z) */
|
||||
val[el] = -a2(x,y,z)/sqdeltah+b2(x,y,z)/deltah2;
|
||||
if (iy==idim-1) {
|
||||
zt[0] += g(x,1.0,z)*(-val[el]);
|
||||
} else {
|
||||
icol[el]=(ix)*idim*idim+(iy+1)*idim+(iz);
|
||||
el=el+1;
|
||||
}
|
||||
/* term depending on (x+1,y,z) */
|
||||
val[el] = -a1(x,y,z)/sqdeltah+b1(x,y,z)/deltah2;
|
||||
if (ix==idim-1) {
|
||||
zt[0] += g(1.0,y,z)*(-val[el]);
|
||||
} else {
|
||||
icol[el]=(ix+1)*idim*idim+(iy)*idim+(iz);
|
||||
el=el+1;
|
||||
}
|
||||
for (i=0; i<el; i++) irow[i]=glob_row;
|
||||
if ((ret=psb_c_dspins(el,irow,icol,val,ah,cdh))!=0)
|
||||
fprintf(stderr,"From psb_c_dspins: %d\n",ret);
|
||||
irow[0] = glob_row;
|
||||
psb_c_dgeins(1,irow,zt,bh,cdh);
|
||||
zt[0]=0.0;
|
||||
psb_c_dgeins(1,irow,zt,xh,cdh);
|
||||
}
|
||||
}
|
||||
|
||||
if ((info=psb_c_cdasb(cdh))!=0) return(info);
|
||||
|
||||
if ((info=psb_c_dspasb(ah,cdh))!=0) return(info);
|
||||
|
||||
if ((info=psb_c_dgeasb(xh,cdh))!=0) return(info);
|
||||
if ((info=psb_c_dgeasb(bh,cdh))!=0) return(info);
|
||||
if ((info=psb_c_dgeasb(rh,cdh))!=0) return(info);
|
||||
return(info);
|
||||
|
||||
}
|
||||
|
||||
int main(int argc, char *argv[])
|
||||
{
|
||||
int ictxt, iam, np;
|
||||
char methd[40], ptype[20], afmt[8], buffer[LINEBUFSIZE+1];
|
||||
int nparms;
|
||||
int idim,info,istop,itmax,itrace,irst,i,iter,ret;
|
||||
psb_c_dprec *ph;
|
||||
psb_c_dspmat *ah;
|
||||
psb_c_dvector *bh, *xh, *rh;
|
||||
int *vg, ng, nb,nlr;
|
||||
double t1,t2,eps,err;
|
||||
double *xv, *bv, *rv;
|
||||
double one=1.0, zero=0.0, res2;
|
||||
psb_c_SolverOptions options;
|
||||
psb_c_descriptor *cdh;
|
||||
FILE *vectfile;
|
||||
|
||||
ictxt = psb_c_init();
|
||||
psb_c_info(ictxt,&iam,&np);
|
||||
fprintf(stdout,"Initialization: am %d of %d\n",iam,np);
|
||||
|
||||
fflush(stdout);
|
||||
psb_c_barrier(ictxt);
|
||||
if (iam == 0) {
|
||||
fgets(buffer,LINEBUFSIZE,stdin);
|
||||
sscanf(buffer,"%d ",&nparms);
|
||||
fgets(buffer,LINEBUFSIZE,stdin);
|
||||
sscanf(buffer,"%s",methd);
|
||||
fgets(buffer,LINEBUFSIZE,stdin);
|
||||
sscanf(buffer,"%s",ptype);
|
||||
fgets(buffer,LINEBUFSIZE,stdin);
|
||||
sscanf(buffer,"%s",afmt);
|
||||
fgets(buffer,LINEBUFSIZE,stdin);
|
||||
sscanf(buffer,"%d",&idim);
|
||||
fgets(buffer,LINEBUFSIZE,stdin);
|
||||
sscanf(buffer,"%d",&istop);
|
||||
fgets(buffer,LINEBUFSIZE,stdin);
|
||||
sscanf(buffer,"%d",&itmax);
|
||||
fgets(buffer,LINEBUFSIZE,stdin);
|
||||
sscanf(buffer,"%d",&itrace);
|
||||
fgets(buffer,LINEBUFSIZE,stdin);
|
||||
sscanf(buffer,"%d",&irst);
|
||||
}
|
||||
/* Now broadcast the values, and check they're OK */
|
||||
psb_c_ibcast(ictxt,1,&nparms,0);
|
||||
psb_c_hbcast(ictxt,methd,0);
|
||||
psb_c_hbcast(ictxt,ptype,0);
|
||||
psb_c_hbcast(ictxt,afmt,0);
|
||||
psb_c_ibcast(ictxt,1,&idim,0);
|
||||
psb_c_ibcast(ictxt,1,&istop,0);
|
||||
psb_c_ibcast(ictxt,1,&itmax,0);
|
||||
psb_c_ibcast(ictxt,1,&itrace,0);
|
||||
psb_c_ibcast(ictxt,1,&irst,0);
|
||||
|
||||
fprintf(stderr,"%d Check on received: methd %s ptype %s afmt %s\n",
|
||||
iam,methd,ptype,afmt);
|
||||
|
||||
psb_c_barrier(ictxt);
|
||||
|
||||
cdh=psb_c_new_descriptor();
|
||||
|
||||
/* Simple minded BLOCK data distribution */
|
||||
ng = idim*idim*idim;
|
||||
nb = (ng+np-1)/np;
|
||||
if ((vg=malloc(ng*sizeof(int)))==NULL) {
|
||||
fprintf(stderr,"On %d: malloc failure\n",iam);
|
||||
psb_c_abort(ictxt);
|
||||
}
|
||||
for (i=0; i<ng; i++) {
|
||||
vg[i] = i/nb;
|
||||
}
|
||||
if ((info=psb_c_cdall_vg(ng,vg,ictxt,cdh))!=0) {
|
||||
fprintf(stderr,"From cdall: %d\nBailing out\n",info);
|
||||
psb_c_abort(ictxt);
|
||||
}
|
||||
|
||||
bh = psb_c_new_dvector();
|
||||
xh = psb_c_new_dvector();
|
||||
rh = psb_c_new_dvector();
|
||||
ah = psb_c_new_dspmat();
|
||||
fprintf(stderr,"From psb_c_new_dspmat: %p\n",ah);
|
||||
|
||||
/* Allocate mem space for sparse matrix and vectors */
|
||||
ret=psb_c_dspall(ah,cdh);
|
||||
fprintf(stderr,"From psb_c_dspall: %d\n",ret);
|
||||
psb_c_dgeall(bh,cdh);
|
||||
psb_c_dgeall(xh,cdh);
|
||||
psb_c_dgeall(rh,cdh);
|
||||
|
||||
|
||||
|
||||
/* Matrix generation */
|
||||
if (matgen(ictxt,ng,idim,vg,ah,cdh,xh,bh,rh) != 0) {
|
||||
fprintf(stderr,"Error during matrix build loop\n");
|
||||
psb_c_abort(ictxt);
|
||||
}
|
||||
psb_c_barrier(ictxt);
|
||||
/* Set up the preconditioner */
|
||||
ph = psb_c_new_dprec();
|
||||
psb_c_dprecinit(ph,ptype);
|
||||
ret=psb_c_dprecbld(ah,cdh,ph);
|
||||
fprintf(stderr,"From psb_c_dprecbld: %d\n",ret);
|
||||
|
||||
/* Set up the solver options */
|
||||
psb_c_DefaultSolverOptions(&options);
|
||||
options.eps = 1.e-9;
|
||||
options.itmax = itmax;
|
||||
options.irst = irst;
|
||||
options.itrace = 1;
|
||||
options.istop = istop;
|
||||
psb_c_seterraction_ret();
|
||||
t1=psb_c_wtime();
|
||||
ret=psb_c_dkrylov(methd,ah,ph,bh,xh,cdh,&options);
|
||||
t2=psb_c_wtime();
|
||||
iter = options.iter;
|
||||
err = options.err;
|
||||
fprintf(stderr,"From krylov: %d %lf, %d %d\n",iter,err,ret,psb_c_get_errstatus());
|
||||
if (psb_c_get_errstatus() != 0) {
|
||||
psb_c_print_errmsg();
|
||||
}
|
||||
fprintf(stderr,"After cleanup %d\n",psb_c_get_errstatus());
|
||||
/* Check 2-norm of residual on exit */
|
||||
psb_c_dgeaxpby(one,bh,zero,rh,cdh);
|
||||
psb_c_dspmm(-one,ah,xh,one,rh,cdh);
|
||||
res2=psb_c_dgenrm2(rh,cdh);
|
||||
|
||||
if (iam==0) {
|
||||
fprintf(stdout,"Time: %lf\n",(t2-t1));
|
||||
fprintf(stdout,"Iter: %d\n",iter);
|
||||
fprintf(stdout,"Err: %lg\n",err);
|
||||
fprintf(stdout,"||r||_2: %lg\n",res2);
|
||||
|
||||
}
|
||||
|
||||
#if DUMPATRIX
|
||||
psb_c_dmat_name_print(ah,"cbindmat.mtx");
|
||||
nlr = psb_c_cd_get_local_rows(cdh);
|
||||
bv = psb_c_dvect_get_cpy(bh);
|
||||
vectfile=fopen("cbindb.mtx","w");
|
||||
for (i=0;i<nlr; i++)
|
||||
fprintf(vectfile,"%lf\n",bv[i]);
|
||||
fclose(vectfile);
|
||||
|
||||
|
||||
xv = psb_c_dvect_get_cpy(xh);
|
||||
nlr=psb_c_cd_get_local_rows(cdh);
|
||||
for (i=0;i<nlr; i++)
|
||||
fprintf(stdout,"SOL: %d %d %lf\n",iam,i,xv[i]);
|
||||
|
||||
|
||||
rv = psb_c_dvect_get_cpy(rh);
|
||||
nlr=psb_c_cd_get_local_rows(cdh);
|
||||
for (i=0;i<nlr; i++)
|
||||
fprintf(stdout,"RES: %d %d %lf\n",iam,i,rv[i]);
|
||||
|
||||
#endif
|
||||
|
||||
/* Clean up memory */
|
||||
if ((info=psb_c_dgefree(xh,cdh))!=0) {
|
||||
fprintf(stderr,"From dgefree: %d\nBailing out\n",info);
|
||||
psb_c_abort(ictxt);
|
||||
}
|
||||
if ((info=psb_c_dgefree(bh,cdh))!=0) {
|
||||
fprintf(stderr,"From dgefree: %d\nBailing out\n",info);
|
||||
psb_c_abort(ictxt);
|
||||
}
|
||||
if ((info=psb_c_dgefree(rh,cdh))!=0) {
|
||||
fprintf(stderr,"From dgefree: %d\nBailing out\n",info);
|
||||
psb_c_abort(ictxt);
|
||||
}
|
||||
|
||||
if ((info=psb_c_cdfree(cdh))!=0) {
|
||||
fprintf(stderr,"From cdfree: %d\nBailing out\n",info);
|
||||
psb_c_abort(ictxt);
|
||||
}
|
||||
fprintf(stderr,"pointer from cdfree: %p\n",cdh->descriptor);
|
||||
|
||||
/* Clean up object handles */
|
||||
free(ph);
|
||||
free(xh);
|
||||
free(bh);
|
||||
free(ah);
|
||||
free(cdh);
|
||||
|
||||
|
||||
fprintf(stderr,"program completed successfully\n");
|
||||
|
||||
psb_c_barrier(ictxt);
|
||||
psb_c_exit(ictxt);
|
||||
}
|
||||
@ -0,0 +1,11 @@
|
||||
7 Number of entries below this
|
||||
BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES
|
||||
BJAC Preconditioner NONE DIAG BJAC
|
||||
CSR A Storage format CSR COO
|
||||
40 Domain size (acutal system is this**3)
|
||||
1 Stopping criterion
|
||||
80 MAXIT
|
||||
01 ITRACE
|
||||
20 IRST restart for RGMRES and BiCGSTABL
|
||||
|
||||
|
||||
Loading…
Reference in New Issue