mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-06 22:55:12 +00:00
mld2p4-2:
mlprec/impl/mld_cmlprec_bld.f90 mlprec/impl/mld_dmlprec_bld.f90 mlprec/impl/mld_smlprec_bld.f90 mlprec/impl/mld_zmlprec_bld.f90 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 tests/pdegen/runs/ppde.inp Take out mld_move_alloc, transform it into method(s).
This commit is contained in:
Salvatore Filippone
@@ -293,7 +293,7 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! First do a move_alloc.
|
||||
! This handles the AC, DESC_AC and MAP fields
|
||||
if (info == psb_success_) &
|
||||
& call mld_move_alloc(current%item,p%precv(i),info)
|
||||
& call current%item%move_alloc(p%precv(i),info)
|
||||
! Now set the smoother/solver parts.
|
||||
if (info == psb_success_) then
|
||||
if (i ==1) then
|
||||
@@ -422,13 +422,13 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
goto 9999
|
||||
endif
|
||||
do i=1,newsz-1
|
||||
call mld_move_alloc(p%precv(i),t_prec%precv(i),info)
|
||||
call p%precv(i)%move_alloc(t_prec%precv(i),info)
|
||||
end do
|
||||
call mld_move_alloc(p%precv(iszv),t_prec%precv(newsz),info)
|
||||
call p%precv(iszv)%move_alloc(t_prec%precv(newsz),info)
|
||||
do i=newsz+1, iszv
|
||||
call p%precv(i)%free(info)
|
||||
end do
|
||||
call mld_move_alloc(t_prec,p,info)
|
||||
call t_prec%move_alloc(p,info)
|
||||
! Ignore errors from transfer
|
||||
info = psb_success_
|
||||
!
|
||||
|
||||
@@ -293,7 +293,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! First do a move_alloc.
|
||||
! This handles the AC, DESC_AC and MAP fields
|
||||
if (info == psb_success_) &
|
||||
& call mld_move_alloc(current%item,p%precv(i),info)
|
||||
& call current%item%move_alloc(p%precv(i),info)
|
||||
! Now set the smoother/solver parts.
|
||||
if (info == psb_success_) then
|
||||
if (i ==1) then
|
||||
@@ -422,13 +422,13 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
goto 9999
|
||||
endif
|
||||
do i=1,newsz-1
|
||||
call mld_move_alloc(p%precv(i),t_prec%precv(i),info)
|
||||
call p%precv(i)%move_alloc(t_prec%precv(i),info)
|
||||
end do
|
||||
call mld_move_alloc(p%precv(iszv),t_prec%precv(newsz),info)
|
||||
call p%precv(iszv)%move_alloc(t_prec%precv(newsz),info)
|
||||
do i=newsz+1, iszv
|
||||
call p%precv(i)%free(info)
|
||||
end do
|
||||
call mld_move_alloc(t_prec,p,info)
|
||||
call t_prec%move_alloc(p,info)
|
||||
! Ignore errors from transfer
|
||||
info = psb_success_
|
||||
!
|
||||
|
||||
@@ -293,7 +293,7 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! First do a move_alloc.
|
||||
! This handles the AC, DESC_AC and MAP fields
|
||||
if (info == psb_success_) &
|
||||
& call mld_move_alloc(current%item,p%precv(i),info)
|
||||
& call current%item%move_alloc(p%precv(i),info)
|
||||
! Now set the smoother/solver parts.
|
||||
if (info == psb_success_) then
|
||||
if (i ==1) then
|
||||
@@ -422,13 +422,13 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
goto 9999
|
||||
endif
|
||||
do i=1,newsz-1
|
||||
call mld_move_alloc(p%precv(i),t_prec%precv(i),info)
|
||||
call p%precv(i)%move_alloc(t_prec%precv(i),info)
|
||||
end do
|
||||
call mld_move_alloc(p%precv(iszv),t_prec%precv(newsz),info)
|
||||
call p%precv(iszv)%move_alloc(t_prec%precv(newsz),info)
|
||||
do i=newsz+1, iszv
|
||||
call p%precv(i)%free(info)
|
||||
end do
|
||||
call mld_move_alloc(t_prec,p,info)
|
||||
call t_prec%move_alloc(p,info)
|
||||
! Ignore errors from transfer
|
||||
info = psb_success_
|
||||
!
|
||||
|
||||
@@ -293,7 +293,7 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
! First do a move_alloc.
|
||||
! This handles the AC, DESC_AC and MAP fields
|
||||
if (info == psb_success_) &
|
||||
& call mld_move_alloc(current%item,p%precv(i),info)
|
||||
& call current%item%move_alloc(p%precv(i),info)
|
||||
! Now set the smoother/solver parts.
|
||||
if (info == psb_success_) then
|
||||
if (i ==1) then
|
||||
@@ -422,13 +422,13 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
|
||||
goto 9999
|
||||
endif
|
||||
do i=1,newsz-1
|
||||
call mld_move_alloc(p%precv(i),t_prec%precv(i),info)
|
||||
call p%precv(i)%move_alloc(t_prec%precv(i),info)
|
||||
end do
|
||||
call mld_move_alloc(p%precv(iszv),t_prec%precv(newsz),info)
|
||||
call p%precv(iszv)%move_alloc(t_prec%precv(newsz),info)
|
||||
do i=newsz+1, iszv
|
||||
call p%precv(i)%free(info)
|
||||
end do
|
||||
call mld_move_alloc(t_prec,p,info)
|
||||
call t_prec%move_alloc(p,info)
|
||||
! Ignore errors from transfer
|
||||
info = psb_success_
|
||||
!
|
||||
|
||||
+16
-19
@@ -152,6 +152,7 @@ module mld_c_onelev_mod
|
||||
procedure, pass(lv) :: sizeof => c_base_onelev_sizeof
|
||||
procedure, pass(lv) :: get_nzeros => c_base_onelev_get_nzeros
|
||||
procedure, nopass :: stringval => mld_stringval
|
||||
procedure, pass(lv) :: move_alloc => c_base_onelev_move_alloc
|
||||
end type mld_c_onelev_type
|
||||
|
||||
type mld_c_onelev_node
|
||||
@@ -161,7 +162,7 @@ module mld_c_onelev_mod
|
||||
|
||||
private :: c_base_onelev_default, c_base_onelev_sizeof, &
|
||||
& c_base_onelev_nullify, c_base_onelev_get_nzeros, &
|
||||
& c_base_onelev_clone
|
||||
& c_base_onelev_clone, c_base_onelev_move_alloc
|
||||
|
||||
|
||||
|
||||
@@ -351,10 +352,6 @@ module mld_c_onelev_mod
|
||||
end subroutine mld_c_base_onelev_dump
|
||||
end interface
|
||||
|
||||
interface mld_move_alloc
|
||||
module procedure mld_c_onelev_move_alloc
|
||||
end interface
|
||||
|
||||
contains
|
||||
!
|
||||
! Function returning the size of the mld_prec_type data structure
|
||||
@@ -484,30 +481,30 @@ contains
|
||||
end subroutine c_base_onelev_clone
|
||||
|
||||
|
||||
subroutine mld_c_onelev_move_alloc(a, b,info)
|
||||
subroutine c_base_onelev_move_alloc(lv, b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(mld_c_onelev_type), target, intent(inout) :: a, b
|
||||
class(mld_c_onelev_type), target, intent(inout) :: lv, b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
call b%free(info)
|
||||
b%parms = a%parms
|
||||
if (associated(a%sm2,a%sm2a)) then
|
||||
call move_alloc(a%sm,b%sm)
|
||||
call move_alloc(a%sm2a,b%sm2a)
|
||||
b%parms = lv%parms
|
||||
if (associated(lv%sm2,lv%sm2a)) then
|
||||
call move_alloc(lv%sm,b%sm)
|
||||
call move_alloc(lv%sm2a,b%sm2a)
|
||||
b%sm2 =>b%sm2a
|
||||
else
|
||||
call move_alloc(a%sm,b%sm)
|
||||
call move_alloc(a%sm2a,b%sm2a)
|
||||
call move_alloc(lv%sm,b%sm)
|
||||
call move_alloc(lv%sm2a,b%sm2a)
|
||||
b%sm2 =>b%sm
|
||||
end if
|
||||
|
||||
if (info == psb_success_) call psb_move_alloc(a%ac,b%ac,info)
|
||||
if (info == psb_success_) call psb_move_alloc(a%desc_ac,b%desc_ac,info)
|
||||
if (info == psb_success_) call psb_move_alloc(a%map,b%map,info)
|
||||
b%base_a => a%base_a
|
||||
b%base_desc => a%base_desc
|
||||
if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
|
||||
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
|
||||
if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info)
|
||||
b%base_a => lv%base_a
|
||||
b%base_desc => lv%base_desc
|
||||
|
||||
end subroutine mld_c_onelev_move_alloc
|
||||
end subroutine c_base_onelev_move_alloc
|
||||
|
||||
end module mld_c_onelev_mod
|
||||
|
||||
+27
-26
@@ -108,10 +108,11 @@ module mld_c_prec_type
|
||||
& cseti, csetc, csetr, setsm, setsv
|
||||
procedure, pass(prec) :: get_smoother => mld_c_get_smootherp
|
||||
procedure, pass(prec) :: get_solver => mld_c_get_solverp
|
||||
procedure, pass(prec) :: move_alloc => c_prec_move_alloc
|
||||
end type mld_cprec_type
|
||||
|
||||
private :: mld_c_dump, mld_c_get_compl, mld_c_cmp_compl,&
|
||||
& mld_c_get_nzeros
|
||||
& mld_c_get_nzeros, c_prec_move_alloc
|
||||
|
||||
|
||||
!
|
||||
@@ -255,11 +256,6 @@ module mld_c_prec_type
|
||||
end subroutine mld_ccprecsetc
|
||||
end interface
|
||||
|
||||
|
||||
interface mld_move_alloc
|
||||
module procedure mld_cprec_move_alloc
|
||||
end interface
|
||||
|
||||
contains
|
||||
!
|
||||
! Function returning a pointer to the smoother
|
||||
@@ -812,31 +808,36 @@ contains
|
||||
9999 continue
|
||||
end subroutine mld_c_inner_clone
|
||||
|
||||
subroutine mld_cprec_move_alloc(a, b,info)
|
||||
subroutine c_prec_move_alloc(prec, b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(mld_cprec_type), intent(inout) :: a
|
||||
type(mld_cprec_type), intent(inout), target :: b
|
||||
class(mld_cprec_type), intent(inout) :: prec
|
||||
class(mld_cprec_type), intent(inout), target :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
if (allocated(b%precv)) then
|
||||
! This might not be required if FINAL procedures are available.
|
||||
call mld_precfree(b,info)
|
||||
if (info /= psb_success_) then
|
||||
! ?????
|
||||
!!$ return
|
||||
endif
|
||||
if (same_type_as(prec,b)) then
|
||||
if (allocated(b%precv)) then
|
||||
! This might not be required if FINAL procedures are available.
|
||||
call b%free(info)
|
||||
if (info /= psb_success_) then
|
||||
!?????
|
||||
!!$ return
|
||||
endif
|
||||
end if
|
||||
|
||||
call move_alloc(prec%precv,b%precv)
|
||||
! Fix the pointers except on level 1.
|
||||
do i=2, size(b%precv)
|
||||
b%precv(i)%base_a => b%precv(i)%ac
|
||||
b%precv(i)%base_desc => b%precv(i)%desc_ac
|
||||
b%precv(i)%map%p_desc_X => b%precv(i-1)%base_desc
|
||||
b%precv(i)%map%p_desc_Y => b%precv(i)%base_desc
|
||||
end do
|
||||
else
|
||||
write(0,*) 'Warning: PREC%move_alloc onto different type?'
|
||||
info = psb_err_internal_error_
|
||||
end if
|
||||
|
||||
call move_alloc(a%precv,b%precv)
|
||||
! Fix the pointers except on level 1.
|
||||
do i=2, size(b%precv)
|
||||
b%precv(i)%base_a => b%precv(i)%ac
|
||||
b%precv(i)%base_desc => b%precv(i)%desc_ac
|
||||
b%precv(i)%map%p_desc_X => b%precv(i-1)%base_desc
|
||||
b%precv(i)%map%p_desc_Y => b%precv(i)%base_desc
|
||||
end do
|
||||
end subroutine mld_cprec_move_alloc
|
||||
end subroutine c_prec_move_alloc
|
||||
|
||||
end module mld_c_prec_type
|
||||
|
||||
+16
-19
@@ -152,6 +152,7 @@ module mld_d_onelev_mod
|
||||
procedure, pass(lv) :: sizeof => d_base_onelev_sizeof
|
||||
procedure, pass(lv) :: get_nzeros => d_base_onelev_get_nzeros
|
||||
procedure, nopass :: stringval => mld_stringval
|
||||
procedure, pass(lv) :: move_alloc => d_base_onelev_move_alloc
|
||||
end type mld_d_onelev_type
|
||||
|
||||
type mld_d_onelev_node
|
||||
@@ -161,7 +162,7 @@ module mld_d_onelev_mod
|
||||
|
||||
private :: d_base_onelev_default, d_base_onelev_sizeof, &
|
||||
& d_base_onelev_nullify, d_base_onelev_get_nzeros, &
|
||||
& d_base_onelev_clone
|
||||
& d_base_onelev_clone, d_base_onelev_move_alloc
|
||||
|
||||
|
||||
|
||||
@@ -351,10 +352,6 @@ module mld_d_onelev_mod
|
||||
end subroutine mld_d_base_onelev_dump
|
||||
end interface
|
||||
|
||||
interface mld_move_alloc
|
||||
module procedure mld_d_onelev_move_alloc
|
||||
end interface
|
||||
|
||||
contains
|
||||
!
|
||||
! Function returning the size of the mld_prec_type data structure
|
||||
@@ -484,30 +481,30 @@ contains
|
||||
end subroutine d_base_onelev_clone
|
||||
|
||||
|
||||
subroutine mld_d_onelev_move_alloc(a, b,info)
|
||||
subroutine d_base_onelev_move_alloc(lv, b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(mld_d_onelev_type), target, intent(inout) :: a, b
|
||||
class(mld_d_onelev_type), target, intent(inout) :: lv, b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
call b%free(info)
|
||||
b%parms = a%parms
|
||||
if (associated(a%sm2,a%sm2a)) then
|
||||
call move_alloc(a%sm,b%sm)
|
||||
call move_alloc(a%sm2a,b%sm2a)
|
||||
b%parms = lv%parms
|
||||
if (associated(lv%sm2,lv%sm2a)) then
|
||||
call move_alloc(lv%sm,b%sm)
|
||||
call move_alloc(lv%sm2a,b%sm2a)
|
||||
b%sm2 =>b%sm2a
|
||||
else
|
||||
call move_alloc(a%sm,b%sm)
|
||||
call move_alloc(a%sm2a,b%sm2a)
|
||||
call move_alloc(lv%sm,b%sm)
|
||||
call move_alloc(lv%sm2a,b%sm2a)
|
||||
b%sm2 =>b%sm
|
||||
end if
|
||||
|
||||
if (info == psb_success_) call psb_move_alloc(a%ac,b%ac,info)
|
||||
if (info == psb_success_) call psb_move_alloc(a%desc_ac,b%desc_ac,info)
|
||||
if (info == psb_success_) call psb_move_alloc(a%map,b%map,info)
|
||||
b%base_a => a%base_a
|
||||
b%base_desc => a%base_desc
|
||||
if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
|
||||
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
|
||||
if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info)
|
||||
b%base_a => lv%base_a
|
||||
b%base_desc => lv%base_desc
|
||||
|
||||
end subroutine mld_d_onelev_move_alloc
|
||||
end subroutine d_base_onelev_move_alloc
|
||||
|
||||
end module mld_d_onelev_mod
|
||||
|
||||
+27
-26
@@ -108,10 +108,11 @@ module mld_d_prec_type
|
||||
& cseti, csetc, csetr, setsm, setsv
|
||||
procedure, pass(prec) :: get_smoother => mld_d_get_smootherp
|
||||
procedure, pass(prec) :: get_solver => mld_d_get_solverp
|
||||
procedure, pass(prec) :: move_alloc => d_prec_move_alloc
|
||||
end type mld_dprec_type
|
||||
|
||||
private :: mld_d_dump, mld_d_get_compl, mld_d_cmp_compl,&
|
||||
& mld_d_get_nzeros
|
||||
& mld_d_get_nzeros, d_prec_move_alloc
|
||||
|
||||
|
||||
!
|
||||
@@ -255,11 +256,6 @@ module mld_d_prec_type
|
||||
end subroutine mld_dcprecsetc
|
||||
end interface
|
||||
|
||||
|
||||
interface mld_move_alloc
|
||||
module procedure mld_dprec_move_alloc
|
||||
end interface
|
||||
|
||||
contains
|
||||
!
|
||||
! Function returning a pointer to the smoother
|
||||
@@ -812,31 +808,36 @@ contains
|
||||
9999 continue
|
||||
end subroutine mld_d_inner_clone
|
||||
|
||||
subroutine mld_dprec_move_alloc(a, b,info)
|
||||
subroutine d_prec_move_alloc(prec, b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(mld_dprec_type), intent(inout) :: a
|
||||
type(mld_dprec_type), intent(inout), target :: b
|
||||
class(mld_dprec_type), intent(inout) :: prec
|
||||
class(mld_dprec_type), intent(inout), target :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
if (allocated(b%precv)) then
|
||||
! This might not be required if FINAL procedures are available.
|
||||
call mld_precfree(b,info)
|
||||
if (info /= psb_success_) then
|
||||
! ?????
|
||||
!!$ return
|
||||
endif
|
||||
if (same_type_as(prec,b)) then
|
||||
if (allocated(b%precv)) then
|
||||
! This might not be required if FINAL procedures are available.
|
||||
call b%free(info)
|
||||
if (info /= psb_success_) then
|
||||
!?????
|
||||
!!$ return
|
||||
endif
|
||||
end if
|
||||
|
||||
call move_alloc(prec%precv,b%precv)
|
||||
! Fix the pointers except on level 1.
|
||||
do i=2, size(b%precv)
|
||||
b%precv(i)%base_a => b%precv(i)%ac
|
||||
b%precv(i)%base_desc => b%precv(i)%desc_ac
|
||||
b%precv(i)%map%p_desc_X => b%precv(i-1)%base_desc
|
||||
b%precv(i)%map%p_desc_Y => b%precv(i)%base_desc
|
||||
end do
|
||||
else
|
||||
write(0,*) 'Warning: PREC%move_alloc onto different type?'
|
||||
info = psb_err_internal_error_
|
||||
end if
|
||||
|
||||
call move_alloc(a%precv,b%precv)
|
||||
! Fix the pointers except on level 1.
|
||||
do i=2, size(b%precv)
|
||||
b%precv(i)%base_a => b%precv(i)%ac
|
||||
b%precv(i)%base_desc => b%precv(i)%desc_ac
|
||||
b%precv(i)%map%p_desc_X => b%precv(i-1)%base_desc
|
||||
b%precv(i)%map%p_desc_Y => b%precv(i)%base_desc
|
||||
end do
|
||||
end subroutine mld_dprec_move_alloc
|
||||
end subroutine d_prec_move_alloc
|
||||
|
||||
end module mld_d_prec_type
|
||||
|
||||
+16
-19
@@ -152,6 +152,7 @@ module mld_s_onelev_mod
|
||||
procedure, pass(lv) :: sizeof => s_base_onelev_sizeof
|
||||
procedure, pass(lv) :: get_nzeros => s_base_onelev_get_nzeros
|
||||
procedure, nopass :: stringval => mld_stringval
|
||||
procedure, pass(lv) :: move_alloc => s_base_onelev_move_alloc
|
||||
end type mld_s_onelev_type
|
||||
|
||||
type mld_s_onelev_node
|
||||
@@ -161,7 +162,7 @@ module mld_s_onelev_mod
|
||||
|
||||
private :: s_base_onelev_default, s_base_onelev_sizeof, &
|
||||
& s_base_onelev_nullify, s_base_onelev_get_nzeros, &
|
||||
& s_base_onelev_clone
|
||||
& s_base_onelev_clone, s_base_onelev_move_alloc
|
||||
|
||||
|
||||
|
||||
@@ -351,10 +352,6 @@ module mld_s_onelev_mod
|
||||
end subroutine mld_s_base_onelev_dump
|
||||
end interface
|
||||
|
||||
interface mld_move_alloc
|
||||
module procedure mld_s_onelev_move_alloc
|
||||
end interface
|
||||
|
||||
contains
|
||||
!
|
||||
! Function returning the size of the mld_prec_type data structure
|
||||
@@ -484,30 +481,30 @@ contains
|
||||
end subroutine s_base_onelev_clone
|
||||
|
||||
|
||||
subroutine mld_s_onelev_move_alloc(a, b,info)
|
||||
subroutine s_base_onelev_move_alloc(lv, b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(mld_s_onelev_type), target, intent(inout) :: a, b
|
||||
class(mld_s_onelev_type), target, intent(inout) :: lv, b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
call b%free(info)
|
||||
b%parms = a%parms
|
||||
if (associated(a%sm2,a%sm2a)) then
|
||||
call move_alloc(a%sm,b%sm)
|
||||
call move_alloc(a%sm2a,b%sm2a)
|
||||
b%parms = lv%parms
|
||||
if (associated(lv%sm2,lv%sm2a)) then
|
||||
call move_alloc(lv%sm,b%sm)
|
||||
call move_alloc(lv%sm2a,b%sm2a)
|
||||
b%sm2 =>b%sm2a
|
||||
else
|
||||
call move_alloc(a%sm,b%sm)
|
||||
call move_alloc(a%sm2a,b%sm2a)
|
||||
call move_alloc(lv%sm,b%sm)
|
||||
call move_alloc(lv%sm2a,b%sm2a)
|
||||
b%sm2 =>b%sm
|
||||
end if
|
||||
|
||||
if (info == psb_success_) call psb_move_alloc(a%ac,b%ac,info)
|
||||
if (info == psb_success_) call psb_move_alloc(a%desc_ac,b%desc_ac,info)
|
||||
if (info == psb_success_) call psb_move_alloc(a%map,b%map,info)
|
||||
b%base_a => a%base_a
|
||||
b%base_desc => a%base_desc
|
||||
if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
|
||||
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
|
||||
if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info)
|
||||
b%base_a => lv%base_a
|
||||
b%base_desc => lv%base_desc
|
||||
|
||||
end subroutine mld_s_onelev_move_alloc
|
||||
end subroutine s_base_onelev_move_alloc
|
||||
|
||||
end module mld_s_onelev_mod
|
||||
|
||||
+27
-26
@@ -108,10 +108,11 @@ module mld_s_prec_type
|
||||
& cseti, csetc, csetr, setsm, setsv
|
||||
procedure, pass(prec) :: get_smoother => mld_s_get_smootherp
|
||||
procedure, pass(prec) :: get_solver => mld_s_get_solverp
|
||||
procedure, pass(prec) :: move_alloc => s_prec_move_alloc
|
||||
end type mld_sprec_type
|
||||
|
||||
private :: mld_s_dump, mld_s_get_compl, mld_s_cmp_compl,&
|
||||
& mld_s_get_nzeros
|
||||
& mld_s_get_nzeros, s_prec_move_alloc
|
||||
|
||||
|
||||
!
|
||||
@@ -255,11 +256,6 @@ module mld_s_prec_type
|
||||
end subroutine mld_scprecsetc
|
||||
end interface
|
||||
|
||||
|
||||
interface mld_move_alloc
|
||||
module procedure mld_sprec_move_alloc
|
||||
end interface
|
||||
|
||||
contains
|
||||
!
|
||||
! Function returning a pointer to the smoother
|
||||
@@ -812,31 +808,36 @@ contains
|
||||
9999 continue
|
||||
end subroutine mld_s_inner_clone
|
||||
|
||||
subroutine mld_sprec_move_alloc(a, b,info)
|
||||
subroutine s_prec_move_alloc(prec, b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(mld_sprec_type), intent(inout) :: a
|
||||
type(mld_sprec_type), intent(inout), target :: b
|
||||
class(mld_sprec_type), intent(inout) :: prec
|
||||
class(mld_sprec_type), intent(inout), target :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
if (allocated(b%precv)) then
|
||||
! This might not be required if FINAL procedures are available.
|
||||
call mld_precfree(b,info)
|
||||
if (info /= psb_success_) then
|
||||
! ?????
|
||||
!!$ return
|
||||
endif
|
||||
if (same_type_as(prec,b)) then
|
||||
if (allocated(b%precv)) then
|
||||
! This might not be required if FINAL procedures are available.
|
||||
call b%free(info)
|
||||
if (info /= psb_success_) then
|
||||
!?????
|
||||
!!$ return
|
||||
endif
|
||||
end if
|
||||
|
||||
call move_alloc(prec%precv,b%precv)
|
||||
! Fix the pointers except on level 1.
|
||||
do i=2, size(b%precv)
|
||||
b%precv(i)%base_a => b%precv(i)%ac
|
||||
b%precv(i)%base_desc => b%precv(i)%desc_ac
|
||||
b%precv(i)%map%p_desc_X => b%precv(i-1)%base_desc
|
||||
b%precv(i)%map%p_desc_Y => b%precv(i)%base_desc
|
||||
end do
|
||||
else
|
||||
write(0,*) 'Warning: PREC%move_alloc onto different type?'
|
||||
info = psb_err_internal_error_
|
||||
end if
|
||||
|
||||
call move_alloc(a%precv,b%precv)
|
||||
! Fix the pointers except on level 1.
|
||||
do i=2, size(b%precv)
|
||||
b%precv(i)%base_a => b%precv(i)%ac
|
||||
b%precv(i)%base_desc => b%precv(i)%desc_ac
|
||||
b%precv(i)%map%p_desc_X => b%precv(i-1)%base_desc
|
||||
b%precv(i)%map%p_desc_Y => b%precv(i)%base_desc
|
||||
end do
|
||||
end subroutine mld_sprec_move_alloc
|
||||
end subroutine s_prec_move_alloc
|
||||
|
||||
end module mld_s_prec_type
|
||||
|
||||
+16
-19
@@ -152,6 +152,7 @@ module mld_z_onelev_mod
|
||||
procedure, pass(lv) :: sizeof => z_base_onelev_sizeof
|
||||
procedure, pass(lv) :: get_nzeros => z_base_onelev_get_nzeros
|
||||
procedure, nopass :: stringval => mld_stringval
|
||||
procedure, pass(lv) :: move_alloc => z_base_onelev_move_alloc
|
||||
end type mld_z_onelev_type
|
||||
|
||||
type mld_z_onelev_node
|
||||
@@ -161,7 +162,7 @@ module mld_z_onelev_mod
|
||||
|
||||
private :: z_base_onelev_default, z_base_onelev_sizeof, &
|
||||
& z_base_onelev_nullify, z_base_onelev_get_nzeros, &
|
||||
& z_base_onelev_clone
|
||||
& z_base_onelev_clone, z_base_onelev_move_alloc
|
||||
|
||||
|
||||
|
||||
@@ -351,10 +352,6 @@ module mld_z_onelev_mod
|
||||
end subroutine mld_z_base_onelev_dump
|
||||
end interface
|
||||
|
||||
interface mld_move_alloc
|
||||
module procedure mld_z_onelev_move_alloc
|
||||
end interface
|
||||
|
||||
contains
|
||||
!
|
||||
! Function returning the size of the mld_prec_type data structure
|
||||
@@ -484,30 +481,30 @@ contains
|
||||
end subroutine z_base_onelev_clone
|
||||
|
||||
|
||||
subroutine mld_z_onelev_move_alloc(a, b,info)
|
||||
subroutine z_base_onelev_move_alloc(lv, b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(mld_z_onelev_type), target, intent(inout) :: a, b
|
||||
class(mld_z_onelev_type), target, intent(inout) :: lv, b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
|
||||
call b%free(info)
|
||||
b%parms = a%parms
|
||||
if (associated(a%sm2,a%sm2a)) then
|
||||
call move_alloc(a%sm,b%sm)
|
||||
call move_alloc(a%sm2a,b%sm2a)
|
||||
b%parms = lv%parms
|
||||
if (associated(lv%sm2,lv%sm2a)) then
|
||||
call move_alloc(lv%sm,b%sm)
|
||||
call move_alloc(lv%sm2a,b%sm2a)
|
||||
b%sm2 =>b%sm2a
|
||||
else
|
||||
call move_alloc(a%sm,b%sm)
|
||||
call move_alloc(a%sm2a,b%sm2a)
|
||||
call move_alloc(lv%sm,b%sm)
|
||||
call move_alloc(lv%sm2a,b%sm2a)
|
||||
b%sm2 =>b%sm
|
||||
end if
|
||||
|
||||
if (info == psb_success_) call psb_move_alloc(a%ac,b%ac,info)
|
||||
if (info == psb_success_) call psb_move_alloc(a%desc_ac,b%desc_ac,info)
|
||||
if (info == psb_success_) call psb_move_alloc(a%map,b%map,info)
|
||||
b%base_a => a%base_a
|
||||
b%base_desc => a%base_desc
|
||||
if (info == psb_success_) call psb_move_alloc(lv%ac,b%ac,info)
|
||||
if (info == psb_success_) call psb_move_alloc(lv%desc_ac,b%desc_ac,info)
|
||||
if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info)
|
||||
b%base_a => lv%base_a
|
||||
b%base_desc => lv%base_desc
|
||||
|
||||
end subroutine mld_z_onelev_move_alloc
|
||||
end subroutine z_base_onelev_move_alloc
|
||||
|
||||
end module mld_z_onelev_mod
|
||||
|
||||
+27
-26
@@ -108,10 +108,11 @@ module mld_z_prec_type
|
||||
& cseti, csetc, csetr, setsm, setsv
|
||||
procedure, pass(prec) :: get_smoother => mld_z_get_smootherp
|
||||
procedure, pass(prec) :: get_solver => mld_z_get_solverp
|
||||
procedure, pass(prec) :: move_alloc => z_prec_move_alloc
|
||||
end type mld_zprec_type
|
||||
|
||||
private :: mld_z_dump, mld_z_get_compl, mld_z_cmp_compl,&
|
||||
& mld_z_get_nzeros
|
||||
& mld_z_get_nzeros, z_prec_move_alloc
|
||||
|
||||
|
||||
!
|
||||
@@ -255,11 +256,6 @@ module mld_z_prec_type
|
||||
end subroutine mld_zcprecsetc
|
||||
end interface
|
||||
|
||||
|
||||
interface mld_move_alloc
|
||||
module procedure mld_zprec_move_alloc
|
||||
end interface
|
||||
|
||||
contains
|
||||
!
|
||||
! Function returning a pointer to the smoother
|
||||
@@ -812,31 +808,36 @@ contains
|
||||
9999 continue
|
||||
end subroutine mld_z_inner_clone
|
||||
|
||||
subroutine mld_zprec_move_alloc(a, b,info)
|
||||
subroutine z_prec_move_alloc(prec, b,info)
|
||||
use psb_base_mod
|
||||
implicit none
|
||||
type(mld_zprec_type), intent(inout) :: a
|
||||
type(mld_zprec_type), intent(inout), target :: b
|
||||
class(mld_zprec_type), intent(inout) :: prec
|
||||
class(mld_zprec_type), intent(inout), target :: b
|
||||
integer(psb_ipk_), intent(out) :: info
|
||||
integer(psb_ipk_) :: i
|
||||
|
||||
if (allocated(b%precv)) then
|
||||
! This might not be required if FINAL procedures are available.
|
||||
call mld_precfree(b,info)
|
||||
if (info /= psb_success_) then
|
||||
! ?????
|
||||
!!$ return
|
||||
endif
|
||||
if (same_type_as(prec,b)) then
|
||||
if (allocated(b%precv)) then
|
||||
! This might not be required if FINAL procedures are available.
|
||||
call b%free(info)
|
||||
if (info /= psb_success_) then
|
||||
!?????
|
||||
!!$ return
|
||||
endif
|
||||
end if
|
||||
|
||||
call move_alloc(prec%precv,b%precv)
|
||||
! Fix the pointers except on level 1.
|
||||
do i=2, size(b%precv)
|
||||
b%precv(i)%base_a => b%precv(i)%ac
|
||||
b%precv(i)%base_desc => b%precv(i)%desc_ac
|
||||
b%precv(i)%map%p_desc_X => b%precv(i-1)%base_desc
|
||||
b%precv(i)%map%p_desc_Y => b%precv(i)%base_desc
|
||||
end do
|
||||
else
|
||||
write(0,*) 'Warning: PREC%move_alloc onto different type?'
|
||||
info = psb_err_internal_error_
|
||||
end if
|
||||
|
||||
call move_alloc(a%precv,b%precv)
|
||||
! Fix the pointers except on level 1.
|
||||
do i=2, size(b%precv)
|
||||
b%precv(i)%base_a => b%precv(i)%ac
|
||||
b%precv(i)%base_desc => b%precv(i)%desc_ac
|
||||
b%precv(i)%map%p_desc_X => b%precv(i-1)%base_desc
|
||||
b%precv(i)%map%p_desc_Y => b%precv(i)%base_desc
|
||||
end do
|
||||
end subroutine mld_zprec_move_alloc
|
||||
end subroutine z_prec_move_alloc
|
||||
|
||||
end module mld_z_prec_type
|
||||
|
||||
@@ -19,7 +19,7 @@ GS ! Subdomain solver DSCALE ILU MILU ILUT UMF SLU GS M
|
||||
BJAC ! Smoother type JACOBI BJAC AS; ignored for non-ML
|
||||
2 ! Number of levels in a multilevel preconditioner
|
||||
SMOOTHED ! Kind of aggregation: SMOOTHED, NONSMOOTHED, MINENERGY
|
||||
DEC ! Type of aggregation DEC SYMDEC GLB
|
||||
SYMDEC ! Type of aggregation DEC SYMDEC
|
||||
NATURAL ! Ordering of aggregation NATURAL DEGREE
|
||||
MULT ! Type of multilevel correction: ADD MULT
|
||||
TWOSIDE ! Side of correction PRE POST TWOSIDE (ignored for ADD)
|
||||
|
||||
Reference in New Issue
Block a user