mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-06 14:44:55 +00:00
Corrected return on C interface of precinit for already associated prec
This commit is contained in:
Cirdans-Home
@@ -8,7 +8,7 @@ module mld_dprec_cbind_mod
|
||||
type(c_ptr) :: item = c_null_ptr
|
||||
end type mld_c_dprec
|
||||
|
||||
contains
|
||||
contains
|
||||
|
||||
#if 1
|
||||
#define MLDC_DEBUG(MSG) write(*,*) __FILE__,':',__LINE__,':',MSG
|
||||
@@ -21,13 +21,13 @@ contains
|
||||
!#define MLDC_ERR_FILTER(INFO) min(0,INFO)
|
||||
#define MLDC_ERR_FILTER(INFO) (INFO)
|
||||
#define MLDC_ERR_HANDLE(INFO) if(INFO/=mld_success_)MLDC_ERROR("ERROR!")
|
||||
|
||||
|
||||
function mld_c_dprecinit(ictxt,ph,ptype) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use mld_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(mld_c_dprec) :: ph
|
||||
integer(psb_c_ipk_), value :: ictxt
|
||||
character(c_char) :: ptype(*)
|
||||
@@ -36,20 +36,20 @@ contains
|
||||
character(len=80) :: fptype
|
||||
|
||||
res = -1
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
return
|
||||
if (c_associated(ph%item)) then
|
||||
res = 0
|
||||
return
|
||||
end if
|
||||
|
||||
allocate(precp,stat=info)
|
||||
if (info /= 0) return
|
||||
|
||||
|
||||
ph%item = c_loc(precp)
|
||||
|
||||
call stringc2f(ptype,fptype)
|
||||
|
||||
call precp%init(ictxt,fptype,info)
|
||||
|
||||
|
||||
call precp%init(ictxt,fptype,info)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
@@ -58,9 +58,9 @@ contains
|
||||
function mld_c_dprecseti(ph,what,val) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use mld_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: what(*)
|
||||
integer(psb_c_ipk_), value :: val
|
||||
@@ -69,28 +69,28 @@ contains
|
||||
type(mld_dprec_type), pointer :: precp
|
||||
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
|
||||
call stringc2f(what,fwhat)
|
||||
|
||||
call mld_precset(precp,fwhat,val,info)
|
||||
|
||||
call mld_precset(precp,fwhat,val,info)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function mld_c_dprecseti
|
||||
|
||||
|
||||
|
||||
function mld_c_dprecsetr(ph,what,val) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use mld_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: what(*)
|
||||
real(c_double), value :: val
|
||||
@@ -99,27 +99,27 @@ contains
|
||||
type(mld_dprec_type), pointer :: precp
|
||||
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
|
||||
call stringc2f(what,fwhat)
|
||||
|
||||
call mld_precset(precp,fwhat,val,info)
|
||||
|
||||
call mld_precset(precp,fwhat,val,info)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function mld_c_dprecsetr
|
||||
|
||||
|
||||
function mld_c_dprecsetc(ph,what,val) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use mld_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: what(*), val(*)
|
||||
integer :: info
|
||||
@@ -127,17 +127,17 @@ contains
|
||||
type(mld_dprec_type), pointer :: precp
|
||||
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
|
||||
call stringc2f(what,fwhat)
|
||||
call stringc2f(val,fval)
|
||||
|
||||
call mld_precset(precp,fwhat,fval,info)
|
||||
|
||||
call mld_precset(precp,fwhat,fval,info)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
@@ -146,9 +146,9 @@ contains
|
||||
function mld_c_dprecbld(ah,cdh,ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use mld_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph,ah,cdh
|
||||
integer :: info
|
||||
type(mld_dprec_type), pointer :: precp
|
||||
@@ -158,36 +158,36 @@ contains
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(cdh%item)) then
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
if (c_associated(ph%item)) then
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
|
||||
call mld_precbld(ap,descp,precp,info)
|
||||
call mld_precbld(ap,descp,precp,info)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
|
||||
return
|
||||
end function mld_c_dprecbld
|
||||
|
||||
|
||||
function mld_c_dhierarchy_build(ah,cdh,ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use mld_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph,ah,cdh
|
||||
integer :: info
|
||||
type(mld_dprec_type), pointer :: precp
|
||||
@@ -197,23 +197,23 @@ contains
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(cdh%item)) then
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
if (c_associated(ph%item)) then
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
|
||||
call precp%hierarchy_build(ap,descp,info)
|
||||
call precp%hierarchy_build(ap,descp,info)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
@@ -224,9 +224,9 @@ contains
|
||||
function mld_c_dsmoothers_build(ah,cdh,ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use mld_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph,ah,cdh
|
||||
integer :: info
|
||||
type(mld_dprec_type), pointer :: precp
|
||||
@@ -236,30 +236,30 @@ contains
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(cdh%item)) then
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
if (c_associated(ph%item)) then
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
|
||||
call precp%smoothers_build(ap,descp,info)
|
||||
call precp%smoothers_build(ap,descp,info)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
|
||||
return
|
||||
end function mld_c_dsmoothers_build
|
||||
|
||||
|
||||
function mld_c_dkrylov(methd,&
|
||||
& ah,ph,bh,xh,cdh,options) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
@@ -267,17 +267,17 @@ contains
|
||||
use psb_krylov_mod
|
||||
use psb_prec_cbind_mod
|
||||
use psb_dkrylov_cbind_mod
|
||||
implicit none
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ah,cdh,ph,bh,xh
|
||||
character(c_char) :: methd(*)
|
||||
type(solveroptions) :: options
|
||||
|
||||
|
||||
res= mld_c_dkrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh, &
|
||||
& itmax=options%itmax, iter=options%iter,&
|
||||
& itrace=options%itrace, istop=options%istop,&
|
||||
& irst=options%irst, err=options%err)
|
||||
|
||||
|
||||
end function mld_c_dkrylov
|
||||
|
||||
|
||||
@@ -289,7 +289,7 @@ contains
|
||||
use psb_objhandle_mod
|
||||
use psb_prec_cbind_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ah,cdh,ph,bh,xh
|
||||
integer(psb_c_ipk_), value :: itmax,itrace,irst,istop
|
||||
@@ -307,33 +307,33 @@ contains
|
||||
real(kind(1.d0)) :: feps,ferr
|
||||
|
||||
res = -1
|
||||
if (c_associated(cdh%item)) then
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
if (c_associated(xh%item)) then
|
||||
if (c_associated(xh%item)) then
|
||||
call c_f_pointer(xh%item,xp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
if (c_associated(bh%item)) then
|
||||
if (c_associated(bh%item)) then
|
||||
call c_f_pointer(bh%item,bp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
if (c_associated(ph%item)) then
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
|
||||
|
||||
|
||||
call stringc2f(methd,fmethd)
|
||||
feps = eps
|
||||
fitmax = itmax
|
||||
@@ -348,34 +348,33 @@ contains
|
||||
iter = fiter
|
||||
err = ferr
|
||||
res = min(info,0)
|
||||
|
||||
|
||||
end function mld_c_dkrylov_opt
|
||||
|
||||
function mld_c_dprecfree(ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use mld_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
integer :: info
|
||||
type(mld_dprec_type), pointer :: precp
|
||||
character(len=80) :: fptype
|
||||
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
|
||||
|
||||
call precp%free(info)
|
||||
|
||||
|
||||
call precp%free(info)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function mld_c_dprecfree
|
||||
|
||||
end module mld_dprec_cbind_mod
|
||||
|
||||
|
||||
@@ -8,7 +8,7 @@ module mld_zprec_cbind_mod
|
||||
type(c_ptr) :: item = c_null_ptr
|
||||
end type mld_c_zprec
|
||||
|
||||
contains
|
||||
contains
|
||||
|
||||
#if 1
|
||||
#define MLDC_DEBUG(MSG) write(*,*) __FILE__,':',__LINE__,':',MSG
|
||||
@@ -21,13 +21,13 @@ contains
|
||||
!#define MLDC_ERR_FILTER(INFO) min(0,INFO)
|
||||
#define MLDC_ERR_FILTER(INFO) (INFO)
|
||||
#define MLDC_ERR_HANDLE(INFO) if(INFO/=mld_success_)MLDC_ERROR("ERROR!")
|
||||
|
||||
|
||||
function mld_c_zprecinit(ictxt,ph,ptype) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use mld_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(mld_c_zprec) :: ph
|
||||
integer(psb_c_ipk_), value :: ictxt
|
||||
character(c_char) :: ptype(*)
|
||||
@@ -36,20 +36,20 @@ contains
|
||||
character(len=80) :: fptype
|
||||
|
||||
res = -1
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
return
|
||||
if (c_associated(ph%item)) then
|
||||
res = 0
|
||||
return
|
||||
end if
|
||||
|
||||
allocate(precp,stat=info)
|
||||
if (info /= 0) return
|
||||
|
||||
|
||||
ph%item = c_loc(precp)
|
||||
|
||||
call stringc2f(ptype,fptype)
|
||||
|
||||
call precp%init(ictxt,fptype,info)
|
||||
|
||||
|
||||
call precp%init(ictxt,fptype,info)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
@@ -58,9 +58,9 @@ contains
|
||||
function mld_c_zprecseti(ph,what,val) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use mld_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: what(*)
|
||||
integer(psb_c_ipk_), value :: val
|
||||
@@ -69,28 +69,28 @@ contains
|
||||
type(mld_zprec_type), pointer :: precp
|
||||
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
|
||||
call stringc2f(what,fwhat)
|
||||
|
||||
call mld_precset(precp,fwhat,val,info)
|
||||
|
||||
call mld_precset(precp,fwhat,val,info)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function mld_c_zprecseti
|
||||
|
||||
|
||||
|
||||
function mld_c_zprecsetr(ph,what,val) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use mld_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: what(*)
|
||||
real(c_double), value :: val
|
||||
@@ -99,27 +99,27 @@ contains
|
||||
type(mld_zprec_type), pointer :: precp
|
||||
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
|
||||
call stringc2f(what,fwhat)
|
||||
|
||||
call mld_precset(precp,fwhat,val,info)
|
||||
|
||||
call mld_precset(precp,fwhat,val,info)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function mld_c_zprecsetr
|
||||
|
||||
|
||||
function mld_c_zprecsetc(ph,what,val) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use mld_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
character(c_char) :: what(*), val(*)
|
||||
integer :: info
|
||||
@@ -127,17 +127,17 @@ contains
|
||||
type(mld_zprec_type), pointer :: precp
|
||||
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
|
||||
call stringc2f(what,fwhat)
|
||||
call stringc2f(val,fval)
|
||||
|
||||
call mld_precset(precp,fwhat,fval,info)
|
||||
|
||||
call mld_precset(precp,fwhat,fval,info)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
@@ -146,9 +146,9 @@ contains
|
||||
function mld_c_zprecbld(ah,cdh,ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use mld_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph,ah,cdh
|
||||
integer :: info
|
||||
type(mld_zprec_type), pointer :: precp
|
||||
@@ -158,36 +158,36 @@ contains
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(cdh%item)) then
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
if (c_associated(ph%item)) then
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
|
||||
call mld_precbld(ap,descp,precp,info)
|
||||
call mld_precbld(ap,descp,precp,info)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
|
||||
return
|
||||
end function mld_c_zprecbld
|
||||
|
||||
|
||||
function mld_c_zhierarchy_build(ah,cdh,ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use mld_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph,ah,cdh
|
||||
integer :: info
|
||||
type(mld_zprec_type), pointer :: precp
|
||||
@@ -197,23 +197,23 @@ contains
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(cdh%item)) then
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
if (c_associated(ph%item)) then
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
|
||||
call precp%hierarchy_build(ap,descp,info)
|
||||
call precp%hierarchy_build(ap,descp,info)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
@@ -224,9 +224,9 @@ contains
|
||||
function mld_c_zsmoothers_build(ah,cdh,ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use mld_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph,ah,cdh
|
||||
integer :: info
|
||||
type(mld_zprec_type), pointer :: precp
|
||||
@@ -236,30 +236,30 @@ contains
|
||||
|
||||
res = -1
|
||||
|
||||
if (c_associated(cdh%item)) then
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
if (c_associated(ph%item)) then
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
|
||||
call precp%smoothers_build(ap,descp,info)
|
||||
call precp%smoothers_build(ap,descp,info)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
|
||||
return
|
||||
end function mld_c_zsmoothers_build
|
||||
|
||||
|
||||
function mld_c_zkrylov(methd,&
|
||||
& ah,ph,bh,xh,cdh,options) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
@@ -267,17 +267,17 @@ contains
|
||||
use psb_krylov_mod
|
||||
use psb_prec_cbind_mod
|
||||
use psb_zkrylov_cbind_mod
|
||||
implicit none
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ah,cdh,ph,bh,xh
|
||||
character(c_char) :: methd(*)
|
||||
type(solveroptions) :: options
|
||||
|
||||
|
||||
res= mld_c_zkrylov_opt(methd, ah, ph, bh, xh, options%eps,cdh, &
|
||||
& itmax=options%itmax, iter=options%iter,&
|
||||
& itrace=options%itrace, istop=options%istop,&
|
||||
& irst=options%irst, err=options%err)
|
||||
|
||||
|
||||
end function mld_c_zkrylov
|
||||
|
||||
|
||||
@@ -289,7 +289,7 @@ contains
|
||||
use psb_objhandle_mod
|
||||
use psb_prec_cbind_mod
|
||||
use psb_base_string_cbind_mod
|
||||
implicit none
|
||||
implicit none
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ah,cdh,ph,bh,xh
|
||||
integer(psb_c_ipk_), value :: itmax,itrace,irst,istop
|
||||
@@ -307,33 +307,33 @@ contains
|
||||
real(kind(1.d0)) :: feps,ferr
|
||||
|
||||
res = -1
|
||||
if (c_associated(cdh%item)) then
|
||||
if (c_associated(cdh%item)) then
|
||||
call c_f_pointer(cdh%item,descp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
if (c_associated(xh%item)) then
|
||||
if (c_associated(xh%item)) then
|
||||
call c_f_pointer(xh%item,xp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
if (c_associated(bh%item)) then
|
||||
if (c_associated(bh%item)) then
|
||||
call c_f_pointer(bh%item,bp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
if (c_associated(ah%item)) then
|
||||
if (c_associated(ah%item)) then
|
||||
call c_f_pointer(ah%item,ap)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
if (c_associated(ph%item)) then
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
|
||||
|
||||
|
||||
call stringc2f(methd,fmethd)
|
||||
feps = eps
|
||||
fitmax = itmax
|
||||
@@ -348,34 +348,33 @@ contains
|
||||
iter = fiter
|
||||
err = ferr
|
||||
res = min(info,0)
|
||||
|
||||
|
||||
end function mld_c_zkrylov_opt
|
||||
|
||||
function mld_c_zprecfree(ph) bind(c) result(res)
|
||||
use psb_base_mod
|
||||
use mld_prec_mod
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
implicit none
|
||||
|
||||
integer(psb_c_ipk_) :: res
|
||||
type(psb_c_object_type) :: ph
|
||||
integer :: info
|
||||
type(mld_zprec_type), pointer :: precp
|
||||
character(len=80) :: fptype
|
||||
|
||||
res = -1
|
||||
if (c_associated(ph%item)) then
|
||||
if (c_associated(ph%item)) then
|
||||
call c_f_pointer(ph%item,precp)
|
||||
else
|
||||
return
|
||||
return
|
||||
end if
|
||||
|
||||
|
||||
call precp%free(info)
|
||||
|
||||
|
||||
call precp%free(info)
|
||||
|
||||
res = MLDC_ERR_FILTER(info)
|
||||
MLDC_ERR_HANDLE(res)
|
||||
return
|
||||
end function mld_c_zprecfree
|
||||
|
||||
end module mld_zprec_cbind_mod
|
||||
|
||||
|
||||
Reference in New Issue
Block a user