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

mld2p4:

Browse Source 
mlprec/impl/mld_c_bld_mlhier_aggsize.f90
 mlprec/impl/mld_d_bld_mlhier_aggsize.f90
 mlprec/impl/mld_s_bld_mlhier_aggsize.f90
 mlprec/impl/mld_z_bld_mlhier_aggsize.f90

Fixed copy-back of second smoother.
stopcriterion
Salvatore Filippone 9 years ago
parent 6361d330dd
commit 05ae06609a
4 changed files with 92 additions and 16 deletions
Show Stats Download Patch File Download Diff File

27
mlprec/impl/mld_c_bld_mlhier_aggsize.f90
Unescape Escape View File

@ -57,7 +57,7 @@ subroutine mld_c_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
character :: upd_ character :: upd_
class(mld_c_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm class(mld_c_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm, base_sm2, med_sm2
type(mld_sml_parms) :: baseparms, medparms, coarseparms type(mld_sml_parms) :: baseparms, medparms, coarseparms
type(mld_c_onelev_node), pointer :: head, tail, newnode, current type(mld_c_onelev_node), pointer :: head, tail, newnode, current
real(psb_spk_) :: sizeratio real(psb_spk_) :: sizeratio
@ -84,7 +84,11 @@ subroutine mld_c_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
if (info == psb_success_) & if (info == psb_success_) &
& allocate(med_sm, source=precv(2)%sm,stat=info) & allocate(med_sm, source=precv(2)%sm,stat=info)
if (info == psb_success_) & if (info == psb_success_) &
& allocate(base_sm, source=precv(1)%sm,stat=info) & allocate(base_sm, source=precv(1)%sm,stat=info)
if ((info == psb_success_).and.allocated(precv(1)%sm2a)) &
& allocate(base_sm2, source=precv(1)%sm2a,stat=info)
if ((info == psb_success_).and.allocated(precv(2)%sm2a)) &
& allocate(med_sm2, source=precv(2)%sm2a,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(0,*) 'Error in saving smoothers',info write(0,*) 'Error in saving smoothers',info
call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.')
@ -142,7 +146,8 @@ subroutine mld_c_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
sizeratio = iaggsize sizeratio = iaggsize
sizeratio = sum(current%prev%item%map%naggr)/sizeratio sizeratio = sum(current%prev%item%map%naggr)/sizeratio
if (sizeratio < mnaggratio) then if (sizeratio < mnaggratio) then
if (sizeratio > 1) exit list_build_loop
! !
! We are not gaining ! We are not gaining
! !
@ -198,9 +203,21 @@ subroutine mld_c_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
! 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
allocate(precv(i)%sm,source=base_sm,stat=info) allocate(precv(i)%sm,source=base_sm,stat=info)
if (allocated(base_sm2)) then
allocate(precv(i)%sm2a,source=base_sm2,stat=info)
precv(i)%sm2 => precv(i)%sm2a
else
precv(i)%sm2 => precv(i)%sm
end if
else if (i < newsz) then else if (i < newsz) then
allocate(precv(i)%sm,source=med_sm,stat=info) allocate(precv(i)%sm,source=med_sm,stat=info)
if (allocated(med_sm2)) then
allocate(precv(i)%sm2a,source=med_sm2,stat=info)
precv(i)%sm2 => precv(i)%sm2a
else
precv(i)%sm2 => precv(i)%sm
end if
else else
allocate(precv(i)%sm,source=coarse_sm,stat=info) allocate(precv(i)%sm,source=coarse_sm,stat=info)
end if end if
@ -225,6 +242,8 @@ subroutine mld_c_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
call base_sm%free(info) call base_sm%free(info)
if (info == psb_success_) call med_sm%free(info) if (info == psb_success_) call med_sm%free(info)
if (info == psb_success_) call coarse_sm%free(info) if (info == psb_success_) call coarse_sm%free(info)
if ((info == psb_success_).and.(allocated(base_sm2))) call base_sm2%free(info)
if ((info == psb_success_).and.(allocated(med_sm2))) call med_sm2%free(info)
if (info == psb_success_) deallocate(coarse_sm,med_sm,base_sm,stat=info) if (info == psb_success_) deallocate(coarse_sm,med_sm,base_sm,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_internal_error_ info = psb_err_internal_error_

27
mlprec/impl/mld_d_bld_mlhier_aggsize.f90
Unescape Escape View File

@ -57,7 +57,7 @@ subroutine mld_d_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
character :: upd_ character :: upd_
class(mld_d_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm class(mld_d_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm, base_sm2, med_sm2
type(mld_dml_parms) :: baseparms, medparms, coarseparms type(mld_dml_parms) :: baseparms, medparms, coarseparms
type(mld_d_onelev_node), pointer :: head, tail, newnode, current type(mld_d_onelev_node), pointer :: head, tail, newnode, current
real(psb_dpk_) :: sizeratio real(psb_dpk_) :: sizeratio
@ -84,7 +84,11 @@ subroutine mld_d_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
if (info == psb_success_) & if (info == psb_success_) &
& allocate(med_sm, source=precv(2)%sm,stat=info) & allocate(med_sm, source=precv(2)%sm,stat=info)
if (info == psb_success_) & if (info == psb_success_) &
& allocate(base_sm, source=precv(1)%sm,stat=info) & allocate(base_sm, source=precv(1)%sm,stat=info)
if ((info == psb_success_).and.allocated(precv(1)%sm2a)) &
& allocate(base_sm2, source=precv(1)%sm2a,stat=info)
if ((info == psb_success_).and.allocated(precv(2)%sm2a)) &
& allocate(med_sm2, source=precv(2)%sm2a,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(0,*) 'Error in saving smoothers',info write(0,*) 'Error in saving smoothers',info
call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.')
@ -142,7 +146,8 @@ subroutine mld_d_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
sizeratio = iaggsize sizeratio = iaggsize
sizeratio = sum(current%prev%item%map%naggr)/sizeratio sizeratio = sum(current%prev%item%map%naggr)/sizeratio
if (sizeratio < mnaggratio) then if (sizeratio < mnaggratio) then
if (sizeratio > 1) exit list_build_loop
! !
! We are not gaining ! We are not gaining
! !
@ -198,9 +203,21 @@ subroutine mld_d_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
! 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
allocate(precv(i)%sm,source=base_sm,stat=info) allocate(precv(i)%sm,source=base_sm,stat=info)
if (allocated(base_sm2)) then
allocate(precv(i)%sm2a,source=base_sm2,stat=info)
precv(i)%sm2 => precv(i)%sm2a
else
precv(i)%sm2 => precv(i)%sm
end if
else if (i < newsz) then else if (i < newsz) then
allocate(precv(i)%sm,source=med_sm,stat=info) allocate(precv(i)%sm,source=med_sm,stat=info)
if (allocated(med_sm2)) then
allocate(precv(i)%sm2a,source=med_sm2,stat=info)
precv(i)%sm2 => precv(i)%sm2a
else
precv(i)%sm2 => precv(i)%sm
end if
else else
allocate(precv(i)%sm,source=coarse_sm,stat=info) allocate(precv(i)%sm,source=coarse_sm,stat=info)
end if end if
@ -225,6 +242,8 @@ subroutine mld_d_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
call base_sm%free(info) call base_sm%free(info)
if (info == psb_success_) call med_sm%free(info) if (info == psb_success_) call med_sm%free(info)
if (info == psb_success_) call coarse_sm%free(info) if (info == psb_success_) call coarse_sm%free(info)
if ((info == psb_success_).and.(allocated(base_sm2))) call base_sm2%free(info)
if ((info == psb_success_).and.(allocated(med_sm2))) call med_sm2%free(info)
if (info == psb_success_) deallocate(coarse_sm,med_sm,base_sm,stat=info) if (info == psb_success_) deallocate(coarse_sm,med_sm,base_sm,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_internal_error_ info = psb_err_internal_error_

27
mlprec/impl/mld_s_bld_mlhier_aggsize.f90
Unescape Escape View File

@ -57,7 +57,7 @@ subroutine mld_s_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
character :: upd_ character :: upd_
class(mld_s_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm class(mld_s_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm, base_sm2, med_sm2
type(mld_sml_parms) :: baseparms, medparms, coarseparms type(mld_sml_parms) :: baseparms, medparms, coarseparms
type(mld_s_onelev_node), pointer :: head, tail, newnode, current type(mld_s_onelev_node), pointer :: head, tail, newnode, current
real(psb_spk_) :: sizeratio real(psb_spk_) :: sizeratio
@ -84,7 +84,11 @@ subroutine mld_s_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
if (info == psb_success_) & if (info == psb_success_) &
& allocate(med_sm, source=precv(2)%sm,stat=info) & allocate(med_sm, source=precv(2)%sm,stat=info)
if (info == psb_success_) & if (info == psb_success_) &
& allocate(base_sm, source=precv(1)%sm,stat=info) & allocate(base_sm, source=precv(1)%sm,stat=info)
if ((info == psb_success_).and.allocated(precv(1)%sm2a)) &
& allocate(base_sm2, source=precv(1)%sm2a,stat=info)
if ((info == psb_success_).and.allocated(precv(2)%sm2a)) &
& allocate(med_sm2, source=precv(2)%sm2a,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(0,*) 'Error in saving smoothers',info write(0,*) 'Error in saving smoothers',info
call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.')
@ -142,7 +146,8 @@ subroutine mld_s_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
sizeratio = iaggsize sizeratio = iaggsize
sizeratio = sum(current%prev%item%map%naggr)/sizeratio sizeratio = sum(current%prev%item%map%naggr)/sizeratio
if (sizeratio < mnaggratio) then if (sizeratio < mnaggratio) then
if (sizeratio > 1) exit list_build_loop
! !
! We are not gaining ! We are not gaining
! !
@ -198,9 +203,21 @@ subroutine mld_s_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
! 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
allocate(precv(i)%sm,source=base_sm,stat=info) allocate(precv(i)%sm,source=base_sm,stat=info)
if (allocated(base_sm2)) then
allocate(precv(i)%sm2a,source=base_sm2,stat=info)
precv(i)%sm2 => precv(i)%sm2a
else
precv(i)%sm2 => precv(i)%sm
end if
else if (i < newsz) then else if (i < newsz) then
allocate(precv(i)%sm,source=med_sm,stat=info) allocate(precv(i)%sm,source=med_sm,stat=info)
if (allocated(med_sm2)) then
allocate(precv(i)%sm2a,source=med_sm2,stat=info)
precv(i)%sm2 => precv(i)%sm2a
else
precv(i)%sm2 => precv(i)%sm
end if
else else
allocate(precv(i)%sm,source=coarse_sm,stat=info) allocate(precv(i)%sm,source=coarse_sm,stat=info)
end if end if
@ -225,6 +242,8 @@ subroutine mld_s_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
call base_sm%free(info) call base_sm%free(info)
if (info == psb_success_) call med_sm%free(info) if (info == psb_success_) call med_sm%free(info)
if (info == psb_success_) call coarse_sm%free(info) if (info == psb_success_) call coarse_sm%free(info)
if ((info == psb_success_).and.(allocated(base_sm2))) call base_sm2%free(info)
if ((info == psb_success_).and.(allocated(med_sm2))) call med_sm2%free(info)
if (info == psb_success_) deallocate(coarse_sm,med_sm,base_sm,stat=info) if (info == psb_success_) deallocate(coarse_sm,med_sm,base_sm,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_internal_error_ info = psb_err_internal_error_

27
mlprec/impl/mld_z_bld_mlhier_aggsize.f90
Unescape Escape View File

@ -57,7 +57,7 @@ subroutine mld_z_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
integer(psb_ipk_) :: ipv(mld_ifpsz_), val integer(psb_ipk_) :: ipv(mld_ifpsz_), val
integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: int_err(5)
character :: upd_ character :: upd_
class(mld_z_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm class(mld_z_base_smoother_type), allocatable :: coarse_sm, base_sm, med_sm, base_sm2, med_sm2
type(mld_dml_parms) :: baseparms, medparms, coarseparms type(mld_dml_parms) :: baseparms, medparms, coarseparms
type(mld_z_onelev_node), pointer :: head, tail, newnode, current type(mld_z_onelev_node), pointer :: head, tail, newnode, current
real(psb_dpk_) :: sizeratio real(psb_dpk_) :: sizeratio
@ -84,7 +84,11 @@ subroutine mld_z_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
if (info == psb_success_) & if (info == psb_success_) &
& allocate(med_sm, source=precv(2)%sm,stat=info) & allocate(med_sm, source=precv(2)%sm,stat=info)
if (info == psb_success_) & if (info == psb_success_) &
& allocate(base_sm, source=precv(1)%sm,stat=info) & allocate(base_sm, source=precv(1)%sm,stat=info)
if ((info == psb_success_).and.allocated(precv(1)%sm2a)) &
& allocate(base_sm2, source=precv(1)%sm2a,stat=info)
if ((info == psb_success_).and.allocated(precv(2)%sm2a)) &
& allocate(med_sm2, source=precv(2)%sm2a,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
write(0,*) 'Error in saving smoothers',info write(0,*) 'Error in saving smoothers',info
call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.') call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.')
@ -142,7 +146,8 @@ subroutine mld_z_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
sizeratio = iaggsize sizeratio = iaggsize
sizeratio = sum(current%prev%item%map%naggr)/sizeratio sizeratio = sum(current%prev%item%map%naggr)/sizeratio
if (sizeratio < mnaggratio) then if (sizeratio < mnaggratio) then
if (sizeratio > 1) exit list_build_loop
! !
! We are not gaining ! We are not gaining
! !
@ -198,9 +203,21 @@ subroutine mld_z_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
! 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
allocate(precv(i)%sm,source=base_sm,stat=info) allocate(precv(i)%sm,source=base_sm,stat=info)
if (allocated(base_sm2)) then
allocate(precv(i)%sm2a,source=base_sm2,stat=info)
precv(i)%sm2 => precv(i)%sm2a
else
precv(i)%sm2 => precv(i)%sm
end if
else if (i < newsz) then else if (i < newsz) then
allocate(precv(i)%sm,source=med_sm,stat=info) allocate(precv(i)%sm,source=med_sm,stat=info)
if (allocated(med_sm2)) then
allocate(precv(i)%sm2a,source=med_sm2,stat=info)
precv(i)%sm2 => precv(i)%sm2a
else
precv(i)%sm2 => precv(i)%sm
end if
else else
allocate(precv(i)%sm,source=coarse_sm,stat=info) allocate(precv(i)%sm,source=coarse_sm,stat=info)
end if end if
@ -225,6 +242,8 @@ subroutine mld_z_bld_mlhier_aggsize(casize,mxplevs,mnaggratio,a,desc_a,precv,inf
call base_sm%free(info) call base_sm%free(info)
if (info == psb_success_) call med_sm%free(info) if (info == psb_success_) call med_sm%free(info)
if (info == psb_success_) call coarse_sm%free(info) if (info == psb_success_) call coarse_sm%free(info)
if ((info == psb_success_).and.(allocated(base_sm2))) call base_sm2%free(info)
if ((info == psb_success_).and.(allocated(med_sm2))) call med_sm2%free(info)
if (info == psb_success_) deallocate(coarse_sm,med_sm,base_sm,stat=info) if (info == psb_success_) deallocate(coarse_sm,med_sm,base_sm,stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info = psb_err_internal_error_ info = psb_err_internal_error_

Write Preview
Loading…
Cancel
Save