fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Updates for C ctxt handling.

Browse Source
new-context
Salvatore Filippone 4 years ago
parent 5f67cc4bb5
commit 9178d63ebd
16 changed files with 195 additions and 236 deletions
Show Stats Download Patch File Download Diff File

89
base/internals/psi_bld_glb_dep_list.F90
Unescape Escape View File

@ -29,95 +29,6 @@
! POSSIBILITY OF SUCH DAMAGE.
!
!
!!$subroutine psi_i_bld_glb_dep_list(ctxt,loc_dl,length_dl,dep_list,dl_lda,info)
!!$ use psi_mod, psb_protect_name => psi_i_bld_glb_dep_list
!!$#ifdef MPI_MOD
!!$ use mpi
!!$#endif
!!$ use psb_penv_mod
!!$ use psb_const_mod
!!$ use psb_error_mod
!!$ use psb_desc_mod
!!$ use psb_sort_mod
!!$ implicit none
!!$#ifdef MPI_H
!!$ include 'mpif.h'
!!$#endif
!!$ ! ....scalar parameters...
!!$ type(psb_ctxt_type), intent(in) :: ctxt
!!$ integer(psb_ipk_), intent(out) :: dl_lda
!!$ integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:)
!!$ integer(psb_ipk_), allocatable, intent(out) :: dep_list(:,:)
!!$ integer(psb_ipk_), intent(out) :: info
!!$
!!$
!!$ ! .....local arrays....
!!$ integer(psb_ipk_) :: int_err(5)
!!$
!!$ ! .....local scalars...
!!$ integer(psb_ipk_) :: i, proc,j,err_act
!!$ integer(psb_ipk_) :: err
!!$ integer(psb_ipk_) :: debug_level, debug_unit
!!$ integer(psb_ipk_) :: me, np
!!$ integer(psb_mpk_) :: icomm, minfo
!!$ logical, parameter :: dist_symm_list=.false., print_dl=.false.
!!$ character name*20
!!$ name='psi_bld_glb_dep_list'
!!$
!!$ call psb_erractionsave(err_act)
!!$ debug_unit = psb_get_debug_unit()
!!$ debug_level = psb_get_debug_level()
!!$
!!$ info = psb_success_
!!$
!!$ call psb_info(ctxt,me,np)
!!$
!!$
!!$ dl_lda = length_dl(me)
!!$ call psb_max(ctxt, dl_lda)
!!$
!!$ if (debug_level >= psb_debug_inner_) &
!!$ & write(debug_unit,*) me,' ',trim(name),': Dep_list length ',length_dl(me),dl_lda
!!$ dl_lda = max(dl_lda,1)
!!$ allocate(dep_list(dl_lda,0:np),stat=info)
!!$ if (info /= psb_success_) then
!!$ call psb_errpush(psb_err_from_subroutine_,name,a_err='Allocate')
!!$ goto 9999
!!$ end if
!!$ icomm = psb_get_mpi_comm(ctxt)
!!$ call mpi_allgather(loc_dl,dl_lda,psb_mpi_ipk_,&
!!$ & dep_list,dl_lda,psb_mpi_ipk_,icomm,minfo)
!!$
!!$ info = minfo
!!$ if (info /= psb_success_) then
!!$ info=psb_err_internal_error_
!!$ goto 9999
!!$ endif
!!$ if (print_dl) then
!!$ if (me == 0) then
!!$ write(0,*) ' Dep_list '
!!$ do i=0,np-1
!!$ j = length_dl(i)
!!$ write(0,*) 'Proc ',i,':',dep_list(1:j,i)
!!$ end do
!!$ flush(0)
!!$ end if
!!$ call psb_barrier(ctxt)
!!$ end if
!!$
!!$ call psb_erractionrestore(err_act)
!!$ return
!!$
!!$
!!$9999 continue
!!$
!!$ call psb_errpush(info,name,i_err=int_err)
!!$ call psb_error_handler(err_act)
!!$
!!$ return
!!$
!!$end subroutine psi_i_bld_glb_dep_list
subroutine psi_i_bld_glb_csr_dep_list(ctxt,loc_dl,length_dl,c_dep_list,dl_ptr,info)
use psi_mod, psb_protect_name => psi_i_bld_glb_csr_dep_list
#ifdef MPI_MOD

2
base/internals/psi_crea_index.f90
Unescape Escape View File

@ -126,7 +126,7 @@ subroutine psi_i_crea_index(desc_a,index_in,index_out,nxch,nsnd,nrcv,info)
if (choose_sorting(dlmax,dlavg,np)) then
if (do_timings) call psb_tic(idx_phase21)
call psi_bld_glb_dep_csr_list(ctxt,&
call psi_bld_glb_dep_list(ctxt,&
& loc_dl,length_dl,c_dep_list,dl_ptr,info)
if (info /= 0) then
write(0,*) me,trim(name),' From bld_glb_list ',info

14
base/modules/psi_i_mod.F90
Unescape Escape View File

@ -110,20 +110,12 @@ module psi_i_mod
end interface
interface psi_bld_glb_dep_list
!!$ subroutine psi_i_bld_glb_dep_list(ctxt,loc_dl,length_dl,dep_list,dl_lda,info)
!!$ import
!!$ type(psb_ctxt_type), intent(in) :: ctxt
!!$ integer(psb_ipk_), intent(out) :: dl_lda
!!$ integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:)
!!$ integer(psb_ipk_), allocatable, intent(out) :: dep_list(:,:)
!!$ integer(psb_ipk_), intent(out) :: info
!!$ end subroutine psi_i_bld_glb_dep_list
subroutine psi_i_bld_glb_csr_dep_list(ctxt,loc_dl,length_dl,c_dep_list,dl_ptr,info)
import
integer(psb_ipk_), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:)
type(psb_ctxt_type), intent(in) :: ctxt
integer(psb_ipk_), intent(in) :: loc_dl(:), length_dl(0:)
integer(psb_ipk_), allocatable, intent(out) :: c_dep_list(:), dl_ptr(:)
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_), intent(out) :: info
end subroutine psi_i_bld_glb_csr_dep_list
end interface

10
cbind/base/psb_base_tools_cbind_mod.F90
Unescape Escape View File

@ -28,7 +28,7 @@ contains
integer(psb_c_ipk_) :: res
integer(psb_c_lpk_), value :: ng
integer(psb_c_ipk_), value :: cctxt
type(psb_c_object_type), value :: cctxt
integer(psb_c_ipk_) :: vg(*)
type(psb_c_object_type) :: cdh
type(psb_desc_type), pointer :: descp
@ -63,7 +63,8 @@ contains
implicit none
integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: nl, cctxt
type(psb_c_object_type), value :: cctxt
integer(psb_c_ipk_), value :: nl
integer(psb_c_lpk_) :: vl(*)
type(psb_c_object_type) :: cdh
type(psb_desc_type), pointer :: descp
@ -103,7 +104,8 @@ contains
implicit none
integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: nl, cctxt
type(psb_c_object_type), value :: cctxt
integer(psb_c_ipk_), value :: nl
type(psb_c_object_type) :: cdh
type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info
@ -137,7 +139,7 @@ contains
integer(psb_c_ipk_) :: res
integer(psb_c_lpk_), value :: n
integer(psb_c_ipk_), value :: cctxt
type(psb_c_object_type), value :: cctxt
type(psb_c_object_type) :: cdh
type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info

21
cbind/base/psb_c_base.c
Unescape Escape View File

@ -11,6 +11,27 @@ psb_c_descriptor* psb_c_new_descriptor()
return(temp);
}
void psb_c_delete_descriptor(psb_c_descriptor* cdh)
{
if (cdh != NULL) free(cdh);
return;
}
psb_c_ctxt* psb_c_new_ctxt()
{
psb_c_ctxt* temp;
temp=(psb_c_ctxt *) malloc(sizeof(psb_c_ctxt));
temp->ctxt=NULL;
return(temp);
}
void psb_c_delete_ctxt(psb_c_ctxt* cctxt)
{
if (cctxt != NULL) free(cctxt);
return;
}
void psb_c_print_errmsg()
{

46
cbind/base/psb_c_base.h
Unescape Escape View File

@ -43,6 +43,11 @@ extern "C" {
} psb_c_descriptor;
typedef struct PSB_C_CTXT {
psb_i_t *ctxt;
} psb_c_ctxt;
psb_i_t psb_c_error();
psb_i_t psb_c_clean_errstack();
@ -54,34 +59,37 @@ extern "C" {
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);
void psb_c_init(psb_c_ctxt *cctxt);
void psb_c_exit(psb_c_ctxt cctxt);
void psb_c_exit_ctxt(psb_c_ctxt cctxt);
void psb_c_abort(psb_c_ctxt cctxt);
void psb_c_barrier(psb_c_ctxt cctxt);
void psb_c_info(psb_c_ctxt cctxt, 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_mbcast(psb_i_t ictxt, psb_i_t n, psb_m_t *v, psb_i_t root);
void psb_c_ibcast(psb_i_t ictxt, psb_i_t n, psb_i_t *v, psb_i_t root);
void psb_c_lbcast(psb_i_t ictxt, psb_i_t n, psb_l_t *v, psb_i_t root);
void psb_c_ebcast(psb_i_t ictxt, psb_i_t n, psb_e_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);
void psb_c_mbcast(psb_c_ctxt cctxt, psb_i_t n, psb_m_t *v, psb_i_t root);
void psb_c_ibcast(psb_c_ctxt cctxt, psb_i_t n, psb_i_t *v, psb_i_t root);
void psb_c_lbcast(psb_c_ctxt cctxt, psb_i_t n, psb_l_t *v, psb_i_t root);
void psb_c_ebcast(psb_c_ctxt cctxt, psb_i_t n, psb_e_t *v, psb_i_t root);
void psb_c_sbcast(psb_c_ctxt cctxt, psb_i_t n, psb_s_t *v, psb_i_t root);
void psb_c_dbcast(psb_c_ctxt cctxt, psb_i_t n, psb_d_t *v, psb_i_t root);
void psb_c_cbcast(psb_c_ctxt cctxt, psb_i_t n, psb_c_t *v, psb_i_t root);
void psb_c_zbcast(psb_c_ctxt cctxt, psb_i_t n, psb_z_t *v, psb_i_t root);
void psb_c_hbcast(psb_c_ctxt cctxt, 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_l_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_l_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_l_t n, psb_i_t ictxt, psb_c_descriptor *cd);
void psb_c_delete_descriptor(psb_c_descriptor *);
psb_c_ctxt* psb_c_new_ctxt();
void psb_c_delete_ctxt(psb_c_ctxt *);
psb_i_t psb_c_cdall_vg(psb_l_t ng, psb_i_t *vg, psb_c_ctxt cctxt, psb_c_descriptor *cd);
psb_i_t psb_c_cdall_vl(psb_i_t nl, psb_l_t *vl, psb_c_ctxt cctxt, psb_c_descriptor *cd);
psb_i_t psb_c_cdall_nl(psb_i_t nl, psb_c_ctxt cctxt, psb_c_descriptor *cd);
psb_i_t psb_c_cdall_repl(psb_l_t n, psb_c_ctxt cctxt, 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_l_t *ia, const psb_l_t *ja, psb_c_descriptor *cd);

137
cbind/base/psb_cpenv_mod.f90
Unescape Escape View File

@ -30,33 +30,55 @@ contains
res = psb_get_errstatus()
end function psb_c_get_errstatus
function psb_c_init() bind(c)
subroutine psb_c_init(cctxt) bind(c)
use psb_base_mod, only : psb_init, psb_ctxt_type
implicit none
integer(psb_c_ipk_) :: psb_c_init
type(psb_ctxt_type) :: ctxt
type(psb_c_object_type) :: cctxt
type(psb_ctxt_type), pointer :: ctxt
integer :: info
if (c_associated(cctxt%item)) then
call c_f_pointer(cctxt%item,ctxt)
deallocate(ctxt,stat=info)
if (info /= 0) return
end if
allocate(ctxt,stat=info)
if (info /= 0) return
call psb_init(ctxt)
psb_c_init = ctxt%ctxt
end function psb_c_init
cctxt%item = c_loc(ctxt)
end subroutine psb_c_init
function psb_c2f_ctxt(cctxt) result(res)
implicit none
type(psb_c_object_type), value :: cctxt
type(psb_ctxt_type), pointer :: res
!res%ctxt = cctxt%ctxt
if (.not.c_associated(cctxt%item)) then
write(0,*) 'Null item in c2f_ctxt? '
flush(0)
end if
if (c_associated(cctxt%item)) call c_f_pointer(cctxt%item,res)
end function psb_c2f_ctxt
subroutine psb_c_exit_ctxt(cctxt) bind(c)
use psb_base_mod, only : psb_exit, psb_ctxt_type
integer(psb_c_ipk_), value :: cctxt
type(psb_ctxt_type) :: ctxt
ctxt = psb_c2f_ctxt(cctxt)
type(psb_c_object_type), value :: cctxt
type(psb_ctxt_type), pointer :: ctxt
ctxt => psb_c2f_ctxt(cctxt)
call psb_exit(ctxt,close=.false.)
return
end subroutine psb_c_exit_ctxt
subroutine psb_c_exit(cctxt) bind(c)
use psb_base_mod, only : psb_exit, psb_ctxt_type
integer(psb_c_ipk_), value :: cctxt
type(psb_c_object_type), value :: cctxt
type(psb_ctxt_type) :: ctxt
ctxt = psb_c2f_ctxt(cctxt)
type(psb_ctxt_type), pointer :: ctxt
ctxt => psb_c2f_ctxt(cctxt)
call psb_exit(ctxt)
return
@ -64,10 +86,10 @@ contains
subroutine psb_c_abort(cctxt) bind(c)
use psb_base_mod, only : psb_abort, psb_ctxt_type
integer(psb_c_ipk_), value :: cctxt
type(psb_c_object_type), value :: cctxt
type(psb_ctxt_type) :: ctxt
ctxt = psb_c2f_ctxt(cctxt)
type(psb_ctxt_type), pointer :: ctxt
ctxt => psb_c2f_ctxt(cctxt)
call psb_abort(ctxt)
return
end subroutine psb_c_abort
@ -75,21 +97,21 @@ contains
subroutine psb_c_info(cctxt,iam,np) bind(c)
use psb_base_mod, only : psb_info, psb_ctxt_type
integer(psb_c_ipk_), value :: cctxt
type(psb_c_object_type), value :: cctxt
integer(psb_c_ipk_) :: iam,np
type(psb_ctxt_type) :: ctxt
ctxt = psb_c2f_ctxt(cctxt)
type(psb_ctxt_type), pointer :: ctxt
ctxt => psb_c2f_ctxt(cctxt)
call psb_info(ctxt,iam,np)
return
end subroutine psb_c_info
subroutine psb_c_barrier(cctxt) bind(c)
use psb_base_mod, only : psb_barrier, psb_ctxt_type
integer(psb_c_ipk_), value :: cctxt
type(psb_c_object_type), value :: cctxt
type(psb_ctxt_type) :: ctxt
ctxt = psb_c2f_ctxt(cctxt)
type(psb_ctxt_type), pointer :: ctxt
ctxt => psb_c2f_ctxt(cctxt)
call psb_barrier(ctxt)
end subroutine psb_c_barrier
@ -102,11 +124,12 @@ contains
subroutine psb_c_mbcast(cctxt,n,v,root) bind(c)
use psb_base_mod, only : psb_bcast, psb_ctxt_type
implicit none
integer(psb_c_ipk_), value :: cctxt, n, root
type(psb_c_object_type), value :: cctxt
integer(psb_c_ipk_), value :: n, root
integer(psb_c_mpk_) :: v(*)
type(psb_ctxt_type) :: ctxt
ctxt = psb_c2f_ctxt(cctxt)
type(psb_ctxt_type), pointer :: ctxt
ctxt => psb_c2f_ctxt(cctxt)
if (n < 0) then
write(0,*) 'Wrong size in BCAST'
@ -120,11 +143,12 @@ contains
subroutine psb_c_ibcast(cctxt,n,v,root) bind(c)
use psb_base_mod, only : psb_bcast, psb_ctxt_type
implicit none
integer(psb_c_ipk_), value :: cctxt, n, root
type(psb_c_object_type), value :: cctxt
integer(psb_c_ipk_), value :: n, root
integer(psb_c_ipk_) :: v(*)
type(psb_ctxt_type) :: ctxt
type(psb_ctxt_type), pointer :: ctxt
ctxt = psb_c2f_ctxt(cctxt)
ctxt => psb_c2f_ctxt(cctxt)
if (n < 0) then
write(0,*) 'Wrong size in BCAST'
@ -138,10 +162,11 @@ contains
subroutine psb_c_lbcast(cctxt,n,v,root) bind(c)
use psb_base_mod, only : psb_bcast, psb_ctxt_type
implicit none
integer(psb_c_ipk_), value :: cctxt, n, root
type(psb_c_object_type), value :: cctxt
integer(psb_c_ipk_), value :: n, root
integer(psb_c_lpk_) :: v(*)
type(psb_ctxt_type) :: ctxt
ctxt = psb_c2f_ctxt(cctxt)
type(psb_ctxt_type), pointer :: ctxt
ctxt => psb_c2f_ctxt(cctxt)
if (n < 0) then
write(0,*) 'Wrong size in BCAST'
@ -155,10 +180,11 @@ contains
subroutine psb_c_ebcast(cctxt,n,v,root) bind(c)
use psb_base_mod, only : psb_bcast, psb_ctxt_type
implicit none
integer(psb_c_ipk_), value :: cctxt, n, root
type(psb_c_object_type), value :: cctxt
integer(psb_c_ipk_), value :: n, root
integer(psb_c_epk_) :: v(*)
type(psb_ctxt_type) :: ctxt
ctxt = psb_c2f_ctxt(cctxt)
type(psb_ctxt_type), pointer :: ctxt
ctxt => psb_c2f_ctxt(cctxt)
if (n < 0) then
write(0,*) 'Wrong size in BCAST'
@ -172,10 +198,11 @@ contains
subroutine psb_c_sbcast(cctxt,n,v,root) bind(c)
use psb_base_mod
implicit none
integer(psb_c_ipk_), value :: cctxt, n, root
type(psb_c_object_type), value :: cctxt
integer(psb_c_ipk_), value :: n, root
real(c_float) :: v(*)
type(psb_ctxt_type) :: ctxt
ctxt = psb_c2f_ctxt(cctxt)
type(psb_ctxt_type), pointer :: ctxt
ctxt => psb_c2f_ctxt(cctxt)
if (n < 0) then
write(0,*) 'Wrong size in BCAST'
@ -189,10 +216,11 @@ contains
subroutine psb_c_dbcast(cctxt,n,v,root) bind(c)
use psb_base_mod, only : psb_bcast, psb_ctxt_type
implicit none
integer(psb_c_ipk_), value :: cctxt, n, root
type(psb_c_object_type), value :: cctxt
integer(psb_c_ipk_), value :: n, root
real(c_double) :: v(*)
type(psb_ctxt_type) :: ctxt
ctxt = psb_c2f_ctxt(cctxt)
type(psb_ctxt_type), pointer :: ctxt
ctxt => psb_c2f_ctxt(cctxt)
if (n < 0) then
write(0,*) 'Wrong size in BCAST'
@ -207,10 +235,11 @@ contains
subroutine psb_c_cbcast(cctxt,n,v,root) bind(c)
use psb_base_mod, only : psb_bcast, psb_ctxt_type
implicit none
integer(psb_c_ipk_), value :: cctxt, n, root
type(psb_c_object_type), value :: cctxt
integer(psb_c_ipk_), value :: n, root
complex(c_float_complex) :: v(*)
type(psb_ctxt_type) :: ctxt
ctxt = psb_c2f_ctxt(cctxt)
type(psb_ctxt_type), pointer :: ctxt
ctxt => psb_c2f_ctxt(cctxt)
if (n < 0) then
write(0,*) 'Wrong size in BCAST'
@ -224,10 +253,11 @@ contains
subroutine psb_c_zbcast(cctxt,n,v,root) bind(c)
use psb_base_mod
implicit none
integer(psb_c_ipk_), value :: cctxt, n, root
type(psb_c_object_type), value :: cctxt
integer(psb_c_ipk_), value :: n, root
complex(c_double_complex) :: v(*)
type(psb_ctxt_type) :: ctxt
ctxt = psb_c2f_ctxt(cctxt)
type(psb_ctxt_type), pointer :: ctxt
ctxt => psb_c2f_ctxt(cctxt)
if (n < 0) then
write(0,*) 'Wrong size in BCAST'
@ -241,11 +271,12 @@ contains
subroutine psb_c_hbcast(cctxt,v,root) bind(c)
use psb_base_mod, only : psb_bcast, psb_info, psb_ipk_, psb_ctxt_type
implicit none
integer(psb_c_ipk_), value :: cctxt, root
type(psb_c_object_type), value :: cctxt
integer(psb_c_ipk_), value :: root
character(c_char) :: v(*)
integer(psb_ipk_) :: iam, np, n
type(psb_ctxt_type) :: ctxt
ctxt = psb_c2f_ctxt(cctxt)
type(psb_ctxt_type), pointer :: ctxt
ctxt => psb_c2f_ctxt(cctxt)
call psb_info(ctxt,iam,np)
@ -289,15 +320,6 @@ contains
end if
cmesg(ll) = c_null_char
end function psb_c_f2c_errmsg
function psb_c2f_ctxt(cctxt) result(res)
implicit none
integer(psb_ipk_) :: cctxt
type(psb_ctxt_type) :: res
res%ctxt = cctxt
end function psb_c2f_ctxt
subroutine psb_c_seterraction_ret() bind(c)
use psb_base_mod, only : psb_set_erraction, psb_act_ret_, psb_ctxt_type
@ -313,6 +335,5 @@ contains
use psb_base_mod, only : psb_set_erraction, psb_act_abort_, psb_ctxt_type
call psb_set_erraction(psb_act_abort_)
end subroutine psb_c_seterraction_abort
end module psb_cpenv_mod

2
cbind/prec/psb_c_cprec.h
Unescape Escape View File

@ -14,7 +14,7 @@ extern "C" {
psb_c_cprec* psb_c_new_cprec();
psb_i_t psb_c_cprecinit(psb_i_t ictxt,psb_c_cprec *ph, const char *ptype);
psb_i_t psb_c_cprecinit(psb_c_ctxt cctxt,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

2
cbind/prec/psb_c_dprec.h
Unescape Escape View File

@ -14,7 +14,7 @@ extern "C" {
psb_c_dprec* psb_c_new_dprec();
psb_i_t psb_c_dprecinit(psb_i_t ictxt, psb_c_dprec *ph, const char *ptype);
psb_i_t psb_c_dprecinit(psb_c_ctxt cctxt, 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

2
cbind/prec/psb_c_sprec.h
Unescape Escape View File

@ -14,7 +14,7 @@ extern "C" {
psb_c_sprec* psb_c_new_sprec();
psb_i_t psb_c_sprecinit(psb_i_t ictxt, psb_c_sprec *ph, const char *ptype);
psb_i_t psb_c_sprecinit(psb_c_ctxt cctxt, 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

2
cbind/prec/psb_c_zprec.h
Unescape Escape View File

@ -14,7 +14,7 @@ extern "C" {
psb_c_zprec* psb_c_new_zprec();
psb_i_t psb_c_zprecinit(psb_i_t ictxt, psb_c_zprec *ph, const char *ptype);
psb_i_t psb_c_zprecinit(psb_c_ctxt cctxt, 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

9
cbind/prec/psb_cprec_cbind_mod.f90
Unescape Escape View File

@ -18,16 +18,17 @@ contains
use psb_cpenv_mod
use psb_base_string_cbind_mod
implicit none
integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: cctxt
integer(psb_c_ipk_) :: res
type(psb_c_object_type), value :: cctxt
type(psb_c_cprec) :: ph
character(c_char) :: ptype(*)
type(psb_cprec_type), pointer :: precp
integer(psb_c_ipk_) :: info
character(len=80) :: fptype
type(psb_ctxt_type) :: ctxt
ctxt = psb_c2f_ctxt(cctxt)
type(psb_ctxt_type), pointer :: ctxt
ctxt => psb_c2f_ctxt(cctxt)
res = -1
if (c_associated(ph%item)) then

9
cbind/prec/psb_dprec_cbind_mod.f90
Unescape Escape View File

@ -18,16 +18,17 @@ contains
use psb_cpenv_mod
use psb_base_string_cbind_mod
implicit none
integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: cctxt
integer(psb_c_ipk_) :: res
type(psb_c_object_type), value :: cctxt
type(psb_c_dprec) :: ph
character(c_char) :: ptype(*)
type(psb_dprec_type), pointer :: precp
integer(psb_c_ipk_) :: info
character(len=80) :: fptype
type(psb_ctxt_type) :: ctxt
ctxt = psb_c2f_ctxt(cctxt)
type(psb_ctxt_type), pointer :: ctxt
ctxt => psb_c2f_ctxt(cctxt)
res = -1
if (c_associated(ph%item)) then

9
cbind/prec/psb_sprec_cbind_mod.f90
Unescape Escape View File

@ -18,16 +18,17 @@ contains
use psb_cpenv_mod
use psb_base_string_cbind_mod
implicit none
integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: cctxt
integer(psb_c_ipk_) :: res
type(psb_c_object_type), value :: cctxt
type(psb_c_sprec) :: ph
character(c_char) :: ptype(*)
type(psb_sprec_type), pointer :: precp
integer(psb_c_ipk_) :: info
character(len=80) :: fptype
type(psb_ctxt_type) :: ctxt
ctxt = psb_c2f_ctxt(cctxt)
type(psb_ctxt_type), pointer :: ctxt
ctxt => psb_c2f_ctxt(cctxt)
res = -1
if (c_associated(ph%item)) then

9
cbind/prec/psb_zprec_cbind_mod.f90
Unescape Escape View File

@ -18,16 +18,17 @@ contains
use psb_cpenv_mod
use psb_base_string_cbind_mod
implicit none
integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: cctxt
integer(psb_c_ipk_) :: res
type(psb_c_object_type), value :: cctxt
type(psb_c_zprec) :: ph
character(c_char) :: ptype(*)
type(psb_zprec_type), pointer :: precp
integer(psb_c_ipk_) :: info
character(len=80) :: fptype
type(psb_ctxt_type) :: ctxt
ctxt = psb_c2f_ctxt(cctxt)
type(psb_ctxt_type), pointer :: ctxt
ctxt => psb_c2f_ctxt(cctxt)
res = -1
if (c_associated(ph%item)) then

68
cbind/test/pargen/ppdec.c
Unescape Escape View File

@ -120,7 +120,7 @@ double g(double x, double y, double z)
}
}
psb_i_t matgen(psb_i_t ictxt, psb_i_t nl, psb_i_t idim, psb_l_t vl[],
psb_i_t matgen(psb_c_ctxt cctxt, psb_i_t nl, psb_i_t idim, psb_l_t vl[],
psb_c_dspmat *ah,psb_c_descriptor *cdh,
psb_c_dvector *xh, psb_c_dvector *bh, psb_c_dvector *rh)
{
@ -132,7 +132,7 @@ psb_i_t matgen(psb_i_t ictxt, psb_i_t nl, psb_i_t idim, psb_l_t vl[],
psb_l_t irow[10*NBMAX], icol[10*NBMAX];
info = 0;
psb_c_info(ictxt,&iam,&np);
psb_c_info(cctxt,&iam,&np);
deltah = (double) 1.0/(idim+1);
sqdeltah = deltah*deltah;
deltah2 = 2.0* deltah;
@ -223,7 +223,8 @@ psb_i_t matgen(psb_i_t ictxt, psb_i_t nl, psb_i_t idim, psb_l_t vl[],
int main(int argc, char *argv[])
{
psb_i_t ictxt, iam, np;
psb_c_ctxt *cctxt;
psb_i_t iam, np;
char methd[40], ptype[20], afmt[8], buffer[LINEBUFSIZE+1];
psb_i_t nparms;
psb_i_t idim,info,istop,itmax,itrace,irst,iter,ret;
@ -238,13 +239,12 @@ int main(int argc, char *argv[])
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);
cctxt = psb_c_new_ctxt();
psb_c_init(cctxt);
psb_c_info(*cctxt,&iam,&np);
psb_c_barrier(*cctxt);
if (iam == 0) {
fgets(buffer,LINEBUFSIZE,stdin);
sscanf(buffer,"%d ",&nparms);
@ -264,22 +264,22 @@ int main(int argc, char *argv[])
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);
psb_c_ibcast(*cctxt,1,&nparms,0);
psb_c_hbcast(*cctxt,methd,0);
psb_c_hbcast(*cctxt,ptype,0);
psb_c_hbcast(*cctxt,afmt,0);
psb_c_ibcast(*cctxt,1,&idim,0);
psb_c_ibcast(*cctxt,1,&istop,0);
psb_c_ibcast(*cctxt,1,&itmax,0);
psb_c_ibcast(*cctxt,1,&itrace,0);
psb_c_ibcast(*cctxt,1,&irst,0);
fprintf(stderr,"%d Check on received: methd %s ptype %s afmt %s\n",
iam,methd,ptype,afmt);
fflush(stderr);
psb_c_barrier(ictxt);
psb_c_barrier(*cctxt);
cdh=psb_c_new_descriptor();
psb_c_set_index_base(0);
@ -292,15 +292,15 @@ int main(int argc, char *argv[])
fprintf(stderr,"%d: Input data %d %ld %d %d\n",iam,idim,ng,nb, nl);
if ((vl=malloc(nb*sizeof(psb_l_t)))==NULL) {
fprintf(stderr,"On %d: malloc failure\n",iam);
psb_c_abort(ictxt);
psb_c_abort(*cctxt);
}
i = ((psb_l_t)iam) * nb;
for (k=0; k<nl; k++)
vl[k] = i+k;
if ((info=psb_c_cdall_vl(nl,vl,ictxt,cdh))!=0) {
if ((info=psb_c_cdall_vl(nl,vl,*cctxt,cdh))!=0) {
fprintf(stderr,"From cdall: %d\nBailing out\n",info);
psb_c_abort(ictxt);
psb_c_abort(*cctxt);
}
bh = psb_c_new_dvector();
@ -319,14 +319,14 @@ int main(int argc, char *argv[])
/* Matrix generation */
if (matgen(ictxt,nl,idim,vl,ah,cdh,xh,bh,rh) != 0) {
if (matgen(*cctxt,nl,idim,vl,ah,cdh,xh,bh,rh) != 0) {
fprintf(stderr,"Error during matrix build loop\n");
psb_c_abort(ictxt);
psb_c_abort(*cctxt);
}
psb_c_barrier(ictxt);
psb_c_barrier(*cctxt);
/* Set up the preconditioner */
ph = psb_c_new_dprec();
psb_c_dprecinit(ictxt,ph,ptype);
psb_c_dprecinit(*cctxt,ph,ptype);
ret=psb_c_dprecbld(ah,cdh,ph);
//fprintf(stderr,"From psb_c_dprecbld: %d\n",ret);
@ -387,20 +387,20 @@ int main(int argc, char *argv[])
/* Clean up memory */
if ((info=psb_c_dgefree(xh,cdh))!=0) {
fprintf(stderr,"From dgefree: %d\nBailing out\n",info);
psb_c_abort(ictxt);
psb_c_abort(*cctxt);
}
if ((info=psb_c_dgefree(bh,cdh))!=0) {
fprintf(stderr,"From dgefree: %d\nBailing out\n",info);
psb_c_abort(ictxt);
psb_c_abort(*cctxt);
}
if ((info=psb_c_dgefree(rh,cdh))!=0) {
fprintf(stderr,"From dgefree: %d\nBailing out\n",info);
psb_c_abort(ictxt);
psb_c_abort(*cctxt);
}
if ((info=psb_c_cdfree(cdh))!=0) {
fprintf(stderr,"From cdfree: %d\nBailing out\n",info);
psb_c_abort(ictxt);
psb_c_abort(*cctxt);
}
//fprintf(stderr,"pointer from cdfree: %p\n",cdh->descriptor);
@ -412,8 +412,8 @@ int main(int argc, char *argv[])
free(cdh);
if (iam == 0) fprintf(stderr,"program completed successfully\n");
//if (iam == 0) fprintf(stderr,"program completed successfully\n");
psb_c_barrier(ictxt);
psb_c_exit(ictxt);
psb_c_barrier(*cctxt);
psb_c_exit(*cctxt);
}

Write Preview
Loading…
Cancel
Save