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

mld2p4-2

Browse Source 
mlprec/mld_c_onelev_mod.f90
 mlprec/mld_c_prec_type.f90
 mlprec/mld_d_onelev_mod.f90
 mlprec/mld_d_prec_type.f90
 mlprec/mld_s_onelev_mod.f90
 mlprec/mld_s_prec_type.f90
 mlprec/mld_z_onelev_mod.f90
 mlprec/mld_z_prec_type.f90

Defined CLONE method in mld level/prec type.
This commit is contained in:
Salvatore Filippone
2013-04-04 10:35:02 +00:00
parent 851800d9a5
commit 1fbe3ddb1c
8 changed files with 284 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mlprec/mld_c_onelev_mod.f90
+33 -7
View File
@@ -120,13 +120,14 @@ module mld_c_onelev_mod
!
type mld_c_onelev_type
class(mld_c_base_smoother_type), allocatable :: sm
type(mld_sml_parms) :: parms
type(psb_cspmat_type) :: ac
type(psb_desc_type) :: desc_ac
type(psb_cspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_clinmap_type) :: map
type(mld_sml_parms) :: parms
type(psb_cspmat_type) :: ac
type(psb_desc_type) :: desc_ac
type(psb_cspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_clinmap_type) :: map
contains
procedure, pass(lv) :: clone => c_base_onelev_clone
procedure, pass(lv) :: descr => mld_c_base_onelev_descr
procedure, pass(lv) :: default => c_base_onelev_default
procedure, pass(lv) :: free => mld_c_base_onelev_free
@@ -151,7 +152,8 @@ module mld_c_onelev_mod
end type mld_c_onelev_node
private :: c_base_onelev_default, c_base_onelev_sizeof, &
& c_base_onelev_nullify, c_base_onelev_get_nzeros
& c_base_onelev_nullify, c_base_onelev_get_nzeros, &
& c_base_onelev_clone
@@ -376,6 +378,30 @@ contains
end subroutine c_base_onelev_default
subroutine c_base_onelev_clone(lv,lvout,info)
Implicit None
! Arguments
class(mld_c_onelev_type), target, intent(inout) :: lv
class(mld_c_onelev_type), intent(out) :: lvout
integer(psb_ipk_), intent(out) :: info
if (allocated(lv%sm)) &
& call lv%sm%clone(lvout%sm,info)
if (info == psb_success_) call lv%parms%clone(lvout%parms,info)
if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
if (info == psb_success_) call lv%map%clone(lvout%map,info)
lvout%base_a => lv%base_a
lvout%base_desc => lv%base_desc
return
end subroutine c_base_onelev_clone
subroutine mld_c_onelev_move_alloc(a, b,info)
use psb_base_mod
implicit none
mlprec/mld_c_prec_type.f90
+38 -1
View File
@@ -89,7 +89,8 @@ module mld_c_prec_type
procedure, pass(prec) :: psb_c_apply1_vect => mld_c_apply1_vect
procedure, pass(prec) :: psb_c_apply2v => mld_c_apply2v
procedure, pass(prec) :: psb_c_apply1v => mld_c_apply1v
procedure, pass(prec) :: dump => mld_c_dump
procedure, pass(prec) :: dump => mld_c_dump
procedure, pass(prec) :: clone => mld_c_clone
procedure, pass(prec) :: get_complexity => mld_c_get_compl
procedure, pass(prec) :: cmp_complexity => mld_c_cmp_compl
procedure, pass(prec) :: get_nzeros => mld_c_get_nzeros
@@ -722,6 +723,42 @@ contains
end subroutine mld_c_dump
subroutine mld_c_clone(prec,precout,info)
implicit none
class(mld_cprec_type), intent(inout) :: prec
class(mld_cprec_type), target, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
! Local vars
integer(psb_ipk_) :: i, j, il1, ln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np
info = psb_success_
precout%ictxt = prec%ictxt
precout%coarse_aggr_size = prec%coarse_aggr_size
precout%op_complexity = prec%op_complexity
if (allocated(prec%precv)) then
ln = size(prec%precv)
allocate(precout%precv(ln),stat=info)
if (info /= psb_success_) goto 9999
if (ln > 1) then
call prec%precv(1)%clone(precout%precv(1),info)
end if
do lev=2, ln
if (info /= psb_success_) exit
call prec%precv(lev)%clone(precout%precv(lev),info)
if (info == psb_success_) then
precout%precv(lev)%base_a => precout%precv(lev)%ac
precout%precv(lev)%base_desc => precout%precv(lev)%desc_ac
precout%precv(lev)%map%p_desc_X => precout%precv(lev-1)%base_desc
precout%precv(lev)%map%p_desc_Y => precout%precv(lev)%base_desc
end if
end do
end if
9999 continue
end subroutine mld_c_clone
subroutine mld_cprec_move_alloc(a, b,info)
use psb_base_mod
implicit none
mlprec/mld_d_onelev_mod.f90
+33 -7
View File
@@ -120,13 +120,14 @@ module mld_d_onelev_mod
!
type mld_d_onelev_type
class(mld_d_base_smoother_type), allocatable :: sm
type(mld_dml_parms) :: parms
type(psb_dspmat_type) :: ac
type(psb_desc_type) :: desc_ac
type(psb_dspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_dlinmap_type) :: map
type(mld_dml_parms) :: parms
type(psb_dspmat_type) :: ac
type(psb_desc_type) :: desc_ac
type(psb_dspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_dlinmap_type) :: map
contains
procedure, pass(lv) :: clone => d_base_onelev_clone
procedure, pass(lv) :: descr => mld_d_base_onelev_descr
procedure, pass(lv) :: default => d_base_onelev_default
procedure, pass(lv) :: free => mld_d_base_onelev_free
@@ -151,7 +152,8 @@ module mld_d_onelev_mod
end type mld_d_onelev_node
private :: d_base_onelev_default, d_base_onelev_sizeof, &
& d_base_onelev_nullify, d_base_onelev_get_nzeros
& d_base_onelev_nullify, d_base_onelev_get_nzeros, &
& d_base_onelev_clone
@@ -376,6 +378,30 @@ contains
end subroutine d_base_onelev_default
subroutine d_base_onelev_clone(lv,lvout,info)
Implicit None
! Arguments
class(mld_d_onelev_type), target, intent(inout) :: lv
class(mld_d_onelev_type), intent(out) :: lvout
integer(psb_ipk_), intent(out) :: info
if (allocated(lv%sm)) &
& call lv%sm%clone(lvout%sm,info)
if (info == psb_success_) call lv%parms%clone(lvout%parms,info)
if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
if (info == psb_success_) call lv%map%clone(lvout%map,info)
lvout%base_a => lv%base_a
lvout%base_desc => lv%base_desc
return
end subroutine d_base_onelev_clone
subroutine mld_d_onelev_move_alloc(a, b,info)
use psb_base_mod
implicit none
mlprec/mld_d_prec_type.f90
+38 -1
View File
@@ -89,7 +89,8 @@ module mld_d_prec_type
procedure, pass(prec) :: psb_d_apply1_vect => mld_d_apply1_vect
procedure, pass(prec) :: psb_d_apply2v => mld_d_apply2v
procedure, pass(prec) :: psb_d_apply1v => mld_d_apply1v
procedure, pass(prec) :: dump => mld_d_dump
procedure, pass(prec) :: dump => mld_d_dump
procedure, pass(prec) :: clone => mld_d_clone
procedure, pass(prec) :: get_complexity => mld_d_get_compl
procedure, pass(prec) :: cmp_complexity => mld_d_cmp_compl
procedure, pass(prec) :: get_nzeros => mld_d_get_nzeros
@@ -722,6 +723,42 @@ contains
end subroutine mld_d_dump
subroutine mld_d_clone(prec,precout,info)
implicit none
class(mld_dprec_type), intent(inout) :: prec
class(mld_dprec_type), target, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
! Local vars
integer(psb_ipk_) :: i, j, il1, ln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np
info = psb_success_
precout%ictxt = prec%ictxt
precout%coarse_aggr_size = prec%coarse_aggr_size
precout%op_complexity = prec%op_complexity
if (allocated(prec%precv)) then
ln = size(prec%precv)
allocate(precout%precv(ln),stat=info)
if (info /= psb_success_) goto 9999
if (ln > 1) then
call prec%precv(1)%clone(precout%precv(1),info)
end if
do lev=2, ln
if (info /= psb_success_) exit
call prec%precv(lev)%clone(precout%precv(lev),info)
if (info == psb_success_) then
precout%precv(lev)%base_a => precout%precv(lev)%ac
precout%precv(lev)%base_desc => precout%precv(lev)%desc_ac
precout%precv(lev)%map%p_desc_X => precout%precv(lev-1)%base_desc
precout%precv(lev)%map%p_desc_Y => precout%precv(lev)%base_desc
end if
end do
end if
9999 continue
end subroutine mld_d_clone
subroutine mld_dprec_move_alloc(a, b,info)
use psb_base_mod
implicit none
mlprec/mld_s_onelev_mod.f90
+33 -7
View File
@@ -120,13 +120,14 @@ module mld_s_onelev_mod
!
type mld_s_onelev_type
class(mld_s_base_smoother_type), allocatable :: sm
type(mld_sml_parms) :: parms
type(psb_sspmat_type) :: ac
type(psb_desc_type) :: desc_ac
type(psb_sspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_slinmap_type) :: map
type(mld_sml_parms) :: parms
type(psb_sspmat_type) :: ac
type(psb_desc_type) :: desc_ac
type(psb_sspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_slinmap_type) :: map
contains
procedure, pass(lv) :: clone => s_base_onelev_clone
procedure, pass(lv) :: descr => mld_s_base_onelev_descr
procedure, pass(lv) :: default => s_base_onelev_default
procedure, pass(lv) :: free => mld_s_base_onelev_free
@@ -151,7 +152,8 @@ module mld_s_onelev_mod
end type mld_s_onelev_node
private :: s_base_onelev_default, s_base_onelev_sizeof, &
& s_base_onelev_nullify, s_base_onelev_get_nzeros
& s_base_onelev_nullify, s_base_onelev_get_nzeros, &
& s_base_onelev_clone
@@ -376,6 +378,30 @@ contains
end subroutine s_base_onelev_default
subroutine s_base_onelev_clone(lv,lvout,info)
Implicit None
! Arguments
class(mld_s_onelev_type), target, intent(inout) :: lv
class(mld_s_onelev_type), intent(out) :: lvout
integer(psb_ipk_), intent(out) :: info
if (allocated(lv%sm)) &
& call lv%sm%clone(lvout%sm,info)
if (info == psb_success_) call lv%parms%clone(lvout%parms,info)
if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
if (info == psb_success_) call lv%map%clone(lvout%map,info)
lvout%base_a => lv%base_a
lvout%base_desc => lv%base_desc
return
end subroutine s_base_onelev_clone
subroutine mld_s_onelev_move_alloc(a, b,info)
use psb_base_mod
implicit none
mlprec/mld_s_prec_type.f90
+38 -1
View File
@@ -89,7 +89,8 @@ module mld_s_prec_type
procedure, pass(prec) :: psb_s_apply1_vect => mld_s_apply1_vect
procedure, pass(prec) :: psb_s_apply2v => mld_s_apply2v
procedure, pass(prec) :: psb_s_apply1v => mld_s_apply1v
procedure, pass(prec) :: dump => mld_s_dump
procedure, pass(prec) :: dump => mld_s_dump
procedure, pass(prec) :: clone => mld_s_clone
procedure, pass(prec) :: get_complexity => mld_s_get_compl
procedure, pass(prec) :: cmp_complexity => mld_s_cmp_compl
procedure, pass(prec) :: get_nzeros => mld_s_get_nzeros
@@ -722,6 +723,42 @@ contains
end subroutine mld_s_dump
subroutine mld_s_clone(prec,precout,info)
implicit none
class(mld_sprec_type), intent(inout) :: prec
class(mld_sprec_type), target, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
! Local vars
integer(psb_ipk_) :: i, j, il1, ln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np
info = psb_success_
precout%ictxt = prec%ictxt
precout%coarse_aggr_size = prec%coarse_aggr_size
precout%op_complexity = prec%op_complexity
if (allocated(prec%precv)) then
ln = size(prec%precv)
allocate(precout%precv(ln),stat=info)
if (info /= psb_success_) goto 9999
if (ln > 1) then
call prec%precv(1)%clone(precout%precv(1),info)
end if
do lev=2, ln
if (info /= psb_success_) exit
call prec%precv(lev)%clone(precout%precv(lev),info)
if (info == psb_success_) then
precout%precv(lev)%base_a => precout%precv(lev)%ac
precout%precv(lev)%base_desc => precout%precv(lev)%desc_ac
precout%precv(lev)%map%p_desc_X => precout%precv(lev-1)%base_desc
precout%precv(lev)%map%p_desc_Y => precout%precv(lev)%base_desc
end if
end do
end if
9999 continue
end subroutine mld_s_clone
subroutine mld_sprec_move_alloc(a, b,info)
use psb_base_mod
implicit none
mlprec/mld_z_onelev_mod.f90
+33 -7
View File
@@ -120,13 +120,14 @@ module mld_z_onelev_mod
!
type mld_z_onelev_type
class(mld_z_base_smoother_type), allocatable :: sm
type(mld_dml_parms) :: parms
type(psb_zspmat_type) :: ac
type(psb_desc_type) :: desc_ac
type(psb_zspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_zlinmap_type) :: map
type(mld_dml_parms) :: parms
type(psb_zspmat_type) :: ac
type(psb_desc_type) :: desc_ac
type(psb_zspmat_type), pointer :: base_a => null()
type(psb_desc_type), pointer :: base_desc => null()
type(psb_zlinmap_type) :: map
contains
procedure, pass(lv) :: clone => z_base_onelev_clone
procedure, pass(lv) :: descr => mld_z_base_onelev_descr
procedure, pass(lv) :: default => z_base_onelev_default
procedure, pass(lv) :: free => mld_z_base_onelev_free
@@ -151,7 +152,8 @@ module mld_z_onelev_mod
end type mld_z_onelev_node
private :: z_base_onelev_default, z_base_onelev_sizeof, &
& z_base_onelev_nullify, z_base_onelev_get_nzeros
& z_base_onelev_nullify, z_base_onelev_get_nzeros, &
& z_base_onelev_clone
@@ -376,6 +378,30 @@ contains
end subroutine z_base_onelev_default
subroutine z_base_onelev_clone(lv,lvout,info)
Implicit None
! Arguments
class(mld_z_onelev_type), target, intent(inout) :: lv
class(mld_z_onelev_type), intent(out) :: lvout
integer(psb_ipk_), intent(out) :: info
if (allocated(lv%sm)) &
& call lv%sm%clone(lvout%sm,info)
if (info == psb_success_) call lv%parms%clone(lvout%parms,info)
if (info == psb_success_) call lv%ac%clone(lvout%ac,info)
if (info == psb_success_) call lv%desc_ac%clone(lvout%desc_ac,info)
if (info == psb_success_) call lv%map%clone(lvout%map,info)
lvout%base_a => lv%base_a
lvout%base_desc => lv%base_desc
return
end subroutine z_base_onelev_clone
subroutine mld_z_onelev_move_alloc(a, b,info)
use psb_base_mod
implicit none
mlprec/mld_z_prec_type.f90
+38 -1
View File
@@ -89,7 +89,8 @@ module mld_z_prec_type
procedure, pass(prec) :: psb_z_apply1_vect => mld_z_apply1_vect
procedure, pass(prec) :: psb_z_apply2v => mld_z_apply2v
procedure, pass(prec) :: psb_z_apply1v => mld_z_apply1v
procedure, pass(prec) :: dump => mld_z_dump
procedure, pass(prec) :: dump => mld_z_dump
procedure, pass(prec) :: clone => mld_z_clone
procedure, pass(prec) :: get_complexity => mld_z_get_compl
procedure, pass(prec) :: cmp_complexity => mld_z_cmp_compl
procedure, pass(prec) :: get_nzeros => mld_z_get_nzeros
@@ -722,6 +723,42 @@ contains
end subroutine mld_z_dump
subroutine mld_z_clone(prec,precout,info)
implicit none
class(mld_zprec_type), intent(inout) :: prec
class(mld_zprec_type), target, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
! Local vars
integer(psb_ipk_) :: i, j, il1, ln, lname, lev
integer(psb_ipk_) :: icontxt,iam, np
info = psb_success_
precout%ictxt = prec%ictxt
precout%coarse_aggr_size = prec%coarse_aggr_size
precout%op_complexity = prec%op_complexity
if (allocated(prec%precv)) then
ln = size(prec%precv)
allocate(precout%precv(ln),stat=info)
if (info /= psb_success_) goto 9999
if (ln > 1) then
call prec%precv(1)%clone(precout%precv(1),info)
end if
do lev=2, ln
if (info /= psb_success_) exit
call prec%precv(lev)%clone(precout%precv(lev),info)
if (info == psb_success_) then
precout%precv(lev)%base_a => precout%precv(lev)%ac
precout%precv(lev)%base_desc => precout%precv(lev)%desc_ac
precout%precv(lev)%map%p_desc_X => precout%precv(lev-1)%base_desc
precout%precv(lev)%map%p_desc_Y => precout%precv(lev)%base_desc
end if
end do
end if
9999 continue
end subroutine mld_z_clone
subroutine mld_zprec_move_alloc(a, b,info)
use psb_base_mod
implicit none