fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Corrected return on C interface of precinit for already associated prec

Browse Source
pizdaint-runs
Cirdans-Home 5 years ago
parent 8f60a49fc6
commit 8eae0dc459
2 changed files with 182 additions and 184 deletions
Show Stats Download Patch File Download Diff File

183
cbind/mlprec/mld_dprec_cbind_mod.F90
Unescape Escape View File

@ -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

183
cbind/mlprec/mld_zprec_cbind_mod.F90
Unescape Escape View File

@ -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

Write Preview
Loading…
Cancel
Save