mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-06 14:44:54 +00:00
Merge pull request #44 from fdrmrc/reinit_clear
Reintroduce implementation of psb_c_gereinit
This commit is contained in:
@@ -252,6 +252,38 @@ contains
|
||||
return
|
||||
end function psb_c_cgefree
|
||||
|
||||
function psb_c_cgereinit(xh,cdh,clear) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_cvector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
logical(c_bool), value :: clear
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_c_vect_type), pointer :: xp
|
||||
integer(psb_c_ipk_) :: info
|
||||
logical :: fclear
|
||||
|
||||
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
|
||||
|
||||
fclear = clear
|
||||
call xp%reinit(info, clear=fclear)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_cgereinit
|
||||
|
||||
function psb_c_cgeins(nz,irw,val,xh,cdh) bind(c) result(res)
|
||||
|
||||
|
||||
@@ -252,6 +252,38 @@ contains
|
||||
return
|
||||
end function psb_c_dgefree
|
||||
|
||||
function psb_c_dgereinit(xh,cdh,clear) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_dvector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
logical(c_bool), value :: clear
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_d_vect_type), pointer :: xp
|
||||
integer(psb_c_ipk_) :: info
|
||||
logical :: fclear
|
||||
|
||||
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
|
||||
|
||||
fclear = clear
|
||||
call xp%reinit(info, clear=fclear)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_dgereinit
|
||||
|
||||
function psb_c_dgeins(nz,irw,val,xh,cdh) bind(c) result(res)
|
||||
|
||||
|
||||
@@ -252,6 +252,38 @@ contains
|
||||
return
|
||||
end function psb_c_sgefree
|
||||
|
||||
function psb_c_sgereinit(xh,cdh,clear) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_svector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
logical(c_bool), value :: clear
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_s_vect_type), pointer :: xp
|
||||
integer(psb_c_ipk_) :: info
|
||||
logical :: fclear
|
||||
|
||||
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
|
||||
|
||||
fclear = clear
|
||||
call xp%reinit(info, clear=fclear)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_sgereinit
|
||||
|
||||
function psb_c_sgeins(nz,irw,val,xh,cdh) bind(c) result(res)
|
||||
|
||||
|
||||
@@ -252,6 +252,38 @@ contains
|
||||
return
|
||||
end function psb_c_zgefree
|
||||
|
||||
function psb_c_zgereinit(xh,cdh,clear) bind(c) result(res)
|
||||
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_zvector) :: xh
|
||||
type(psb_c_descriptor) :: cdh
|
||||
logical(c_bool), value :: clear
|
||||
|
||||
type(psb_desc_type), pointer :: descp
|
||||
type(psb_z_vect_type), pointer :: xp
|
||||
integer(psb_c_ipk_) :: info
|
||||
logical :: fclear
|
||||
|
||||
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
|
||||
|
||||
fclear = clear
|
||||
call xp%reinit(info, clear=fclear)
|
||||
res = min(0,info)
|
||||
|
||||
return
|
||||
end function psb_c_zgereinit
|
||||
|
||||
function psb_c_zgeins(nz,irw,val,xh,cdh) bind(c) result(res)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user