fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-19 20:32:12 +00:00
Code Issues Packages Projects Releases Wiki Activity

psblas3:

Browse Source 
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
This commit is contained in:
Salvatore Filippone
2013-03-31 20:57:16 +00:00
parent a50ce17bcb
commit b508c9ad85
21 changed files with 675 additions and 253 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/psb_c_vect_mod.F90
+3 -1
View File
@@ -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
base/modules/psb_d_vect_mod.F90
+3 -1
View File
@@ -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
base/modules/psb_i_vect_mod.F90
+3 -1
View File
@@ -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
base/modules/psb_s_vect_mod.F90
+3 -1
View File
@@ -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
base/modules/psb_z_vect_mod.F90
+3 -1
View File
@@ -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
prec/psb_c_base_prec_mod.f90
+13
View File
@@ -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, &
@@ -179,6 +180,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
prec/psb_c_bjacprec.f90
+56 -56
View File
@@ -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,60 +211,6 @@ contains
end function psb_c_bjac_get_nzeros
subroutine psb_c_bjac_precsetr(prec,what,val,info)
Implicit None
class(psb_c_bjac_prec_type),intent(inout) :: prec
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
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'
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_precsetc
subroutine psb_c_bjac_precfree(prec,info)
Implicit None
@@ -304,4 +251,57 @@ contains
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_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)
if (info /= psb_success_) exit
call prec%av(i)%clone(pout%av(i),info)
enddo
if (info /= psb_success_) goto 9999
end if
if (allocated(prec%dv)) then
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
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_clone
end module psb_c_bjacprec
prec/psb_c_diagprec.f90
+53 -6
View File
@@ -39,12 +39,13 @@ module psb_c_diagprec
contains
procedure, pass(prec) :: c_apply_v => psb_c_diag_apply_vect
procedure, pass(prec) :: c_apply => psb_c_diag_apply
procedure, pass(prec) :: precbld => psb_c_diag_precbld
procedure, pass(prec) :: precinit => psb_c_diag_precinit
procedure, pass(prec) :: precfree => psb_c_diag_precfree
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) :: precbld => psb_c_diag_precbld
procedure, pass(prec) :: precinit => psb_c_diag_precinit
procedure, pass(prec) :: precfree => psb_c_diag_precfree
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
prec/psb_c_nullprec.f90
+43
View File
@@ -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
prec/psb_d_base_prec_mod.f90
+13
View File
@@ -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, &
@@ -179,6 +180,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
prec/psb_d_bjacprec.f90
+56 -56
View File
@@ -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,60 +211,6 @@ contains
end function psb_d_bjac_get_nzeros
subroutine psb_d_bjac_precsetr(prec,what,val,info)
Implicit None
class(psb_d_bjac_prec_type),intent(inout) :: prec
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
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'
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_precsetc
subroutine psb_d_bjac_precfree(prec,info)
Implicit None
@@ -304,4 +251,57 @@ contains
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_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)
if (info /= psb_success_) exit
call prec%av(i)%clone(pout%av(i),info)
enddo
if (info /= psb_success_) goto 9999
end if
if (allocated(prec%dv)) then
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
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_clone
end module psb_d_bjacprec
prec/psb_d_diagprec.f90
+53 -6
View File
@@ -39,12 +39,13 @@ module psb_d_diagprec
contains
procedure, pass(prec) :: d_apply_v => psb_d_diag_apply_vect
procedure, pass(prec) :: d_apply => psb_d_diag_apply
procedure, pass(prec) :: precbld => psb_d_diag_precbld
procedure, pass(prec) :: precinit => psb_d_diag_precinit
procedure, pass(prec) :: precfree => psb_d_diag_precfree
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) :: precbld => psb_d_diag_precbld
procedure, pass(prec) :: precinit => psb_d_diag_precinit
procedure, pass(prec) :: precfree => psb_d_diag_precfree
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
prec/psb_d_nullprec.f90
+43
View File
@@ -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
prec/psb_s_base_prec_mod.f90
+13
View File
@@ -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, &
@@ -179,6 +180,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
prec/psb_s_bjacprec.f90
+56 -56
View File
@@ -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,60 +211,6 @@ contains
end function psb_s_bjac_get_nzeros
subroutine psb_s_bjac_precsetr(prec,what,val,info)
Implicit None
class(psb_s_bjac_prec_type),intent(inout) :: prec
integer(psb_ipk_), intent(in) :: what
real(psb_spk_), intent(in) :: val
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'
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_precsetc
subroutine psb_s_bjac_precfree(prec,info)
Implicit None
@@ -304,4 +251,57 @@ contains
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_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)
if (info /= psb_success_) exit
call prec%av(i)%clone(pout%av(i),info)
enddo
if (info /= psb_success_) goto 9999
end if
if (allocated(prec%dv)) then
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
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_clone
end module psb_s_bjacprec
prec/psb_s_diagprec.f90
+53 -6
View File
@@ -39,12 +39,13 @@ module psb_s_diagprec
contains
procedure, pass(prec) :: s_apply_v => psb_s_diag_apply_vect
procedure, pass(prec) :: s_apply => psb_s_diag_apply
procedure, pass(prec) :: precbld => psb_s_diag_precbld
procedure, pass(prec) :: precinit => psb_s_diag_precinit
procedure, pass(prec) :: precfree => psb_s_diag_precfree
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) :: precbld => psb_s_diag_precbld
procedure, pass(prec) :: precinit => psb_s_diag_precinit
procedure, pass(prec) :: precfree => psb_s_diag_precfree
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
prec/psb_s_nullprec.f90
+43
View File
@@ -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
prec/psb_z_base_prec_mod.f90
+13
View File
@@ -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, &
@@ -179,6 +180,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
prec/psb_z_bjacprec.f90
+56 -56
View File
@@ -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,60 +211,6 @@ contains
end function psb_z_bjac_get_nzeros
subroutine psb_z_bjac_precsetr(prec,what,val,info)
Implicit None
class(psb_z_bjac_prec_type),intent(inout) :: prec
integer(psb_ipk_), intent(in) :: what
real(psb_dpk_), intent(in) :: val
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'
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_precsetc
subroutine psb_z_bjac_precfree(prec,info)
Implicit None
@@ -304,4 +251,57 @@ contains
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_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)
if (info /= psb_success_) exit
call prec%av(i)%clone(pout%av(i),info)
enddo
if (info /= psb_success_) goto 9999
end if
if (allocated(prec%dv)) then
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
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_clone
end module psb_z_bjacprec
prec/psb_z_diagprec.f90
+53 -6
View File
@@ -39,12 +39,13 @@ module psb_z_diagprec
contains
procedure, pass(prec) :: z_apply_v => psb_z_diag_apply_vect
procedure, pass(prec) :: z_apply => psb_z_diag_apply
procedure, pass(prec) :: precbld => psb_z_diag_precbld
procedure, pass(prec) :: precinit => psb_z_diag_precinit
procedure, pass(prec) :: precfree => psb_z_diag_precfree
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) :: precbld => psb_z_diag_precbld
procedure, pass(prec) :: precinit => psb_z_diag_precinit
procedure, pass(prec) :: precfree => psb_z_diag_precfree
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
prec/psb_z_nullprec.f90
+43
View File
@@ -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