fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-07 07:04:57 +00:00
Code Issues Packages Projects Releases Wiki Activity

new context in CBIND

Browse Source
This commit is contained in:
Salvatore Filippone
2020-11-16 16:16:11 +01:00
parent 02b9ff5cfb
commit 5f67cc4bb5
6 changed files with 84 additions and 75 deletions
Download Patch File Download Diff File Expand all files Collapse all files
cbind/base/psb_base_tools_cbind_mod.F90
+13 -12
View File
@@ -23,18 +23,18 @@ contains
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)
function psb_c_cdall_vg(ng,vg,cctxt,cdh) bind(c,name='psb_c_cdall_vg') result(res)
implicit none
integer(psb_c_ipk_) :: res
integer(psb_c_lpk_), value :: ng
integer(psb_c_ipk_), value :: ictxt
integer(psb_c_ipk_), value :: cctxt
integer(psb_c_ipk_) :: vg(*)
type(psb_c_object_type) :: cdh
type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
res = -1
if (ng <=0) then
@@ -59,17 +59,17 @@ contains
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
integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: nl, ictxt
integer(psb_c_ipk_), value :: nl, cctxt
integer(psb_c_lpk_) :: vl(*)
type(psb_c_object_type) :: cdh
type(psb_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info, ixb
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
res = -1
if (nl <=0) then
@@ -99,16 +99,16 @@ contains
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
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_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
res = -1
if (nl <=0) then
@@ -132,17 +132,18 @@ contains
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
integer(psb_c_ipk_) :: res
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_desc_type), pointer :: descp
integer(psb_c_ipk_) :: info
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
res = -1
if (n <=0) then
cbind/base/psb_cpenv_mod.f90
+55 -47
View File
@@ -34,63 +34,62 @@ contains
use psb_base_mod, only : psb_init, psb_ctxt_type
implicit none
integer(psb_c_ipk_) :: psb_c_init
type(psb_ctxt_type) :: ictxt
integer(psb_c_ipk_) :: psb_c_init
type(psb_ctxt_type) :: ctxt
call psb_init(ictxt)
psb_c_init = ictxt%ctxt
call psb_init(ctxt)
psb_c_init = ctxt%ctxt
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
integer(psb_c_ipk_), value :: ictxt
integer(psb_c_ipk_), value :: cctxt
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
call psb_exit(ctxt,close=.false.)
return
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
integer(psb_c_ipk_), value :: ictxt
integer(psb_c_ipk_), value :: cctxt
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
call psb_exit(ctxt)
return
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
integer(psb_c_ipk_), value :: ictxt
integer(psb_c_ipk_), value :: cctxt
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
call psb_abort(ctxt)
return
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
integer(psb_c_ipk_), value :: ictxt
integer(psb_c_ipk_), value :: cctxt
integer(psb_c_ipk_) :: iam,np
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
call psb_info(ctxt,iam,np)
return
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
integer(psb_c_ipk_), value :: ictxt
integer(psb_c_ipk_), value :: cctxt
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
call psb_barrier(ctxt)
end subroutine psb_c_barrier
@@ -100,14 +99,14 @@ contains
psb_c_wtime = psb_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
implicit none
integer(psb_c_ipk_), value :: ictxt,n, root
integer(psb_c_ipk_), value :: cctxt, n, root
integer(psb_c_mpk_) :: v(*)
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
if (n < 0) then
write(0,*) 'Wrong size in BCAST'
@@ -118,14 +117,14 @@ contains
call psb_bcast(ctxt,v(1:n),root=root)
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
implicit none
integer(psb_c_ipk_), value :: ictxt,n, root
integer(psb_c_ipk_), value :: cctxt, n, root
integer(psb_c_ipk_) :: v(*)
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
if (n < 0) then
write(0,*) 'Wrong size in BCAST'
@@ -136,13 +135,13 @@ contains
call psb_bcast(ctxt,v(1:n),root=root)
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
implicit none
integer(psb_c_ipk_), value :: ictxt,n, root
integer(psb_c_ipk_), value :: cctxt, n, root
integer(psb_c_lpk_) :: v(*)
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
if (n < 0) then
write(0,*) 'Wrong size in BCAST'
@@ -153,13 +152,13 @@ contains
call psb_bcast(ctxt,v(1:n),root=root)
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
implicit none
integer(psb_c_ipk_), value :: ictxt,n, root
integer(psb_c_ipk_), value :: cctxt, n, root
integer(psb_c_epk_) :: v(*)
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
if (n < 0) then
write(0,*) 'Wrong size in BCAST'
@@ -170,13 +169,13 @@ contains
call psb_bcast(ctxt,v(1:n),root=root)
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
implicit none
integer(psb_c_ipk_), value :: ictxt,n, root
integer(psb_c_ipk_), value :: cctxt, n, root
real(c_float) :: v(*)
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
if (n < 0) then
write(0,*) 'Wrong size in BCAST'
@@ -187,13 +186,13 @@ contains
call psb_bcast(ctxt,v(1:n),root=root)
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
implicit none
integer(psb_c_ipk_), value :: ictxt,n, root
integer(psb_c_ipk_), value :: cctxt, n, root
real(c_double) :: v(*)
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
if (n < 0) then
write(0,*) 'Wrong size in BCAST'
@@ -205,13 +204,13 @@ contains
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
implicit none
integer(psb_c_ipk_), value :: ictxt,n, root
integer(psb_c_ipk_), value :: cctxt, n, root
complex(c_float_complex) :: v(*)
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
if (n < 0) then
write(0,*) 'Wrong size in BCAST'
@@ -222,13 +221,13 @@ contains
call psb_bcast(ctxt,v(1:n),root=root)
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
implicit none
integer(psb_c_ipk_), value :: ictxt,n, root
integer(psb_c_ipk_), value :: cctxt, n, root
complex(c_double_complex) :: v(*)
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
if (n < 0) then
write(0,*) 'Wrong size in BCAST'
@@ -239,14 +238,14 @@ contains
call psb_bcast(ctxt,v(1:n),root=root)
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
implicit none
integer(psb_c_ipk_), value :: ictxt, root
integer(psb_c_ipk_), value :: cctxt, root
character(c_char) :: v(*)
integer(psb_ipk_) :: iam, np, n
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
call psb_info(ctxt,iam,np)
@@ -291,6 +290,15 @@ contains
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
call psb_set_erraction(psb_act_ret_)
cbind/prec/psb_cprec_cbind_mod.f90
+4 -4
View File
@@ -12,14 +12,14 @@ module psb_cprec_cbind_mod
contains
function psb_c_cprecinit(ictxt,ph,ptype) bind(c) result(res)
function psb_c_cprecinit(cctxt,ph,ptype) bind(c) result(res)
use psb_base_mod
use psb_prec_mod
use psb_cpenv_mod
use psb_base_string_cbind_mod
implicit none
integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: ictxt
integer(psb_c_ipk_), value :: cctxt
type(psb_c_cprec) :: ph
character(c_char) :: ptype(*)
@@ -27,7 +27,7 @@ contains
integer(psb_c_ipk_) :: info
character(len=80) :: fptype
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
res = -1
if (c_associated(ph%item)) then
cbind/prec/psb_dprec_cbind_mod.f90
+4 -4
View File
@@ -12,14 +12,14 @@ module psb_dprec_cbind_mod
contains
function psb_c_dprecinit(ictxt,ph,ptype) bind(c) result(res)
function psb_c_dprecinit(cctxt,ph,ptype) bind(c) result(res)
use psb_base_mod
use psb_prec_mod
use psb_cpenv_mod
use psb_base_string_cbind_mod
implicit none
integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: ictxt
integer(psb_c_ipk_), value :: cctxt
type(psb_c_dprec) :: ph
character(c_char) :: ptype(*)
@@ -27,7 +27,7 @@ contains
integer(psb_c_ipk_) :: info
character(len=80) :: fptype
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
res = -1
if (c_associated(ph%item)) then
cbind/prec/psb_sprec_cbind_mod.f90
+4 -4
View File
@@ -12,14 +12,14 @@ module psb_sprec_cbind_mod
contains
function psb_c_sprecinit(ictxt,ph,ptype) bind(c) result(res)
function psb_c_sprecinit(cctxt,ph,ptype) bind(c) result(res)
use psb_base_mod
use psb_prec_mod
use psb_cpenv_mod
use psb_base_string_cbind_mod
implicit none
integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: ictxt
integer(psb_c_ipk_), value :: cctxt
type(psb_c_sprec) :: ph
character(c_char) :: ptype(*)
@@ -27,7 +27,7 @@ contains
integer(psb_c_ipk_) :: info
character(len=80) :: fptype
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
res = -1
if (c_associated(ph%item)) then
cbind/prec/psb_zprec_cbind_mod.f90
+4 -4
View File
@@ -12,14 +12,14 @@ module psb_zprec_cbind_mod
contains
function psb_c_zprecinit(ictxt,ph,ptype) bind(c) result(res)
function psb_c_zprecinit(cctxt,ph,ptype) bind(c) result(res)
use psb_base_mod
use psb_prec_mod
use psb_cpenv_mod
use psb_base_string_cbind_mod
implicit none
integer(psb_c_ipk_) :: res
integer(psb_c_ipk_), value :: ictxt
integer(psb_c_ipk_), value :: cctxt
type(psb_c_zprec) :: ph
character(c_char) :: ptype(*)
@@ -27,7 +27,7 @@ contains
integer(psb_c_ipk_) :: info
character(len=80) :: fptype
type(psb_ctxt_type) :: ctxt
ctxt%ctxt = ictxt
ctxt = psb_c2f_ctxt(cctxt)
res = -1
if (c_associated(ph%item)) then