base/modules/psb_c_vect_mod.F90
 base/modules/psb_d_vect_mod.F90
 base/modules/psb_i_vect_mod.F90
 base/modules/psb_s_vect_mod.F90
 base/modules/psb_z_vect_mod.F90
 prec/psb_c_base_prec_mod.f90
 prec/psb_c_bjacprec.f90
 prec/psb_c_diagprec.f90
 prec/psb_c_nullprec.f90
 prec/psb_d_base_prec_mod.f90
 prec/psb_d_bjacprec.f90
 prec/psb_d_diagprec.f90
 prec/psb_d_nullprec.f90
 prec/psb_s_base_prec_mod.f90
 prec/psb_s_bjacprec.f90
 prec/psb_s_diagprec.f90
 prec/psb_s_nullprec.f90
 prec/psb_z_base_prec_mod.f90
 prec/psb_z_bjacprec.f90
 prec/psb_z_diagprec.f90
 prec/psb_z_nullprec.f90


Clone method in base_prec
psblas3-final
Salvatore Filippone 12 years ago
parent a50ce17bcb
commit b508c9ad85

@ -95,11 +95,13 @@ module psb_c_vect_mod
contains
subroutine c_vect_clone(x,y)
subroutine c_vect_clone(x,y,info)
implicit none
class(psb_c_vect_type), intent(inout) :: x
class(psb_c_vect_type), intent(out) :: y
integer(psb_ipk_), intent(out) :: info
info = psb_success_
if (allocated(x%v)) then
call y%bld(x%get_vect(),mold=x%v)
end if

@ -95,11 +95,13 @@ module psb_d_vect_mod
contains
subroutine d_vect_clone(x,y)
subroutine d_vect_clone(x,y,info)
implicit none
class(psb_d_vect_type), intent(inout) :: x
class(psb_d_vect_type), intent(out) :: y
integer(psb_ipk_), intent(out) :: info
info = psb_success_
if (allocated(x%v)) then
call y%bld(x%get_vect(),mold=x%v)
end if

@ -95,11 +95,13 @@ module psb_i_vect_mod
contains
subroutine i_vect_clone(x,y)
subroutine i_vect_clone(x,y,info)
implicit none
class(psb_i_vect_type), intent(inout) :: x
class(psb_i_vect_type), intent(out) :: y
integer(psb_ipk_), intent(out) :: info
info = psb_success_
if (allocated(x%v)) then
call y%bld(x%get_vect(),mold=x%v)
end if

@ -95,11 +95,13 @@ module psb_s_vect_mod
contains
subroutine s_vect_clone(x,y)
subroutine s_vect_clone(x,y,info)
implicit none
class(psb_s_vect_type), intent(inout) :: x
class(psb_s_vect_type), intent(out) :: y
integer(psb_ipk_), intent(out) :: info
info = psb_success_
if (allocated(x%v)) then
call y%bld(x%get_vect(),mold=x%v)
end if

@ -95,11 +95,13 @@ module psb_z_vect_mod
contains
subroutine z_vect_clone(x,y)
subroutine z_vect_clone(x,y,info)
implicit none
class(psb_z_vect_type), intent(inout) :: x
class(psb_z_vect_type), intent(out) :: y
integer(psb_ipk_), intent(out) :: info
info = psb_success_
if (allocated(x%v)) then
call y%bld(x%get_vect(),mold=x%v)
end if

@ -64,6 +64,7 @@ module psb_c_base_prec_mod
procedure(psb_c_base_precfree), pass(prec), deferred :: precfree
procedure(psb_c_base_precdescr), pass(prec), deferred :: precdescr
procedure(psb_c_base_precdump), pass(prec), deferred :: dump
procedure(psb_c_base_precclone), pass(prec), deferred :: clone
end type psb_c_base_prec_type
private :: psb_c_base_set_ctxt, psb_c_base_get_ctxt, &
@ -180,6 +181,18 @@ module psb_c_base_prec_mod
end subroutine psb_c_base_precdump
end interface
abstract interface
subroutine psb_c_base_precclone(prec,precout,info)
import psb_ipk_, psb_spk_, psb_desc_type, psb_c_vect_type, &
& psb_c_base_vect_type, psb_cspmat_type, psb_c_base_prec_type,&
& psb_c_base_sparse_mat
implicit none
class(psb_c_base_prec_type), intent(inout) :: prec
class(psb_c_base_prec_type), allocatable, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
end subroutine psb_c_base_precclone
end interface
contains
subroutine psb_c_base_precseti(prec,what,val,info)

@ -43,11 +43,12 @@ module psb_c_bjacprec
procedure, pass(prec) :: precbld => psb_c_bjac_precbld
procedure, pass(prec) :: precinit => psb_c_bjac_precinit
procedure, pass(prec) :: precseti => psb_c_bjac_precseti
procedure, pass(prec) :: precsetr => psb_c_bjac_precsetr
procedure, pass(prec) :: precsetc => psb_c_bjac_precsetc
!!$ procedure, pass(prec) :: precsetr => psb_c_bjac_precsetr
!!$ procedure, pass(prec) :: precsetc => psb_c_bjac_precsetc
procedure, pass(prec) :: precfree => psb_c_bjac_precfree
procedure, pass(prec) :: precdescr => psb_c_bjac_precdescr
procedure, pass(prec) :: dump => psb_c_bjac_dump
procedure, pass(prec) :: clone => psb_c_bjac_clone
procedure, pass(prec) :: sizeof => psb_c_bjac_sizeof
procedure, pass(prec) :: get_nzeros => psb_c_bjac_get_nzeros
end type psb_c_bjac_prec_type
@ -210,48 +211,33 @@ contains
end function psb_c_bjac_get_nzeros
subroutine psb_c_bjac_precsetr(prec,what,val,info)
subroutine psb_c_bjac_precfree(prec,info)
Implicit None
class(psb_c_bjac_prec_type),intent(inout) :: prec
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
class(psb_c_bjac_prec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, nrow
character(len=20) :: name='c_bjac_precset'
call psb_erractionsave(err_act)
info = psb_success_
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_c_bjac_precsetr
subroutine psb_c_bjac_precsetc(prec,what,val,info)
Implicit None
class(psb_c_bjac_prec_type),intent(inout) :: prec
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, nrow
character(len=20) :: name='c_bjac_precset'
integer(psb_ipk_) :: err_act, i
character(len=20) :: name='c_bjac_precfree'
call psb_erractionsave(err_act)
info = psb_success_
if (allocated(prec%av)) then
do i=1,size(prec%av)
call prec%av(i)%free()
enddo
deallocate(prec%av,stat=info)
end if
if (allocated(prec%dv)) then
call prec%dv%free(info)
if (info == 0) deallocate(prec%dv,stat=info)
end if
if (allocated(prec%iprcparm)) then
deallocate(prec%iprcparm,stat=info)
end if
call psb_erractionrestore(err_act)
return
@ -262,35 +248,49 @@ contains
return
end if
return
end subroutine psb_c_bjac_precsetc
subroutine psb_c_bjac_precfree(prec,info)
end subroutine psb_c_bjac_precfree
subroutine psb_c_bjac_clone(prec,precout,info)
use psb_error_mod
use psb_realloc_mod
Implicit None
class(psb_c_bjac_prec_type), intent(inout) :: prec
class(psb_c_base_prec_type), allocatable, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, i
character(len=20) :: name='c_bjac_precfree'
character(len=20) :: name='c_bjac_clone'
call psb_erractionsave(err_act)
info = psb_success_
allocate(psb_c_bjac_prec_type :: precout, stat=info)
if (info /= 0) goto 9999
select type(pout => precout)
type is (psb_c_bjac_prec_type)
call pout%set_ctxt(prec%get_ctxt())
if (allocated(prec%av)) then
allocate(pout%av(size(prec%av)),stat=info)
do i=1,size(prec%av)
call prec%av(i)%free()
if (info /= psb_success_) exit
call prec%av(i)%clone(pout%av(i),info)
enddo
deallocate(prec%av,stat=info)
if (info /= psb_success_) goto 9999
end if
if (allocated(prec%dv)) then
call prec%dv%free(info)
if (info == 0) deallocate(prec%dv,stat=info)
end if
if (allocated(prec%iprcparm)) then
deallocate(prec%iprcparm,stat=info)
allocate(pout%dv,stat=info)
if (info == 0) call prec%dv%clone(pout%dv,info)
end if
class default
info = psb_err_internal_error_
end select
if (info /= 0) goto 9999
call psb_erractionrestore(err_act)
return
@ -302,6 +302,6 @@ contains
end if
return
end subroutine psb_c_bjac_precfree
end subroutine psb_c_bjac_clone
end module psb_c_bjacprec

@ -45,6 +45,7 @@ module psb_c_diagprec
procedure, pass(prec) :: precdescr => psb_c_diag_precdescr
procedure, pass(prec) :: sizeof => psb_c_diag_sizeof
procedure, pass(prec) :: dump => psb_c_diag_dump
procedure, pass(prec) :: clone => psb_c_diag_clone
procedure, pass(prec) :: get_nzeros => psb_c_diag_get_nzeros
end type psb_c_diag_prec_type
@ -225,4 +226,50 @@ contains
end function psb_c_diag_get_nzeros
subroutine psb_c_diag_clone(prec,precout,info)
use psb_error_mod
use psb_realloc_mod
Implicit None
class(psb_c_diag_prec_type), intent(inout) :: prec
class(psb_c_base_prec_type), allocatable, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, i
character(len=20) :: name='c_diag_clone'
call psb_erractionsave(err_act)
info = psb_success_
allocate(psb_c_diag_prec_type :: precout, stat=info)
if (info /= 0) goto 9999
select type(pout => precout)
type is (psb_c_diag_prec_type)
call pout%set_ctxt(prec%get_ctxt())
if (allocated(prec%dv)) then
allocate(pout%dv,stat=info)
if (info == 0) call prec%dv%clone(pout%dv,info)
end if
if (info == 0) call psb_safe_ab_cpy(prec%d,pout%d,info)
class default
info = psb_err_internal_error_
end select
if (info /= 0) goto 9999
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_c_diag_clone
end module psb_c_diagprec

@ -43,6 +43,7 @@ module psb_c_nullprec
procedure, pass(prec) :: precdescr => psb_c_null_precdescr
procedure, pass(prec) :: sizeof => psb_c_null_sizeof
procedure, pass(prec) :: dump => psb_c_null_dump
procedure, pass(prec) :: clone => psb_c_null_clone
end type psb_c_null_prec_type
private :: psb_c_null_precbld, psb_c_null_sizeof,&
@ -258,4 +259,46 @@ contains
return
end function psb_c_null_sizeof
subroutine psb_c_null_clone(prec,precout,info)
use psb_const_mod
use psb_error_mod
Implicit None
class(psb_c_null_prec_type), intent(inout) :: prec
class(psb_c_base_prec_type), allocatable, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, i
character(len=20) :: name='c_null_clone'
call psb_erractionsave(err_act)
info = psb_success_
allocate(psb_c_null_prec_type :: precout, stat=info)
if (info /= 0) goto 9999
select type(pout => precout)
type is (psb_c_null_prec_type)
call pout%set_ctxt(prec%get_ctxt())
class default
info = psb_err_internal_error_
end select
if (info /= 0) goto 9999
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_c_null_clone
end module psb_c_nullprec

@ -64,6 +64,7 @@ module psb_d_base_prec_mod
procedure(psb_d_base_precfree), pass(prec), deferred :: precfree
procedure(psb_d_base_precdescr), pass(prec), deferred :: precdescr
procedure(psb_d_base_precdump), pass(prec), deferred :: dump
procedure(psb_d_base_precclone), pass(prec), deferred :: clone
end type psb_d_base_prec_type
private :: psb_d_base_set_ctxt, psb_d_base_get_ctxt, &
@ -180,6 +181,18 @@ module psb_d_base_prec_mod
end subroutine psb_d_base_precdump
end interface
abstract interface
subroutine psb_d_base_precclone(prec,precout,info)
import psb_ipk_, psb_dpk_, psb_desc_type, psb_d_vect_type, &
& psb_d_base_vect_type, psb_dspmat_type, psb_d_base_prec_type,&
& psb_d_base_sparse_mat
implicit none
class(psb_d_base_prec_type), intent(inout) :: prec
class(psb_d_base_prec_type), allocatable, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
end subroutine psb_d_base_precclone
end interface
contains
subroutine psb_d_base_precseti(prec,what,val,info)

@ -43,11 +43,12 @@ module psb_d_bjacprec
procedure, pass(prec) :: precbld => psb_d_bjac_precbld
procedure, pass(prec) :: precinit => psb_d_bjac_precinit
procedure, pass(prec) :: precseti => psb_d_bjac_precseti
procedure, pass(prec) :: precsetr => psb_d_bjac_precsetr
procedure, pass(prec) :: precsetc => psb_d_bjac_precsetc
!!$ procedure, pass(prec) :: precsetr => psb_d_bjac_precsetr
!!$ procedure, pass(prec) :: precsetc => psb_d_bjac_precsetc
procedure, pass(prec) :: precfree => psb_d_bjac_precfree
procedure, pass(prec) :: precdescr => psb_d_bjac_precdescr
procedure, pass(prec) :: dump => psb_d_bjac_dump
procedure, pass(prec) :: clone => psb_d_bjac_clone
procedure, pass(prec) :: sizeof => psb_d_bjac_sizeof
procedure, pass(prec) :: get_nzeros => psb_d_bjac_get_nzeros
end type psb_d_bjac_prec_type
@ -210,48 +211,33 @@ contains
end function psb_d_bjac_get_nzeros
subroutine psb_d_bjac_precsetr(prec,what,val,info)
subroutine psb_d_bjac_precfree(prec,info)
Implicit None
class(psb_d_bjac_prec_type),intent(inout) :: prec
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
class(psb_d_bjac_prec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, nrow
character(len=20) :: name='d_bjac_precset'
call psb_erractionsave(err_act)
info = psb_success_
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_d_bjac_precsetr
subroutine psb_d_bjac_precsetc(prec,what,val,info)
Implicit None
class(psb_d_bjac_prec_type),intent(inout) :: prec
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, nrow
character(len=20) :: name='d_bjac_precset'
integer(psb_ipk_) :: err_act, i
character(len=20) :: name='d_bjac_precfree'
call psb_erractionsave(err_act)
info = psb_success_
if (allocated(prec%av)) then
do i=1,size(prec%av)
call prec%av(i)%free()
enddo
deallocate(prec%av,stat=info)
end if
if (allocated(prec%dv)) then
call prec%dv%free(info)
if (info == 0) deallocate(prec%dv,stat=info)
end if
if (allocated(prec%iprcparm)) then
deallocate(prec%iprcparm,stat=info)
end if
call psb_erractionrestore(err_act)
return
@ -262,35 +248,49 @@ contains
return
end if
return
end subroutine psb_d_bjac_precsetc
subroutine psb_d_bjac_precfree(prec,info)
end subroutine psb_d_bjac_precfree
subroutine psb_d_bjac_clone(prec,precout,info)
use psb_error_mod
use psb_realloc_mod
Implicit None
class(psb_d_bjac_prec_type), intent(inout) :: prec
class(psb_d_base_prec_type), allocatable, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, i
character(len=20) :: name='d_bjac_precfree'
character(len=20) :: name='d_bjac_clone'
call psb_erractionsave(err_act)
info = psb_success_
allocate(psb_d_bjac_prec_type :: precout, stat=info)
if (info /= 0) goto 9999
select type(pout => precout)
type is (psb_d_bjac_prec_type)
call pout%set_ctxt(prec%get_ctxt())
if (allocated(prec%av)) then
allocate(pout%av(size(prec%av)),stat=info)
do i=1,size(prec%av)
call prec%av(i)%free()
if (info /= psb_success_) exit
call prec%av(i)%clone(pout%av(i),info)
enddo
deallocate(prec%av,stat=info)
if (info /= psb_success_) goto 9999
end if
if (allocated(prec%dv)) then
call prec%dv%free(info)
if (info == 0) deallocate(prec%dv,stat=info)
end if
if (allocated(prec%iprcparm)) then
deallocate(prec%iprcparm,stat=info)
allocate(pout%dv,stat=info)
if (info == 0) call prec%dv%clone(pout%dv,info)
end if
class default
info = psb_err_internal_error_
end select
if (info /= 0) goto 9999
call psb_erractionrestore(err_act)
return
@ -302,6 +302,6 @@ contains
end if
return
end subroutine psb_d_bjac_precfree
end subroutine psb_d_bjac_clone
end module psb_d_bjacprec

@ -45,6 +45,7 @@ module psb_d_diagprec
procedure, pass(prec) :: precdescr => psb_d_diag_precdescr
procedure, pass(prec) :: sizeof => psb_d_diag_sizeof
procedure, pass(prec) :: dump => psb_d_diag_dump
procedure, pass(prec) :: clone => psb_d_diag_clone
procedure, pass(prec) :: get_nzeros => psb_d_diag_get_nzeros
end type psb_d_diag_prec_type
@ -225,4 +226,50 @@ contains
end function psb_d_diag_get_nzeros
subroutine psb_d_diag_clone(prec,precout,info)
use psb_error_mod
use psb_realloc_mod
Implicit None
class(psb_d_diag_prec_type), intent(inout) :: prec
class(psb_d_base_prec_type), allocatable, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, i
character(len=20) :: name='d_diag_clone'
call psb_erractionsave(err_act)
info = psb_success_
allocate(psb_d_diag_prec_type :: precout, stat=info)
if (info /= 0) goto 9999
select type(pout => precout)
type is (psb_d_diag_prec_type)
call pout%set_ctxt(prec%get_ctxt())
if (allocated(prec%dv)) then
allocate(pout%dv,stat=info)
if (info == 0) call prec%dv%clone(pout%dv,info)
end if
if (info == 0) call psb_safe_ab_cpy(prec%d,pout%d,info)
class default
info = psb_err_internal_error_
end select
if (info /= 0) goto 9999
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_d_diag_clone
end module psb_d_diagprec

@ -43,6 +43,7 @@ module psb_d_nullprec
procedure, pass(prec) :: precdescr => psb_d_null_precdescr
procedure, pass(prec) :: sizeof => psb_d_null_sizeof
procedure, pass(prec) :: dump => psb_d_null_dump
procedure, pass(prec) :: clone => psb_d_null_clone
end type psb_d_null_prec_type
private :: psb_d_null_precbld, psb_d_null_sizeof,&
@ -258,4 +259,46 @@ contains
return
end function psb_d_null_sizeof
subroutine psb_d_null_clone(prec,precout,info)
use psb_const_mod
use psb_error_mod
Implicit None
class(psb_d_null_prec_type), intent(inout) :: prec
class(psb_d_base_prec_type), allocatable, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, i
character(len=20) :: name='d_null_clone'
call psb_erractionsave(err_act)
info = psb_success_
allocate(psb_d_null_prec_type :: precout, stat=info)
if (info /= 0) goto 9999
select type(pout => precout)
type is (psb_d_null_prec_type)
call pout%set_ctxt(prec%get_ctxt())
class default
info = psb_err_internal_error_
end select
if (info /= 0) goto 9999
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_d_null_clone
end module psb_d_nullprec

@ -64,6 +64,7 @@ module psb_s_base_prec_mod
procedure(psb_s_base_precfree), pass(prec), deferred :: precfree
procedure(psb_s_base_precdescr), pass(prec), deferred :: precdescr
procedure(psb_s_base_precdump), pass(prec), deferred :: dump
procedure(psb_s_base_precclone), pass(prec), deferred :: clone
end type psb_s_base_prec_type
private :: psb_s_base_set_ctxt, psb_s_base_get_ctxt, &
@ -180,6 +181,18 @@ module psb_s_base_prec_mod
end subroutine psb_s_base_precdump
end interface
abstract interface
subroutine psb_s_base_precclone(prec,precout,info)
import psb_ipk_, psb_spk_, psb_desc_type, psb_s_vect_type, &
& psb_s_base_vect_type, psb_sspmat_type, psb_s_base_prec_type,&
& psb_s_base_sparse_mat
implicit none
class(psb_s_base_prec_type), intent(inout) :: prec
class(psb_s_base_prec_type), allocatable, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
end subroutine psb_s_base_precclone
end interface
contains
subroutine psb_s_base_precseti(prec,what,val,info)

@ -43,11 +43,12 @@ module psb_s_bjacprec
procedure, pass(prec) :: precbld => psb_s_bjac_precbld
procedure, pass(prec) :: precinit => psb_s_bjac_precinit
procedure, pass(prec) :: precseti => psb_s_bjac_precseti
procedure, pass(prec) :: precsetr => psb_s_bjac_precsetr
procedure, pass(prec) :: precsetc => psb_s_bjac_precsetc
!!$ procedure, pass(prec) :: precsetr => psb_s_bjac_precsetr
!!$ procedure, pass(prec) :: precsetc => psb_s_bjac_precsetc
procedure, pass(prec) :: precfree => psb_s_bjac_precfree
procedure, pass(prec) :: precdescr => psb_s_bjac_precdescr
procedure, pass(prec) :: dump => psb_s_bjac_dump
procedure, pass(prec) :: clone => psb_s_bjac_clone
procedure, pass(prec) :: sizeof => psb_s_bjac_sizeof
procedure, pass(prec) :: get_nzeros => psb_s_bjac_get_nzeros
end type psb_s_bjac_prec_type
@ -210,48 +211,33 @@ contains
end function psb_s_bjac_get_nzeros
subroutine psb_s_bjac_precsetr(prec,what,val,info)
subroutine psb_s_bjac_precfree(prec,info)
Implicit None
class(psb_s_bjac_prec_type),intent(inout) :: prec
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
class(psb_s_bjac_prec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, nrow
character(len=20) :: name='s_bjac_precset'
call psb_erractionsave(err_act)
info = psb_success_
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_s_bjac_precsetr
subroutine psb_s_bjac_precsetc(prec,what,val,info)
Implicit None
class(psb_s_bjac_prec_type),intent(inout) :: prec
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, nrow
character(len=20) :: name='s_bjac_precset'
integer(psb_ipk_) :: err_act, i
character(len=20) :: name='s_bjac_precfree'
call psb_erractionsave(err_act)
info = psb_success_
if (allocated(prec%av)) then
do i=1,size(prec%av)
call prec%av(i)%free()
enddo
deallocate(prec%av,stat=info)
end if
if (allocated(prec%dv)) then
call prec%dv%free(info)
if (info == 0) deallocate(prec%dv,stat=info)
end if
if (allocated(prec%iprcparm)) then
deallocate(prec%iprcparm,stat=info)
end if
call psb_erractionrestore(err_act)
return
@ -262,35 +248,49 @@ contains
return
end if
return
end subroutine psb_s_bjac_precsetc
subroutine psb_s_bjac_precfree(prec,info)
end subroutine psb_s_bjac_precfree
subroutine psb_s_bjac_clone(prec,precout,info)
use psb_error_mod
use psb_realloc_mod
Implicit None
class(psb_s_bjac_prec_type), intent(inout) :: prec
class(psb_s_base_prec_type), allocatable, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, i
character(len=20) :: name='s_bjac_precfree'
character(len=20) :: name='s_bjac_clone'
call psb_erractionsave(err_act)
info = psb_success_
allocate(psb_s_bjac_prec_type :: precout, stat=info)
if (info /= 0) goto 9999
select type(pout => precout)
type is (psb_s_bjac_prec_type)
call pout%set_ctxt(prec%get_ctxt())
if (allocated(prec%av)) then
allocate(pout%av(size(prec%av)),stat=info)
do i=1,size(prec%av)
call prec%av(i)%free()
if (info /= psb_success_) exit
call prec%av(i)%clone(pout%av(i),info)
enddo
deallocate(prec%av,stat=info)
if (info /= psb_success_) goto 9999
end if
if (allocated(prec%dv)) then
call prec%dv%free(info)
if (info == 0) deallocate(prec%dv,stat=info)
end if
if (allocated(prec%iprcparm)) then
deallocate(prec%iprcparm,stat=info)
allocate(pout%dv,stat=info)
if (info == 0) call prec%dv%clone(pout%dv,info)
end if
class default
info = psb_err_internal_error_
end select
if (info /= 0) goto 9999
call psb_erractionrestore(err_act)
return
@ -302,6 +302,6 @@ contains
end if
return
end subroutine psb_s_bjac_precfree
end subroutine psb_s_bjac_clone
end module psb_s_bjacprec

@ -45,6 +45,7 @@ module psb_s_diagprec
procedure, pass(prec) :: precdescr => psb_s_diag_precdescr
procedure, pass(prec) :: sizeof => psb_s_diag_sizeof
procedure, pass(prec) :: dump => psb_s_diag_dump
procedure, pass(prec) :: clone => psb_s_diag_clone
procedure, pass(prec) :: get_nzeros => psb_s_diag_get_nzeros
end type psb_s_diag_prec_type
@ -225,4 +226,50 @@ contains
end function psb_s_diag_get_nzeros
subroutine psb_s_diag_clone(prec,precout,info)
use psb_error_mod
use psb_realloc_mod
Implicit None
class(psb_s_diag_prec_type), intent(inout) :: prec
class(psb_s_base_prec_type), allocatable, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, i
character(len=20) :: name='s_diag_clone'
call psb_erractionsave(err_act)
info = psb_success_
allocate(psb_s_diag_prec_type :: precout, stat=info)
if (info /= 0) goto 9999
select type(pout => precout)
type is (psb_s_diag_prec_type)
call pout%set_ctxt(prec%get_ctxt())
if (allocated(prec%dv)) then
allocate(pout%dv,stat=info)
if (info == 0) call prec%dv%clone(pout%dv,info)
end if
if (info == 0) call psb_safe_ab_cpy(prec%d,pout%d,info)
class default
info = psb_err_internal_error_
end select
if (info /= 0) goto 9999
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_s_diag_clone
end module psb_s_diagprec

@ -43,6 +43,7 @@ module psb_s_nullprec
procedure, pass(prec) :: precdescr => psb_s_null_precdescr
procedure, pass(prec) :: sizeof => psb_s_null_sizeof
procedure, pass(prec) :: dump => psb_s_null_dump
procedure, pass(prec) :: clone => psb_s_null_clone
end type psb_s_null_prec_type
private :: psb_s_null_precbld, psb_s_null_sizeof,&
@ -258,4 +259,46 @@ contains
return
end function psb_s_null_sizeof
subroutine psb_s_null_clone(prec,precout,info)
use psb_const_mod
use psb_error_mod
Implicit None
class(psb_s_null_prec_type), intent(inout) :: prec
class(psb_s_base_prec_type), allocatable, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, i
character(len=20) :: name='s_null_clone'
call psb_erractionsave(err_act)
info = psb_success_
allocate(psb_s_null_prec_type :: precout, stat=info)
if (info /= 0) goto 9999
select type(pout => precout)
type is (psb_s_null_prec_type)
call pout%set_ctxt(prec%get_ctxt())
class default
info = psb_err_internal_error_
end select
if (info /= 0) goto 9999
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_s_null_clone
end module psb_s_nullprec

@ -64,6 +64,7 @@ module psb_z_base_prec_mod
procedure(psb_z_base_precfree), pass(prec), deferred :: precfree
procedure(psb_z_base_precdescr), pass(prec), deferred :: precdescr
procedure(psb_z_base_precdump), pass(prec), deferred :: dump
procedure(psb_z_base_precclone), pass(prec), deferred :: clone
end type psb_z_base_prec_type
private :: psb_z_base_set_ctxt, psb_z_base_get_ctxt, &
@ -180,6 +181,18 @@ module psb_z_base_prec_mod
end subroutine psb_z_base_precdump
end interface
abstract interface
subroutine psb_z_base_precclone(prec,precout,info)
import psb_ipk_, psb_dpk_, psb_desc_type, psb_z_vect_type, &
& psb_z_base_vect_type, psb_zspmat_type, psb_z_base_prec_type,&
& psb_z_base_sparse_mat
implicit none
class(psb_z_base_prec_type), intent(inout) :: prec
class(psb_z_base_prec_type), allocatable, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
end subroutine psb_z_base_precclone
end interface
contains
subroutine psb_z_base_precseti(prec,what,val,info)

@ -43,11 +43,12 @@ module psb_z_bjacprec
procedure, pass(prec) :: precbld => psb_z_bjac_precbld
procedure, pass(prec) :: precinit => psb_z_bjac_precinit
procedure, pass(prec) :: precseti => psb_z_bjac_precseti
procedure, pass(prec) :: precsetr => psb_z_bjac_precsetr
procedure, pass(prec) :: precsetc => psb_z_bjac_precsetc
!!$ procedure, pass(prec) :: precsetr => psb_z_bjac_precsetr
!!$ procedure, pass(prec) :: precsetc => psb_z_bjac_precsetc
procedure, pass(prec) :: precfree => psb_z_bjac_precfree
procedure, pass(prec) :: precdescr => psb_z_bjac_precdescr
procedure, pass(prec) :: dump => psb_z_bjac_dump
procedure, pass(prec) :: clone => psb_z_bjac_clone
procedure, pass(prec) :: sizeof => psb_z_bjac_sizeof
procedure, pass(prec) :: get_nzeros => psb_z_bjac_get_nzeros
end type psb_z_bjac_prec_type
@ -210,48 +211,33 @@ contains
end function psb_z_bjac_get_nzeros
subroutine psb_z_bjac_precsetr(prec,what,val,info)
subroutine psb_z_bjac_precfree(prec,info)
Implicit None
class(psb_z_bjac_prec_type),intent(inout) :: prec
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
class(psb_z_bjac_prec_type), intent(inout) :: prec
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, nrow
character(len=20) :: name='z_bjac_precset'
call psb_erractionsave(err_act)
info = psb_success_
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_z_bjac_precsetr
subroutine psb_z_bjac_precsetc(prec,what,val,info)
Implicit None
class(psb_z_bjac_prec_type),intent(inout) :: prec
integer(psb_ipk_), intent(in) :: what
character(len=*), intent(in) :: val
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, nrow
character(len=20) :: name='z_bjac_precset'
integer(psb_ipk_) :: err_act, i
character(len=20) :: name='z_bjac_precfree'
call psb_erractionsave(err_act)
info = psb_success_
if (allocated(prec%av)) then
do i=1,size(prec%av)
call prec%av(i)%free()
enddo
deallocate(prec%av,stat=info)
end if
if (allocated(prec%dv)) then
call prec%dv%free(info)
if (info == 0) deallocate(prec%dv,stat=info)
end if
if (allocated(prec%iprcparm)) then
deallocate(prec%iprcparm,stat=info)
end if
call psb_erractionrestore(err_act)
return
@ -262,35 +248,49 @@ contains
return
end if
return
end subroutine psb_z_bjac_precsetc
subroutine psb_z_bjac_precfree(prec,info)
end subroutine psb_z_bjac_precfree
subroutine psb_z_bjac_clone(prec,precout,info)
use psb_error_mod
use psb_realloc_mod
Implicit None
class(psb_z_bjac_prec_type), intent(inout) :: prec
class(psb_z_base_prec_type), allocatable, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, i
character(len=20) :: name='z_bjac_precfree'
character(len=20) :: name='z_bjac_clone'
call psb_erractionsave(err_act)
info = psb_success_
allocate(psb_z_bjac_prec_type :: precout, stat=info)
if (info /= 0) goto 9999
select type(pout => precout)
type is (psb_z_bjac_prec_type)
call pout%set_ctxt(prec%get_ctxt())
if (allocated(prec%av)) then
allocate(pout%av(size(prec%av)),stat=info)
do i=1,size(prec%av)
call prec%av(i)%free()
if (info /= psb_success_) exit
call prec%av(i)%clone(pout%av(i),info)
enddo
deallocate(prec%av,stat=info)
if (info /= psb_success_) goto 9999
end if
if (allocated(prec%dv)) then
call prec%dv%free(info)
if (info == 0) deallocate(prec%dv,stat=info)
end if
if (allocated(prec%iprcparm)) then
deallocate(prec%iprcparm,stat=info)
allocate(pout%dv,stat=info)
if (info == 0) call prec%dv%clone(pout%dv,info)
end if
class default
info = psb_err_internal_error_
end select
if (info /= 0) goto 9999
call psb_erractionrestore(err_act)
return
@ -302,6 +302,6 @@ contains
end if
return
end subroutine psb_z_bjac_precfree
end subroutine psb_z_bjac_clone
end module psb_z_bjacprec

@ -45,6 +45,7 @@ module psb_z_diagprec
procedure, pass(prec) :: precdescr => psb_z_diag_precdescr
procedure, pass(prec) :: sizeof => psb_z_diag_sizeof
procedure, pass(prec) :: dump => psb_z_diag_dump
procedure, pass(prec) :: clone => psb_z_diag_clone
procedure, pass(prec) :: get_nzeros => psb_z_diag_get_nzeros
end type psb_z_diag_prec_type
@ -225,4 +226,50 @@ contains
end function psb_z_diag_get_nzeros
subroutine psb_z_diag_clone(prec,precout,info)
use psb_error_mod
use psb_realloc_mod
Implicit None
class(psb_z_diag_prec_type), intent(inout) :: prec
class(psb_z_base_prec_type), allocatable, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, i
character(len=20) :: name='z_diag_clone'
call psb_erractionsave(err_act)
info = psb_success_
allocate(psb_z_diag_prec_type :: precout, stat=info)
if (info /= 0) goto 9999
select type(pout => precout)
type is (psb_z_diag_prec_type)
call pout%set_ctxt(prec%get_ctxt())
if (allocated(prec%dv)) then
allocate(pout%dv,stat=info)
if (info == 0) call prec%dv%clone(pout%dv,info)
end if
if (info == 0) call psb_safe_ab_cpy(prec%d,pout%d,info)
class default
info = psb_err_internal_error_
end select
if (info /= 0) goto 9999
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_z_diag_clone
end module psb_z_diagprec

@ -43,6 +43,7 @@ module psb_z_nullprec
procedure, pass(prec) :: precdescr => psb_z_null_precdescr
procedure, pass(prec) :: sizeof => psb_z_null_sizeof
procedure, pass(prec) :: dump => psb_z_null_dump
procedure, pass(prec) :: clone => psb_z_null_clone
end type psb_z_null_prec_type
private :: psb_z_null_precbld, psb_z_null_sizeof,&
@ -258,4 +259,46 @@ contains
return
end function psb_z_null_sizeof
subroutine psb_z_null_clone(prec,precout,info)
use psb_const_mod
use psb_error_mod
Implicit None
class(psb_z_null_prec_type), intent(inout) :: prec
class(psb_z_base_prec_type), allocatable, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act, i
character(len=20) :: name='z_null_clone'
call psb_erractionsave(err_act)
info = psb_success_
allocate(psb_z_null_prec_type :: precout, stat=info)
if (info /= 0) goto 9999
select type(pout => precout)
type is (psb_z_null_prec_type)
call pout%set_ctxt(prec%get_ctxt())
class default
info = psb_err_internal_error_
end select
if (info /= 0) goto 9999
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
return
end subroutine psb_z_null_clone
end module psb_z_nullprec

Loading…
Cancel
Save