fdurastante
/
amg4psblas
mirror of https://github.com/sfilippone/amg4psblas.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

mld2p4-2:

Browse Source 
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).
stopcriterion
Salvatore Filippone 10 years ago
parent 5224097818
commit 81a3e58358
13 changed files with 189 additions and 197 deletions
Show Stats Download Patch File Download Diff File

8
mlprec/impl/mld_cmlprec_bld.f90
Unescape Escape View File

@ -293,7 +293,7 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
! First do a move_alloc. ! First do a move_alloc.
! This handles the AC, DESC_AC and MAP fields ! This handles the AC, DESC_AC and MAP fields
if (info == psb_success_) & 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. ! Now set the smoother/solver parts.
if (info == psb_success_) then if (info == psb_success_) then
if (i ==1) then if (i ==1) then
@ -422,13 +422,13 @@ subroutine mld_cmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
goto 9999 goto 9999
endif endif
do i=1,newsz-1 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 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 do i=newsz+1, iszv
call p%precv(i)%free(info) call p%precv(i)%free(info)
end do end do
call mld_move_alloc(t_prec,p,info) call t_prec%move_alloc(p,info)
! Ignore errors from transfer ! Ignore errors from transfer
info = psb_success_ info = psb_success_
! !

8
mlprec/impl/mld_dmlprec_bld.f90
Unescape Escape View File

@ -293,7 +293,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
! First do a move_alloc. ! First do a move_alloc.
! This handles the AC, DESC_AC and MAP fields ! This handles the AC, DESC_AC and MAP fields
if (info == psb_success_) & 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. ! Now set the smoother/solver parts.
if (info == psb_success_) then if (info == psb_success_) then
if (i ==1) then if (i ==1) then
@ -422,13 +422,13 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
goto 9999 goto 9999
endif endif
do i=1,newsz-1 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 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 do i=newsz+1, iszv
call p%precv(i)%free(info) call p%precv(i)%free(info)
end do end do
call mld_move_alloc(t_prec,p,info) call t_prec%move_alloc(p,info)
! Ignore errors from transfer ! Ignore errors from transfer
info = psb_success_ info = psb_success_
! !

8
mlprec/impl/mld_smlprec_bld.f90
Unescape Escape View File

@ -293,7 +293,7 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold)
! First do a move_alloc. ! First do a move_alloc.
! This handles the AC, DESC_AC and MAP fields ! This handles the AC, DESC_AC and MAP fields
if (info == psb_success_) & 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. ! Now set the smoother/solver parts.
if (info == psb_success_) then if (info == psb_success_) then
if (i ==1) then if (i ==1) then
@ -422,13 +422,13 @@ subroutine mld_smlprec_bld(a,desc_a,p,info,amold,vmold,imold)
goto 9999 goto 9999
endif endif
do i=1,newsz-1 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 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 do i=newsz+1, iszv
call p%precv(i)%free(info) call p%precv(i)%free(info)
end do end do
call mld_move_alloc(t_prec,p,info) call t_prec%move_alloc(p,info)
! Ignore errors from transfer ! Ignore errors from transfer
info = psb_success_ info = psb_success_
! !

8
mlprec/impl/mld_zmlprec_bld.f90
Unescape Escape View File

@ -293,7 +293,7 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
! First do a move_alloc. ! First do a move_alloc.
! This handles the AC, DESC_AC and MAP fields ! This handles the AC, DESC_AC and MAP fields
if (info == psb_success_) & 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. ! Now set the smoother/solver parts.
if (info == psb_success_) then if (info == psb_success_) then
if (i ==1) then if (i ==1) then
@ -422,13 +422,13 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info,amold,vmold,imold)
goto 9999 goto 9999
endif endif
do i=1,newsz-1 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 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 do i=newsz+1, iszv
call p%precv(i)%free(info) call p%precv(i)%free(info)
end do end do
call mld_move_alloc(t_prec,p,info) call t_prec%move_alloc(p,info)
! Ignore errors from transfer ! Ignore errors from transfer
info = psb_success_ info = psb_success_
! !

35
mlprec/mld_c_onelev_mod.f90
Unescape Escape View File

@ -152,6 +152,7 @@ module mld_c_onelev_mod
procedure, pass(lv) :: sizeof => c_base_onelev_sizeof procedure, pass(lv) :: sizeof => c_base_onelev_sizeof
procedure, pass(lv) :: get_nzeros => c_base_onelev_get_nzeros procedure, pass(lv) :: get_nzeros => c_base_onelev_get_nzeros
procedure, nopass :: stringval => mld_stringval procedure, nopass :: stringval => mld_stringval
procedure, pass(lv) :: move_alloc => c_base_onelev_move_alloc
end type mld_c_onelev_type end type mld_c_onelev_type
type mld_c_onelev_node type mld_c_onelev_node
@ -161,7 +162,7 @@ module mld_c_onelev_mod
private :: c_base_onelev_default, c_base_onelev_sizeof, & 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 & 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 subroutine mld_c_base_onelev_dump
end interface end interface
interface mld_move_alloc
module procedure mld_c_onelev_move_alloc
end interface
contains contains
! !
! Function returning the size of the mld_prec_type data structure ! Function returning the size of the mld_prec_type data structure
@ -484,30 +481,30 @@ contains
end subroutine c_base_onelev_clone 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 use psb_base_mod
implicit none 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 integer(psb_ipk_), intent(out) :: info
call b%free(info) call b%free(info)
b%parms = a%parms b%parms = lv%parms
if (associated(a%sm2,a%sm2a)) then if (associated(lv%sm2,lv%sm2a)) then
call move_alloc(a%sm,b%sm) call move_alloc(lv%sm,b%sm)
call move_alloc(a%sm2a,b%sm2a) call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm2a b%sm2 =>b%sm2a
else else
call move_alloc(a%sm,b%sm) call move_alloc(lv%sm,b%sm)
call move_alloc(a%sm2a,b%sm2a) call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm b%sm2 =>b%sm
end if end if
if (info == psb_success_) call psb_move_alloc(a%ac,b%ac,info) if (info == psb_success_) call psb_move_alloc(lv%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(lv%desc_ac,b%desc_ac,info)
if (info == psb_success_) call psb_move_alloc(a%map,b%map,info) if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info)
b%base_a => a%base_a b%base_a => lv%base_a
b%base_desc => a%base_desc 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 end module mld_c_onelev_mod

53
mlprec/mld_c_prec_type.f90
Unescape Escape View File

@ -108,10 +108,11 @@ module mld_c_prec_type
& cseti, csetc, csetr, setsm, setsv & cseti, csetc, csetr, setsm, setsv
procedure, pass(prec) :: get_smoother => mld_c_get_smootherp procedure, pass(prec) :: get_smoother => mld_c_get_smootherp
procedure, pass(prec) :: get_solver => mld_c_get_solverp procedure, pass(prec) :: get_solver => mld_c_get_solverp
procedure, pass(prec) :: move_alloc => c_prec_move_alloc
end type mld_cprec_type end type mld_cprec_type
private :: mld_c_dump, mld_c_get_compl, mld_c_cmp_compl,& 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 subroutine mld_ccprecsetc
end interface end interface
interface mld_move_alloc
module procedure mld_cprec_move_alloc
end interface
contains contains
! !
! Function returning a pointer to the smoother ! Function returning a pointer to the smoother
@ -812,31 +808,36 @@ contains
9999 continue 9999 continue
end subroutine mld_c_inner_clone 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 use psb_base_mod
implicit none implicit none
type(mld_cprec_type), intent(inout) :: a class(mld_cprec_type), intent(inout) :: prec
type(mld_cprec_type), intent(inout), target :: b class(mld_cprec_type), intent(inout), target :: b
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
if (allocated(b%precv)) then if (same_type_as(prec,b)) then
! This might not be required if FINAL procedures are available. if (allocated(b%precv)) then
call mld_precfree(b,info) ! This might not be required if FINAL procedures are available.
if (info /= psb_success_) then call b%free(info)
! ????? if (info /= psb_success_) then
!!$ return !?????
endif !!$ 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 end if
end subroutine c_prec_move_alloc
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 module mld_c_prec_type end module mld_c_prec_type

35
mlprec/mld_d_onelev_mod.f90
Unescape Escape View File

@ -152,6 +152,7 @@ module mld_d_onelev_mod
procedure, pass(lv) :: sizeof => d_base_onelev_sizeof procedure, pass(lv) :: sizeof => d_base_onelev_sizeof
procedure, pass(lv) :: get_nzeros => d_base_onelev_get_nzeros procedure, pass(lv) :: get_nzeros => d_base_onelev_get_nzeros
procedure, nopass :: stringval => mld_stringval procedure, nopass :: stringval => mld_stringval
procedure, pass(lv) :: move_alloc => d_base_onelev_move_alloc
end type mld_d_onelev_type end type mld_d_onelev_type
type mld_d_onelev_node type mld_d_onelev_node
@ -161,7 +162,7 @@ module mld_d_onelev_mod
private :: d_base_onelev_default, d_base_onelev_sizeof, & 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 & 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 subroutine mld_d_base_onelev_dump
end interface end interface
interface mld_move_alloc
module procedure mld_d_onelev_move_alloc
end interface
contains contains
! !
! Function returning the size of the mld_prec_type data structure ! Function returning the size of the mld_prec_type data structure
@ -484,30 +481,30 @@ contains
end subroutine d_base_onelev_clone 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 use psb_base_mod
implicit none 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 integer(psb_ipk_), intent(out) :: info
call b%free(info) call b%free(info)
b%parms = a%parms b%parms = lv%parms
if (associated(a%sm2,a%sm2a)) then if (associated(lv%sm2,lv%sm2a)) then
call move_alloc(a%sm,b%sm) call move_alloc(lv%sm,b%sm)
call move_alloc(a%sm2a,b%sm2a) call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm2a b%sm2 =>b%sm2a
else else
call move_alloc(a%sm,b%sm) call move_alloc(lv%sm,b%sm)
call move_alloc(a%sm2a,b%sm2a) call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm b%sm2 =>b%sm
end if end if
if (info == psb_success_) call psb_move_alloc(a%ac,b%ac,info) if (info == psb_success_) call psb_move_alloc(lv%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(lv%desc_ac,b%desc_ac,info)
if (info == psb_success_) call psb_move_alloc(a%map,b%map,info) if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info)
b%base_a => a%base_a b%base_a => lv%base_a
b%base_desc => a%base_desc 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 end module mld_d_onelev_mod

53
mlprec/mld_d_prec_type.f90
Unescape Escape View File

@ -108,10 +108,11 @@ module mld_d_prec_type
& cseti, csetc, csetr, setsm, setsv & cseti, csetc, csetr, setsm, setsv
procedure, pass(prec) :: get_smoother => mld_d_get_smootherp procedure, pass(prec) :: get_smoother => mld_d_get_smootherp
procedure, pass(prec) :: get_solver => mld_d_get_solverp procedure, pass(prec) :: get_solver => mld_d_get_solverp
procedure, pass(prec) :: move_alloc => d_prec_move_alloc
end type mld_dprec_type end type mld_dprec_type
private :: mld_d_dump, mld_d_get_compl, mld_d_cmp_compl,& 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 subroutine mld_dcprecsetc
end interface end interface
interface mld_move_alloc
module procedure mld_dprec_move_alloc
end interface
contains contains
! !
! Function returning a pointer to the smoother ! Function returning a pointer to the smoother
@ -812,31 +808,36 @@ contains
9999 continue 9999 continue
end subroutine mld_d_inner_clone 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 use psb_base_mod
implicit none implicit none
type(mld_dprec_type), intent(inout) :: a class(mld_dprec_type), intent(inout) :: prec
type(mld_dprec_type), intent(inout), target :: b class(mld_dprec_type), intent(inout), target :: b
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
if (allocated(b%precv)) then if (same_type_as(prec,b)) then
! This might not be required if FINAL procedures are available. if (allocated(b%precv)) then
call mld_precfree(b,info) ! This might not be required if FINAL procedures are available.
if (info /= psb_success_) then call b%free(info)
! ????? if (info /= psb_success_) then
!!$ return !?????
endif !!$ 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 end if
end subroutine d_prec_move_alloc
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 module mld_d_prec_type end module mld_d_prec_type

35
mlprec/mld_s_onelev_mod.f90
Unescape Escape View File

@ -152,6 +152,7 @@ module mld_s_onelev_mod
procedure, pass(lv) :: sizeof => s_base_onelev_sizeof procedure, pass(lv) :: sizeof => s_base_onelev_sizeof
procedure, pass(lv) :: get_nzeros => s_base_onelev_get_nzeros procedure, pass(lv) :: get_nzeros => s_base_onelev_get_nzeros
procedure, nopass :: stringval => mld_stringval procedure, nopass :: stringval => mld_stringval
procedure, pass(lv) :: move_alloc => s_base_onelev_move_alloc
end type mld_s_onelev_type end type mld_s_onelev_type
type mld_s_onelev_node type mld_s_onelev_node
@ -161,7 +162,7 @@ module mld_s_onelev_mod
private :: s_base_onelev_default, s_base_onelev_sizeof, & 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 & 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 subroutine mld_s_base_onelev_dump
end interface end interface
interface mld_move_alloc
module procedure mld_s_onelev_move_alloc
end interface
contains contains
! !
! Function returning the size of the mld_prec_type data structure ! Function returning the size of the mld_prec_type data structure
@ -484,30 +481,30 @@ contains
end subroutine s_base_onelev_clone 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 use psb_base_mod
implicit none 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 integer(psb_ipk_), intent(out) :: info
call b%free(info) call b%free(info)
b%parms = a%parms b%parms = lv%parms
if (associated(a%sm2,a%sm2a)) then if (associated(lv%sm2,lv%sm2a)) then
call move_alloc(a%sm,b%sm) call move_alloc(lv%sm,b%sm)
call move_alloc(a%sm2a,b%sm2a) call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm2a b%sm2 =>b%sm2a
else else
call move_alloc(a%sm,b%sm) call move_alloc(lv%sm,b%sm)
call move_alloc(a%sm2a,b%sm2a) call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm b%sm2 =>b%sm
end if end if
if (info == psb_success_) call psb_move_alloc(a%ac,b%ac,info) if (info == psb_success_) call psb_move_alloc(lv%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(lv%desc_ac,b%desc_ac,info)
if (info == psb_success_) call psb_move_alloc(a%map,b%map,info) if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info)
b%base_a => a%base_a b%base_a => lv%base_a
b%base_desc => a%base_desc 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 end module mld_s_onelev_mod

53
mlprec/mld_s_prec_type.f90
Unescape Escape View File

@ -108,10 +108,11 @@ module mld_s_prec_type
& cseti, csetc, csetr, setsm, setsv & cseti, csetc, csetr, setsm, setsv
procedure, pass(prec) :: get_smoother => mld_s_get_smootherp procedure, pass(prec) :: get_smoother => mld_s_get_smootherp
procedure, pass(prec) :: get_solver => mld_s_get_solverp procedure, pass(prec) :: get_solver => mld_s_get_solverp
procedure, pass(prec) :: move_alloc => s_prec_move_alloc
end type mld_sprec_type end type mld_sprec_type
private :: mld_s_dump, mld_s_get_compl, mld_s_cmp_compl,& 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 subroutine mld_scprecsetc
end interface end interface
interface mld_move_alloc
module procedure mld_sprec_move_alloc
end interface
contains contains
! !
! Function returning a pointer to the smoother ! Function returning a pointer to the smoother
@ -812,31 +808,36 @@ contains
9999 continue 9999 continue
end subroutine mld_s_inner_clone 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 use psb_base_mod
implicit none implicit none
type(mld_sprec_type), intent(inout) :: a class(mld_sprec_type), intent(inout) :: prec
type(mld_sprec_type), intent(inout), target :: b class(mld_sprec_type), intent(inout), target :: b
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
if (allocated(b%precv)) then if (same_type_as(prec,b)) then
! This might not be required if FINAL procedures are available. if (allocated(b%precv)) then
call mld_precfree(b,info) ! This might not be required if FINAL procedures are available.
if (info /= psb_success_) then call b%free(info)
! ????? if (info /= psb_success_) then
!!$ return !?????
endif !!$ 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 end if
end subroutine s_prec_move_alloc
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 module mld_s_prec_type end module mld_s_prec_type

35
mlprec/mld_z_onelev_mod.f90
Unescape Escape View File

@ -152,6 +152,7 @@ module mld_z_onelev_mod
procedure, pass(lv) :: sizeof => z_base_onelev_sizeof procedure, pass(lv) :: sizeof => z_base_onelev_sizeof
procedure, pass(lv) :: get_nzeros => z_base_onelev_get_nzeros procedure, pass(lv) :: get_nzeros => z_base_onelev_get_nzeros
procedure, nopass :: stringval => mld_stringval procedure, nopass :: stringval => mld_stringval
procedure, pass(lv) :: move_alloc => z_base_onelev_move_alloc
end type mld_z_onelev_type end type mld_z_onelev_type
type mld_z_onelev_node type mld_z_onelev_node
@ -161,7 +162,7 @@ module mld_z_onelev_mod
private :: z_base_onelev_default, z_base_onelev_sizeof, & 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 & 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 subroutine mld_z_base_onelev_dump
end interface end interface
interface mld_move_alloc
module procedure mld_z_onelev_move_alloc
end interface
contains contains
! !
! Function returning the size of the mld_prec_type data structure ! Function returning the size of the mld_prec_type data structure
@ -484,30 +481,30 @@ contains
end subroutine z_base_onelev_clone 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 use psb_base_mod
implicit none 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 integer(psb_ipk_), intent(out) :: info
call b%free(info) call b%free(info)
b%parms = a%parms b%parms = lv%parms
if (associated(a%sm2,a%sm2a)) then if (associated(lv%sm2,lv%sm2a)) then
call move_alloc(a%sm,b%sm) call move_alloc(lv%sm,b%sm)
call move_alloc(a%sm2a,b%sm2a) call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm2a b%sm2 =>b%sm2a
else else
call move_alloc(a%sm,b%sm) call move_alloc(lv%sm,b%sm)
call move_alloc(a%sm2a,b%sm2a) call move_alloc(lv%sm2a,b%sm2a)
b%sm2 =>b%sm b%sm2 =>b%sm
end if end if
if (info == psb_success_) call psb_move_alloc(a%ac,b%ac,info) if (info == psb_success_) call psb_move_alloc(lv%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(lv%desc_ac,b%desc_ac,info)
if (info == psb_success_) call psb_move_alloc(a%map,b%map,info) if (info == psb_success_) call psb_move_alloc(lv%map,b%map,info)
b%base_a => a%base_a b%base_a => lv%base_a
b%base_desc => a%base_desc 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 end module mld_z_onelev_mod

53
mlprec/mld_z_prec_type.f90
Unescape Escape View File

@ -108,10 +108,11 @@ module mld_z_prec_type
& cseti, csetc, csetr, setsm, setsv & cseti, csetc, csetr, setsm, setsv
procedure, pass(prec) :: get_smoother => mld_z_get_smootherp procedure, pass(prec) :: get_smoother => mld_z_get_smootherp
procedure, pass(prec) :: get_solver => mld_z_get_solverp procedure, pass(prec) :: get_solver => mld_z_get_solverp
procedure, pass(prec) :: move_alloc => z_prec_move_alloc
end type mld_zprec_type end type mld_zprec_type
private :: mld_z_dump, mld_z_get_compl, mld_z_cmp_compl,& 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 subroutine mld_zcprecsetc
end interface end interface
interface mld_move_alloc
module procedure mld_zprec_move_alloc
end interface
contains contains
! !
! Function returning a pointer to the smoother ! Function returning a pointer to the smoother
@ -812,31 +808,36 @@ contains
9999 continue 9999 continue
end subroutine mld_z_inner_clone 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 use psb_base_mod
implicit none implicit none
type(mld_zprec_type), intent(inout) :: a class(mld_zprec_type), intent(inout) :: prec
type(mld_zprec_type), intent(inout), target :: b class(mld_zprec_type), intent(inout), target :: b
integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: i integer(psb_ipk_) :: i
if (allocated(b%precv)) then if (same_type_as(prec,b)) then
! This might not be required if FINAL procedures are available. if (allocated(b%precv)) then
call mld_precfree(b,info) ! This might not be required if FINAL procedures are available.
if (info /= psb_success_) then call b%free(info)
! ????? if (info /= psb_success_) then
!!$ return !?????
endif !!$ 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 end if
end subroutine z_prec_move_alloc
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 module mld_z_prec_type end module mld_z_prec_type

2
tests/pdegen/runs/ppde.inp
Unescape Escape View File

@ -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 BJAC ! Smoother type JACOBI BJAC AS; ignored for non-ML
2 ! Number of levels in a multilevel preconditioner 2 ! Number of levels in a multilevel preconditioner
SMOOTHED ! Kind of aggregation: SMOOTHED, NONSMOOTHED, MINENERGY 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 NATURAL ! Ordering of aggregation NATURAL DEGREE
MULT ! Type of multilevel correction: ADD MULT MULT ! Type of multilevel correction: ADD MULT
TWOSIDE ! Side of correction PRE POST TWOSIDE (ignored for ADD) TWOSIDE ! Side of correction PRE POST TWOSIDE (ignored for ADD)

Write Preview
Loading…
Cancel
Save