Fix (de)allocate prec and SolverOptions

maint-3.9.0
sfilippone 3 days ago
parent ed138c8afd
commit 9e1c7b775e

@ -27,7 +27,7 @@ contains
function psb_c_PrintSolverOptions(options)&
& bind(c,name='psb_c_PrintSolverOptions') result(res)
implicit none
type(solveroptions) :: options
type(solveroptions), value :: options
integer(psb_c_ipk_) :: res
write(*,*) 'PSBLAS C Interface Solver Options '

@ -32,6 +32,7 @@ contains
function psb_c_ckrylov_opt(methd,&
& ah,ph,bh,xh,eps,cdh,itmax,iter,err,itrace,irst,istop) bind(c) result(res)
use psb_base_mod
use psb_error_mod
use psb_prec_mod
use psb_linsolve_mod
use psb_objhandle_mod
@ -53,7 +54,7 @@ contains
type(psb_cprec_type), pointer :: precp
type(psb_c_vect_type), pointer :: xp, bp
integer(psb_c_ipk_) :: info,fitmax,fitrace,first,fistop,fiter
integer(psb_c_ipk_) :: info,fitmax,fitrace,first,fistop,fiter,err_act
character(len=20) :: fmethd
real(psb_spk_) :: feps,ferr
@ -91,7 +92,8 @@ contains
fitrace = itrace
first = irst
fistop = istop
err_act = psb_act_abort_
if (psb_errstatus_fatal()) call psb_error_handler(err_act)
call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
& descp, info,&
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
@ -99,6 +101,7 @@ contains
iter = fiter
err = ferr
res = info
if (psb_errstatus_fatal()) call psb_error_handler(err_act)
end function psb_c_ckrylov_opt

@ -32,6 +32,7 @@ contains
function psb_c_dkrylov_opt(methd,&
& ah,ph,bh,xh,eps,cdh,itmax,iter,err,itrace,irst,istop) bind(c) result(res)
use psb_base_mod
use psb_error_mod
use psb_prec_mod
use psb_linsolve_mod
use psb_objhandle_mod
@ -53,7 +54,7 @@ contains
type(psb_dprec_type), pointer :: precp
type(psb_d_vect_type), pointer :: xp, bp
integer(psb_c_ipk_) :: info,fitmax,fitrace,first,fistop,fiter
integer(psb_c_ipk_) :: info,fitmax,fitrace,first,fistop,fiter,err_act
character(len=20) :: fmethd
real(psb_dpk_) :: feps,ferr
@ -91,7 +92,8 @@ contains
fitrace = itrace
first = irst
fistop = istop
err_act = psb_act_abort_
if (psb_errstatus_fatal()) call psb_error_handler(err_act)
call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
& descp, info,&
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
@ -99,6 +101,7 @@ contains
iter = fiter
err = ferr
res = info
if (psb_errstatus_fatal()) call psb_error_handler(err_act)
end function psb_c_dkrylov_opt

@ -25,7 +25,7 @@ typedef struct psb_c_solveroptions {
} psb_c_SolverOptions;
int psb_c_DefaultSolverOptions(psb_c_SolverOptions *opt);
int psb_c_PrintSolverOptions(psb_c_SolverOptions *opt);
int psb_c_PrintSolverOptions(psb_c_SolverOptions opt);
int psb_c_skrylov(const char *method, psb_c_sspmat *ah, psb_c_sprec *ph,
psb_c_svector *bh, psb_c_svector *xh,

@ -32,6 +32,7 @@ contains
function psb_c_skrylov_opt(methd,&
& ah,ph,bh,xh,eps,cdh,itmax,iter,err,itrace,irst,istop) bind(c) result(res)
use psb_base_mod
use psb_error_mod
use psb_prec_mod
use psb_linsolve_mod
use psb_objhandle_mod
@ -53,7 +54,7 @@ contains
type(psb_sprec_type), pointer :: precp
type(psb_s_vect_type), pointer :: xp, bp
integer(psb_c_ipk_) :: info,fitmax,fitrace,first,fistop,fiter
integer(psb_c_ipk_) :: info,fitmax,fitrace,first,fistop,fiter,err_act
character(len=20) :: fmethd
real(psb_spk_) :: feps,ferr
@ -91,7 +92,8 @@ contains
fitrace = itrace
first = irst
fistop = istop
err_act = psb_act_abort_
if (psb_errstatus_fatal()) call psb_error_handler(err_act)
call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
& descp, info,&
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
@ -99,6 +101,7 @@ contains
iter = fiter
err = ferr
res = info
if (psb_errstatus_fatal()) call psb_error_handler(err_act)
end function psb_c_skrylov_opt

@ -32,6 +32,7 @@ contains
function psb_c_zkrylov_opt(methd,&
& ah,ph,bh,xh,eps,cdh,itmax,iter,err,itrace,irst,istop) bind(c) result(res)
use psb_base_mod
use psb_error_mod
use psb_prec_mod
use psb_linsolve_mod
use psb_objhandle_mod
@ -53,7 +54,7 @@ contains
type(psb_zprec_type), pointer :: precp
type(psb_z_vect_type), pointer :: xp, bp
integer(psb_c_ipk_) :: info,fitmax,fitrace,first,fistop,fiter
integer(psb_c_ipk_) :: info,fitmax,fitrace,first,fistop,fiter,err_act
character(len=20) :: fmethd
real(psb_dpk_) :: feps,ferr
@ -91,7 +92,8 @@ contains
fitrace = itrace
first = irst
fistop = istop
err_act = psb_act_abort_
if (psb_errstatus_fatal()) call psb_error_handler(err_act)
call psb_krylov(fmethd, ap, precp, bp, xp, feps, &
& descp, info,&
& itmax=fitmax,iter=fiter,itrace=fitrace,istop=fistop,&
@ -99,6 +101,7 @@ contains
iter = fiter
err = ferr
res = info
if (psb_errstatus_fatal()) call psb_error_handler(err_act)
end function psb_c_zkrylov_opt

@ -644,6 +644,10 @@ subroutine psb_c_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
enddo
deallocate(prec%av,stat=info)
endif
if (allocated (prec%dv)) then
call prec%dv%free(info)
if (info == 0) deallocate(prec%dv)
end if
end if
if (.not.allocated(prec%av)) then
allocate(prec%av(psb_max_avsz),stat=info)

@ -270,7 +270,7 @@ subroutine psb_c_diag_precbld(a,desc_a,prec,info,amold,vmold,imold)
prec%d(i) = cone
end do
allocate(prec%dv,stat=info)
if (.not.allocated(prec%dv)) allocate(prec%dv,stat=info)
if (info == 0) then
if (present(vmold)) then
allocate(prec%dv%v,mold=vmold,stat=info)

@ -644,6 +644,10 @@ subroutine psb_d_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
enddo
deallocate(prec%av,stat=info)
endif
if (allocated (prec%dv)) then
call prec%dv%free(info)
if (info == 0) deallocate(prec%dv)
end if
end if
if (.not.allocated(prec%av)) then
allocate(prec%av(psb_max_avsz),stat=info)

@ -270,7 +270,7 @@ subroutine psb_d_diag_precbld(a,desc_a,prec,info,amold,vmold,imold)
prec%d(i) = done
end do
allocate(prec%dv,stat=info)
if (.not.allocated(prec%dv)) allocate(prec%dv,stat=info)
if (info == 0) then
if (present(vmold)) then
allocate(prec%dv%v,mold=vmold,stat=info)

@ -644,6 +644,10 @@ subroutine psb_s_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
enddo
deallocate(prec%av,stat=info)
endif
if (allocated (prec%dv)) then
call prec%dv%free(info)
if (info == 0) deallocate(prec%dv)
end if
end if
if (.not.allocated(prec%av)) then
allocate(prec%av(psb_max_avsz),stat=info)

@ -270,7 +270,7 @@ subroutine psb_s_diag_precbld(a,desc_a,prec,info,amold,vmold,imold)
prec%d(i) = sone
end do
allocate(prec%dv,stat=info)
if (.not.allocated(prec%dv)) allocate(prec%dv,stat=info)
if (info == 0) then
if (present(vmold)) then
allocate(prec%dv%v,mold=vmold,stat=info)

@ -644,6 +644,10 @@ subroutine psb_z_bjac_precbld(a,desc_a,prec,info,amold,vmold,imold)
enddo
deallocate(prec%av,stat=info)
endif
if (allocated (prec%dv)) then
call prec%dv%free(info)
if (info == 0) deallocate(prec%dv)
end if
end if
if (.not.allocated(prec%av)) then
allocate(prec%av(psb_max_avsz),stat=info)

@ -270,7 +270,7 @@ subroutine psb_z_diag_precbld(a,desc_a,prec,info,amold,vmold,imold)
prec%d(i) = zone
end do
allocate(prec%dv,stat=info)
if (.not.allocated(prec%dv)) allocate(prec%dv,stat=info)
if (info == 0) then
if (present(vmold)) then
allocate(prec%dv%v,mold=vmold,stat=info)

Loading…
Cancel
Save