diff --git a/mlprec/mld_base_prec_type.F90 b/mlprec/mld_base_prec_type.F90 index 10c014dc..70a593d2 100644 --- a/mlprec/mld_base_prec_type.F90 +++ b/mlprec/mld_base_prec_type.F90 @@ -45,7 +45,9 @@ ! - character constants describing the preconditioner (used by the routines ! printing out a preconditioner description); ! - the interfaces to the routines for the management of the preconditioner -! data structure (see below). +! data structure (see below); +! - The data type encapsulating the parameters defining the ML preconditioner +! - The data type encapsulating the basic aggregation map. ! ! It contains routines for ! - converting character constants defining the preconditioner into integer @@ -91,6 +93,7 @@ module mld_base_prec_type integer :: naggr integer, allocatable :: ilaggr(:) end type mld_aux_onelev_map_type + type mld_aux_map_type type(mld_aux_onelev_map_type), allocatable :: mapv(:) end type mld_aux_map_type diff --git a/mlprec/mld_d_move_alloc_mod.f90 b/mlprec/mld_d_move_alloc_mod.f90 index 33fc78ce..71e12f0f 100644 --- a/mlprec/mld_d_move_alloc_mod.f90 +++ b/mlprec/mld_d_move_alloc_mod.f90 @@ -61,7 +61,7 @@ contains type(mld_donelev_type), intent(inout) :: a, b integer, intent(out) :: info - call mld_precfree(b,info) + call b%free(info) call move_alloc(a%sm,b%sm) if (info == psb_success_) call psb_move_alloc(a%ac,b%ac,info) if (info == psb_success_) call psb_move_alloc(a%desc_ac,b%desc_ac,info) diff --git a/mlprec/mld_d_prec_type.f90 b/mlprec/mld_d_prec_type.f90 index f7d9e9b5..4a5caa0f 100644 --- a/mlprec/mld_d_prec_type.f90 +++ b/mlprec/mld_d_prec_type.f90 @@ -43,11 +43,6 @@ ! This module defines: ! - the mld_prec_type data structure containing the preconditioner and related ! data structures; -! - integer constants defining the preconditioner; -! - character constants describing the preconditioner (used by the routines -! printing out a preconditioner description); -! - the interfaces to the routines for the management of the preconditioner -! data structure (see below). ! ! It contains routines for ! - converting character constants defining the preconditioner into integer @@ -64,12 +59,13 @@ module mld_d_prec_type ! ! Type: mld_Tprec_type. ! - ! It is the data type containing all the information about the multilevel + ! This is the data type containing all the information about the multilevel ! preconditioner (here and in the following 'T' denotes 'd', 's', 'c' and ! 'z', according to the real/complex, single/double precision version of ! MLD2P4). It consists of an array of 'one-level' intermediate data structures ! of type mld_Tonelev_type, each containing the information needed to apply - ! the smoothing and the coarse-space correction at a generic level. + ! the smoothing and the coarse-space correction at a generic level. RT is the + ! real data type, i.e. S for both S and C, and D for both D and Z. ! ! type mld_Tprec_type ! type(mld_Tonelev_type), allocatable :: precv(:) @@ -86,31 +82,28 @@ module mld_d_prec_type ! and the restriction and prolongation operators). ! ! type mld_Tonelev_type - ! type(mld_Tbaseprec_type) :: prec - ! integer, allocatable :: iprcparm(:) - ! real(psb_Tpk_), allocatable :: rprcparm(:) - ! type(psb_Tspmat_type) :: ac - ! type(psb_desc_type) :: desc_ac - ! type(psb_Tspmat_type), pointer :: base_a => null() - ! type(psb_desc_type), pointer :: base_desc => null() - ! type(psb_Tlinmap_type) :: map + ! class(mld_T_base_smoother_type), allocatable :: sm + ! type(mld_RTml_parms) :: parms + ! type(psb_Tspmat_type) :: ac + ! type(psb_Tesc_type) :: desc_ac + ! type(psb_Tspmat_type), pointer :: base_a => null() + ! type(psb_Tesc_type), pointer :: base_desc => null() + ! type(psb_Tlinmap_type) :: map ! end type mld_Tonelev_type ! ! Note that psb_Tpk denotes the kind of the real data type to be chosen ! according to single/double precision version of MLD2P4. ! - ! prec - type(mld_Tbaseprec_type). + ! sm - class(mld_T_base_smoother_type), allocatable ! The current level preconditioner (aka smoother). - ! iprcparm - integer, dimension(:), allocatable. - ! The integer parameters defining the multilevel strategy. - ! rprcparm - real(psb_Ypk_), dimension(:), allocatable. - ! The real parameters defining the multilevel strategy. + ! parms - type(mld_RTml_parms) + ! The parameters defining the multilevel strategy. ! ac - The local part of the current-level matrix, built by ! coarsening the previous-level matrix. ! desc_ac - type(psb_desc_type). ! The communication descriptor associated to the matrix ! stored in ac. - ! base_a - type(psb_zspmat_type), pointer. + ! base_a - type(psb_Tspmat_type), pointer. ! Pointer (really a pointer!) to the local part of the current ! matrix (so we have a unified treatment of residuals). ! We need this to avoid passing explicitly the current matrix @@ -122,58 +115,75 @@ module mld_d_prec_type ! vector spaces associated to the index spaces of the previous ! and current levels. ! + ! Methods: + ! Most methods follow the encapsulation hierarchy: they take whatever action + ! is appropriate for the current object, then call the corresponding method for + ! the contained object. + ! As an example: the descr() method prints out a description of the + ! level. It starts by invoking the descr() method of the parms object, + ! then calls the descr() method of the smoother object. + ! + ! descr - Prints a description of the object. + ! default - Set default values + ! dump - Dump to file object contents + ! set - Sets various parameters; when a request is unknown + ! it is passed to the smoother object for further processing. + ! check - Sanity checks. + ! sizeof - Total memory occupation in bytes + ! get_nzeros - Number of nonzeros + ! + ! ! - ! Type: mld_Tbaseprec_type. + ! Type: mld_T_base_smoother_type. ! - ! It holds the smoother (base preconditioner) at a single level. + ! It holds the smoother a single level. Its only mandatory component is a solver + ! object which holds a local solver; this decoupling allows to have the same solver + ! e.g ILU to work with Jacobi with multiple sweeps as well as with any AS variant. ! - ! type mld_Tbaseprec_type - ! type(psb_Tspmat_type), allocatable :: av(:) - ! IntrType(psb_Tpk_), allocatable :: d(:) - ! type(psb_desc_type) :: desc_data - ! integer, allocatable :: iprcparm(:) - ! real(psb_Tpk_), allocatable :: rprcparm(:) - ! integer, allocatable :: perm(:), invperm(:) - ! end type mld_sbaseprec_type + ! type mld_T_base_smoother_type + ! class(mld_T_base_solver_type), allocatable :: sv + ! end type mld_T_base_smoother_type ! - ! Note that IntrType denotes the real or complex data type, and psb_Tpk denotes - ! the kind of the real or complex type, according to the real/complex, single/double - ! precision version of MLD2P4. + ! Methods: + ! + ! build - Compute the actual contents of the smoother; includes + ! invocation of the build method on the solver component. + ! free - Release memory + ! apply - Apply the smoother to a vector (or to an array); includes + ! invocation of the apply method on the solver component. + ! descr - Prints a description of the object. + ! default - Set default values + ! dump - Dump to file object contents + ! set - Sets various parameters; when a request is unknown + ! it is passed to the smoother object for further processing. + ! check - Sanity checks. + ! sizeof - Total memory occupation in bytes + ! get_nzeros - Number of nonzeros + ! + ! + ! + ! Type: mld_T_base_solver_type. + ! + ! It holds the local solver; it has no mandatory components. + ! + ! type mld_T_base_solver_type + ! end type mld_T_base_solver_type + ! + ! build - Compute the actual contents of the smoother; includes + ! invocation of the build method on the solver component. + ! free - Release memory + ! apply - Apply the smoother to a vector (or to an array); includes + ! invocation of the apply method on the solver component. + ! descr - Prints a description of the object. + ! default - Set default values + ! dump - Dump to file object contents + ! set - Sets various parameters; when a request is unknown + ! it is passed to the smoother object for further processing. + ! check - Sanity checks. + ! sizeof - Total memory occupation in bytes + ! get_nzeros - Number of nonzeros ! - ! av - type(psb_Tspmat_type), dimension(:), allocatable(:). - ! The sparse matrices needed to apply the preconditioner at - ! the current level ilev. - ! av(mld_l_pr_) - The L factor of the ILU factorization of the local - ! diagonal block of the current-level matrix A(ilev). - ! av(mld_u_pr_) - The U factor of the ILU factorization of the local - ! diagonal block of A(ilev), except its diagonal entries - ! (stored in d). - ! av(mld_ap_nd_) - The entries of the local part of A(ilev) outside - ! the diagonal block, for block-Jacobi sweeps. - ! d - real/complex(psb_Tpk_), dimension(:), allocatable. - ! The diagonal entries of the U factor in the ILU factorization - ! of A(ilev). - ! desc_data - type(psb_desc_type). - ! The communication descriptor associated to the base preconditioner, - ! i.e. to the sparse matrices needed to apply the base preconditioner - ! at the current level. - ! iprcparm - integer, dimension(:), allocatable. - ! The integer parameters defining the base preconditioner K(ilev) - ! (the iprcparm entries and values are specified below). - ! rprcparm - real(psb_Tpk_), dimension(:), allocatable. - ! The real parameters defining the base preconditioner K(ilev) - ! (the rprcparm entries and values are specified below). - ! perm - integer, dimension(:), allocatable. - ! The row and column permutations applied to the local part of - ! A(ilev) (defined only if iprcparm(mld_sub_ren_)>0). - ! invperm - integer, dimension(:), allocatable. - ! The inverse of the permutation stored in perm. ! - ! Note that when the LU factorization of the (local part of the) matrix A(ilev) is - ! computed instead of the ILU one, by using UMFPACK, SuperLU or SuperLU_dist, the - ! corresponding L and U factors are stored in data structures provided by those - ! packages and pointed by prec%iprcparm(mld_umf_ptr), prec%iprcparm(mld_slu_ptr) - ! or prec%iprcparm(mld_slud_ptr). ! type mld_d_base_solver_type @@ -226,18 +236,21 @@ module mld_d_prec_type contains procedure, pass(lv) :: descr => d_base_onelev_descr procedure, pass(lv) :: default => d_base_onelev_default + procedure, pass(lv) :: free => d_base_onelev_free + procedure, pass(lv) :: nullify => d_base_onelev_nullify procedure, pass(lv) :: check => d_base_onelev_check procedure, pass(lv) :: dump => d_base_onelev_dump procedure, pass(lv) :: seti => d_base_onelev_seti procedure, pass(lv) :: setr => d_base_onelev_setr procedure, pass(lv) :: setc => d_base_onelev_setc generic, public :: set => seti, setr, setc + procedure, pass(lv) :: sizeof => d_base_onelev_sizeof procedure, pass(lv) :: get_nzeros => d_base_onelev_get_nzeros end type mld_donelev_type type, extends(psb_dprec_type) :: mld_dprec_type integer :: ictxt - real(psb_dpk_) :: op_complexity=-done + real(psb_dpk_) :: op_complexity=dzero type(mld_donelev_type), allocatable :: precv(:) contains procedure, pass(prec) :: d_apply2_vect => mld_d_apply2_vect @@ -264,7 +277,9 @@ module mld_d_prec_type & d_base_onelev_seti, d_base_onelev_setc, & & d_base_onelev_setr, d_base_onelev_check, & & d_base_onelev_default, d_base_onelev_dump, & - & d_base_onelev_descr, mld_d_dump, & + & d_base_onelev_descr, d_base_onelev_sizeof, & + & d_base_onelev_free, d_base_onelev_nullify,& + & mld_d_dump, & & mld_d_get_compl, mld_d_cmp_compl,& & mld_d_get_nzeros, d_base_onelev_get_nzeros, & & d_base_smoother_get_nzeros, d_base_solver_get_nzeros @@ -276,7 +291,7 @@ module mld_d_prec_type ! interface mld_precfree - module procedure mld_d_onelev_precfree, mld_dprec_free + module procedure mld_dprec_free end interface interface mld_nullify_onelevprec @@ -288,7 +303,7 @@ module mld_d_prec_type end interface interface mld_sizeof - module procedure mld_dprec_sizeof, mld_d_onelev_prec_sizeof + module procedure mld_dprec_sizeof end interface interface mld_precaply @@ -382,23 +397,23 @@ contains val = val + psb_sizeof_int if (allocated(prec%precv)) then do i=1, size(prec%precv) - val = val + mld_sizeof(prec%precv(i)) + val = val + prec%precv(i)%sizeof() end do end if end function mld_dprec_sizeof - function mld_d_onelev_prec_sizeof(prec) result(val) + function d_base_onelev_sizeof(lv) result(val) implicit none - type(mld_donelev_type), intent(in) :: prec + class(mld_donelev_type), intent(in) :: lv integer(psb_long_int_k_) :: val integer :: i val = 0 - val = val + psb_sizeof(prec%desc_ac) - val = val + psb_sizeof(prec%ac) - val = val + psb_sizeof(prec%map) - if (allocated(prec%sm)) val = val + prec%sm%sizeof() - end function mld_d_onelev_prec_sizeof + val = val + lv%desc_ac%sizeof() + val = val + lv%ac%sizeof() + val = val + lv%map%sizeof() + if (allocated(lv%sm)) val = val + lv%sm%sizeof() + end function d_base_onelev_sizeof function mld_d_get_compl(prec) result(val) implicit none @@ -631,11 +646,11 @@ contains return end subroutine d_base_onelev_descr - subroutine mld_d_onelev_precfree(p,info) + subroutine d_base_onelev_free(lv,info) use psb_base_mod implicit none - type(mld_donelev_type), intent(inout) :: p + class(mld_donelev_type), intent(inout) :: lv integer, intent(out) :: info integer :: i @@ -644,25 +659,37 @@ contains ! Actually we might just deallocate the top level array, except ! for the inner UMFPACK or SLU stuff. ! We really need FINALs. - call p%sm%free(info) + call lv%sm%free(info) - call p%ac%free() - if (psb_is_ok_desc(p%desc_ac)) & - & call psb_cdfree(p%desc_ac,info) + call lv%ac%free() + if (psb_is_ok_desc(lv%desc_ac)) & + & call psb_cdfree(lv%desc_ac,info) ! This is a pointer to something else, must not free it here. - nullify(p%base_a) + nullify(lv%base_a) ! This is a pointer to something else, must not free it here. - nullify(p%base_desc) + nullify(lv%base_desc) ! ! free explicitly map??? ! For now thanks to allocatable semantics ! works anyway. ! + + call lv%nullify() + + end subroutine d_base_onelev_free + + + subroutine d_base_onelev_nullify(lv) + implicit none + + class(mld_donelev_type), intent(inout) :: lv + + nullify(lv%base_a) + nullify(lv%base_desc) - call mld_nullify_onelevprec(p) - end subroutine mld_d_onelev_precfree + end subroutine d_base_onelev_nullify subroutine mld_nullify_d_onelevprec(p) @@ -698,7 +725,7 @@ contains if (allocated(p%precv)) then do i=1,size(p%precv) - call mld_precfree(p%precv(i),info) + call p%precv(i)%free(info) end do deallocate(p%precv) end if