fdurastante/amg4psblas
1
0
Fork 0
mirror of https://github.com/sfilippone/amg4psblas.git synced 2026-10-06 22:55:12 +00:00
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)
This commit is contained in:
Salvatore Filippone
2013-04-05 14:35:50 +00:00
parent 1fbe3ddb1c
commit c6881d1926
65 changed files with 808 additions and 324 deletions
Download Patch File Download Diff File Expand all files Collapse all files
mlprec/impl/smoother/mld_c_as_smoother_clone.f90
+14 -4
View File
@@ -44,9 +44,9 @@ subroutine mld_c_as_smoother_clone(sm,smout,info)
Implicit None
! Arguments
class(mld_c_as_smoother_type), intent(inout) :: sm
class(mld_c_base_smoother_type), allocatable, intent(out) :: smout
integer(psb_ipk_), intent(out) :: info
class(mld_c_as_smoother_type), intent(inout) :: sm
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_
mlprec/impl/smoother/mld_c_base_smoother_clone.f90
+2 -2
View File
@@ -42,8 +42,8 @@ subroutine mld_c_base_smoother_clone(sm,smout,info)
use mld_c_base_smoother_mod, mld_protect_name => mld_c_base_smoother_clone
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), intent(inout) :: sm
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'
mlprec/impl/smoother/mld_c_jac_smoother_clone.f90
+15 -5
View File
@@ -44,9 +44,9 @@ subroutine mld_c_jac_smoother_clone(sm,smout,info)
Implicit None
! Arguments
class(mld_c_jac_smoother_type), intent(inout) :: sm
class(mld_c_base_smoother_type), allocatable, intent(out) :: smout
integer(psb_ipk_), intent(out) :: info
class(mld_c_jac_smoother_type), intent(inout) :: sm
class(mld_c_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@@ -54,16 +54,26 @@ 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_
end select
mlprec/impl/smoother/mld_d_as_smoother_clone.f90
+14 -4
View File
@@ -44,9 +44,9 @@ subroutine mld_d_as_smoother_clone(sm,smout,info)
Implicit None
! Arguments
class(mld_d_as_smoother_type), intent(inout) :: sm
class(mld_d_base_smoother_type), allocatable, intent(out) :: smout
integer(psb_ipk_), intent(out) :: info
class(mld_d_as_smoother_type), intent(inout) :: sm
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_
mlprec/impl/smoother/mld_d_base_smoother_clone.f90
+2 -2
View File
@@ -42,8 +42,8 @@ subroutine mld_d_base_smoother_clone(sm,smout,info)
use mld_d_base_smoother_mod, mld_protect_name => mld_d_base_smoother_clone
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), intent(inout) :: sm
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'
mlprec/impl/smoother/mld_d_jac_smoother_clone.f90
+15 -5
View File
@@ -44,9 +44,9 @@ subroutine mld_d_jac_smoother_clone(sm,smout,info)
Implicit None
! Arguments
class(mld_d_jac_smoother_type), intent(inout) :: sm
class(mld_d_base_smoother_type), allocatable, intent(out) :: smout
integer(psb_ipk_), intent(out) :: info
class(mld_d_jac_smoother_type), intent(inout) :: sm
class(mld_d_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@@ -54,16 +54,26 @@ 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_
end select
mlprec/impl/smoother/mld_s_as_smoother_clone.f90
+14 -4
View File
@@ -44,9 +44,9 @@ subroutine mld_s_as_smoother_clone(sm,smout,info)
Implicit None
! Arguments
class(mld_s_as_smoother_type), intent(inout) :: sm
class(mld_s_base_smoother_type), allocatable, intent(out) :: smout
integer(psb_ipk_), intent(out) :: info
class(mld_s_as_smoother_type), intent(inout) :: sm
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_
mlprec/impl/smoother/mld_s_base_smoother_clone.f90
+2 -2
View File
@@ -42,8 +42,8 @@ subroutine mld_s_base_smoother_clone(sm,smout,info)
use mld_s_base_smoother_mod, mld_protect_name => mld_s_base_smoother_clone
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), intent(inout) :: sm
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'
mlprec/impl/smoother/mld_s_jac_smoother_clone.f90
+15 -5
View File
@@ -44,9 +44,9 @@ subroutine mld_s_jac_smoother_clone(sm,smout,info)
Implicit None
! Arguments
class(mld_s_jac_smoother_type), intent(inout) :: sm
class(mld_s_base_smoother_type), allocatable, intent(out) :: smout
integer(psb_ipk_), intent(out) :: info
class(mld_s_jac_smoother_type), intent(inout) :: sm
class(mld_s_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@@ -54,16 +54,26 @@ 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_
end select
mlprec/impl/smoother/mld_z_as_smoother_clone.f90
+14 -4
View File
@@ -44,9 +44,9 @@ subroutine mld_z_as_smoother_clone(sm,smout,info)
Implicit None
! Arguments
class(mld_z_as_smoother_type), intent(inout) :: sm
class(mld_z_base_smoother_type), allocatable, intent(out) :: smout
integer(psb_ipk_), intent(out) :: info
class(mld_z_as_smoother_type), intent(inout) :: sm
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_
mlprec/impl/smoother/mld_z_base_smoother_clone.f90
+2 -2
View File
@@ -42,8 +42,8 @@ subroutine mld_z_base_smoother_clone(sm,smout,info)
use mld_z_base_smoother_mod, mld_protect_name => mld_z_base_smoother_clone
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), intent(inout) :: sm
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'
mlprec/impl/smoother/mld_z_jac_smoother_clone.f90
+15 -5
View File
@@ -44,9 +44,9 @@ subroutine mld_z_jac_smoother_clone(sm,smout,info)
Implicit None
! Arguments
class(mld_z_jac_smoother_type), intent(inout) :: sm
class(mld_z_base_smoother_type), allocatable, intent(out) :: smout
integer(psb_ipk_), intent(out) :: info
class(mld_z_jac_smoother_type), intent(inout) :: sm
class(mld_z_base_smoother_type), allocatable, intent(inout) :: smout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
@@ -54,16 +54,26 @@ 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_
end select
mlprec/impl/solver/mld_c_base_solver_clone.f90
+3 -3
View File
@@ -42,9 +42,9 @@ subroutine mld_c_base_solver_clone(sv,svout,info)
use mld_c_base_solver_mod, mld_protect_name => mld_c_base_solver_clone
Implicit None
! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv
class(mld_c_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_c_base_solver_type), intent(inout) :: sv
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'
mlprec/impl/solver/mld_c_diag_solver_clone.f90
+10 -5
View File
@@ -44,21 +44,26 @@ subroutine mld_c_diag_solver_clone(sv,svout,info)
Implicit None
! Arguments
class(mld_c_diag_solver_type), intent(inout) :: sv
class(mld_c_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_c_diag_solver_type), intent(inout) :: sv
class(mld_c_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
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
end if
select type(svo => svout)
type is (mld_c_diag_solver_type)
call psb_safe_ab_cpy(sv%d,svo%d,info)
mlprec/impl/solver/mld_c_id_solver_clone.f90
+10 -5
View File
@@ -44,21 +44,26 @@ subroutine mld_c_id_solver_clone(sv,svout,info)
Implicit None
! Arguments
class(mld_c_id_solver_type), intent(inout) :: sv
class(mld_c_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_c_id_solver_type), intent(inout) :: sv
class(mld_c_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
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
end if
select type(svo => svout)
type is (mld_c_id_solver_type)
! Nothing to be done.
mlprec/impl/solver/mld_c_ilu_solver_clone.f90
+10 -5
View File
@@ -44,21 +44,26 @@ subroutine mld_c_ilu_solver_clone(sv,svout,info)
Implicit None
! Arguments
class(mld_c_ilu_solver_type), intent(inout) :: sv
class(mld_c_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_c_ilu_solver_type), intent(inout) :: sv
class(mld_c_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
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
mlprec/impl/solver/mld_d_base_solver_clone.f90
+3 -3
View File
@@ -42,9 +42,9 @@ subroutine mld_d_base_solver_clone(sv,svout,info)
use mld_d_base_solver_mod, mld_protect_name => mld_d_base_solver_clone
Implicit None
! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv
class(mld_d_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_d_base_solver_type), intent(inout) :: sv
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'
mlprec/impl/solver/mld_d_diag_solver_clone.f90
+10 -5
View File
@@ -44,21 +44,26 @@ subroutine mld_d_diag_solver_clone(sv,svout,info)
Implicit None
! Arguments
class(mld_d_diag_solver_type), intent(inout) :: sv
class(mld_d_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_d_diag_solver_type), intent(inout) :: sv
class(mld_d_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
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
end if
select type(svo => svout)
type is (mld_d_diag_solver_type)
call psb_safe_ab_cpy(sv%d,svo%d,info)
mlprec/impl/solver/mld_d_id_solver_clone.f90
+10 -5
View File
@@ -44,21 +44,26 @@ subroutine mld_d_id_solver_clone(sv,svout,info)
Implicit None
! Arguments
class(mld_d_id_solver_type), intent(inout) :: sv
class(mld_d_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_d_id_solver_type), intent(inout) :: sv
class(mld_d_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
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
end if
select type(svo => svout)
type is (mld_d_id_solver_type)
! Nothing to be done.
mlprec/impl/solver/mld_d_ilu_solver_clone.f90
+10 -5
View File
@@ -44,21 +44,26 @@ subroutine mld_d_ilu_solver_clone(sv,svout,info)
Implicit None
! Arguments
class(mld_d_ilu_solver_type), intent(inout) :: sv
class(mld_d_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_d_ilu_solver_type), intent(inout) :: sv
class(mld_d_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
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
mlprec/impl/solver/mld_s_base_solver_clone.f90
+3 -3
View File
@@ -42,9 +42,9 @@ subroutine mld_s_base_solver_clone(sv,svout,info)
use mld_s_base_solver_mod, mld_protect_name => mld_s_base_solver_clone
Implicit None
! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv
class(mld_s_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_s_base_solver_type), intent(inout) :: sv
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'
mlprec/impl/solver/mld_s_diag_solver_clone.f90
+10 -5
View File
@@ -44,21 +44,26 @@ subroutine mld_s_diag_solver_clone(sv,svout,info)
Implicit None
! Arguments
class(mld_s_diag_solver_type), intent(inout) :: sv
class(mld_s_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_s_diag_solver_type), intent(inout) :: sv
class(mld_s_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
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
end if
select type(svo => svout)
type is (mld_s_diag_solver_type)
call psb_safe_ab_cpy(sv%d,svo%d,info)
mlprec/impl/solver/mld_s_id_solver_clone.f90
+10 -5
View File
@@ -44,21 +44,26 @@ subroutine mld_s_id_solver_clone(sv,svout,info)
Implicit None
! Arguments
class(mld_s_id_solver_type), intent(inout) :: sv
class(mld_s_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_s_id_solver_type), intent(inout) :: sv
class(mld_s_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
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
end if
select type(svo => svout)
type is (mld_s_id_solver_type)
! Nothing to be done.
mlprec/impl/solver/mld_s_ilu_solver_clone.f90
+10 -5
View File
@@ -44,21 +44,26 @@ subroutine mld_s_ilu_solver_clone(sv,svout,info)
Implicit None
! Arguments
class(mld_s_ilu_solver_type), intent(inout) :: sv
class(mld_s_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_s_ilu_solver_type), intent(inout) :: sv
class(mld_s_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
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
mlprec/impl/solver/mld_z_base_solver_clone.f90
+3 -3
View File
@@ -42,9 +42,9 @@ subroutine mld_z_base_solver_clone(sv,svout,info)
use mld_z_base_solver_mod, mld_protect_name => mld_z_base_solver_clone
Implicit None
! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv
class(mld_z_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_z_base_solver_type), intent(inout) :: sv
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'
mlprec/impl/solver/mld_z_diag_solver_clone.f90
+10 -5
View File
@@ -44,21 +44,26 @@ subroutine mld_z_diag_solver_clone(sv,svout,info)
Implicit None
! Arguments
class(mld_z_diag_solver_type), intent(inout) :: sv
class(mld_z_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_z_diag_solver_type), intent(inout) :: sv
class(mld_z_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
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
end if
select type(svo => svout)
type is (mld_z_diag_solver_type)
call psb_safe_ab_cpy(sv%d,svo%d,info)
mlprec/impl/solver/mld_z_id_solver_clone.f90
+10 -5
View File
@@ -44,21 +44,26 @@ subroutine mld_z_id_solver_clone(sv,svout,info)
Implicit None
! Arguments
class(mld_z_id_solver_type), intent(inout) :: sv
class(mld_z_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_z_id_solver_type), intent(inout) :: sv
class(mld_z_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
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
end if
select type(svo => svout)
type is (mld_z_id_solver_type)
! Nothing to be done.
mlprec/impl/solver/mld_z_ilu_solver_clone.f90
+10 -5
View File
@@ -44,21 +44,26 @@ subroutine mld_z_ilu_solver_clone(sv,svout,info)
Implicit None
! Arguments
class(mld_z_ilu_solver_type), intent(inout) :: sv
class(mld_z_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_z_ilu_solver_type), intent(inout) :: sv
class(mld_z_base_solver_type), allocatable, intent(inout) :: svout
integer(psb_ipk_), intent(out) :: info
! Local variables
integer(psb_ipk_) :: err_act
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
mlprec/mld_base_prec_type.F90
+4 -4
View File
@@ -79,10 +79,10 @@ module mld_base_prec_type
!
! Version numbers
!
character(len=*), parameter :: mld_version_string_ = "2.0.0"
integer(psb_ipk_), parameter :: mld_version_major_ = 2
integer(psb_ipk_), parameter :: mld_version_minor_ = 0
integer(psb_ipk_), parameter :: mld_patchlevel_ = 0
character(len=*), parameter :: mld_version_string_ = "2.0.0"
integer(psb_ipk_), parameter :: mld_version_major_ = 2
integer(psb_ipk_), parameter :: mld_version_minor_ = 0
integer(psb_ipk_), parameter :: mld_patchlevel_ = 0
type mld_aux_onelev_map_type
mlprec/mld_c_as_smoother.f90
+12 -3
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 ',' ',' ',' '/)
@@ -243,8 +245,8 @@ module mld_c_as_smoother
subroutine mld_c_as_smoother_clone(sm,smout,info)
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_as_smoother_type), intent(inout) :: sm
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
mlprec/mld_c_base_smoother_mod.f90
+10 -3
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
@@ -304,8 +305,8 @@ module mld_c_base_smoother_mod
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), intent(inout) :: sm
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
mlprec/mld_c_base_solver_mod.f90
+13 -4
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
@@ -318,9 +319,9 @@ module mld_c_base_solver_mod
Implicit None
! Arguments
class(mld_c_base_solver_type), intent(inout) :: sv
class(mld_c_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_c_base_solver_type), intent(inout) :: sv
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
mlprec/mld_c_diag_solver.f90
+14 -4
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
@@ -122,9 +124,9 @@ module mld_c_diag_solver
Implicit None
! Arguments
class(mld_c_diag_solver_type), intent(inout) :: sv
class(mld_c_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_c_diag_solver_type), intent(inout) :: sv
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
mlprec/mld_c_id_solver.f90
+13 -4
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
@@ -102,9 +103,9 @@ module mld_c_id_solver
Implicit None
! Arguments
class(mld_c_id_solver_type), intent(inout) :: sv
class(mld_c_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_c_id_solver_type), intent(inout) :: sv
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
mlprec/mld_c_ilu_solver.f90
+13 -4
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 :: &
@@ -162,9 +164,9 @@ module mld_c_ilu_solver
Implicit None
! Arguments
class(mld_c_ilu_solver_type), intent(inout) :: sv
class(mld_c_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_c_ilu_solver_type), intent(inout) :: sv
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
mlprec/mld_c_jac_smoother.f90
+12 -3
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
@@ -120,8 +122,8 @@ module mld_c_jac_smoother
subroutine mld_c_jac_smoother_clone(sm,smout,info)
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_jac_smoother_type), intent(inout) :: sm
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
mlprec/mld_c_onelev_mod.f90
+10 -3
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)
mlprec/mld_c_prec_type.f90
+40 -23
View File
@@ -728,36 +728,53 @@ contains
implicit none
class(mld_cprec_type), intent(inout) :: prec
class(mld_cprec_type), target, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
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
if (allocated(prec%precv)) then
ln = size(prec%precv)
allocate(precout%precv(ln),stat=info)
if (info /= psb_success_) goto 9999
if (ln > 1) then
call prec%precv(1)%clone(precout%precv(1),info)
end if
do lev=2, ln
if (info /= psb_success_) exit
call prec%precv(lev)%clone(precout%precv(lev),info)
if (info == psb_success_) then
precout%precv(lev)%base_a => precout%precv(lev)%ac
precout%precv(lev)%base_desc => precout%precv(lev)%desc_ac
precout%precv(lev)%map%p_desc_X => precout%precv(lev-1)%base_desc
precout%precv(lev)%map%p_desc_Y => precout%precv(lev)%base_desc
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(pout%precv(ln),stat=info)
if (info /= psb_success_) goto 9999
if (ln >= 1) then
call prec%precv(1)%clone(pout%precv(1),info)
end if
end do
end if
do lev=2, ln
if (info /= psb_success_) exit
call prec%precv(lev)%clone(pout%precv(lev),info)
if (info == psb_success_) then
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
mlprec/mld_d_as_smoother.f90
+12 -3
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 ',' ',' ',' '/)
@@ -243,8 +245,8 @@ module mld_d_as_smoother
subroutine mld_d_as_smoother_clone(sm,smout,info)
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_as_smoother_type), intent(inout) :: sm
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
mlprec/mld_d_base_smoother_mod.f90
+10 -3
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
@@ -304,8 +305,8 @@ module mld_d_base_smoother_mod
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), intent(inout) :: sm
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
mlprec/mld_d_base_solver_mod.f90
+13 -4
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
@@ -318,9 +319,9 @@ module mld_d_base_solver_mod
Implicit None
! Arguments
class(mld_d_base_solver_type), intent(inout) :: sv
class(mld_d_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_d_base_solver_type), intent(inout) :: sv
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
mlprec/mld_d_diag_solver.f90
+14 -4
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
@@ -122,9 +124,9 @@ module mld_d_diag_solver
Implicit None
! Arguments
class(mld_d_diag_solver_type), intent(inout) :: sv
class(mld_d_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_d_diag_solver_type), intent(inout) :: sv
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
mlprec/mld_d_id_solver.f90
+13 -4
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
@@ -102,9 +103,9 @@ module mld_d_id_solver
Implicit None
! Arguments
class(mld_d_id_solver_type), intent(inout) :: sv
class(mld_d_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_d_id_solver_type), intent(inout) :: sv
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
mlprec/mld_d_ilu_solver.f90
+13 -4
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 :: &
@@ -162,9 +164,9 @@ module mld_d_ilu_solver
Implicit None
! Arguments
class(mld_d_ilu_solver_type), intent(inout) :: sv
class(mld_d_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_d_ilu_solver_type), intent(inout) :: sv
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
mlprec/mld_d_jac_smoother.f90
+12 -3
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
@@ -120,8 +122,8 @@ module mld_d_jac_smoother
subroutine mld_d_jac_smoother_clone(sm,smout,info)
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_jac_smoother_type), intent(inout) :: sm
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
mlprec/mld_d_onelev_mod.f90
+10 -3
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)
mlprec/mld_d_prec_type.f90
+40 -23
View File
@@ -728,36 +728,53 @@ contains
implicit none
class(mld_dprec_type), intent(inout) :: prec
class(mld_dprec_type), target, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
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
if (allocated(prec%precv)) then
ln = size(prec%precv)
allocate(precout%precv(ln),stat=info)
if (info /= psb_success_) goto 9999
if (ln > 1) then
call prec%precv(1)%clone(precout%precv(1),info)
end if
do lev=2, ln
if (info /= psb_success_) exit
call prec%precv(lev)%clone(precout%precv(lev),info)
if (info == psb_success_) then
precout%precv(lev)%base_a => precout%precv(lev)%ac
precout%precv(lev)%base_desc => precout%precv(lev)%desc_ac
precout%precv(lev)%map%p_desc_X => precout%precv(lev-1)%base_desc
precout%precv(lev)%map%p_desc_Y => precout%precv(lev)%base_desc
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(pout%precv(ln),stat=info)
if (info /= psb_success_) goto 9999
if (ln >= 1) then
call prec%precv(1)%clone(pout%precv(1),info)
end if
end do
end if
do lev=2, ln
if (info /= psb_success_) exit
call prec%precv(lev)%clone(pout%precv(lev),info)
if (info == psb_success_) then
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
mlprec/mld_s_as_smoother.f90
+12 -3
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 ',' ',' ',' '/)
@@ -243,8 +245,8 @@ module mld_s_as_smoother
subroutine mld_s_as_smoother_clone(sm,smout,info)
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_as_smoother_type), intent(inout) :: sm
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
mlprec/mld_s_base_smoother_mod.f90
+10 -3
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
@@ -304,8 +305,8 @@ module mld_s_base_smoother_mod
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), intent(inout) :: sm
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
mlprec/mld_s_base_solver_mod.f90
+13 -4
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
@@ -318,9 +319,9 @@ module mld_s_base_solver_mod
Implicit None
! Arguments
class(mld_s_base_solver_type), intent(inout) :: sv
class(mld_s_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_s_base_solver_type), intent(inout) :: sv
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
mlprec/mld_s_diag_solver.f90
+14 -4
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
@@ -122,9 +124,9 @@ module mld_s_diag_solver
Implicit None
! Arguments
class(mld_s_diag_solver_type), intent(inout) :: sv
class(mld_s_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_s_diag_solver_type), intent(inout) :: sv
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
mlprec/mld_s_id_solver.f90
+13 -4
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
@@ -102,9 +103,9 @@ module mld_s_id_solver
Implicit None
! Arguments
class(mld_s_id_solver_type), intent(inout) :: sv
class(mld_s_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_s_id_solver_type), intent(inout) :: sv
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
mlprec/mld_s_ilu_solver.f90
+13 -4
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 :: &
@@ -162,9 +164,9 @@ module mld_s_ilu_solver
Implicit None
! Arguments
class(mld_s_ilu_solver_type), intent(inout) :: sv
class(mld_s_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_s_ilu_solver_type), intent(inout) :: sv
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
mlprec/mld_s_jac_smoother.f90
+12 -3
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
@@ -120,8 +122,8 @@ module mld_s_jac_smoother
subroutine mld_s_jac_smoother_clone(sm,smout,info)
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_jac_smoother_type), intent(inout) :: sm
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
mlprec/mld_s_onelev_mod.f90
+10 -3
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)
mlprec/mld_s_prec_type.f90
+40 -23
View File
@@ -728,36 +728,53 @@ contains
implicit none
class(mld_sprec_type), intent(inout) :: prec
class(mld_sprec_type), target, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
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
if (allocated(prec%precv)) then
ln = size(prec%precv)
allocate(precout%precv(ln),stat=info)
if (info /= psb_success_) goto 9999
if (ln > 1) then
call prec%precv(1)%clone(precout%precv(1),info)
end if
do lev=2, ln
if (info /= psb_success_) exit
call prec%precv(lev)%clone(precout%precv(lev),info)
if (info == psb_success_) then
precout%precv(lev)%base_a => precout%precv(lev)%ac
precout%precv(lev)%base_desc => precout%precv(lev)%desc_ac
precout%precv(lev)%map%p_desc_X => precout%precv(lev-1)%base_desc
precout%precv(lev)%map%p_desc_Y => precout%precv(lev)%base_desc
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(pout%precv(ln),stat=info)
if (info /= psb_success_) goto 9999
if (ln >= 1) then
call prec%precv(1)%clone(pout%precv(1),info)
end if
end do
end if
do lev=2, ln
if (info /= psb_success_) exit
call prec%precv(lev)%clone(pout%precv(lev),info)
if (info == psb_success_) then
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
mlprec/mld_z_as_smoother.f90
+12 -3
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 ',' ',' ',' '/)
@@ -243,8 +245,8 @@ module mld_z_as_smoother
subroutine mld_z_as_smoother_clone(sm,smout,info)
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_as_smoother_type), intent(inout) :: sm
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
mlprec/mld_z_base_smoother_mod.f90
+10 -3
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
@@ -304,8 +305,8 @@ module mld_z_base_smoother_mod
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), intent(inout) :: sm
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
mlprec/mld_z_base_solver_mod.f90
+13 -4
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
@@ -318,9 +319,9 @@ module mld_z_base_solver_mod
Implicit None
! Arguments
class(mld_z_base_solver_type), intent(inout) :: sv
class(mld_z_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_z_base_solver_type), intent(inout) :: sv
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
mlprec/mld_z_diag_solver.f90
+14 -4
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
@@ -122,9 +124,9 @@ module mld_z_diag_solver
Implicit None
! Arguments
class(mld_z_diag_solver_type), intent(inout) :: sv
class(mld_z_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_z_diag_solver_type), intent(inout) :: sv
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
mlprec/mld_z_id_solver.f90
+13 -4
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
@@ -102,9 +103,9 @@ module mld_z_id_solver
Implicit None
! Arguments
class(mld_z_id_solver_type), intent(inout) :: sv
class(mld_z_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_z_id_solver_type), intent(inout) :: sv
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
mlprec/mld_z_ilu_solver.f90
+13 -4
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 :: &
@@ -162,9 +164,9 @@ module mld_z_ilu_solver
Implicit None
! Arguments
class(mld_z_ilu_solver_type), intent(inout) :: sv
class(mld_z_base_solver_type), allocatable, intent(out) :: svout
integer(psb_ipk_), intent(out) :: info
class(mld_z_ilu_solver_type), intent(inout) :: sv
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
mlprec/mld_z_jac_smoother.f90
+12 -3
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
@@ -120,8 +122,8 @@ module mld_z_jac_smoother
subroutine mld_z_jac_smoother_clone(sm,smout,info)
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_jac_smoother_type), intent(inout) :: sm
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
mlprec/mld_z_onelev_mod.f90
+10 -3
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)
mlprec/mld_z_prec_type.f90
+40 -23
View File
@@ -728,36 +728,53 @@ contains
implicit none
class(mld_zprec_type), intent(inout) :: prec
class(mld_zprec_type), target, intent(out) :: precout
integer(psb_ipk_), intent(out) :: info
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
if (allocated(prec%precv)) then
ln = size(prec%precv)
allocate(precout%precv(ln),stat=info)
if (info /= psb_success_) goto 9999
if (ln > 1) then
call prec%precv(1)%clone(precout%precv(1),info)
end if
do lev=2, ln
if (info /= psb_success_) exit
call prec%precv(lev)%clone(precout%precv(lev),info)
if (info == psb_success_) then
precout%precv(lev)%base_a => precout%precv(lev)%ac
precout%precv(lev)%base_desc => precout%precv(lev)%desc_ac
precout%precv(lev)%map%p_desc_X => precout%precv(lev-1)%base_desc
precout%precv(lev)%map%p_desc_Y => precout%precv(lev)%base_desc
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(pout%precv(ln),stat=info)
if (info /= psb_success_) goto 9999
if (ln >= 1) then
call prec%precv(1)%clone(pout%precv(1),info)
end if
end do
end if
do lev=2, ln
if (info /= psb_success_) exit
call prec%precv(lev)%clone(pout%precv(lev),info)
if (info == psb_success_) then
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