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/smoother/mld_c_as_smoother_clone.f90
 mlprec/impl/smoother/mld_c_base_smoother_clone.f90
 mlprec/impl/smoother/mld_c_jac_smoother_clone.f90
 mlprec/impl/smoother/mld_d_as_smoother_clone.f90
 mlprec/impl/smoother/mld_d_base_smoother_clone.f90
 mlprec/impl/smoother/mld_d_jac_smoother_clone.f90
 mlprec/impl/smoother/mld_s_as_smoother_clone.f90
 mlprec/impl/smoother/mld_s_base_smoother_clone.f90
 mlprec/impl/smoother/mld_s_jac_smoother_clone.f90
 mlprec/impl/smoother/mld_z_as_smoother_clone.f90
 mlprec/impl/smoother/mld_z_base_smoother_clone.f90
 mlprec/impl/smoother/mld_z_jac_smoother_clone.f90
 mlprec/impl/solver/mld_c_base_solver_clone.f90
 mlprec/impl/solver/mld_c_diag_solver_clone.f90
 mlprec/impl/solver/mld_c_id_solver_clone.f90
 mlprec/impl/solver/mld_c_ilu_solver_clone.f90
 mlprec/impl/solver/mld_d_base_solver_clone.f90
 mlprec/impl/solver/mld_d_diag_solver_clone.f90
 mlprec/impl/solver/mld_d_id_solver_clone.f90
 mlprec/impl/solver/mld_d_ilu_solver_clone.f90
 mlprec/impl/solver/mld_s_base_solver_clone.f90
 mlprec/impl/solver/mld_s_diag_solver_clone.f90
 mlprec/impl/solver/mld_s_id_solver_clone.f90
 mlprec/impl/solver/mld_s_ilu_solver_clone.f90
 mlprec/impl/solver/mld_z_base_solver_clone.f90
 mlprec/impl/solver/mld_z_diag_solver_clone.f90
 mlprec/impl/solver/mld_z_id_solver_clone.f90
 mlprec/impl/solver/mld_z_ilu_solver_clone.f90
 mlprec/mld_base_prec_type.F90
 mlprec/mld_c_as_smoother.f90
 mlprec/mld_c_base_smoother_mod.f90
 mlprec/mld_c_base_solver_mod.f90
 mlprec/mld_c_diag_solver.f90
 mlprec/mld_c_id_solver.f90
 mlprec/mld_c_ilu_solver.f90
 mlprec/mld_c_jac_smoother.f90
 mlprec/mld_c_onelev_mod.f90
 mlprec/mld_c_prec_type.f90
 mlprec/mld_d_as_smoother.f90
 mlprec/mld_d_base_smoother_mod.f90
 mlprec/mld_d_base_solver_mod.f90
 mlprec/mld_d_diag_solver.f90
 mlprec/mld_d_id_solver.f90
 mlprec/mld_d_ilu_solver.f90
 mlprec/mld_d_jac_smoother.f90
 mlprec/mld_d_onelev_mod.f90
 mlprec/mld_d_prec_type.f90
 mlprec/mld_s_as_smoother.f90
 mlprec/mld_s_base_smoother_mod.f90
 mlprec/mld_s_base_solver_mod.f90
 mlprec/mld_s_diag_solver.f90
 mlprec/mld_s_id_solver.f90
 mlprec/mld_s_ilu_solver.f90
 mlprec/mld_s_jac_smoother.f90
 mlprec/mld_s_onelev_mod.f90
 mlprec/mld_s_prec_type.f90
 mlprec/mld_z_as_smoother.f90
 mlprec/mld_z_base_smoother_mod.f90
 mlprec/mld_z_base_solver_mod.f90
 mlprec/mld_z_diag_solver.f90
 mlprec/mld_z_id_solver.f90
 mlprec/mld_z_ilu_solver.f90
 mlprec/mld_z_jac_smoother.f90
 mlprec/mld_z_onelev_mod.f90
 mlprec/mld_z_prec_type.f90


Fix clone  to avoid INTENT(OUT),ALLOCATABLE and use intent(inout)
stopcriterion
Salvatore Filippone 12 years ago
parent 1fbe3ddb1c
commit c6881d1926
65 changed files with 808 additions and 324 deletions
Show Stats Download Patch File Download Diff File

14
mlprec/impl/smoother/mld_c_as_smoother_clone.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine mld_c_as_smoother_clone(sm,smout,info)
! Arguments
class(mld_c_as_smoother_type), intent(inout) :: sm
class(mld_c_base_smoother_type), allocatable, intent(out) :: smout
class(mld_c_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@ -54,11 +54,17 @@ subroutine mld_c_as_smoother_clone(sm,smout,info)
info=psb_success_
call psb_erractionsave(err_act)
allocate(mld_c_as_smoother_type :: smout, stat=info)
if (allocated(smout)) then
call smout%free(info)
if (info == psb_success_) deallocate(smout, stat=info)
end if
if (info == psb_success_) &
& allocate(mld_c_as_smoother_type :: smout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
select type(smo => smout)
type is (mld_c_as_smoother_type)
smo%novr = sm%novr
@ -68,6 +74,10 @@ subroutine mld_c_as_smoother_clone(sm,smout,info)
call sm%nd%clone(smo%nd,info)
if (info == psb_success_) &
& call sm%desc_data%clone(smo%desc_data,info)
if ((info==psb_success_).and.(allocated(sm%sv))) then
allocate(smout%sv,mold=sm%sv,stat=info)
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
end if
class default
info = psb_err_internal_error_

2
mlprec/impl/smoother/mld_c_base_smoother_clone.f90
Unescape Escape View File

@ -43,7 +43,7 @@ subroutine mld_c_base_smoother_clone(sm,smout,info)
Implicit None
! Arguments
class(mld_c_base_smoother_type), intent(inout) :: sm
class(mld_c_base_smoother_type), allocatable, intent(out) :: smout
class(mld_c_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_smoother_clone'

14
mlprec/impl/smoother/mld_c_jac_smoother_clone.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine mld_c_jac_smoother_clone(sm,smout,info)
! Arguments
class(mld_c_jac_smoother_type), intent(inout) :: sm
class(mld_c_base_smoother_type), allocatable, intent(out) :: smout
class(mld_c_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@ -54,15 +54,25 @@ subroutine mld_c_jac_smoother_clone(sm,smout,info)
info=psb_success_
call psb_erractionsave(err_act)
allocate(mld_c_jac_smoother_type :: smout, stat=info)
if (allocated(smout)) then
call smout%free(info)
if (info == psb_success_) deallocate(smout, stat=info)
end if
if (info == psb_success_) &
& allocate(mld_c_jac_smoother_type :: smout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
select type(smo => smout)
type is (mld_c_jac_smoother_type)
smo%nnz_nd_tot = sm%nnz_nd_tot
call sm%nd%clone(smo%nd,info)
if ((info==psb_success_).and.(allocated(sm%sv))) then
allocate(smout%sv,mold=sm%sv,stat=info)
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
end if
class default
info = psb_err_internal_error_

14
mlprec/impl/smoother/mld_d_as_smoother_clone.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine mld_d_as_smoother_clone(sm,smout,info)
! Arguments
class(mld_d_as_smoother_type), intent(inout) :: sm
class(mld_d_base_smoother_type), allocatable, intent(out) :: smout
class(mld_d_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@ -54,11 +54,17 @@ subroutine mld_d_as_smoother_clone(sm,smout,info)
info=psb_success_
call psb_erractionsave(err_act)
allocate(mld_d_as_smoother_type :: smout, stat=info)
if (allocated(smout)) then
call smout%free(info)
if (info == psb_success_) deallocate(smout, stat=info)
end if
if (info == psb_success_) &
& allocate(mld_d_as_smoother_type :: smout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
select type(smo => smout)
type is (mld_d_as_smoother_type)
smo%novr = sm%novr
@ -68,6 +74,10 @@ subroutine mld_d_as_smoother_clone(sm,smout,info)
call sm%nd%clone(smo%nd,info)
if (info == psb_success_) &
& call sm%desc_data%clone(smo%desc_data,info)
if ((info==psb_success_).and.(allocated(sm%sv))) then
allocate(smout%sv,mold=sm%sv,stat=info)
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
end if
class default
info = psb_err_internal_error_

2
mlprec/impl/smoother/mld_d_base_smoother_clone.f90
Unescape Escape View File

@ -43,7 +43,7 @@ subroutine mld_d_base_smoother_clone(sm,smout,info)
Implicit None
! Arguments
class(mld_d_base_smoother_type), intent(inout) :: sm
class(mld_d_base_smoother_type), allocatable, intent(out) :: smout
class(mld_d_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_smoother_clone'

14
mlprec/impl/smoother/mld_d_jac_smoother_clone.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine mld_d_jac_smoother_clone(sm,smout,info)
! Arguments
class(mld_d_jac_smoother_type), intent(inout) :: sm
class(mld_d_base_smoother_type), allocatable, intent(out) :: smout
class(mld_d_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@ -54,15 +54,25 @@ subroutine mld_d_jac_smoother_clone(sm,smout,info)
info=psb_success_
call psb_erractionsave(err_act)
allocate(mld_d_jac_smoother_type :: smout, stat=info)
if (allocated(smout)) then
call smout%free(info)
if (info == psb_success_) deallocate(smout, stat=info)
end if
if (info == psb_success_) &
& allocate(mld_d_jac_smoother_type :: smout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
select type(smo => smout)
type is (mld_d_jac_smoother_type)
smo%nnz_nd_tot = sm%nnz_nd_tot
call sm%nd%clone(smo%nd,info)
if ((info==psb_success_).and.(allocated(sm%sv))) then
allocate(smout%sv,mold=sm%sv,stat=info)
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
end if
class default
info = psb_err_internal_error_

14
mlprec/impl/smoother/mld_s_as_smoother_clone.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine mld_s_as_smoother_clone(sm,smout,info)
! Arguments
class(mld_s_as_smoother_type), intent(inout) :: sm
class(mld_s_base_smoother_type), allocatable, intent(out) :: smout
class(mld_s_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@ -54,11 +54,17 @@ subroutine mld_s_as_smoother_clone(sm,smout,info)
info=psb_success_
call psb_erractionsave(err_act)
allocate(mld_s_as_smoother_type :: smout, stat=info)
if (allocated(smout)) then
call smout%free(info)
if (info == psb_success_) deallocate(smout, stat=info)
end if
if (info == psb_success_) &
& allocate(mld_s_as_smoother_type :: smout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
select type(smo => smout)
type is (mld_s_as_smoother_type)
smo%novr = sm%novr
@ -68,6 +74,10 @@ subroutine mld_s_as_smoother_clone(sm,smout,info)
call sm%nd%clone(smo%nd,info)
if (info == psb_success_) &
& call sm%desc_data%clone(smo%desc_data,info)
if ((info==psb_success_).and.(allocated(sm%sv))) then
allocate(smout%sv,mold=sm%sv,stat=info)
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
end if
class default
info = psb_err_internal_error_

2
mlprec/impl/smoother/mld_s_base_smoother_clone.f90
Unescape Escape View File

@ -43,7 +43,7 @@ subroutine mld_s_base_smoother_clone(sm,smout,info)
Implicit None
! Arguments
class(mld_s_base_smoother_type), intent(inout) :: sm
class(mld_s_base_smoother_type), allocatable, intent(out) :: smout
class(mld_s_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_smoother_clone'

14
mlprec/impl/smoother/mld_s_jac_smoother_clone.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine mld_s_jac_smoother_clone(sm,smout,info)
! Arguments
class(mld_s_jac_smoother_type), intent(inout) :: sm
class(mld_s_base_smoother_type), allocatable, intent(out) :: smout
class(mld_s_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@ -54,15 +54,25 @@ subroutine mld_s_jac_smoother_clone(sm,smout,info)
info=psb_success_
call psb_erractionsave(err_act)
allocate(mld_s_jac_smoother_type :: smout, stat=info)
if (allocated(smout)) then
call smout%free(info)
if (info == psb_success_) deallocate(smout, stat=info)
end if
if (info == psb_success_) &
& allocate(mld_s_jac_smoother_type :: smout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
select type(smo => smout)
type is (mld_s_jac_smoother_type)
smo%nnz_nd_tot = sm%nnz_nd_tot
call sm%nd%clone(smo%nd,info)
if ((info==psb_success_).and.(allocated(sm%sv))) then
allocate(smout%sv,mold=sm%sv,stat=info)
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
end if
class default
info = psb_err_internal_error_

14
mlprec/impl/smoother/mld_z_as_smoother_clone.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine mld_z_as_smoother_clone(sm,smout,info)
! Arguments
class(mld_z_as_smoother_type), intent(inout) :: sm
class(mld_z_base_smoother_type), allocatable, intent(out) :: smout
class(mld_z_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@ -54,11 +54,17 @@ subroutine mld_z_as_smoother_clone(sm,smout,info)
info=psb_success_
call psb_erractionsave(err_act)
allocate(mld_z_as_smoother_type :: smout, stat=info)
if (allocated(smout)) then
call smout%free(info)
if (info == psb_success_) deallocate(smout, stat=info)
end if
if (info == psb_success_) &
& allocate(mld_z_as_smoother_type :: smout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
select type(smo => smout)
type is (mld_z_as_smoother_type)
smo%novr = sm%novr
@ -68,6 +74,10 @@ subroutine mld_z_as_smoother_clone(sm,smout,info)
call sm%nd%clone(smo%nd,info)
if (info == psb_success_) &
& call sm%desc_data%clone(smo%desc_data,info)
if ((info==psb_success_).and.(allocated(sm%sv))) then
allocate(smout%sv,mold=sm%sv,stat=info)
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
end if
class default
info = psb_err_internal_error_

2
mlprec/impl/smoother/mld_z_base_smoother_clone.f90
Unescape Escape View File

@ -43,7 +43,7 @@ subroutine mld_z_base_smoother_clone(sm,smout,info)
Implicit None
! Arguments
class(mld_z_base_smoother_type), intent(inout) :: sm
class(mld_z_base_smoother_type), allocatable, intent(out) :: smout
class(mld_z_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_smoother_clone'

14
mlprec/impl/smoother/mld_z_jac_smoother_clone.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine mld_z_jac_smoother_clone(sm,smout,info)
! Arguments
class(mld_z_jac_smoother_type), intent(inout) :: sm
class(mld_z_base_smoother_type), allocatable, intent(out) :: smout
class(mld_z_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@ -54,15 +54,25 @@ subroutine mld_z_jac_smoother_clone(sm,smout,info)
info=psb_success_
call psb_erractionsave(err_act)
allocate(mld_z_jac_smoother_type :: smout, stat=info)
if (allocated(smout)) then
call smout%free(info)
if (info == psb_success_) deallocate(smout, stat=info)
end if
if (info == psb_success_) &
& allocate(mld_z_jac_smoother_type :: smout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
select type(smo => smout)
type is (mld_z_jac_smoother_type)
smo%nnz_nd_tot = sm%nnz_nd_tot
call sm%nd%clone(smo%nd,info)
if ((info==psb_success_).and.(allocated(sm%sv))) then
allocate(smout%sv,mold=sm%sv,stat=info)
if (info == psb_success_) call sm%sv%clone(smo%sv,info)
end if
class default
info = psb_err_internal_error_

2
mlprec/impl/solver/mld_c_base_solver_clone.f90
Unescape Escape View File

@ -43,7 +43,7 @@ subroutine mld_c_base_solver_clone(sv,svout,info)
Implicit None
! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv
class(mld_c_base_solver_type), allocatable, intent(out) :: svout
class(mld_c_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_clone'

9
mlprec/impl/solver/mld_c_diag_solver_clone.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine mld_c_diag_solver_clone(sv,svout,info)
! Arguments
class(mld_c_diag_solver_type), intent(inout) :: sv
class(mld_c_base_solver_type), allocatable, intent(out) :: svout
class(mld_c_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@ -53,7 +53,12 @@ subroutine mld_c_diag_solver_clone(sv,svout,info)
info=psb_success_
call psb_erractionsave(err_act)
allocate(mld_c_diag_solver_type :: svout, stat=info)
if (allocated(svout)) then
call svout%free(info)
if (info == psb_success_) deallocate(svout, stat=info)
end if
if (info == psb_success_) &
& allocate(mld_c_diag_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999

9
mlprec/impl/solver/mld_c_id_solver_clone.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine mld_c_id_solver_clone(sv,svout,info)
! Arguments
class(mld_c_id_solver_type), intent(inout) :: sv
class(mld_c_base_solver_type), allocatable, intent(out) :: svout
class(mld_c_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@ -53,7 +53,12 @@ subroutine mld_c_id_solver_clone(sv,svout,info)
info=psb_success_
call psb_erractionsave(err_act)
allocate(mld_c_id_solver_type :: svout, stat=info)
if (allocated(svout)) then
call svout%free(info)
if (info == psb_success_) deallocate(svout, stat=info)
end if
if (info == psb_success_) &
& allocate(mld_c_id_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999

11
mlprec/impl/solver/mld_c_ilu_solver_clone.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine mld_c_ilu_solver_clone(sv,svout,info)
! Arguments
class(mld_c_ilu_solver_type), intent(inout) :: sv
class(mld_c_base_solver_type), allocatable, intent(out) :: svout
class(mld_c_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@ -53,12 +53,17 @@ subroutine mld_c_ilu_solver_clone(sv,svout,info)
info=psb_success_
call psb_erractionsave(err_act)
allocate(mld_c_ilu_solver_type :: svout, stat=info)
if (allocated(svout)) then
call svout%free(info)
if (info == psb_success_) deallocate(svout, stat=info)
end if
if (info == psb_success_) &
& allocate(mld_c_ilu_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
select type(svo => svout)
type is (mld_c_ilu_solver_type)
svo%fact_type = sv%fact_type

2
mlprec/impl/solver/mld_d_base_solver_clone.f90
Unescape Escape View File

@ -43,7 +43,7 @@ subroutine mld_d_base_solver_clone(sv,svout,info)
Implicit None
! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv
class(mld_d_base_solver_type), allocatable, intent(out) :: svout
class(mld_d_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_clone'

9
mlprec/impl/solver/mld_d_diag_solver_clone.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine mld_d_diag_solver_clone(sv,svout,info)
! Arguments
class(mld_d_diag_solver_type), intent(inout) :: sv
class(mld_d_base_solver_type), allocatable, intent(out) :: svout
class(mld_d_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@ -53,7 +53,12 @@ subroutine mld_d_diag_solver_clone(sv,svout,info)
info=psb_success_
call psb_erractionsave(err_act)
allocate(mld_d_diag_solver_type :: svout, stat=info)
if (allocated(svout)) then
call svout%free(info)
if (info == psb_success_) deallocate(svout, stat=info)
end if
if (info == psb_success_) &
& allocate(mld_d_diag_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999

9
mlprec/impl/solver/mld_d_id_solver_clone.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine mld_d_id_solver_clone(sv,svout,info)
! Arguments
class(mld_d_id_solver_type), intent(inout) :: sv
class(mld_d_base_solver_type), allocatable, intent(out) :: svout
class(mld_d_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@ -53,7 +53,12 @@ subroutine mld_d_id_solver_clone(sv,svout,info)
info=psb_success_
call psb_erractionsave(err_act)
allocate(mld_d_id_solver_type :: svout, stat=info)
if (allocated(svout)) then
call svout%free(info)
if (info == psb_success_) deallocate(svout, stat=info)
end if
if (info == psb_success_) &
& allocate(mld_d_id_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999

11
mlprec/impl/solver/mld_d_ilu_solver_clone.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine mld_d_ilu_solver_clone(sv,svout,info)
! Arguments
class(mld_d_ilu_solver_type), intent(inout) :: sv
class(mld_d_base_solver_type), allocatable, intent(out) :: svout
class(mld_d_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@ -53,12 +53,17 @@ subroutine mld_d_ilu_solver_clone(sv,svout,info)
info=psb_success_
call psb_erractionsave(err_act)
allocate(mld_d_ilu_solver_type :: svout, stat=info)
if (allocated(svout)) then
call svout%free(info)
if (info == psb_success_) deallocate(svout, stat=info)
end if
if (info == psb_success_) &
& allocate(mld_d_ilu_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
select type(svo => svout)
type is (mld_d_ilu_solver_type)
svo%fact_type = sv%fact_type

2
mlprec/impl/solver/mld_s_base_solver_clone.f90
Unescape Escape View File

@ -43,7 +43,7 @@ subroutine mld_s_base_solver_clone(sv,svout,info)
Implicit None
! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv
class(mld_s_base_solver_type), allocatable, intent(out) :: svout
class(mld_s_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_clone'

9
mlprec/impl/solver/mld_s_diag_solver_clone.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine mld_s_diag_solver_clone(sv,svout,info)
! Arguments
class(mld_s_diag_solver_type), intent(inout) :: sv
class(mld_s_base_solver_type), allocatable, intent(out) :: svout
class(mld_s_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@ -53,7 +53,12 @@ subroutine mld_s_diag_solver_clone(sv,svout,info)
info=psb_success_
call psb_erractionsave(err_act)
allocate(mld_s_diag_solver_type :: svout, stat=info)
if (allocated(svout)) then
call svout%free(info)
if (info == psb_success_) deallocate(svout, stat=info)
end if
if (info == psb_success_) &
& allocate(mld_s_diag_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999

9
mlprec/impl/solver/mld_s_id_solver_clone.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine mld_s_id_solver_clone(sv,svout,info)
! Arguments
class(mld_s_id_solver_type), intent(inout) :: sv
class(mld_s_base_solver_type), allocatable, intent(out) :: svout
class(mld_s_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@ -53,7 +53,12 @@ subroutine mld_s_id_solver_clone(sv,svout,info)
info=psb_success_
call psb_erractionsave(err_act)
allocate(mld_s_id_solver_type :: svout, stat=info)
if (allocated(svout)) then
call svout%free(info)
if (info == psb_success_) deallocate(svout, stat=info)
end if
if (info == psb_success_) &
& allocate(mld_s_id_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999

11
mlprec/impl/solver/mld_s_ilu_solver_clone.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine mld_s_ilu_solver_clone(sv,svout,info)
! Arguments
class(mld_s_ilu_solver_type), intent(inout) :: sv
class(mld_s_base_solver_type), allocatable, intent(out) :: svout
class(mld_s_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@ -53,12 +53,17 @@ subroutine mld_s_ilu_solver_clone(sv,svout,info)
info=psb_success_
call psb_erractionsave(err_act)
allocate(mld_s_ilu_solver_type :: svout, stat=info)
if (allocated(svout)) then
call svout%free(info)
if (info == psb_success_) deallocate(svout, stat=info)
end if
if (info == psb_success_) &
& allocate(mld_s_ilu_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
select type(svo => svout)
type is (mld_s_ilu_solver_type)
svo%fact_type = sv%fact_type

2
mlprec/impl/solver/mld_z_base_solver_clone.f90
Unescape Escape View File

@ -43,7 +43,7 @@ subroutine mld_z_base_solver_clone(sv,svout,info)
Implicit None
! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv
class(mld_z_base_solver_type), allocatable, intent(out) :: svout
class(mld_z_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
integer(psb_ipk_) :: err_act
character(len=20) :: name='d_base_solver_clone'

9
mlprec/impl/solver/mld_z_diag_solver_clone.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine mld_z_diag_solver_clone(sv,svout,info)
! Arguments
class(mld_z_diag_solver_type), intent(inout) :: sv
class(mld_z_base_solver_type), allocatable, intent(out) :: svout
class(mld_z_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@ -53,7 +53,12 @@ subroutine mld_z_diag_solver_clone(sv,svout,info)
info=psb_success_
call psb_erractionsave(err_act)
allocate(mld_z_diag_solver_type :: svout, stat=info)
if (allocated(svout)) then
call svout%free(info)
if (info == psb_success_) deallocate(svout, stat=info)
end if
if (info == psb_success_) &
& allocate(mld_z_diag_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999

9
mlprec/impl/solver/mld_z_id_solver_clone.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine mld_z_id_solver_clone(sv,svout,info)
! Arguments
class(mld_z_id_solver_type), intent(inout) :: sv
class(mld_z_base_solver_type), allocatable, intent(out) :: svout
class(mld_z_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@ -53,7 +53,12 @@ subroutine mld_z_id_solver_clone(sv,svout,info)
info=psb_success_
call psb_erractionsave(err_act)
allocate(mld_z_id_solver_type :: svout, stat=info)
if (allocated(svout)) then
call svout%free(info)
if (info == psb_success_) deallocate(svout, stat=info)
end if
if (info == psb_success_) &
& allocate(mld_z_id_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999

11
mlprec/impl/solver/mld_z_ilu_solver_clone.f90
Unescape Escape View File

@ -45,7 +45,7 @@ subroutine mld_z_ilu_solver_clone(sv,svout,info)
! Arguments
class(mld_z_ilu_solver_type), intent(inout) :: sv
class(mld_z_base_solver_type), allocatable, intent(out) :: svout
class(mld_z_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@ -53,12 +53,17 @@ subroutine mld_z_ilu_solver_clone(sv,svout,info)
info=psb_success_
call psb_erractionsave(err_act)
allocate(mld_z_ilu_solver_type :: svout, stat=info)
if (allocated(svout)) then
call svout%free(info)
if (info == psb_success_) deallocate(svout, stat=info)
end if
if (info == psb_success_) &
& allocate(mld_z_ilu_solver_type :: svout, stat=info)
if (info /= 0) then
info = psb_err_alloc_dealloc_
goto 9999
end if
select type(svo => svout)
type is (mld_z_ilu_solver_type)
svo%fact_type = sv%fact_type

13
mlprec/mld_c_as_smoother.f90
Unescape Escape View File

@ -70,11 +70,13 @@ module mld_c_as_smoother
procedure, pass(sm) :: sizeof => c_as_smoother_sizeof
procedure, pass(sm) :: default => c_as_smoother_default
procedure, pass(sm) :: get_nzeros => c_as_smoother_get_nzeros
procedure, nopass :: get_fmt => c_as_smoother_get_fmt
end type mld_c_as_smoother_type
private :: c_as_smoother_descr, c_as_smoother_sizeof, &
& c_as_smoother_default, c_as_smoother_get_nzeros
& c_as_smoother_default, c_as_smoother_get_nzeros, &
& c_as_smoother_get_fmt
character(len=6), parameter, private :: &
& restrict_names(0:4)=(/'none ','halo ',' ',' ',' '/)
@ -244,7 +246,7 @@ module mld_c_as_smoother
import :: mld_c_as_smoother_type, psb_spk_, &
& mld_c_base_smoother_type, psb_ipk_
class(mld_c_as_smoother_type), intent(inout) :: sm
class(mld_c_base_smoother_type), intent(out) :: smout
class(mld_c_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_as_smoother_clone
end interface
@ -352,4 +354,11 @@ contains
return
end subroutine c_as_smoother_descr
function c_as_smoother_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Schwarz smoother"
end function c_as_smoother_get_fmt
end module mld_c_as_smoother

11
mlprec/mld_c_base_smoother_mod.f90
Unescape Escape View File

@ -112,10 +112,11 @@ module mld_c_base_smoother_mod
procedure, pass(sm) :: sizeof => c_base_smoother_sizeof
procedure, pass(sm) :: get_nzeros => c_base_smoother_get_nzeros
procedure, nopass :: stringval => mld_stringval
procedure, nopass :: get_fmt => c_base_smoother_get_fmt
end type mld_c_base_smoother_type
private :: c_base_smoother_sizeof, &
private :: c_base_smoother_sizeof, c_base_smoother_get_fmt, &
& c_base_smoother_default, c_base_smoother_get_nzeros
@ -305,7 +306,7 @@ module mld_c_base_smoother_mod
! Arguments
class(mld_c_base_smoother_type), intent(inout) :: sm
class(mld_c_base_smoother_type), allocatable, intent(out) :: smout
class(mld_c_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_smoother_clone
end interface
@ -357,5 +358,11 @@ contains
return
end subroutine c_base_smoother_default
function c_base_smoother_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Base smoother"
end function c_base_smoother_get_fmt
end module mld_c_base_smoother_mod

13
mlprec/mld_c_base_solver_mod.f90
Unescape Escape View File

@ -104,10 +104,11 @@ module mld_c_base_solver_mod
procedure, pass(sv) :: sizeof => c_base_solver_sizeof
procedure, pass(sv) :: get_nzeros => c_base_solver_get_nzeros
procedure, nopass :: stringval => mld_stringval
procedure, nopass :: get_fmt => c_base_solver_get_fmt
end type mld_c_base_solver_type
private :: c_base_solver_sizeof, c_base_solver_default,&
& c_base_solver_get_nzeros
& c_base_solver_get_nzeros, c_base_solver_get_fmt
interface
@ -319,7 +320,7 @@ module mld_c_base_solver_mod
! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv
class(mld_c_base_solver_type), allocatable, intent(out) :: svout
class(mld_c_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_base_solver_clone
end interface
@ -360,4 +361,12 @@ contains
return
end subroutine c_base_solver_default
function c_base_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Base solver"
end function c_base_solver_get_fmt
end module mld_c_base_solver_mod

14
mlprec/mld_c_diag_solver.f90
Unescape Escape View File

@ -59,11 +59,13 @@ module mld_c_diag_solver
procedure, pass(sv) :: descr => c_diag_solver_descr
procedure, pass(sv) :: sizeof => c_diag_solver_sizeof
procedure, pass(sv) :: get_nzeros => c_diag_solver_get_nzeros
procedure, nopass :: get_fmt => c_diag_solver_get_fmt
end type mld_c_diag_solver_type
private :: c_diag_solver_free, c_diag_solver_descr, &
& c_diag_solver_sizeof, c_diag_solver_get_nzeros
& c_diag_solver_sizeof, c_diag_solver_get_nzeros, &
& c_diag_solver_get_fmt
interface
@ -123,7 +125,7 @@ module mld_c_diag_solver
! Arguments
class(mld_c_diag_solver_type), intent(inout) :: sv
class(mld_c_base_solver_type), allocatable, intent(out) :: svout
class(mld_c_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_diag_solver_clone
end interface
@ -221,4 +223,12 @@ contains
return
end function c_diag_solver_get_nzeros
function c_diag_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Diag solver"
end function c_diag_solver_get_fmt
end module mld_c_diag_solver

13
mlprec/mld_c_id_solver.f90
Unescape Escape View File

@ -55,11 +55,12 @@ module mld_c_id_solver
procedure, pass(sv) :: apply_a => mld_c_id_solver_apply
procedure, pass(sv) :: free => c_id_solver_free
procedure, pass(sv) :: descr => c_id_solver_descr
procedure, nopass :: get_fmt => c_id_solver_get_fmt
end type mld_c_id_solver_type
private :: c_id_solver_bld, &
& c_id_solver_free, &
& c_id_solver_free, c_id_solver_get_fmt, &
& c_id_solver_descr
interface
@ -103,7 +104,7 @@ module mld_c_id_solver
! Arguments
class(mld_c_id_solver_type), intent(inout) :: sv
class(mld_c_base_solver_type), allocatable, intent(out) :: svout
class(mld_c_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_id_solver_clone
end interface
@ -178,4 +179,12 @@ contains
end subroutine c_id_solver_descr
function c_id_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Identity solver"
end function c_id_solver_get_fmt
end module mld_c_id_solver

13
mlprec/mld_c_ilu_solver.f90
Unescape Escape View File

@ -71,6 +71,7 @@ module mld_c_ilu_solver
procedure, pass(sv) :: default => c_ilu_solver_default
procedure, pass(sv) :: sizeof => c_ilu_solver_sizeof
procedure, pass(sv) :: get_nzeros => c_ilu_solver_get_nzeros
procedure, nopass :: get_fmt => c_ilu_solver_get_fmt
end type mld_c_ilu_solver_type
@ -79,7 +80,8 @@ module mld_c_ilu_solver
& c_ilu_solver_setc, c_ilu_solver_setr,&
& c_ilu_solver_descr, c_ilu_solver_sizeof, &
& c_ilu_solver_default, c_ilu_solver_dmp, &
& c_ilu_solver_apply_vect, c_ilu_solver_get_nzeros
& c_ilu_solver_apply_vect, c_ilu_solver_get_nzeros, &
& c_ilu_solver_get_fmt
character(len=15), parameter, private :: &
@ -163,7 +165,7 @@ module mld_c_ilu_solver
! Arguments
class(mld_c_ilu_solver_type), intent(inout) :: sv
class(mld_c_base_solver_type), allocatable, intent(out) :: svout
class(mld_c_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_ilu_solver_clone
end interface
@ -556,4 +558,11 @@ contains
return
end function c_ilu_solver_sizeof
function c_ilu_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "ILU solver"
end function c_ilu_solver_get_fmt
end module mld_c_ilu_solver

13
mlprec/mld_c_jac_smoother.f90
Unescape Escape View File

@ -62,11 +62,13 @@ module mld_c_jac_smoother
procedure, pass(sm) :: descr => c_jac_smoother_descr
procedure, pass(sm) :: sizeof => c_jac_smoother_sizeof
procedure, pass(sm) :: get_nzeros => c_jac_smoother_get_nzeros
procedure, nopass :: get_fmt => c_jac_smoother_get_fmt
end type mld_c_jac_smoother_type
private :: c_jac_smoother_free, c_jac_smoother_descr, &
& c_jac_smoother_sizeof, c_jac_smoother_get_nzeros
& c_jac_smoother_sizeof, c_jac_smoother_get_nzeros, &
& c_jac_smoother_get_fmt
interface
@ -121,7 +123,7 @@ module mld_c_jac_smoother
import :: mld_c_jac_smoother_type, psb_spk_, &
& mld_c_base_smoother_type, psb_ipk_
class(mld_c_jac_smoother_type), intent(inout) :: sm
class(mld_c_base_smoother_type), intent(out) :: smout
class(mld_c_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_c_jac_smoother_clone
end interface
@ -247,4 +249,11 @@ contains
return
end function c_jac_smoother_get_nzeros
function c_jac_smoother_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Jacobi smoother"
end function c_jac_smoother_get_fmt
end module mld_c_jac_smoother

13
mlprec/mld_c_onelev_mod.f90
Unescape Escape View File

@ -385,11 +385,18 @@ contains
! Arguments
class(mld_c_onelev_type), target, intent(inout) :: lv
class(mld_c_onelev_type), intent(out) :: lvout
class(mld_c_onelev_type), intent(inout) :: lvout
integer(psb_ipk_), intent(out) :: info
if (allocated(lv%sm)) &
& call lv%sm%clone(lvout%sm,info)
info = psb_success_
if (allocated(lv%sm)) then
call lv%sm%clone(lvout%sm,info)
else
if (allocated(lvout%sm)) then
call lvout%sm%free(info)
if (info==psb_success_) deallocate(lvout%sm,stat=info)
end if
end if
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)

43
mlprec/mld_c_prec_type.f90
Unescape Escape View File

@ -728,36 +728,53 @@ contains
implicit none
class(mld_cprec_type), intent(inout) :: prec
class(mld_cprec_type), target, intent(out) :: precout
class(psb_cprec_type), intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
call mld_c_inner_clone(prec,precout,info)
end subroutine mld_c_clone
subroutine mld_c_inner_clone(prec,precout,info)
implicit none
class(mld_cprec_type), intent(inout) :: prec
class(psb_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
select type(pout => precout)
class is (mld_cprec_type)
pout%ictxt = prec%ictxt
pout%coarse_aggr_size = prec%coarse_aggr_size
pout%op_complexity = prec%op_complexity
if (allocated(prec%precv)) then
ln = size(prec%precv)
allocate(precout%precv(ln),stat=info)
allocate(pout%precv(ln),stat=info)
if (info /= psb_success_) goto 9999
if (ln > 1) then
call prec%precv(1)%clone(precout%precv(1),info)
if (ln >= 1) then
call prec%precv(1)%clone(pout%precv(1),info)
end if
do lev=2, ln
if (info /= psb_success_) exit
call prec%precv(lev)%clone(precout%precv(lev),info)
call prec%precv(lev)%clone(pout%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
pout%precv(lev)%base_a => pout%precv(lev)%ac
pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac
pout%precv(lev)%map%p_desc_X => pout%precv(lev-1)%base_desc
pout%precv(lev)%map%p_desc_Y => pout%precv(lev)%base_desc
end if
end do
end if
class default
write(0,*) 'Error: wrong out type'
info = psb_err_invalid_input_
end select
9999 continue
end subroutine mld_c_clone
end subroutine mld_c_inner_clone
subroutine mld_cprec_move_alloc(a, b,info)
use psb_base_mod

13
mlprec/mld_d_as_smoother.f90
Unescape Escape View File

@ -70,11 +70,13 @@ module mld_d_as_smoother
procedure, pass(sm) :: sizeof => d_as_smoother_sizeof
procedure, pass(sm) :: default => d_as_smoother_default
procedure, pass(sm) :: get_nzeros => d_as_smoother_get_nzeros
procedure, nopass :: get_fmt => d_as_smoother_get_fmt
end type mld_d_as_smoother_type
private :: d_as_smoother_descr, d_as_smoother_sizeof, &
& d_as_smoother_default, d_as_smoother_get_nzeros
& d_as_smoother_default, d_as_smoother_get_nzeros, &
& d_as_smoother_get_fmt
character(len=6), parameter, private :: &
& restrict_names(0:4)=(/'none ','halo ',' ',' ',' '/)
@ -244,7 +246,7 @@ module mld_d_as_smoother
import :: mld_d_as_smoother_type, psb_dpk_, &
& mld_d_base_smoother_type, psb_ipk_
class(mld_d_as_smoother_type), intent(inout) :: sm
class(mld_d_base_smoother_type), intent(out) :: smout
class(mld_d_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_as_smoother_clone
end interface
@ -352,4 +354,11 @@ contains
return
end subroutine d_as_smoother_descr
function d_as_smoother_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Schwarz smoother"
end function d_as_smoother_get_fmt
end module mld_d_as_smoother

11
mlprec/mld_d_base_smoother_mod.f90
Unescape Escape View File

@ -112,10 +112,11 @@ module mld_d_base_smoother_mod
procedure, pass(sm) :: sizeof => d_base_smoother_sizeof
procedure, pass(sm) :: get_nzeros => d_base_smoother_get_nzeros
procedure, nopass :: stringval => mld_stringval
procedure, nopass :: get_fmt => d_base_smoother_get_fmt
end type mld_d_base_smoother_type
private :: d_base_smoother_sizeof, &
private :: d_base_smoother_sizeof, d_base_smoother_get_fmt, &
& d_base_smoother_default, d_base_smoother_get_nzeros
@ -305,7 +306,7 @@ module mld_d_base_smoother_mod
! Arguments
class(mld_d_base_smoother_type), intent(inout) :: sm
class(mld_d_base_smoother_type), allocatable, intent(out) :: smout
class(mld_d_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_smoother_clone
end interface
@ -357,5 +358,11 @@ contains
return
end subroutine d_base_smoother_default
function d_base_smoother_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Base smoother"
end function d_base_smoother_get_fmt
end module mld_d_base_smoother_mod

13
mlprec/mld_d_base_solver_mod.f90
Unescape Escape View File

@ -104,10 +104,11 @@ module mld_d_base_solver_mod
procedure, pass(sv) :: sizeof => d_base_solver_sizeof
procedure, pass(sv) :: get_nzeros => d_base_solver_get_nzeros
procedure, nopass :: stringval => mld_stringval
procedure, nopass :: get_fmt => d_base_solver_get_fmt
end type mld_d_base_solver_type
private :: d_base_solver_sizeof, d_base_solver_default,&
& d_base_solver_get_nzeros
& d_base_solver_get_nzeros, d_base_solver_get_fmt
interface
@ -319,7 +320,7 @@ module mld_d_base_solver_mod
! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv
class(mld_d_base_solver_type), allocatable, intent(out) :: svout
class(mld_d_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_base_solver_clone
end interface
@ -360,4 +361,12 @@ contains
return
end subroutine d_base_solver_default
function d_base_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Base solver"
end function d_base_solver_get_fmt
end module mld_d_base_solver_mod

14
mlprec/mld_d_diag_solver.f90
Unescape Escape View File

@ -59,11 +59,13 @@ module mld_d_diag_solver
procedure, pass(sv) :: descr => d_diag_solver_descr
procedure, pass(sv) :: sizeof => d_diag_solver_sizeof
procedure, pass(sv) :: get_nzeros => d_diag_solver_get_nzeros
procedure, nopass :: get_fmt => d_diag_solver_get_fmt
end type mld_d_diag_solver_type
private :: d_diag_solver_free, d_diag_solver_descr, &
& d_diag_solver_sizeof, d_diag_solver_get_nzeros
& d_diag_solver_sizeof, d_diag_solver_get_nzeros, &
& d_diag_solver_get_fmt
interface
@ -123,7 +125,7 @@ module mld_d_diag_solver
! Arguments
class(mld_d_diag_solver_type), intent(inout) :: sv
class(mld_d_base_solver_type), allocatable, intent(out) :: svout
class(mld_d_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_diag_solver_clone
end interface
@ -221,4 +223,12 @@ contains
return
end function d_diag_solver_get_nzeros
function d_diag_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Diag solver"
end function d_diag_solver_get_fmt
end module mld_d_diag_solver

13
mlprec/mld_d_id_solver.f90
Unescape Escape View File

@ -55,11 +55,12 @@ module mld_d_id_solver
procedure, pass(sv) :: apply_a => mld_d_id_solver_apply
procedure, pass(sv) :: free => d_id_solver_free
procedure, pass(sv) :: descr => d_id_solver_descr
procedure, nopass :: get_fmt => d_id_solver_get_fmt
end type mld_d_id_solver_type
private :: d_id_solver_bld, &
& d_id_solver_free, &
& d_id_solver_free, d_id_solver_get_fmt, &
& d_id_solver_descr
interface
@ -103,7 +104,7 @@ module mld_d_id_solver
! Arguments
class(mld_d_id_solver_type), intent(inout) :: sv
class(mld_d_base_solver_type), allocatable, intent(out) :: svout
class(mld_d_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_id_solver_clone
end interface
@ -178,4 +179,12 @@ contains
end subroutine d_id_solver_descr
function d_id_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Identity solver"
end function d_id_solver_get_fmt
end module mld_d_id_solver

13
mlprec/mld_d_ilu_solver.f90
Unescape Escape View File

@ -71,6 +71,7 @@ module mld_d_ilu_solver
procedure, pass(sv) :: default => d_ilu_solver_default
procedure, pass(sv) :: sizeof => d_ilu_solver_sizeof
procedure, pass(sv) :: get_nzeros => d_ilu_solver_get_nzeros
procedure, nopass :: get_fmt => d_ilu_solver_get_fmt
end type mld_d_ilu_solver_type
@ -79,7 +80,8 @@ module mld_d_ilu_solver
& d_ilu_solver_setc, d_ilu_solver_setr,&
& d_ilu_solver_descr, d_ilu_solver_sizeof, &
& d_ilu_solver_default, d_ilu_solver_dmp, &
& d_ilu_solver_apply_vect, d_ilu_solver_get_nzeros
& d_ilu_solver_apply_vect, d_ilu_solver_get_nzeros, &
& d_ilu_solver_get_fmt
character(len=15), parameter, private :: &
@ -163,7 +165,7 @@ module mld_d_ilu_solver
! Arguments
class(mld_d_ilu_solver_type), intent(inout) :: sv
class(mld_d_base_solver_type), allocatable, intent(out) :: svout
class(mld_d_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_ilu_solver_clone
end interface
@ -556,4 +558,11 @@ contains
return
end function d_ilu_solver_sizeof
function d_ilu_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "ILU solver"
end function d_ilu_solver_get_fmt
end module mld_d_ilu_solver

13
mlprec/mld_d_jac_smoother.f90
Unescape Escape View File

@ -62,11 +62,13 @@ module mld_d_jac_smoother
procedure, pass(sm) :: descr => d_jac_smoother_descr
procedure, pass(sm) :: sizeof => d_jac_smoother_sizeof
procedure, pass(sm) :: get_nzeros => d_jac_smoother_get_nzeros
procedure, nopass :: get_fmt => d_jac_smoother_get_fmt
end type mld_d_jac_smoother_type
private :: d_jac_smoother_free, d_jac_smoother_descr, &
& d_jac_smoother_sizeof, d_jac_smoother_get_nzeros
& d_jac_smoother_sizeof, d_jac_smoother_get_nzeros, &
& d_jac_smoother_get_fmt
interface
@ -121,7 +123,7 @@ module mld_d_jac_smoother
import :: mld_d_jac_smoother_type, psb_dpk_, &
& mld_d_base_smoother_type, psb_ipk_
class(mld_d_jac_smoother_type), intent(inout) :: sm
class(mld_d_base_smoother_type), intent(out) :: smout
class(mld_d_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_d_jac_smoother_clone
end interface
@ -247,4 +249,11 @@ contains
return
end function d_jac_smoother_get_nzeros
function d_jac_smoother_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Jacobi smoother"
end function d_jac_smoother_get_fmt
end module mld_d_jac_smoother

13
mlprec/mld_d_onelev_mod.f90
Unescape Escape View File

@ -385,11 +385,18 @@ contains
! Arguments
class(mld_d_onelev_type), target, intent(inout) :: lv
class(mld_d_onelev_type), intent(out) :: lvout
class(mld_d_onelev_type), intent(inout) :: lvout
integer(psb_ipk_), intent(out) :: info
if (allocated(lv%sm)) &
& call lv%sm%clone(lvout%sm,info)
info = psb_success_
if (allocated(lv%sm)) then
call lv%sm%clone(lvout%sm,info)
else
if (allocated(lvout%sm)) then
call lvout%sm%free(info)
if (info==psb_success_) deallocate(lvout%sm,stat=info)
end if
end if
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)

43
mlprec/mld_d_prec_type.f90
Unescape Escape View File

@ -728,36 +728,53 @@ contains
implicit none
class(mld_dprec_type), intent(inout) :: prec
class(mld_dprec_type), target, intent(out) :: precout
class(psb_dprec_type), intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
call mld_d_inner_clone(prec,precout,info)
end subroutine mld_d_clone
subroutine mld_d_inner_clone(prec,precout,info)
implicit none
class(mld_dprec_type), intent(inout) :: prec
class(psb_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
select type(pout => precout)
class is (mld_dprec_type)
pout%ictxt = prec%ictxt
pout%coarse_aggr_size = prec%coarse_aggr_size
pout%op_complexity = prec%op_complexity
if (allocated(prec%precv)) then
ln = size(prec%precv)
allocate(precout%precv(ln),stat=info)
allocate(pout%precv(ln),stat=info)
if (info /= psb_success_) goto 9999
if (ln > 1) then
call prec%precv(1)%clone(precout%precv(1),info)
if (ln >= 1) then
call prec%precv(1)%clone(pout%precv(1),info)
end if
do lev=2, ln
if (info /= psb_success_) exit
call prec%precv(lev)%clone(precout%precv(lev),info)
call prec%precv(lev)%clone(pout%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
pout%precv(lev)%base_a => pout%precv(lev)%ac
pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac
pout%precv(lev)%map%p_desc_X => pout%precv(lev-1)%base_desc
pout%precv(lev)%map%p_desc_Y => pout%precv(lev)%base_desc
end if
end do
end if
class default
write(0,*) 'Error: wrong out type'
info = psb_err_invalid_input_
end select
9999 continue
end subroutine mld_d_clone
end subroutine mld_d_inner_clone
subroutine mld_dprec_move_alloc(a, b,info)
use psb_base_mod

13
mlprec/mld_s_as_smoother.f90
Unescape Escape View File

@ -70,11 +70,13 @@ module mld_s_as_smoother
procedure, pass(sm) :: sizeof => s_as_smoother_sizeof
procedure, pass(sm) :: default => s_as_smoother_default
procedure, pass(sm) :: get_nzeros => s_as_smoother_get_nzeros
procedure, nopass :: get_fmt => s_as_smoother_get_fmt
end type mld_s_as_smoother_type
private :: s_as_smoother_descr, s_as_smoother_sizeof, &
& s_as_smoother_default, s_as_smoother_get_nzeros
& s_as_smoother_default, s_as_smoother_get_nzeros, &
& s_as_smoother_get_fmt
character(len=6), parameter, private :: &
& restrict_names(0:4)=(/'none ','halo ',' ',' ',' '/)
@ -244,7 +246,7 @@ module mld_s_as_smoother
import :: mld_s_as_smoother_type, psb_spk_, &
& mld_s_base_smoother_type, psb_ipk_
class(mld_s_as_smoother_type), intent(inout) :: sm
class(mld_s_base_smoother_type), intent(out) :: smout
class(mld_s_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_as_smoother_clone
end interface
@ -352,4 +354,11 @@ contains
return
end subroutine s_as_smoother_descr
function s_as_smoother_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Schwarz smoother"
end function s_as_smoother_get_fmt
end module mld_s_as_smoother

11
mlprec/mld_s_base_smoother_mod.f90
Unescape Escape View File

@ -112,10 +112,11 @@ module mld_s_base_smoother_mod
procedure, pass(sm) :: sizeof => s_base_smoother_sizeof
procedure, pass(sm) :: get_nzeros => s_base_smoother_get_nzeros
procedure, nopass :: stringval => mld_stringval
procedure, nopass :: get_fmt => s_base_smoother_get_fmt
end type mld_s_base_smoother_type
private :: s_base_smoother_sizeof, &
private :: s_base_smoother_sizeof, s_base_smoother_get_fmt, &
& s_base_smoother_default, s_base_smoother_get_nzeros
@ -305,7 +306,7 @@ module mld_s_base_smoother_mod
! Arguments
class(mld_s_base_smoother_type), intent(inout) :: sm
class(mld_s_base_smoother_type), allocatable, intent(out) :: smout
class(mld_s_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_smoother_clone
end interface
@ -357,5 +358,11 @@ contains
return
end subroutine s_base_smoother_default
function s_base_smoother_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Base smoother"
end function s_base_smoother_get_fmt
end module mld_s_base_smoother_mod

13
mlprec/mld_s_base_solver_mod.f90
Unescape Escape View File

@ -104,10 +104,11 @@ module mld_s_base_solver_mod
procedure, pass(sv) :: sizeof => s_base_solver_sizeof
procedure, pass(sv) :: get_nzeros => s_base_solver_get_nzeros
procedure, nopass :: stringval => mld_stringval
procedure, nopass :: get_fmt => s_base_solver_get_fmt
end type mld_s_base_solver_type
private :: s_base_solver_sizeof, s_base_solver_default,&
& s_base_solver_get_nzeros
& s_base_solver_get_nzeros, s_base_solver_get_fmt
interface
@ -319,7 +320,7 @@ module mld_s_base_solver_mod
! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv
class(mld_s_base_solver_type), allocatable, intent(out) :: svout
class(mld_s_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_base_solver_clone
end interface
@ -360,4 +361,12 @@ contains
return
end subroutine s_base_solver_default
function s_base_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Base solver"
end function s_base_solver_get_fmt
end module mld_s_base_solver_mod

14
mlprec/mld_s_diag_solver.f90
Unescape Escape View File

@ -59,11 +59,13 @@ module mld_s_diag_solver
procedure, pass(sv) :: descr => s_diag_solver_descr
procedure, pass(sv) :: sizeof => s_diag_solver_sizeof
procedure, pass(sv) :: get_nzeros => s_diag_solver_get_nzeros
procedure, nopass :: get_fmt => s_diag_solver_get_fmt
end type mld_s_diag_solver_type
private :: s_diag_solver_free, s_diag_solver_descr, &
& s_diag_solver_sizeof, s_diag_solver_get_nzeros
& s_diag_solver_sizeof, s_diag_solver_get_nzeros, &
& s_diag_solver_get_fmt
interface
@ -123,7 +125,7 @@ module mld_s_diag_solver
! Arguments
class(mld_s_diag_solver_type), intent(inout) :: sv
class(mld_s_base_solver_type), allocatable, intent(out) :: svout
class(mld_s_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_diag_solver_clone
end interface
@ -221,4 +223,12 @@ contains
return
end function s_diag_solver_get_nzeros
function s_diag_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Diag solver"
end function s_diag_solver_get_fmt
end module mld_s_diag_solver

13
mlprec/mld_s_id_solver.f90
Unescape Escape View File

@ -55,11 +55,12 @@ module mld_s_id_solver
procedure, pass(sv) :: apply_a => mld_s_id_solver_apply
procedure, pass(sv) :: free => s_id_solver_free
procedure, pass(sv) :: descr => s_id_solver_descr
procedure, nopass :: get_fmt => s_id_solver_get_fmt
end type mld_s_id_solver_type
private :: s_id_solver_bld, &
& s_id_solver_free, &
& s_id_solver_free, s_id_solver_get_fmt, &
& s_id_solver_descr
interface
@ -103,7 +104,7 @@ module mld_s_id_solver
! Arguments
class(mld_s_id_solver_type), intent(inout) :: sv
class(mld_s_base_solver_type), allocatable, intent(out) :: svout
class(mld_s_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_id_solver_clone
end interface
@ -178,4 +179,12 @@ contains
end subroutine s_id_solver_descr
function s_id_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Identity solver"
end function s_id_solver_get_fmt
end module mld_s_id_solver

13
mlprec/mld_s_ilu_solver.f90
Unescape Escape View File

@ -71,6 +71,7 @@ module mld_s_ilu_solver
procedure, pass(sv) :: default => s_ilu_solver_default
procedure, pass(sv) :: sizeof => s_ilu_solver_sizeof
procedure, pass(sv) :: get_nzeros => s_ilu_solver_get_nzeros
procedure, nopass :: get_fmt => s_ilu_solver_get_fmt
end type mld_s_ilu_solver_type
@ -79,7 +80,8 @@ module mld_s_ilu_solver
& s_ilu_solver_setc, s_ilu_solver_setr,&
& s_ilu_solver_descr, s_ilu_solver_sizeof, &
& s_ilu_solver_default, s_ilu_solver_dmp, &
& s_ilu_solver_apply_vect, s_ilu_solver_get_nzeros
& s_ilu_solver_apply_vect, s_ilu_solver_get_nzeros, &
& s_ilu_solver_get_fmt
character(len=15), parameter, private :: &
@ -163,7 +165,7 @@ module mld_s_ilu_solver
! Arguments
class(mld_s_ilu_solver_type), intent(inout) :: sv
class(mld_s_base_solver_type), allocatable, intent(out) :: svout
class(mld_s_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_ilu_solver_clone
end interface
@ -556,4 +558,11 @@ contains
return
end function s_ilu_solver_sizeof
function s_ilu_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "ILU solver"
end function s_ilu_solver_get_fmt
end module mld_s_ilu_solver

13
mlprec/mld_s_jac_smoother.f90
Unescape Escape View File

@ -62,11 +62,13 @@ module mld_s_jac_smoother
procedure, pass(sm) :: descr => s_jac_smoother_descr
procedure, pass(sm) :: sizeof => s_jac_smoother_sizeof
procedure, pass(sm) :: get_nzeros => s_jac_smoother_get_nzeros
procedure, nopass :: get_fmt => s_jac_smoother_get_fmt
end type mld_s_jac_smoother_type
private :: s_jac_smoother_free, s_jac_smoother_descr, &
& s_jac_smoother_sizeof, s_jac_smoother_get_nzeros
& s_jac_smoother_sizeof, s_jac_smoother_get_nzeros, &
& s_jac_smoother_get_fmt
interface
@ -121,7 +123,7 @@ module mld_s_jac_smoother
import :: mld_s_jac_smoother_type, psb_spk_, &
& mld_s_base_smoother_type, psb_ipk_
class(mld_s_jac_smoother_type), intent(inout) :: sm
class(mld_s_base_smoother_type), intent(out) :: smout
class(mld_s_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_s_jac_smoother_clone
end interface
@ -247,4 +249,11 @@ contains
return
end function s_jac_smoother_get_nzeros
function s_jac_smoother_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Jacobi smoother"
end function s_jac_smoother_get_fmt
end module mld_s_jac_smoother

13
mlprec/mld_s_onelev_mod.f90
Unescape Escape View File

@ -385,11 +385,18 @@ contains
! Arguments
class(mld_s_onelev_type), target, intent(inout) :: lv
class(mld_s_onelev_type), intent(out) :: lvout
class(mld_s_onelev_type), intent(inout) :: lvout
integer(psb_ipk_), intent(out) :: info
if (allocated(lv%sm)) &
& call lv%sm%clone(lvout%sm,info)
info = psb_success_
if (allocated(lv%sm)) then
call lv%sm%clone(lvout%sm,info)
else
if (allocated(lvout%sm)) then
call lvout%sm%free(info)
if (info==psb_success_) deallocate(lvout%sm,stat=info)
end if
end if
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)

43
mlprec/mld_s_prec_type.f90
Unescape Escape View File

@ -728,36 +728,53 @@ contains
implicit none
class(mld_sprec_type), intent(inout) :: prec
class(mld_sprec_type), target, intent(out) :: precout
class(psb_sprec_type), intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
call mld_s_inner_clone(prec,precout,info)
end subroutine mld_s_clone
subroutine mld_s_inner_clone(prec,precout,info)
implicit none
class(mld_sprec_type), intent(inout) :: prec
class(psb_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
select type(pout => precout)
class is (mld_sprec_type)
pout%ictxt = prec%ictxt
pout%coarse_aggr_size = prec%coarse_aggr_size
pout%op_complexity = prec%op_complexity
if (allocated(prec%precv)) then
ln = size(prec%precv)
allocate(precout%precv(ln),stat=info)
allocate(pout%precv(ln),stat=info)
if (info /= psb_success_) goto 9999
if (ln > 1) then
call prec%precv(1)%clone(precout%precv(1),info)
if (ln >= 1) then
call prec%precv(1)%clone(pout%precv(1),info)
end if
do lev=2, ln
if (info /= psb_success_) exit
call prec%precv(lev)%clone(precout%precv(lev),info)
call prec%precv(lev)%clone(pout%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
pout%precv(lev)%base_a => pout%precv(lev)%ac
pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac
pout%precv(lev)%map%p_desc_X => pout%precv(lev-1)%base_desc
pout%precv(lev)%map%p_desc_Y => pout%precv(lev)%base_desc
end if
end do
end if
class default
write(0,*) 'Error: wrong out type'
info = psb_err_invalid_input_
end select
9999 continue
end subroutine mld_s_clone
end subroutine mld_s_inner_clone
subroutine mld_sprec_move_alloc(a, b,info)
use psb_base_mod

13
mlprec/mld_z_as_smoother.f90
Unescape Escape View File

@ -70,11 +70,13 @@ module mld_z_as_smoother
procedure, pass(sm) :: sizeof => z_as_smoother_sizeof
procedure, pass(sm) :: default => z_as_smoother_default
procedure, pass(sm) :: get_nzeros => z_as_smoother_get_nzeros
procedure, nopass :: get_fmt => z_as_smoother_get_fmt
end type mld_z_as_smoother_type
private :: z_as_smoother_descr, z_as_smoother_sizeof, &
& z_as_smoother_default, z_as_smoother_get_nzeros
& z_as_smoother_default, z_as_smoother_get_nzeros, &
& z_as_smoother_get_fmt
character(len=6), parameter, private :: &
& restrict_names(0:4)=(/'none ','halo ',' ',' ',' '/)
@ -244,7 +246,7 @@ module mld_z_as_smoother
import :: mld_z_as_smoother_type, psb_dpk_, &
& mld_z_base_smoother_type, psb_ipk_
class(mld_z_as_smoother_type), intent(inout) :: sm
class(mld_z_base_smoother_type), intent(out) :: smout
class(mld_z_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_as_smoother_clone
end interface
@ -352,4 +354,11 @@ contains
return
end subroutine z_as_smoother_descr
function z_as_smoother_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Schwarz smoother"
end function z_as_smoother_get_fmt
end module mld_z_as_smoother

11
mlprec/mld_z_base_smoother_mod.f90
Unescape Escape View File

@ -112,10 +112,11 @@ module mld_z_base_smoother_mod
procedure, pass(sm) :: sizeof => z_base_smoother_sizeof
procedure, pass(sm) :: get_nzeros => z_base_smoother_get_nzeros
procedure, nopass :: stringval => mld_stringval
procedure, nopass :: get_fmt => z_base_smoother_get_fmt
end type mld_z_base_smoother_type
private :: z_base_smoother_sizeof, &
private :: z_base_smoother_sizeof, z_base_smoother_get_fmt, &
& z_base_smoother_default, z_base_smoother_get_nzeros
@ -305,7 +306,7 @@ module mld_z_base_smoother_mod
! Arguments
class(mld_z_base_smoother_type), intent(inout) :: sm
class(mld_z_base_smoother_type), allocatable, intent(out) :: smout
class(mld_z_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_smoother_clone
end interface
@ -357,5 +358,11 @@ contains
return
end subroutine z_base_smoother_default
function z_base_smoother_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Base smoother"
end function z_base_smoother_get_fmt
end module mld_z_base_smoother_mod

13
mlprec/mld_z_base_solver_mod.f90
Unescape Escape View File

@ -104,10 +104,11 @@ module mld_z_base_solver_mod
procedure, pass(sv) :: sizeof => z_base_solver_sizeof
procedure, pass(sv) :: get_nzeros => z_base_solver_get_nzeros
procedure, nopass :: stringval => mld_stringval
procedure, nopass :: get_fmt => z_base_solver_get_fmt
end type mld_z_base_solver_type
private :: z_base_solver_sizeof, z_base_solver_default,&
& z_base_solver_get_nzeros
& z_base_solver_get_nzeros, z_base_solver_get_fmt
interface
@ -319,7 +320,7 @@ module mld_z_base_solver_mod
! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv
class(mld_z_base_solver_type), allocatable, intent(out) :: svout
class(mld_z_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_base_solver_clone
end interface
@ -360,4 +361,12 @@ contains
return
end subroutine z_base_solver_default
function z_base_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Base solver"
end function z_base_solver_get_fmt
end module mld_z_base_solver_mod

14
mlprec/mld_z_diag_solver.f90
Unescape Escape View File

@ -59,11 +59,13 @@ module mld_z_diag_solver
procedure, pass(sv) :: descr => z_diag_solver_descr
procedure, pass(sv) :: sizeof => z_diag_solver_sizeof
procedure, pass(sv) :: get_nzeros => z_diag_solver_get_nzeros
procedure, nopass :: get_fmt => z_diag_solver_get_fmt
end type mld_z_diag_solver_type
private :: z_diag_solver_free, z_diag_solver_descr, &
& z_diag_solver_sizeof, z_diag_solver_get_nzeros
& z_diag_solver_sizeof, z_diag_solver_get_nzeros, &
& z_diag_solver_get_fmt
interface
@ -123,7 +125,7 @@ module mld_z_diag_solver
! Arguments
class(mld_z_diag_solver_type), intent(inout) :: sv
class(mld_z_base_solver_type), allocatable, intent(out) :: svout
class(mld_z_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_diag_solver_clone
end interface
@ -221,4 +223,12 @@ contains
return
end function z_diag_solver_get_nzeros
function z_diag_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Diag solver"
end function z_diag_solver_get_fmt
end module mld_z_diag_solver

13
mlprec/mld_z_id_solver.f90
Unescape Escape View File

@ -55,11 +55,12 @@ module mld_z_id_solver
procedure, pass(sv) :: apply_a => mld_z_id_solver_apply
procedure, pass(sv) :: free => z_id_solver_free
procedure, pass(sv) :: descr => z_id_solver_descr
procedure, nopass :: get_fmt => z_id_solver_get_fmt
end type mld_z_id_solver_type
private :: z_id_solver_bld, &
& z_id_solver_free, &
& z_id_solver_free, z_id_solver_get_fmt, &
& z_id_solver_descr
interface
@ -103,7 +104,7 @@ module mld_z_id_solver
! Arguments
class(mld_z_id_solver_type), intent(inout) :: sv
class(mld_z_base_solver_type), allocatable, intent(out) :: svout
class(mld_z_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_id_solver_clone
end interface
@ -178,4 +179,12 @@ contains
end subroutine z_id_solver_descr
function z_id_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Identity solver"
end function z_id_solver_get_fmt
end module mld_z_id_solver

13
mlprec/mld_z_ilu_solver.f90
Unescape Escape View File

@ -71,6 +71,7 @@ module mld_z_ilu_solver
procedure, pass(sv) :: default => z_ilu_solver_default
procedure, pass(sv) :: sizeof => z_ilu_solver_sizeof
procedure, pass(sv) :: get_nzeros => z_ilu_solver_get_nzeros
procedure, nopass :: get_fmt => z_ilu_solver_get_fmt
end type mld_z_ilu_solver_type
@ -79,7 +80,8 @@ module mld_z_ilu_solver
& z_ilu_solver_setc, z_ilu_solver_setr,&
& z_ilu_solver_descr, z_ilu_solver_sizeof, &
& z_ilu_solver_default, z_ilu_solver_dmp, &
& z_ilu_solver_apply_vect, z_ilu_solver_get_nzeros
& z_ilu_solver_apply_vect, z_ilu_solver_get_nzeros, &
& z_ilu_solver_get_fmt
character(len=15), parameter, private :: &
@ -163,7 +165,7 @@ module mld_z_ilu_solver
! Arguments
class(mld_z_ilu_solver_type), intent(inout) :: sv
class(mld_z_base_solver_type), allocatable, intent(out) :: svout
class(mld_z_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_ilu_solver_clone
end interface
@ -556,4 +558,11 @@ contains
return
end function z_ilu_solver_sizeof
function z_ilu_solver_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "ILU solver"
end function z_ilu_solver_get_fmt
end module mld_z_ilu_solver

13
mlprec/mld_z_jac_smoother.f90
Unescape Escape View File

@ -62,11 +62,13 @@ module mld_z_jac_smoother
procedure, pass(sm) :: descr => z_jac_smoother_descr
procedure, pass(sm) :: sizeof => z_jac_smoother_sizeof
procedure, pass(sm) :: get_nzeros => z_jac_smoother_get_nzeros
procedure, nopass :: get_fmt => z_jac_smoother_get_fmt
end type mld_z_jac_smoother_type
private :: z_jac_smoother_free, z_jac_smoother_descr, &
& z_jac_smoother_sizeof, z_jac_smoother_get_nzeros
& z_jac_smoother_sizeof, z_jac_smoother_get_nzeros, &
& z_jac_smoother_get_fmt
interface
@ -121,7 +123,7 @@ module mld_z_jac_smoother
import :: mld_z_jac_smoother_type, psb_dpk_, &
& mld_z_base_smoother_type, psb_ipk_
class(mld_z_jac_smoother_type), intent(inout) :: sm
class(mld_z_base_smoother_type), intent(out) :: smout
class(mld_z_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
end subroutine mld_z_jac_smoother_clone
end interface
@ -247,4 +249,11 @@ contains
return
end function z_jac_smoother_get_nzeros
function z_jac_smoother_get_fmt() result(val)
implicit none
character(len=32) :: val
val = "Jacobi smoother"
end function z_jac_smoother_get_fmt
end module mld_z_jac_smoother

13
mlprec/mld_z_onelev_mod.f90
Unescape Escape View File

@ -385,11 +385,18 @@ contains
! Arguments
class(mld_z_onelev_type), target, intent(inout) :: lv
class(mld_z_onelev_type), intent(out) :: lvout
class(mld_z_onelev_type), intent(inout) :: lvout
integer(psb_ipk_), intent(out) :: info
if (allocated(lv%sm)) &
& call lv%sm%clone(lvout%sm,info)
info = psb_success_
if (allocated(lv%sm)) then
call lv%sm%clone(lvout%sm,info)
else
if (allocated(lvout%sm)) then
call lvout%sm%free(info)
if (info==psb_success_) deallocate(lvout%sm,stat=info)
end if
end if
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)

43
mlprec/mld_z_prec_type.f90
Unescape Escape View File

@ -728,36 +728,53 @@ contains
implicit none
class(mld_zprec_type), intent(inout) :: prec
class(mld_zprec_type), target, intent(out) :: precout
class(psb_zprec_type), intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
call mld_z_inner_clone(prec,precout,info)
end subroutine mld_z_clone
subroutine mld_z_inner_clone(prec,precout,info)
implicit none
class(mld_zprec_type), intent(inout) :: prec
class(psb_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
select type(pout => precout)
class is (mld_zprec_type)
pout%ictxt = prec%ictxt
pout%coarse_aggr_size = prec%coarse_aggr_size
pout%op_complexity = prec%op_complexity
if (allocated(prec%precv)) then
ln = size(prec%precv)
allocate(precout%precv(ln),stat=info)
allocate(pout%precv(ln),stat=info)
if (info /= psb_success_) goto 9999
if (ln > 1) then
call prec%precv(1)%clone(precout%precv(1),info)
if (ln >= 1) then
call prec%precv(1)%clone(pout%precv(1),info)
end if
do lev=2, ln
if (info /= psb_success_) exit
call prec%precv(lev)%clone(precout%precv(lev),info)
call prec%precv(lev)%clone(pout%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
pout%precv(lev)%base_a => pout%precv(lev)%ac
pout%precv(lev)%base_desc => pout%precv(lev)%desc_ac
pout%precv(lev)%map%p_desc_X => pout%precv(lev-1)%base_desc
pout%precv(lev)%map%p_desc_Y => pout%precv(lev)%base_desc
end if
end do
end if
class default
write(0,*) 'Error: wrong out type'
info = psb_err_invalid_input_
end select
9999 continue
end subroutine mld_z_clone
end subroutine mld_z_inner_clone
subroutine mld_zprec_move_alloc(a, b,info)
use psb_base_mod

Write Preview
Loading…
Cancel
Save