mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-06 22:55:08 +00:00
Fixes for IPK8
This commit is contained in:
sfilippone
@@ -70,12 +70,13 @@ contains
|
||||
integer(psb_c_ipk_) :: info
|
||||
|
||||
! Local variables
|
||||
integer(psb_c_mpk_) :: mctxt
|
||||
type(psb_ctxt_type), pointer :: ctxt
|
||||
|
||||
ctxt => psb_c2f_ctxt(cctxt)
|
||||
|
||||
call ctxt%get_i_ctxt(ictxt,info)
|
||||
|
||||
call ctxt%get_i_ctxt(mctxt,info)
|
||||
ictxt = mctxt
|
||||
end subroutine
|
||||
|
||||
function psb_c_cmp_ctxt(cctxt1, cctxt2) bind(c,name="psb_c_cmp_ctxt") result(res)
|
||||
@@ -177,6 +178,7 @@ contains
|
||||
type(psb_c_object_type), value :: cctxt
|
||||
integer(psb_c_ipk_), value :: n, root
|
||||
integer(psb_c_mpk_) :: v(*)
|
||||
integer(psb_c_mpk_) :: mroot
|
||||
|
||||
type(psb_ctxt_type), pointer :: ctxt
|
||||
ctxt => psb_c2f_ctxt(cctxt)
|
||||
@@ -186,8 +188,9 @@ contains
|
||||
return
|
||||
end if
|
||||
if (n==0) return
|
||||
mroot=root
|
||||
|
||||
call psb_bcast(ctxt,v(1:n),root=root)
|
||||
call psb_bcast(ctxt,v(1:n),root=mroot)
|
||||
end subroutine psb_c_mbcast
|
||||
|
||||
subroutine psb_c_ibcast(cctxt,n,v,root) bind(c)
|
||||
@@ -197,6 +200,7 @@ contains
|
||||
integer(psb_c_ipk_), value :: n, root
|
||||
integer(psb_c_ipk_) :: v(*)
|
||||
type(psb_ctxt_type), pointer :: ctxt
|
||||
integer(psb_c_mpk_) :: mroot
|
||||
|
||||
ctxt => psb_c2f_ctxt(cctxt)
|
||||
|
||||
@@ -205,8 +209,9 @@ contains
|
||||
return
|
||||
end if
|
||||
if (n==0) return
|
||||
mroot=root
|
||||
|
||||
call psb_bcast(ctxt,v(1:n),root=root)
|
||||
call psb_bcast(ctxt,v(1:n),root=mroot)
|
||||
end subroutine psb_c_ibcast
|
||||
|
||||
subroutine psb_c_lbcast(cctxt,n,v,root) bind(c)
|
||||
@@ -216,6 +221,7 @@ contains
|
||||
integer(psb_c_ipk_), value :: n, root
|
||||
integer(psb_c_lpk_) :: v(*)
|
||||
type(psb_ctxt_type), pointer :: ctxt
|
||||
integer(psb_c_mpk_) :: mroot
|
||||
ctxt => psb_c2f_ctxt(cctxt)
|
||||
|
||||
if (n < 0) then
|
||||
@@ -223,8 +229,9 @@ contains
|
||||
return
|
||||
end if
|
||||
if (n==0) return
|
||||
mroot=root
|
||||
|
||||
call psb_bcast(ctxt,v(1:n),root=root)
|
||||
call psb_bcast(ctxt,v(1:n),root=mroot)
|
||||
end subroutine psb_c_lbcast
|
||||
|
||||
subroutine psb_c_ebcast(cctxt,n,v,root) bind(c)
|
||||
@@ -234,6 +241,7 @@ contains
|
||||
integer(psb_c_ipk_), value :: n, root
|
||||
integer(psb_c_epk_) :: v(*)
|
||||
type(psb_ctxt_type), pointer :: ctxt
|
||||
integer(psb_c_mpk_) :: mroot
|
||||
ctxt => psb_c2f_ctxt(cctxt)
|
||||
|
||||
if (n < 0) then
|
||||
@@ -241,8 +249,9 @@ contains
|
||||
return
|
||||
end if
|
||||
if (n==0) return
|
||||
mroot=root
|
||||
|
||||
call psb_bcast(ctxt,v(1:n),root=root)
|
||||
call psb_bcast(ctxt,v(1:n),root=mroot)
|
||||
end subroutine psb_c_ebcast
|
||||
|
||||
subroutine psb_c_sbcast(cctxt,n,v,root) bind(c)
|
||||
@@ -252,6 +261,7 @@ contains
|
||||
integer(psb_c_ipk_), value :: n, root
|
||||
real(c_float) :: v(*)
|
||||
type(psb_ctxt_type), pointer :: ctxt
|
||||
integer(psb_c_mpk_) :: mroot
|
||||
ctxt => psb_c2f_ctxt(cctxt)
|
||||
|
||||
if (n < 0) then
|
||||
@@ -259,8 +269,9 @@ contains
|
||||
return
|
||||
end if
|
||||
if (n==0) return
|
||||
mroot=root
|
||||
|
||||
call psb_bcast(ctxt,v(1:n),root=root)
|
||||
call psb_bcast(ctxt,v(1:n),root=mroot)
|
||||
end subroutine psb_c_sbcast
|
||||
|
||||
subroutine psb_c_dbcast(cctxt,n,v,root) bind(c)
|
||||
@@ -270,6 +281,7 @@ contains
|
||||
integer(psb_c_ipk_), value :: n, root
|
||||
real(c_double) :: v(*)
|
||||
type(psb_ctxt_type), pointer :: ctxt
|
||||
integer(psb_c_mpk_) :: mroot
|
||||
ctxt => psb_c2f_ctxt(cctxt)
|
||||
|
||||
if (n < 0) then
|
||||
@@ -277,8 +289,9 @@ contains
|
||||
return
|
||||
end if
|
||||
if (n==0) return
|
||||
mroot=root
|
||||
|
||||
call psb_bcast(ctxt,v(1:n),root=root)
|
||||
call psb_bcast(ctxt,v(1:n),root=mroot)
|
||||
end subroutine psb_c_dbcast
|
||||
|
||||
|
||||
@@ -289,6 +302,7 @@ contains
|
||||
integer(psb_c_ipk_), value :: n, root
|
||||
complex(c_float_complex) :: v(*)
|
||||
type(psb_ctxt_type), pointer :: ctxt
|
||||
integer(psb_c_mpk_) :: mroot
|
||||
ctxt => psb_c2f_ctxt(cctxt)
|
||||
|
||||
if (n < 0) then
|
||||
@@ -296,8 +310,9 @@ contains
|
||||
return
|
||||
end if
|
||||
if (n==0) return
|
||||
mroot=root
|
||||
|
||||
call psb_bcast(ctxt,v(1:n),root=root)
|
||||
call psb_bcast(ctxt,v(1:n),root=mroot)
|
||||
end subroutine psb_c_cbcast
|
||||
|
||||
subroutine psb_c_zbcast(cctxt,n,v,root) bind(c)
|
||||
@@ -307,6 +322,7 @@ contains
|
||||
integer(psb_c_ipk_), value :: n, root
|
||||
complex(c_double_complex) :: v(*)
|
||||
type(psb_ctxt_type), pointer :: ctxt
|
||||
integer(psb_c_mpk_) :: mroot
|
||||
ctxt => psb_c2f_ctxt(cctxt)
|
||||
|
||||
if (n < 0) then
|
||||
@@ -314,8 +330,9 @@ contains
|
||||
return
|
||||
end if
|
||||
if (n==0) return
|
||||
mroot=root
|
||||
|
||||
call psb_bcast(ctxt,v(1:n),root=root)
|
||||
call psb_bcast(ctxt,v(1:n),root=mroot)
|
||||
end subroutine psb_c_zbcast
|
||||
|
||||
subroutine psb_c_hbcast(cctxt,v,root) bind(c)
|
||||
@@ -326,6 +343,7 @@ contains
|
||||
character(c_char) :: v(*)
|
||||
integer(psb_ipk_) :: iam, np, n
|
||||
type(psb_ctxt_type), pointer :: ctxt
|
||||
integer(psb_c_mpk_) :: mroot
|
||||
ctxt => psb_c2f_ctxt(cctxt)
|
||||
|
||||
call psb_info(ctxt,iam,np)
|
||||
@@ -337,8 +355,9 @@ contains
|
||||
n = n + 1
|
||||
end do
|
||||
end if
|
||||
call psb_bcast(ctxt,n,root=root)
|
||||
call psb_bcast(ctxt,v(1:n),root=root)
|
||||
mroot=root
|
||||
call psb_bcast(ctxt,n,root=mroot)
|
||||
call psb_bcast(ctxt,v(1:n),root=mroot)
|
||||
end subroutine psb_c_hbcast
|
||||
|
||||
function psb_c_f2c_errmsg(cmesg,len) bind(c) result(res)
|
||||
|
||||
@@ -18,11 +18,12 @@ contains
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: idx
|
||||
integer(psb_c_ipk_), value :: modes, base
|
||||
integer(psb_c_ipk_), value :: modes
|
||||
integer(psb_c_mpk_), value :: base
|
||||
integer(psb_c_ipk_) :: ijk(modes)
|
||||
integer(psb_c_ipk_) :: sizes(modes)
|
||||
|
||||
integer(psb_ipk_) :: fijk(modes), fsizes(modes)
|
||||
integer(psb_mpk_) :: fijk(modes), fsizes(modes)
|
||||
|
||||
fijk(1:modes) = ijk(1:modes)
|
||||
fsizes(1:modes) = sizes(1:modes)
|
||||
@@ -37,11 +38,12 @@ contains
|
||||
implicit none
|
||||
|
||||
integer(psb_c_lpk_) :: idx
|
||||
integer(psb_c_ipk_), value :: modes, base
|
||||
integer(psb_c_ipk_), value :: modes
|
||||
integer(psb_c_mpk_), value :: base
|
||||
integer(psb_c_ipk_) :: ijk(modes)
|
||||
integer(psb_c_ipk_) :: sizes(modes)
|
||||
|
||||
integer(psb_ipk_) :: fijk(modes), fsizes(modes)
|
||||
integer(psb_mpk_) :: fijk(modes), fsizes(modes)
|
||||
|
||||
fijk(1:modes) = ijk(1:modes)
|
||||
fsizes(1:modes) = sizes(1:modes)
|
||||
@@ -56,15 +58,17 @@ contains
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
integer(psb_c_ipk_), value :: idx
|
||||
integer(psb_c_ipk_), value :: modes, base
|
||||
integer(psb_c_ipk_), value :: modes
|
||||
integer(psb_c_mpk_), value :: base
|
||||
integer(psb_c_ipk_) :: ijk(modes)
|
||||
integer(psb_c_ipk_) :: sizes(modes)
|
||||
|
||||
integer(psb_ipk_) :: fijk(modes), fsizes(modes)
|
||||
integer(psb_mpk_) :: fijk(modes), fsizes(modes)
|
||||
|
||||
res = -1
|
||||
|
||||
fsizes(1:modes) = sizes(1:modes)
|
||||
|
||||
call idx2ijk(fijk,idx,fsizes,base=base)
|
||||
|
||||
ijk(1:modes) = fijk(1:modes)
|
||||
@@ -79,11 +83,12 @@ contains
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
integer(psb_c_lpk_), value :: idx
|
||||
integer(psb_c_ipk_), value :: modes, base
|
||||
integer(psb_c_ipk_), value :: modes
|
||||
integer(psb_c_mpk_), value :: base
|
||||
integer(psb_c_ipk_) :: ijk(modes)
|
||||
integer(psb_c_ipk_) :: sizes(modes)
|
||||
|
||||
integer(psb_ipk_) :: fijk(modes), fsizes(modes)
|
||||
integer(psb_mpk_) :: fijk(modes), fsizes(modes)
|
||||
|
||||
res = -1
|
||||
|
||||
|
||||
Reference in New Issue
Block a user