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

new context in CBIND

Browse Source
new-context
Salvatore Filippone 4 years ago
parent 02b9ff5cfb
commit 5f67cc4bb5
6 changed files with 84 additions and 75 deletions
Show Stats Download Patch File Download Diff File

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

@ -23,18 +23,18 @@ contains
call psb_clean_errstack() call psb_clean_errstack()
end function psb_c_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) function psb_c_cdall_vg(ng,vg,cctxt,cdh) bind(c,name='psb_c_cdall_vg') result(res)
implicit none implicit none
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res
integer(psb_c_lpk_), value :: ng integer(psb_c_lpk_), value :: ng
integer(psb_c_ipk_), value :: ictxt integer(psb_c_ipk_), value :: cctxt
integer(psb_c_ipk_) :: vg(*) integer(psb_c_ipk_) :: vg(*)
type(psb_c_object_type) :: cdh type(psb_c_object_type) :: cdh
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info integer(psb_c_ipk_) :: info
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
res = -1 res = -1
if (ng <=0) then if (ng <=0) then
@ -59,17 +59,17 @@ contains
end function psb_c_cdall_vg end function psb_c_cdall_vg
function psb_c_cdall_vl(nl,vl,ictxt,cdh) bind(c,name='psb_c_cdall_vl') result(res) function psb_c_cdall_vl(nl,vl,cctxt,cdh) bind(c,name='psb_c_cdall_vl') result(res)
implicit none implicit none
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: nl, ictxt integer(psb_c_ipk_), value :: nl, cctxt
integer(psb_c_lpk_) :: vl(*) integer(psb_c_lpk_) :: vl(*)
type(psb_c_object_type) :: cdh type(psb_c_object_type) :: cdh
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info, ixb integer(psb_c_ipk_) :: info, ixb
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
res = -1 res = -1
if (nl <=0) then if (nl <=0) then
@ -99,16 +99,16 @@ contains
end function psb_c_cdall_vl end function psb_c_cdall_vl
function psb_c_cdall_nl(nl,ictxt,cdh) bind(c,name='psb_c_cdall_nl') result(res) function psb_c_cdall_nl(nl,cctxt,cdh) bind(c,name='psb_c_cdall_nl') result(res)
implicit none implicit none
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: nl, ictxt integer(psb_c_ipk_), value :: nl, cctxt
type(psb_c_object_type) :: cdh type(psb_c_object_type) :: cdh
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info integer(psb_c_ipk_) :: info
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
res = -1 res = -1
if (nl <=0) then if (nl <=0) then
@ -132,17 +132,18 @@ contains
end function psb_c_cdall_nl end function psb_c_cdall_nl
function psb_c_cdall_repl(n,ictxt,cdh) bind(c,name='psb_c_cdall_repl') result(res) function psb_c_cdall_repl(n,cctxt,cdh) bind(c,name='psb_c_cdall_repl') result(res)
implicit none implicit none
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res
integer(psb_c_lpk_), value :: n integer(psb_c_lpk_), value :: n
integer(psb_c_ipk_), value :: ictxt integer(psb_c_ipk_), value :: cctxt
type(psb_c_object_type) :: cdh type(psb_c_object_type) :: cdh
type(psb_desc_type), pointer :: descp type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info integer(psb_c_ipk_) :: info
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
res = -1 res = -1
if (n <=0) then if (n <=0) then

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

@ -35,62 +35,61 @@ contains
implicit none implicit none
integer(psb_c_ipk_) :: psb_c_init integer(psb_c_ipk_) :: psb_c_init
type(psb_ctxt_type) :: ctxt
type(psb_ctxt_type) :: ictxt call psb_init(ctxt)
psb_c_init = ctxt%ctxt
call psb_init(ictxt)
psb_c_init = ictxt%ctxt
end function psb_c_init end function psb_c_init
subroutine psb_c_exit_ctxt(ictxt) bind(c) subroutine psb_c_exit_ctxt(cctxt) bind(c)
use psb_base_mod, only : psb_exit, psb_ctxt_type use psb_base_mod, only : psb_exit, psb_ctxt_type
integer(psb_c_ipk_), value :: ictxt integer(psb_c_ipk_), value :: cctxt
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
call psb_exit(ctxt,close=.false.) call psb_exit(ctxt,close=.false.)
return return
end subroutine psb_c_exit_ctxt end subroutine psb_c_exit_ctxt
subroutine psb_c_exit(ictxt) bind(c) subroutine psb_c_exit(cctxt) bind(c)
use psb_base_mod, only : psb_exit, psb_ctxt_type use psb_base_mod, only : psb_exit, psb_ctxt_type
integer(psb_c_ipk_), value :: ictxt integer(psb_c_ipk_), value :: cctxt
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
call psb_exit(ctxt) call psb_exit(ctxt)
return return
end subroutine psb_c_exit end subroutine psb_c_exit
subroutine psb_c_abort(ictxt) bind(c) subroutine psb_c_abort(cctxt) bind(c)
use psb_base_mod, only : psb_abort, psb_ctxt_type use psb_base_mod, only : psb_abort, psb_ctxt_type
integer(psb_c_ipk_), value :: ictxt integer(psb_c_ipk_), value :: cctxt
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
call psb_abort(ctxt) call psb_abort(ctxt)
return return
end subroutine psb_c_abort end subroutine psb_c_abort
subroutine psb_c_info(ictxt,iam,np) bind(c) subroutine psb_c_info(cctxt,iam,np) bind(c)
use psb_base_mod, only : psb_info, psb_ctxt_type use psb_base_mod, only : psb_info, psb_ctxt_type
integer(psb_c_ipk_), value :: ictxt integer(psb_c_ipk_), value :: cctxt
integer(psb_c_ipk_) :: iam,np integer(psb_c_ipk_) :: iam,np
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
return return
end subroutine psb_c_info end subroutine psb_c_info
subroutine psb_c_barrier(ictxt) bind(c) subroutine psb_c_barrier(cctxt) bind(c)
use psb_base_mod, only : psb_barrier, psb_ctxt_type use psb_base_mod, only : psb_barrier, psb_ctxt_type
integer(psb_c_ipk_), value :: ictxt integer(psb_c_ipk_), value :: cctxt
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
call psb_barrier(ctxt) call psb_barrier(ctxt)
end subroutine psb_c_barrier end subroutine psb_c_barrier
@ -100,14 +99,14 @@ contains
psb_c_wtime = psb_wtime() psb_c_wtime = psb_wtime()
end function psb_c_wtime end function psb_c_wtime
subroutine psb_c_mbcast(ictxt,n,v,root) bind(c) subroutine psb_c_mbcast(cctxt,n,v,root) bind(c)
use psb_base_mod, only : psb_bcast, psb_ctxt_type use psb_base_mod, only : psb_bcast, psb_ctxt_type
implicit none implicit none
integer(psb_c_ipk_), value :: ictxt,n, root integer(psb_c_ipk_), value :: cctxt, n, root
integer(psb_c_mpk_) :: v(*) integer(psb_c_mpk_) :: v(*)
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
if (n < 0) then if (n < 0) then
write(0,*) 'Wrong size in BCAST' write(0,*) 'Wrong size in BCAST'
@ -118,14 +117,14 @@ contains
call psb_bcast(ctxt,v(1:n),root=root) call psb_bcast(ctxt,v(1:n),root=root)
end subroutine psb_c_mbcast end subroutine psb_c_mbcast
subroutine psb_c_ibcast(ictxt,n,v,root) bind(c) subroutine psb_c_ibcast(cctxt,n,v,root) bind(c)
use psb_base_mod, only : psb_bcast, psb_ctxt_type use psb_base_mod, only : psb_bcast, psb_ctxt_type
implicit none implicit none
integer(psb_c_ipk_), value :: ictxt,n, root integer(psb_c_ipk_), value :: cctxt, n, root
integer(psb_c_ipk_) :: v(*) integer(psb_c_ipk_) :: v(*)
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
if (n < 0) then if (n < 0) then
write(0,*) 'Wrong size in BCAST' write(0,*) 'Wrong size in BCAST'
@ -136,13 +135,13 @@ contains
call psb_bcast(ctxt,v(1:n),root=root) call psb_bcast(ctxt,v(1:n),root=root)
end subroutine psb_c_ibcast end subroutine psb_c_ibcast
subroutine psb_c_lbcast(ictxt,n,v,root) bind(c) subroutine psb_c_lbcast(cctxt,n,v,root) bind(c)
use psb_base_mod, only : psb_bcast, psb_ctxt_type use psb_base_mod, only : psb_bcast, psb_ctxt_type
implicit none implicit none
integer(psb_c_ipk_), value :: ictxt,n, root integer(psb_c_ipk_), value :: cctxt, n, root
integer(psb_c_lpk_) :: v(*) integer(psb_c_lpk_) :: v(*)
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
if (n < 0) then if (n < 0) then
write(0,*) 'Wrong size in BCAST' write(0,*) 'Wrong size in BCAST'
@ -153,13 +152,13 @@ contains
call psb_bcast(ctxt,v(1:n),root=root) call psb_bcast(ctxt,v(1:n),root=root)
end subroutine psb_c_lbcast end subroutine psb_c_lbcast
subroutine psb_c_ebcast(ictxt,n,v,root) bind(c) subroutine psb_c_ebcast(cctxt,n,v,root) bind(c)
use psb_base_mod, only : psb_bcast, psb_ctxt_type use psb_base_mod, only : psb_bcast, psb_ctxt_type
implicit none implicit none
integer(psb_c_ipk_), value :: ictxt,n, root integer(psb_c_ipk_), value :: cctxt, n, root
integer(psb_c_epk_) :: v(*) integer(psb_c_epk_) :: v(*)
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
if (n < 0) then if (n < 0) then
write(0,*) 'Wrong size in BCAST' write(0,*) 'Wrong size in BCAST'
@ -170,13 +169,13 @@ contains
call psb_bcast(ctxt,v(1:n),root=root) call psb_bcast(ctxt,v(1:n),root=root)
end subroutine psb_c_ebcast end subroutine psb_c_ebcast
subroutine psb_c_sbcast(ictxt,n,v,root) bind(c) subroutine psb_c_sbcast(cctxt,n,v,root) bind(c)
use psb_base_mod use psb_base_mod
implicit none implicit none
integer(psb_c_ipk_), value :: ictxt,n, root integer(psb_c_ipk_), value :: cctxt, n, root
real(c_float) :: v(*) real(c_float) :: v(*)
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
if (n < 0) then if (n < 0) then
write(0,*) 'Wrong size in BCAST' write(0,*) 'Wrong size in BCAST'
@ -187,13 +186,13 @@ contains
call psb_bcast(ctxt,v(1:n),root=root) call psb_bcast(ctxt,v(1:n),root=root)
end subroutine psb_c_sbcast end subroutine psb_c_sbcast
subroutine psb_c_dbcast(ictxt,n,v,root) bind(c) subroutine psb_c_dbcast(cctxt,n,v,root) bind(c)
use psb_base_mod, only : psb_bcast, psb_ctxt_type use psb_base_mod, only : psb_bcast, psb_ctxt_type
implicit none implicit none
integer(psb_c_ipk_), value :: ictxt,n, root integer(psb_c_ipk_), value :: cctxt, n, root
real(c_double) :: v(*) real(c_double) :: v(*)
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
if (n < 0) then if (n < 0) then
write(0,*) 'Wrong size in BCAST' write(0,*) 'Wrong size in BCAST'
@ -205,13 +204,13 @@ contains
end subroutine psb_c_dbcast end subroutine psb_c_dbcast
subroutine psb_c_cbcast(ictxt,n,v,root) bind(c) subroutine psb_c_cbcast(cctxt,n,v,root) bind(c)
use psb_base_mod, only : psb_bcast, psb_ctxt_type use psb_base_mod, only : psb_bcast, psb_ctxt_type
implicit none implicit none
integer(psb_c_ipk_), value :: ictxt,n, root integer(psb_c_ipk_), value :: cctxt, n, root
complex(c_float_complex) :: v(*) complex(c_float_complex) :: v(*)
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
if (n < 0) then if (n < 0) then
write(0,*) 'Wrong size in BCAST' write(0,*) 'Wrong size in BCAST'
@ -222,13 +221,13 @@ contains
call psb_bcast(ctxt,v(1:n),root=root) call psb_bcast(ctxt,v(1:n),root=root)
end subroutine psb_c_cbcast end subroutine psb_c_cbcast
subroutine psb_c_zbcast(ictxt,n,v,root) bind(c) subroutine psb_c_zbcast(cctxt,n,v,root) bind(c)
use psb_base_mod use psb_base_mod
implicit none implicit none
integer(psb_c_ipk_), value :: ictxt,n, root integer(psb_c_ipk_), value :: cctxt, n, root
complex(c_double_complex) :: v(*) complex(c_double_complex) :: v(*)
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
if (n < 0) then if (n < 0) then
write(0,*) 'Wrong size in BCAST' write(0,*) 'Wrong size in BCAST'
@ -239,14 +238,14 @@ contains
call psb_bcast(ctxt,v(1:n),root=root) call psb_bcast(ctxt,v(1:n),root=root)
end subroutine psb_c_zbcast end subroutine psb_c_zbcast
subroutine psb_c_hbcast(ictxt,v,root) bind(c) subroutine psb_c_hbcast(cctxt,v,root) bind(c)
use psb_base_mod, only : psb_bcast, psb_info, psb_ipk_, psb_ctxt_type use psb_base_mod, only : psb_bcast, psb_info, psb_ipk_, psb_ctxt_type
implicit none implicit none
integer(psb_c_ipk_), value :: ictxt, root integer(psb_c_ipk_), value :: cctxt, root
character(c_char) :: v(*) character(c_char) :: v(*)
integer(psb_ipk_) :: iam, np, n integer(psb_ipk_) :: iam, np, n
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
call psb_info(ctxt,iam,np) call psb_info(ctxt,iam,np)
@ -291,6 +290,15 @@ contains
cmesg(ll) = c_null_char cmesg(ll) = c_null_char
end function psb_c_f2c_errmsg 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) subroutine psb_c_seterraction_ret() bind(c)
use psb_base_mod, only : psb_set_erraction, psb_act_ret_, psb_ctxt_type use psb_base_mod, only : psb_set_erraction, psb_act_ret_, psb_ctxt_type
call psb_set_erraction(psb_act_ret_) call psb_set_erraction(psb_act_ret_)

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

@ -12,14 +12,14 @@ module psb_cprec_cbind_mod
contains contains
function psb_c_cprecinit(cctxt,ph,ptype) bind(c) result(res)
function psb_c_cprecinit(ictxt,ph,ptype) bind(c) result(res)
use psb_base_mod use psb_base_mod
use psb_prec_mod use psb_prec_mod
use psb_cpenv_mod
use psb_base_string_cbind_mod use psb_base_string_cbind_mod
implicit none implicit none
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: ictxt integer(psb_c_ipk_), value :: cctxt
type(psb_c_cprec) :: ph type(psb_c_cprec) :: ph
character(c_char) :: ptype(*) character(c_char) :: ptype(*)
@ -27,7 +27,7 @@ contains
integer(psb_c_ipk_) :: info integer(psb_c_ipk_) :: info
character(len=80) :: fptype character(len=80) :: fptype
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
res = -1 res = -1
if (c_associated(ph%item)) then if (c_associated(ph%item)) then

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

@ -12,14 +12,14 @@ module psb_dprec_cbind_mod
contains contains
function psb_c_dprecinit(cctxt,ph,ptype) bind(c) result(res)
function psb_c_dprecinit(ictxt,ph,ptype) bind(c) result(res)
use psb_base_mod use psb_base_mod
use psb_prec_mod use psb_prec_mod
use psb_cpenv_mod
use psb_base_string_cbind_mod use psb_base_string_cbind_mod
implicit none implicit none
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: ictxt integer(psb_c_ipk_), value :: cctxt
type(psb_c_dprec) :: ph type(psb_c_dprec) :: ph
character(c_char) :: ptype(*) character(c_char) :: ptype(*)
@ -27,7 +27,7 @@ contains
integer(psb_c_ipk_) :: info integer(psb_c_ipk_) :: info
character(len=80) :: fptype character(len=80) :: fptype
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
res = -1 res = -1
if (c_associated(ph%item)) then if (c_associated(ph%item)) then

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

@ -12,14 +12,14 @@ module psb_sprec_cbind_mod
contains contains
function psb_c_sprecinit(cctxt,ph,ptype) bind(c) result(res)
function psb_c_sprecinit(ictxt,ph,ptype) bind(c) result(res)
use psb_base_mod use psb_base_mod
use psb_prec_mod use psb_prec_mod
use psb_cpenv_mod
use psb_base_string_cbind_mod use psb_base_string_cbind_mod
implicit none implicit none
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: ictxt integer(psb_c_ipk_), value :: cctxt
type(psb_c_sprec) :: ph type(psb_c_sprec) :: ph
character(c_char) :: ptype(*) character(c_char) :: ptype(*)
@ -27,7 +27,7 @@ contains
integer(psb_c_ipk_) :: info integer(psb_c_ipk_) :: info
character(len=80) :: fptype character(len=80) :: fptype
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
res = -1 res = -1
if (c_associated(ph%item)) then if (c_associated(ph%item)) then

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

@ -12,14 +12,14 @@ module psb_zprec_cbind_mod
contains contains
function psb_c_zprecinit(cctxt,ph,ptype) bind(c) result(res)
function psb_c_zprecinit(ictxt,ph,ptype) bind(c) result(res)
use psb_base_mod use psb_base_mod
use psb_prec_mod use psb_prec_mod
use psb_cpenv_mod
use psb_base_string_cbind_mod use psb_base_string_cbind_mod
implicit none implicit none
integer(psb_c_ipk_) :: res integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: ictxt integer(psb_c_ipk_), value :: cctxt
type(psb_c_zprec) :: ph type(psb_c_zprec) :: ph
character(c_char) :: ptype(*) character(c_char) :: ptype(*)
@ -27,7 +27,7 @@ contains
integer(psb_c_ipk_) :: info integer(psb_c_ipk_) :: info
character(len=80) :: fptype character(len=80) :: fptype
type(psb_ctxt_type) :: ctxt type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt ctxt = psb_c2f_ctxt(cctxt)
res = -1 res = -1
if (c_associated(ph%item)) then if (c_associated(ph%item)) then

Write Preview
Loading…
Cancel
Save