mirror of
https://github.com/sfilippone/amg4psblas.git
synced 2026-10-06 22:55:12 +00:00
mld2p4:
mlprec/mld_caggrmat_smth_asb.F90 mlprec/mld_cmlprec_aply.f90 mlprec/mld_daggrmat_smth_asb.F90 mlprec/mld_dmlprec_aply.f90 mlprec/mld_prec_type.f90 mlprec/mld_saggrmat_smth_asb.F90 mlprec/mld_smlprec_aply.f90 mlprec/mld_zaggrmat_smth_asb.F90 mlprec/mld_zmlprec_aply.f90 Take out component dorig(:) from baseprec data structure, it serves no useful purpose outside of aggrmat_smth_asb, where it is replaced by a local allocatable.
This commit is contained in:
Salvatore Filippone
@@ -123,6 +123,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
character(len=20) :: name
|
||||
type(psb_cspmat_type), pointer :: am1,am2
|
||||
type(psb_cspmat_type) :: am3,am4
|
||||
complex(psb_spk_), allocatable :: adiag(:)
|
||||
logical :: ml_global_nmb
|
||||
integer :: debug_level, debug_unit
|
||||
integer, parameter :: ncmax=16
|
||||
@@ -185,7 +186,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
! naggr: number of local aggregates
|
||||
! nrow: local rows.
|
||||
!
|
||||
allocate(p%dorig(nrow),stat=info)
|
||||
allocate(adiag(nrow),stat=info)
|
||||
|
||||
if (info /= 0) then
|
||||
info=4025
|
||||
@@ -195,17 +196,17 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
end if
|
||||
|
||||
! Get diagonal D
|
||||
call psb_sp_getdiag(a,p%dorig,info)
|
||||
call psb_sp_getdiag(a,adiag,info)
|
||||
if(info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='sp_getdiag')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1,size(p%dorig)
|
||||
if (p%dorig(i) /= czero) then
|
||||
p%dorig(i) = cone / p%dorig(i)
|
||||
do i=1,size(adiag)
|
||||
if (adiag(i) /= czero) then
|
||||
adiag(i) = cone / adiag(i)
|
||||
else
|
||||
p%dorig(i) = cone
|
||||
adiag(i) = cone
|
||||
end if
|
||||
end do
|
||||
|
||||
@@ -257,7 +258,7 @@ subroutine mld_caggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
! its diagonal elements stored explicitly!!!
|
||||
! Should we switch to something safer?
|
||||
!
|
||||
call psb_sp_scal(am3,p%dorig,info)
|
||||
call psb_sp_scal(am3,adiag,info)
|
||||
if (info /= 0) goto 9999
|
||||
|
||||
if (p%iprcparm(mld_aggr_eig_) == mld_max_norm_) then
|
||||
|
||||
@@ -138,8 +138,6 @@
|
||||
! baseprecv(ilev)%base_desc - type(psb_desc_type), pointer.
|
||||
! Pointer to the communication descriptor associated
|
||||
! to the sparse matrix pointed by base_a.
|
||||
! baseprecv(ilev)%dorig - complex(psb_spk_), dimension(:), allocatable.
|
||||
! Diagonal entries of the matrix pointed by base_a.
|
||||
!
|
||||
! x - complex(psb_spk_), dimension(:), input.
|
||||
! The local part of the vector X.
|
||||
|
||||
@@ -123,6 +123,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
character(len=20) :: name
|
||||
type(psb_dspmat_type), pointer :: am1,am2
|
||||
type(psb_dspmat_type) :: am3,am4
|
||||
real(psb_dpk_), allocatable :: adiag(:)
|
||||
logical :: ml_global_nmb
|
||||
integer :: debug_level, debug_unit
|
||||
integer, parameter :: ncmax=16
|
||||
@@ -185,7 +186,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
! naggr: number of local aggregates
|
||||
! nrow: local rows.
|
||||
!
|
||||
allocate(p%dorig(nrow),stat=info)
|
||||
allocate(adiag(nrow),stat=info)
|
||||
|
||||
if (info /= 0) then
|
||||
info=4025
|
||||
@@ -195,17 +196,17 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
end if
|
||||
|
||||
! Get diagonal D
|
||||
call psb_sp_getdiag(a,p%dorig,info)
|
||||
call psb_sp_getdiag(a,adiag,info)
|
||||
if(info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='sp_getdiag')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1,size(p%dorig)
|
||||
if (p%dorig(i) /= dzero) then
|
||||
p%dorig(i) = done / p%dorig(i)
|
||||
do i=1,size(adiag)
|
||||
if (adiag(i) /= dzero) then
|
||||
adiag(i) = done / adiag(i)
|
||||
else
|
||||
p%dorig(i) = done
|
||||
adiag(i) = done
|
||||
end if
|
||||
end do
|
||||
|
||||
@@ -257,7 +258,7 @@ subroutine mld_daggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
! its diagonal elements stored explicitly!!!
|
||||
! Should we switch to something safer?
|
||||
!
|
||||
call psb_sp_scal(am3,p%dorig,info)
|
||||
call psb_sp_scal(am3,adiag,info)
|
||||
if (info /= 0) goto 9999
|
||||
|
||||
if (p%iprcparm(mld_aggr_eig_) == mld_max_norm_) then
|
||||
|
||||
@@ -138,8 +138,6 @@
|
||||
! baseprecv(ilev)%base_desc - type(psb_desc_type), pointer.
|
||||
! Pointer to the communication descriptor associated
|
||||
! to the sparse matrix pointed by base_a.
|
||||
! baseprecv(ilev)%dorig - real(psb_dpk_), dimension(:), allocatable.
|
||||
! Diagonal entries of the matrix pointed by base_a.
|
||||
!
|
||||
! x - real(psb_dpk_), dimension(:), input.
|
||||
! The local part of the vector X.
|
||||
|
||||
@@ -154,8 +154,6 @@ module mld_prec_type
|
||||
! base_desc - type(psb_desc_type), pointer.
|
||||
! Pointer to the communication descriptor associated to the sparse
|
||||
! matrix pointed by base_a.
|
||||
! dorig - real(psb_dpk_), dimension(:), allocatable.
|
||||
! Diagonal entries of the matrix pointed by base_a.
|
||||
!
|
||||
! Note that when the LU factorization of the matrix A(ilev) is computed instead of
|
||||
! the ILU one, by using UMFPACK or SuperLU_dist, the corresponding L and U factors
|
||||
@@ -174,7 +172,6 @@ module mld_prec_type
|
||||
integer, allocatable :: mlia(:), nlaggr(:)
|
||||
type(psb_sspmat_type), pointer :: base_a => null()
|
||||
type(psb_desc_type), pointer :: base_desc => null()
|
||||
real(psb_spk_), allocatable :: dorig(:)
|
||||
type(psb_inter_desc_type) :: map_desc
|
||||
end type mld_sbaseprc_type
|
||||
|
||||
@@ -193,7 +190,6 @@ module mld_prec_type
|
||||
integer, allocatable :: mlia(:), nlaggr(:)
|
||||
type(psb_dspmat_type), pointer :: base_a => null()
|
||||
type(psb_desc_type), pointer :: base_desc => null()
|
||||
real(psb_dpk_), allocatable :: dorig(:)
|
||||
type(psb_inter_desc_type) :: map_desc
|
||||
end type mld_dbaseprc_type
|
||||
|
||||
@@ -212,7 +208,6 @@ module mld_prec_type
|
||||
integer, allocatable :: mlia(:), nlaggr(:)
|
||||
type(psb_cspmat_type), pointer :: base_a => null()
|
||||
type(psb_desc_type), pointer :: base_desc => null()
|
||||
complex(psb_spk_), allocatable :: dorig(:)
|
||||
type(psb_inter_desc_type) :: map_desc
|
||||
end type mld_cbaseprc_type
|
||||
|
||||
@@ -231,7 +226,6 @@ module mld_prec_type
|
||||
integer, allocatable :: mlia(:), nlaggr(:)
|
||||
type(psb_zspmat_type), pointer :: base_a => null()
|
||||
type(psb_desc_type), pointer :: base_desc => null()
|
||||
complex(psb_dpk_), allocatable :: dorig(:)
|
||||
type(psb_inter_desc_type) :: map_desc
|
||||
end type mld_zbaseprc_type
|
||||
|
||||
@@ -1344,9 +1338,6 @@ contains
|
||||
! This is a pointer to something else, must not free it here.
|
||||
nullify(p%base_desc)
|
||||
|
||||
if (allocated(p%dorig)) then
|
||||
deallocate(p%dorig,stat=info)
|
||||
endif
|
||||
|
||||
if (allocated(p%mlia)) then
|
||||
deallocate(p%mlia,stat=info)
|
||||
@@ -1430,10 +1421,6 @@ contains
|
||||
! This is a pointer to something else, must not free it here.
|
||||
nullify(p%base_desc)
|
||||
|
||||
if (allocated(p%dorig)) then
|
||||
deallocate(p%dorig,stat=info)
|
||||
endif
|
||||
|
||||
if (allocated(p%mlia)) then
|
||||
deallocate(p%mlia,stat=info)
|
||||
endif
|
||||
@@ -1511,10 +1498,6 @@ contains
|
||||
! This is a pointer to something else, must not free it here.
|
||||
nullify(p%base_desc)
|
||||
|
||||
if (allocated(p%dorig)) then
|
||||
deallocate(p%dorig,stat=info)
|
||||
endif
|
||||
|
||||
if (allocated(p%mlia)) then
|
||||
deallocate(p%mlia,stat=info)
|
||||
endif
|
||||
@@ -1589,10 +1572,6 @@ contains
|
||||
! This is a pointer to something else, must not free it here.
|
||||
nullify(p%base_desc)
|
||||
|
||||
if (allocated(p%dorig)) then
|
||||
deallocate(p%dorig,stat=info)
|
||||
endif
|
||||
|
||||
if (allocated(p%mlia)) then
|
||||
deallocate(p%mlia,stat=info)
|
||||
endif
|
||||
|
||||
@@ -123,6 +123,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
character(len=20) :: name
|
||||
type(psb_sspmat_type), pointer :: am1,am2
|
||||
type(psb_sspmat_type) :: am3,am4
|
||||
real(psb_spk_), allocatable :: adiag(:)
|
||||
logical :: ml_global_nmb
|
||||
integer :: debug_level, debug_unit
|
||||
integer, parameter :: ncmax=16
|
||||
@@ -185,7 +186,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
! naggr: number of local aggregates
|
||||
! nrow: local rows.
|
||||
!
|
||||
allocate(p%dorig(nrow),stat=info)
|
||||
allocate(adiag(nrow),stat=info)
|
||||
|
||||
if (info /= 0) then
|
||||
info=4025
|
||||
@@ -195,17 +196,17 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
end if
|
||||
|
||||
! Get diagonal D
|
||||
call psb_sp_getdiag(a,p%dorig,info)
|
||||
call psb_sp_getdiag(a,adiag,info)
|
||||
if(info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='sp_getdiag')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1,size(p%dorig)
|
||||
if (p%dorig(i) /= szero) then
|
||||
p%dorig(i) = sone / p%dorig(i)
|
||||
do i=1,size(adiag)
|
||||
if (adiag(i) /= szero) then
|
||||
adiag(i) = sone / adiag(i)
|
||||
else
|
||||
p%dorig(i) = sone
|
||||
adiag(i) = sone
|
||||
end if
|
||||
end do
|
||||
|
||||
@@ -257,7 +258,7 @@ subroutine mld_saggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
! its diagonal elements stored explicitly!!!
|
||||
! Should we switch to something safer?
|
||||
!
|
||||
call psb_sp_scal(am3,p%dorig,info)
|
||||
call psb_sp_scal(am3,adiag,info)
|
||||
if (info /= 0) goto 9999
|
||||
|
||||
if (p%iprcparm(mld_aggr_eig_) == mld_max_norm_) then
|
||||
|
||||
@@ -138,8 +138,6 @@
|
||||
! baseprecv(ilev)%base_desc - type(psb_desc_type), pointer.
|
||||
! Pointer to the communication descriptor associated
|
||||
! to the sparse matrix pointed by base_a.
|
||||
! baseprecv(ilev)%dorig - real(psb_spk_), dimension(:), allocatable.
|
||||
! Diagonal entries of the matrix pointed by base_a.
|
||||
!
|
||||
! x - real(psb_spk_), dimension(:), input.
|
||||
! The local part of the vector X.
|
||||
|
||||
@@ -123,6 +123,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
character(len=20) :: name
|
||||
type(psb_zspmat_type), pointer :: am1,am2
|
||||
type(psb_zspmat_type) :: am3,am4
|
||||
complex(psb_dpk_), allocatable :: adiag(:)
|
||||
logical :: ml_global_nmb
|
||||
integer :: debug_level, debug_unit
|
||||
integer, parameter :: ncmax=16
|
||||
@@ -185,7 +186,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
! naggr: number of local aggregates
|
||||
! nrow: local rows.
|
||||
!
|
||||
allocate(p%dorig(nrow),stat=info)
|
||||
allocate(adiag(nrow),stat=info)
|
||||
|
||||
if (info /= 0) then
|
||||
info=4025
|
||||
@@ -195,17 +196,17 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
end if
|
||||
|
||||
! Get diagonal D
|
||||
call psb_sp_getdiag(a,p%dorig,info)
|
||||
call psb_sp_getdiag(a,adiag,info)
|
||||
if(info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='sp_getdiag')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1,size(p%dorig)
|
||||
if (p%dorig(i) /= zzero) then
|
||||
p%dorig(i) = zone / p%dorig(i)
|
||||
do i=1,size(adiag)
|
||||
if (adiag(i) /= zzero) then
|
||||
adiag(i) = zone / adiag(i)
|
||||
else
|
||||
p%dorig(i) = zone
|
||||
adiag(i) = zone
|
||||
end if
|
||||
end do
|
||||
|
||||
@@ -257,7 +258,7 @@ subroutine mld_zaggrmat_smth_asb(a,desc_a,ac,desc_ac,p,info)
|
||||
! its diagonal elements stored explicitly!!!
|
||||
! Should we switch to something safer?
|
||||
!
|
||||
call psb_sp_scal(am3,p%dorig,info)
|
||||
call psb_sp_scal(am3,adiag,info)
|
||||
if (info /= 0) goto 9999
|
||||
|
||||
if (p%iprcparm(mld_aggr_eig_) == mld_max_norm_) then
|
||||
|
||||
@@ -138,8 +138,6 @@
|
||||
! baseprecv(ilev)%base_desc - type(psb_desc_type), pointer.
|
||||
! Pointer to the communication descriptor associated
|
||||
! to the sparse matrix pointed by base_a.
|
||||
! baseprecv(ilev)%dorig - complex(psb_dpk_), dimension(:), allocatable.
|
||||
! Diagonal entries of the matrix pointed by base_a.
|
||||
!
|
||||
! x - complex(psb_dpk_), dimension(:), input.
|
||||
! The local part of the vector X.
|
||||
|
||||
Reference in New Issue
Block a user