|
|
|
@ -43,6 +43,302 @@ contains
|
|
|
|
|
|
|
|
|
|
end function psb_c_dgeaxpby
|
|
|
|
|
|
|
|
|
|
function psb_c_dgemlt(xh,yh,cdh) bind(c) result(res)
|
|
|
|
|
implicit none
|
|
|
|
|
integer(psb_c_ipk_) :: 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(psb_c_ipk_) :: 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_gemlt(xp,yp,descp,info)
|
|
|
|
|
|
|
|
|
|
res = info
|
|
|
|
|
|
|
|
|
|
end function psb_c_dgemlt
|
|
|
|
|
|
|
|
|
|
function psb_c_dgediv(xh,yh,cdh) bind(c) result(res)
|
|
|
|
|
implicit none
|
|
|
|
|
integer(psb_c_ipk_) :: 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(psb_c_ipk_) :: 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_gediv(xp,yp,descp,info)
|
|
|
|
|
|
|
|
|
|
res = info
|
|
|
|
|
|
|
|
|
|
end function psb_c_dgediv
|
|
|
|
|
|
|
|
|
|
function psb_c_dgediv_check(xh,yh,cdh, flag) bind(c) result(res)
|
|
|
|
|
implicit none
|
|
|
|
|
integer(psb_c_ipk_) :: res
|
|
|
|
|
|
|
|
|
|
type(psb_c_dvector) :: xh,yh
|
|
|
|
|
type(psb_c_descriptor) :: cdh
|
|
|
|
|
logical(c_bool), value :: flag
|
|
|
|
|
|
|
|
|
|
type(psb_desc_type), pointer :: descp
|
|
|
|
|
type(psb_d_vect_type), pointer :: xp,yp
|
|
|
|
|
integer(psb_c_ipk_) :: info
|
|
|
|
|
logical :: fflag
|
|
|
|
|
|
|
|
|
|
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
|
|
|
|
|
|
|
|
|
|
fflag = flag
|
|
|
|
|
call psb_gediv(xp,yp,descp,info,fflag)
|
|
|
|
|
|
|
|
|
|
res = info
|
|
|
|
|
|
|
|
|
|
end function psb_c_dgediv_check
|
|
|
|
|
|
|
|
|
|
function psb_c_dgeinv(xh,yh,cdh) bind(c) result(res)
|
|
|
|
|
implicit none
|
|
|
|
|
integer(psb_c_ipk_) :: 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(psb_c_ipk_) :: 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_geinv(xp,yp,descp,info)
|
|
|
|
|
|
|
|
|
|
res = info
|
|
|
|
|
|
|
|
|
|
end function psb_c_dgeinv
|
|
|
|
|
|
|
|
|
|
function psb_c_dgeinv_check(xh,yh,cdh, flag) bind(c) result(res)
|
|
|
|
|
implicit none
|
|
|
|
|
integer(psb_c_ipk_) :: res
|
|
|
|
|
|
|
|
|
|
type(psb_c_dvector) :: xh,yh
|
|
|
|
|
type(psb_c_descriptor) :: cdh
|
|
|
|
|
logical(c_bool), value :: flag
|
|
|
|
|
|
|
|
|
|
type(psb_desc_type), pointer :: descp
|
|
|
|
|
type(psb_d_vect_type), pointer :: xp,yp
|
|
|
|
|
integer(psb_c_ipk_) :: info
|
|
|
|
|
logical :: fflag
|
|
|
|
|
|
|
|
|
|
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
|
|
|
|
|
|
|
|
|
|
fflag = flag
|
|
|
|
|
call psb_geinv(xp,yp,descp,info,fflag)
|
|
|
|
|
|
|
|
|
|
res = info
|
|
|
|
|
|
|
|
|
|
end function psb_c_dgeinv_check
|
|
|
|
|
|
|
|
|
|
function psb_c_dgeabs(xh,yh,cdh) bind(c) result(res)
|
|
|
|
|
implicit none
|
|
|
|
|
integer(psb_c_ipk_) :: 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(psb_c_ipk_) :: 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_geabs(xp,yp,descp,info)
|
|
|
|
|
|
|
|
|
|
res = info
|
|
|
|
|
|
|
|
|
|
end function psb_c_dgeabs
|
|
|
|
|
|
|
|
|
|
function psb_c_dgecmp(xh,ch,zh,cdh) bind(c) result(res)
|
|
|
|
|
implicit none
|
|
|
|
|
integer(psb_c_ipk_) :: res
|
|
|
|
|
|
|
|
|
|
type(psb_c_dvector) :: xh,zh
|
|
|
|
|
type(psb_c_descriptor) :: cdh
|
|
|
|
|
|
|
|
|
|
type(psb_desc_type), pointer :: descp
|
|
|
|
|
type(psb_d_vect_type), pointer :: xp,zp
|
|
|
|
|
integer(psb_c_ipk_) :: info
|
|
|
|
|
real(c_double) :: ch
|
|
|
|
|
|
|
|
|
|
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(zh%item)) then
|
|
|
|
|
call c_f_pointer(zh%item,zp)
|
|
|
|
|
else
|
|
|
|
|
return
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
call psb_gecmp(xp,ch,zp,descp,info)
|
|
|
|
|
|
|
|
|
|
res = info
|
|
|
|
|
|
|
|
|
|
end function psb_c_dgecmp
|
|
|
|
|
|
|
|
|
|
function psb_c_dmask(ch,xh,mh,t,cdh) bind(c) result(res)
|
|
|
|
|
implicit none
|
|
|
|
|
integer(psb_c_ipk_) :: res
|
|
|
|
|
|
|
|
|
|
type(psb_c_dvector) :: ch,xh,mh
|
|
|
|
|
type(psb_c_descriptor) :: cdh
|
|
|
|
|
logical(c_bool), value :: t
|
|
|
|
|
|
|
|
|
|
type(psb_desc_type), pointer :: descp
|
|
|
|
|
type(psb_d_vect_type), pointer :: cp,xp,mp
|
|
|
|
|
integer(psb_c_ipk_) :: info
|
|
|
|
|
logical :: ft
|
|
|
|
|
|
|
|
|
|
res = -1
|
|
|
|
|
|
|
|
|
|
if (c_associated(cdh%item)) then
|
|
|
|
|
call c_f_pointer(cdh%item,descp)
|
|
|
|
|
else
|
|
|
|
|
return
|
|
|
|
|
end if
|
|
|
|
|
if (c_associated(ch%item)) then
|
|
|
|
|
call c_f_pointer(ch%item,cp)
|
|
|
|
|
else
|
|
|
|
|
return
|
|
|
|
|
end if
|
|
|
|
|
if (c_associated(xh%item)) then
|
|
|
|
|
call c_f_pointer(xh%item,xp)
|
|
|
|
|
else
|
|
|
|
|
return
|
|
|
|
|
end if
|
|
|
|
|
if (c_associated(mh%item)) then
|
|
|
|
|
call c_f_pointer(mh%item,mp)
|
|
|
|
|
else
|
|
|
|
|
return
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
ft = t
|
|
|
|
|
call psb_mask(cp,xp,mp,ft,descp,info)
|
|
|
|
|
|
|
|
|
|
t = ft
|
|
|
|
|
res = info
|
|
|
|
|
|
|
|
|
|
end function psb_c_dmask
|
|
|
|
|
|
|
|
|
|
function psb_c_dgenrm2(xh,cdh) bind(c) result(res)
|
|
|
|
|
implicit none
|
|
|
|
|
real(c_double) :: res
|
|
|
|
@ -70,6 +366,75 @@ contains
|
|
|
|
|
|
|
|
|
|
end function psb_c_dgenrm2
|
|
|
|
|
|
|
|
|
|
function psb_c_dgenrm2_weight(xh,wh,cdh) bind(c) result(res)
|
|
|
|
|
implicit none
|
|
|
|
|
real(c_double) :: res
|
|
|
|
|
|
|
|
|
|
type(psb_c_dvector) :: xh, wh
|
|
|
|
|
type(psb_c_descriptor) :: cdh
|
|
|
|
|
type(psb_desc_type), pointer :: descp
|
|
|
|
|
type(psb_d_vect_type), pointer :: xp, wp
|
|
|
|
|
integer(psb_c_ipk_) :: 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(wh%item)) then
|
|
|
|
|
call c_f_pointer(wh%item,wp)
|
|
|
|
|
else
|
|
|
|
|
return
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
res = psb_genrm2(xp,wp,descp,info)
|
|
|
|
|
|
|
|
|
|
end function psb_c_dgenrm2_weight
|
|
|
|
|
|
|
|
|
|
function psb_c_dgenrm2_weightmask(xh,wh,idvh,cdh) bind(c) result(res)
|
|
|
|
|
implicit none
|
|
|
|
|
real(c_double) :: res
|
|
|
|
|
|
|
|
|
|
type(psb_c_dvector) :: xh, wh, idvh
|
|
|
|
|
type(psb_c_descriptor) :: cdh
|
|
|
|
|
type(psb_desc_type), pointer :: descp
|
|
|
|
|
type(psb_d_vect_type), pointer :: xp, wp, idvp
|
|
|
|
|
integer(psb_c_ipk_) :: 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(wh%item)) then
|
|
|
|
|
call c_f_pointer(wh%item,wp)
|
|
|
|
|
else
|
|
|
|
|
return
|
|
|
|
|
end if
|
|
|
|
|
if (c_associated(idvh%item)) then
|
|
|
|
|
call c_f_pointer(idvh%item,idvp)
|
|
|
|
|
else
|
|
|
|
|
return
|
|
|
|
|
end if
|
|
|
|
|
|
|
|
|
|
res = psb_genrm2(xp,wp,idvp,descp,info)
|
|
|
|
|
|
|
|
|
|
end function psb_c_dgenrm2_weightmask
|
|
|
|
|
|
|
|
|
|
function psb_c_dgeamax(xh,cdh) bind(c) result(res)
|
|
|
|
|
implicit none
|
|
|
|
|
real(c_double) :: res
|
|
|
|
|