diff --git a/base/modules/psb_base_mat_mod.f90 b/base/modules/psb_base_mat_mod.f90 index d922ac50c..efd845b6e 100644 --- a/base/modules/psb_base_mat_mod.f90 +++ b/base/modules/psb_base_mat_mod.f90 @@ -193,7 +193,7 @@ module psb_base_mat_mod procedure, pass(a) :: transc_1mat => psb_base_transc_1mat procedure, pass(a) :: transc_2mat => psb_base_transc_2mat generic, public :: transc => transc_1mat, transc_2mat - + final :: base_sparse_mat_finalize end type psb_base_sparse_mat !> Function: psb_base_get_nz_row @@ -715,6 +715,21 @@ contains call a%transp() end subroutine psb_base_transc_1mat + subroutine base_sparse_mat_finalize(a) + implicit none + + type(psb_base_sparse_mat), intent(inout) :: a + write(0,*) 'Base sparse_mat finalize' + a%m = 0 + a%n = 0 + a%state = 0 + a%duplicate = 0 + a%triangle = .false. + a%unitd = .false. + a%upper = .false. + a%sorted = .false. + end subroutine base_sparse_mat_finalize + end module psb_base_mat_mod diff --git a/base/modules/psb_c_base_mat_mod.f90 b/base/modules/psb_c_base_mat_mod.f90 index e5e5fda3f..1814c8ce9 100644 --- a/base/modules/psb_c_base_mat_mod.f90 +++ b/base/modules/psb_c_base_mat_mod.f90 @@ -187,7 +187,7 @@ module psb_c_base_mat_mod procedure, pass(a) :: arwsum => psb_c_coo_arwsum procedure, pass(a) :: colsum => psb_c_coo_colsum procedure, pass(a) :: aclsum => psb_c_coo_aclsum - + final :: c_coo_finalize end type psb_c_coo_sparse_mat private :: c_coo_get_nzeros, c_coo_set_nzeros, & @@ -1756,6 +1756,24 @@ contains end subroutine c_coo_transc_1mat + + subroutine c_coo_finalize(a) + implicit none + + type(psb_c_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: info + + write(0,*) 'Finalizing an c_COO_SPARSE_MAT' + if (allocated(a%ia)) & + & deallocate(a%ia,stat=info) + if (allocated(a%ja)) & + & deallocate(a%ja,stat=info) + if (allocated(a%val)) & + & deallocate(a%val,stat=info) + + + end subroutine c_coo_finalize + end module psb_c_base_mat_mod diff --git a/base/modules/psb_c_csc_mat_mod.f90 b/base/modules/psb_c_csc_mat_mod.f90 index 3770bcd34..cc89cac9f 100644 --- a/base/modules/psb_c_csc_mat_mod.f90 +++ b/base/modules/psb_c_csc_mat_mod.f90 @@ -97,7 +97,7 @@ module psb_c_csc_mat_mod procedure, pass(a) :: print => psb_c_csc_print procedure, pass(a) :: free => c_csc_free procedure, pass(a) :: mold => psb_c_csc_mold - + final :: c_csc_finalize end type psb_c_csc_sparse_mat private :: c_csc_get_nzeros, c_csc_free, c_csc_get_fmt, & @@ -610,4 +610,16 @@ contains end subroutine c_csc_free + subroutine c_csc_finalize(a) + implicit none + + type(psb_c_csc_sparse_mat), intent(inout) :: a + + write(0,*) 'Finalizing a c_csc sparse mat' + call a%free() + + return + + end subroutine c_csc_finalize + end module psb_c_csc_mat_mod diff --git a/base/modules/psb_c_csr_mat_mod.f90 b/base/modules/psb_c_csr_mat_mod.f90 index 4f093e96f..d00011fe9 100644 --- a/base/modules/psb_c_csr_mat_mod.f90 +++ b/base/modules/psb_c_csr_mat_mod.f90 @@ -98,7 +98,7 @@ module psb_c_csr_mat_mod procedure, pass(a) :: print => psb_c_csr_print procedure, pass(a) :: free => c_csr_free procedure, pass(a) :: mold => psb_c_csr_mold - + final :: c_csr_finalize end type psb_c_csr_sparse_mat private :: c_csr_get_nzeros, c_csr_free, c_csr_get_fmt, & @@ -612,5 +612,17 @@ contains end subroutine c_csr_free + subroutine c_csr_finalize(a) + implicit none + + type(psb_c_csr_sparse_mat), intent(inout) :: a + + write(0,*) 'Finalizing a c_csr sparse mat' + call a%free() + + return + + end subroutine c_csr_finalize + end module psb_c_csr_mat_mod diff --git a/base/modules/psb_c_vect_mod.F90 b/base/modules/psb_c_vect_mod.F90 index 3b8031d92..034d9f7f2 100644 --- a/base/modules/psb_c_vect_mod.F90 +++ b/base/modules/psb_c_vect_mod.F90 @@ -523,7 +523,7 @@ contains info = 0 if (allocated(x%v)) then - call x%v%free(info) + ! call x%v%free(info) if (info == 0) deallocate(x%v,stat=info) end if diff --git a/base/modules/psb_d_base_mat_mod.f90 b/base/modules/psb_d_base_mat_mod.f90 index 90f85adf8..c0b790786 100644 --- a/base/modules/psb_d_base_mat_mod.f90 +++ b/base/modules/psb_d_base_mat_mod.f90 @@ -187,7 +187,7 @@ module psb_d_base_mat_mod procedure, pass(a) :: arwsum => psb_d_coo_arwsum procedure, pass(a) :: colsum => psb_d_coo_colsum procedure, pass(a) :: aclsum => psb_d_coo_aclsum - + final :: d_coo_finalize end type psb_d_coo_sparse_mat private :: d_coo_get_nzeros, d_coo_set_nzeros, & @@ -1756,6 +1756,24 @@ contains end subroutine d_coo_transc_1mat + + subroutine d_coo_finalize(a) + implicit none + + type(psb_d_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: info + + write(0,*) 'Finalizing an d_COO_SPARSE_MAT' + if (allocated(a%ia)) & + & deallocate(a%ia,stat=info) + if (allocated(a%ja)) & + & deallocate(a%ja,stat=info) + if (allocated(a%val)) & + & deallocate(a%val,stat=info) + + + end subroutine d_coo_finalize + end module psb_d_base_mat_mod diff --git a/base/modules/psb_d_csc_mat_mod.f90 b/base/modules/psb_d_csc_mat_mod.f90 index 66aee0fe1..b2bad62c1 100644 --- a/base/modules/psb_d_csc_mat_mod.f90 +++ b/base/modules/psb_d_csc_mat_mod.f90 @@ -97,7 +97,7 @@ module psb_d_csc_mat_mod procedure, pass(a) :: print => psb_d_csc_print procedure, pass(a) :: free => d_csc_free procedure, pass(a) :: mold => psb_d_csc_mold - + final :: d_csc_finalize end type psb_d_csc_sparse_mat private :: d_csc_get_nzeros, d_csc_free, d_csc_get_fmt, & @@ -610,4 +610,16 @@ contains end subroutine d_csc_free + subroutine d_csc_finalize(a) + implicit none + + type(psb_d_csc_sparse_mat), intent(inout) :: a + + write(0,*) 'Finalizing a d_csc sparse mat' + call a%free() + + return + + end subroutine d_csc_finalize + end module psb_d_csc_mat_mod diff --git a/base/modules/psb_d_csr_mat_mod.f90 b/base/modules/psb_d_csr_mat_mod.f90 index f2d4fb53c..96b342164 100644 --- a/base/modules/psb_d_csr_mat_mod.f90 +++ b/base/modules/psb_d_csr_mat_mod.f90 @@ -98,7 +98,7 @@ module psb_d_csr_mat_mod procedure, pass(a) :: print => psb_d_csr_print procedure, pass(a) :: free => d_csr_free procedure, pass(a) :: mold => psb_d_csr_mold - + final :: d_csr_finalize end type psb_d_csr_sparse_mat private :: d_csr_get_nzeros, d_csr_free, d_csr_get_fmt, & @@ -612,5 +612,17 @@ contains end subroutine d_csr_free + subroutine d_csr_finalize(a) + implicit none + + type(psb_d_csr_sparse_mat), intent(inout) :: a + + write(0,*) 'Finalizing a d_csr sparse mat' + call a%free() + + return + + end subroutine d_csr_finalize + end module psb_d_csr_mat_mod diff --git a/base/modules/psb_d_vect_mod.F90 b/base/modules/psb_d_vect_mod.F90 index 1f18a431d..c494a430d 100644 --- a/base/modules/psb_d_vect_mod.F90 +++ b/base/modules/psb_d_vect_mod.F90 @@ -523,7 +523,7 @@ contains info = 0 if (allocated(x%v)) then - call x%v%free(info) + ! call x%v%free(info) if (info == 0) deallocate(x%v,stat=info) end if diff --git a/base/modules/psb_i_comm_mod.f90 b/base/modules/psb_i_comm_mod.f90 index f1aa7c651..ab62cf26b 100644 --- a/base/modules/psb_i_comm_mod.f90 +++ b/base/modules/psb_i_comm_mod.f90 @@ -114,17 +114,17 @@ module psb_i_comm_mod end interface psb_scatter interface psb_gather -!!$ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) -!!$ use psb_desc_mod -!!$ use psb_mat_mod -!!$ implicit none -!!$ type(psb_ispmat_type), intent(inout) :: loca -!!$ type(psb_ispmat_type), intent(out) :: globa -!!$ type(psb_desc_type), intent(in) :: desc_a -!!$ integer(psb_ipk_), intent(out) :: info -!!$ integer(psb_ipk_), intent(in), optional :: root,dupl -!!$ logical, intent(in), optional :: keepnum,keeploc -!!$ end subroutine psb_isp_allgather +! !$ subroutine psb_isp_allgather(globa, loca, desc_a, info, root, dupl,keepnum,keeploc) +! !$ use psb_desc_mod +! !$ use psb_mat_mod +! !$ implicit none +! !$ type(psb_ispmat_type), intent(inout) :: loca +! !$ type(psb_ispmat_type), intent(out) :: globa +! !$ type(psb_desc_type), intent(in) :: desc_a +! !$ integer(psb_ipk_), intent(out) :: info +! !$ integer(psb_ipk_), intent(in), optional :: root,dupl +! !$ logical, intent(in), optional :: keepnum,keeploc +! !$ end subroutine psb_isp_allgather subroutine psb_igatherm(globx, locx, desc_a, info, root) use psb_desc_mod integer(psb_ipk_), intent(in) :: locx(:,:) diff --git a/base/modules/psb_i_vect_mod.F90 b/base/modules/psb_i_vect_mod.F90 index f8ecb1faa..96c62d7ac 100644 --- a/base/modules/psb_i_vect_mod.F90 +++ b/base/modules/psb_i_vect_mod.F90 @@ -523,7 +523,7 @@ contains info = 0 if (allocated(x%v)) then - call x%v%free(info) + ! call x%v%free(info) if (info == 0) deallocate(x%v,stat=info) end if diff --git a/base/modules/psb_s_base_mat_mod.f90 b/base/modules/psb_s_base_mat_mod.f90 index 36251b822..2f0a9d80f 100644 --- a/base/modules/psb_s_base_mat_mod.f90 +++ b/base/modules/psb_s_base_mat_mod.f90 @@ -187,7 +187,7 @@ module psb_s_base_mat_mod procedure, pass(a) :: arwsum => psb_s_coo_arwsum procedure, pass(a) :: colsum => psb_s_coo_colsum procedure, pass(a) :: aclsum => psb_s_coo_aclsum - + final :: s_coo_finalize end type psb_s_coo_sparse_mat private :: s_coo_get_nzeros, s_coo_set_nzeros, & @@ -1756,6 +1756,24 @@ contains end subroutine s_coo_transc_1mat + + subroutine s_coo_finalize(a) + implicit none + + type(psb_s_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: info + + write(0,*) 'Finalizing an s_COO_SPARSE_MAT' + if (allocated(a%ia)) & + & deallocate(a%ia,stat=info) + if (allocated(a%ja)) & + & deallocate(a%ja,stat=info) + if (allocated(a%val)) & + & deallocate(a%val,stat=info) + + + end subroutine s_coo_finalize + end module psb_s_base_mat_mod diff --git a/base/modules/psb_s_csc_mat_mod.f90 b/base/modules/psb_s_csc_mat_mod.f90 index 29f5de43b..c8ef4f6f8 100644 --- a/base/modules/psb_s_csc_mat_mod.f90 +++ b/base/modules/psb_s_csc_mat_mod.f90 @@ -97,7 +97,7 @@ module psb_s_csc_mat_mod procedure, pass(a) :: print => psb_s_csc_print procedure, pass(a) :: free => s_csc_free procedure, pass(a) :: mold => psb_s_csc_mold - + final :: s_csc_finalize end type psb_s_csc_sparse_mat private :: s_csc_get_nzeros, s_csc_free, s_csc_get_fmt, & @@ -610,4 +610,16 @@ contains end subroutine s_csc_free + subroutine s_csc_finalize(a) + implicit none + + type(psb_s_csc_sparse_mat), intent(inout) :: a + + write(0,*) 'Finalizing a s_csc sparse mat' + call a%free() + + return + + end subroutine s_csc_finalize + end module psb_s_csc_mat_mod diff --git a/base/modules/psb_s_csr_mat_mod.f90 b/base/modules/psb_s_csr_mat_mod.f90 index 47bf82661..9895ed8c9 100644 --- a/base/modules/psb_s_csr_mat_mod.f90 +++ b/base/modules/psb_s_csr_mat_mod.f90 @@ -98,7 +98,7 @@ module psb_s_csr_mat_mod procedure, pass(a) :: print => psb_s_csr_print procedure, pass(a) :: free => s_csr_free procedure, pass(a) :: mold => psb_s_csr_mold - + final :: s_csr_finalize end type psb_s_csr_sparse_mat private :: s_csr_get_nzeros, s_csr_free, s_csr_get_fmt, & @@ -612,5 +612,17 @@ contains end subroutine s_csr_free + subroutine s_csr_finalize(a) + implicit none + + type(psb_s_csr_sparse_mat), intent(inout) :: a + + write(0,*) 'Finalizing a s_csr sparse mat' + call a%free() + + return + + end subroutine s_csr_finalize + end module psb_s_csr_mat_mod diff --git a/base/modules/psb_s_vect_mod.F90 b/base/modules/psb_s_vect_mod.F90 index 98dbce344..32d98b30c 100644 --- a/base/modules/psb_s_vect_mod.F90 +++ b/base/modules/psb_s_vect_mod.F90 @@ -523,7 +523,7 @@ contains info = 0 if (allocated(x%v)) then - call x%v%free(info) + ! call x%v%free(info) if (info == 0) deallocate(x%v,stat=info) end if diff --git a/base/modules/psb_z_base_mat_mod.f90 b/base/modules/psb_z_base_mat_mod.f90 index 362e0031e..947afecae 100644 --- a/base/modules/psb_z_base_mat_mod.f90 +++ b/base/modules/psb_z_base_mat_mod.f90 @@ -187,7 +187,7 @@ module psb_z_base_mat_mod procedure, pass(a) :: arwsum => psb_z_coo_arwsum procedure, pass(a) :: colsum => psb_z_coo_colsum procedure, pass(a) :: aclsum => psb_z_coo_aclsum - + final :: z_coo_finalize end type psb_z_coo_sparse_mat private :: z_coo_get_nzeros, z_coo_set_nzeros, & @@ -1756,6 +1756,24 @@ contains end subroutine z_coo_transc_1mat + + subroutine z_coo_finalize(a) + implicit none + + type(psb_z_coo_sparse_mat), intent(inout) :: a + integer(psb_ipk_) :: info + + write(0,*) 'Finalizing an z_COO_SPARSE_MAT' + if (allocated(a%ia)) & + & deallocate(a%ia,stat=info) + if (allocated(a%ja)) & + & deallocate(a%ja,stat=info) + if (allocated(a%val)) & + & deallocate(a%val,stat=info) + + + end subroutine z_coo_finalize + end module psb_z_base_mat_mod diff --git a/base/modules/psb_z_csc_mat_mod.f90 b/base/modules/psb_z_csc_mat_mod.f90 index 3de58cbc3..183218528 100644 --- a/base/modules/psb_z_csc_mat_mod.f90 +++ b/base/modules/psb_z_csc_mat_mod.f90 @@ -97,7 +97,7 @@ module psb_z_csc_mat_mod procedure, pass(a) :: print => psb_z_csc_print procedure, pass(a) :: free => z_csc_free procedure, pass(a) :: mold => psb_z_csc_mold - + final :: z_csc_finalize end type psb_z_csc_sparse_mat private :: z_csc_get_nzeros, z_csc_free, z_csc_get_fmt, & @@ -610,4 +610,16 @@ contains end subroutine z_csc_free + subroutine z_csc_finalize(a) + implicit none + + type(psb_z_csc_sparse_mat), intent(inout) :: a + + write(0,*) 'Finalizing a z_csc sparse mat' + call a%free() + + return + + end subroutine z_csc_finalize + end module psb_z_csc_mat_mod diff --git a/base/modules/psb_z_csr_mat_mod.f90 b/base/modules/psb_z_csr_mat_mod.f90 index c5c9ff555..b47549fd5 100644 --- a/base/modules/psb_z_csr_mat_mod.f90 +++ b/base/modules/psb_z_csr_mat_mod.f90 @@ -98,7 +98,7 @@ module psb_z_csr_mat_mod procedure, pass(a) :: print => psb_z_csr_print procedure, pass(a) :: free => z_csr_free procedure, pass(a) :: mold => psb_z_csr_mold - + final :: z_csr_finalize end type psb_z_csr_sparse_mat private :: z_csr_get_nzeros, z_csr_free, z_csr_get_fmt, & @@ -612,5 +612,17 @@ contains end subroutine z_csr_free + subroutine z_csr_finalize(a) + implicit none + + type(psb_z_csr_sparse_mat), intent(inout) :: a + + write(0,*) 'Finalizing a z_csr sparse mat' + call a%free() + + return + + end subroutine z_csr_finalize + end module psb_z_csr_mat_mod diff --git a/base/modules/psb_z_vect_mod.F90 b/base/modules/psb_z_vect_mod.F90 index 5592c9d3a..aed97896b 100644 --- a/base/modules/psb_z_vect_mod.F90 +++ b/base/modules/psb_z_vect_mod.F90 @@ -523,7 +523,7 @@ contains info = 0 if (allocated(x%v)) then - call x%v%free(info) + ! call x%v%free(info) if (info == 0) deallocate(x%v,stat=info) end if diff --git a/base/serial/impl/psb_c_mat_impl.F90 b/base/serial/impl/psb_c_mat_impl.F90 index 309db2d13..74c5c2ea3 100644 --- a/base/serial/impl/psb_c_mat_impl.F90 +++ b/base/serial/impl/psb_c_mat_impl.F90 @@ -692,7 +692,7 @@ subroutine psb_c_free(a) class(psb_cspmat_type), intent(inout) :: a if (allocated(a%a)) then - call a%a%free() + ! call a%a%free() deallocate(a%a) endif diff --git a/base/serial/impl/psb_d_mat_impl.F90 b/base/serial/impl/psb_d_mat_impl.F90 index d7fab12e3..6c41eb91b 100644 --- a/base/serial/impl/psb_d_mat_impl.F90 +++ b/base/serial/impl/psb_d_mat_impl.F90 @@ -692,7 +692,7 @@ subroutine psb_d_free(a) class(psb_dspmat_type), intent(inout) :: a if (allocated(a%a)) then - call a%a%free() + ! call a%a%free() deallocate(a%a) endif diff --git a/base/serial/impl/psb_s_mat_impl.F90 b/base/serial/impl/psb_s_mat_impl.F90 index ae51e2962..b0f08164f 100644 --- a/base/serial/impl/psb_s_mat_impl.F90 +++ b/base/serial/impl/psb_s_mat_impl.F90 @@ -692,7 +692,7 @@ subroutine psb_s_free(a) class(psb_sspmat_type), intent(inout) :: a if (allocated(a%a)) then - call a%a%free() + ! call a%a%free() deallocate(a%a) endif diff --git a/base/serial/impl/psb_z_mat_impl.F90 b/base/serial/impl/psb_z_mat_impl.F90 index 9ce6127a6..8abd33bd5 100644 --- a/base/serial/impl/psb_z_mat_impl.F90 +++ b/base/serial/impl/psb_z_mat_impl.F90 @@ -692,7 +692,7 @@ subroutine psb_z_free(a) class(psb_zspmat_type), intent(inout) :: a if (allocated(a%a)) then - call a%a%free() + ! call a%a%free() deallocate(a%a) endif diff --git a/prec/impl/psb_d_bjacprec_impl.f90 b/prec/impl/psb_d_bjacprec_impl.f90 index 485fdc0b1..345fc3ede 100644 --- a/prec/impl/psb_d_bjacprec_impl.f90 +++ b/prec/impl/psb_d_bjacprec_impl.f90 @@ -441,7 +441,7 @@ subroutine psb_d_bjac_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) integer(psb_ipk_) :: i, m integer(psb_ipk_) :: ierr(5) character :: trans, unitd - type(psb_d_csr_sparse_mat), allocatable :: lf, uf + type(psb_d_csr_sparse_mat), allocatable :: lf, uf real(psb_dpk_), allocatable :: dd(:) integer(psb_ipk_) :: nztota, err_act, n_row, nrow_a,n_col, nhalo integer(psb_ipk_) :: ictxt,np,me @@ -564,6 +564,7 @@ subroutine psb_d_bjac_precbld(a,desc_a,prec,info,upd,amold,afmt,vmold) end if call psb_erractionrestore(err_act) + write(0,*) 'LF and UF are about to go out of scope' return 9999 continue