*** empty log message ***

tests/newslv/mld_d_tlu_solver.f90

@@ -39,7 +39,22 @@
 !  
 !
 !
+! File: mld_d_tlu_solver_mod.f90
 !
+! Module: mld_d_tlu_solver_mod
+!
+!  This module serves as an example of how to define a new solver and integrate
+!  it in MLD2P4 via the P%SET(sv,info) method.
+!  The solver itself is really nothing other than the ILU solver disguised under a new name.
+!
+!  The code is divided in two files:
+!  1. The interface file (this one)
+!  2. The implementation file (mld_d_tlu_solver_impl.f90)
+!  
+!  The separation between interface and iplementation is an essential part of the
+!  object-oriented design. The most appropriate tool would be to have the implementation
+!  in a SUBMODULE, something which we plan to do at some point in the future but will
+!  need to check for compiler support. 
 !  
 !
 !
@@ -53,21 +68,29 @@ module mld_d_tlu_solver
     type(psb_dspmat_type)       :: l, u
     real(psb_dpk_), allocatable :: d(:)
     type(psb_d_vect_type)      :: dv
-    integer                     :: fact_type, fill_in
+    integer(psb_ipk_)            :: fact_type, fill_in
     real(psb_dpk_)                :: thresh
   contains
     procedure, pass(sv) :: dump    => mld_d_tlu_solver_dmp 
+    procedure, pass(sv) :: ccheck  => d_tlu_solver_check
+    procedure, pass(sv) :: clone   => mld_d_tlu_solver_clone
     procedure, pass(sv) :: build   => mld_d_tlu_solver_bld
+    procedure, pass(sv) :: cnv     => mld_d_tlu_solver_cnv
     procedure, pass(sv) :: apply_v => mld_d_tlu_solver_apply_vect
     procedure, pass(sv) :: apply_a => mld_d_tlu_solver_apply
     procedure, pass(sv) :: free    => d_tlu_solver_free
     procedure, pass(sv) :: seti    => d_tlu_solver_seti
     procedure, pass(sv) :: setc    => d_tlu_solver_setc
     procedure, pass(sv) :: setr    => d_tlu_solver_setr
+    procedure, pass(sv) :: cseti   => d_tlu_solver_cseti
+    procedure, pass(sv) :: csetc   => d_tlu_solver_csetc
+    procedure, pass(sv) :: csetr   => d_tlu_solver_csetr
     procedure, pass(sv) :: descr   => d_tlu_solver_descr
     procedure, pass(sv) :: default => d_tlu_solver_default
     procedure, pass(sv) :: sizeof  => d_tlu_solver_sizeof
     procedure, pass(sv) :: get_nzeros => d_tlu_solver_get_nzeros
+    procedure, nopass   :: get_fmt    => d_tlu_solver_get_fmt
+    procedure, nopass   :: get_id     => d_tlu_solver_get_id
   end type mld_d_tlu_solver_type
 
 
@@ -89,9 +112,10 @@ module mld_d_tlu_solver
 
 
   interface 
-    subroutine mld_d_tlu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,trans,work,info)
+    subroutine mld_d_tlu_solver_apply_vect(alpha,sv,x,beta,y,desc_data,&
+         & trans,work,info,init,initu)
       import :: psb_desc_type, mld_d_tlu_solver_type, psb_d_vect_type, psb_dpk_, &
-           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type
+           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
       type(psb_desc_type), intent(in)             :: desc_data
       class(mld_d_tlu_solver_type), intent(inout) :: sv
       type(psb_d_vect_type),intent(inout)         :: x
@@ -99,14 +123,18 @@ module mld_d_tlu_solver
       real(psb_dpk_),intent(in)                    :: alpha,beta
       character(len=1),intent(in)                   :: trans
       real(psb_dpk_),target, intent(inout)         :: work(:)
-      integer, intent(out)                        :: info
+      integer(psb_ipk_), intent(out)                :: info
+      character, intent(in), optional                :: init
+      type(psb_d_vect_type),intent(inout), optional   :: initu
     end subroutine mld_d_tlu_solver_apply_vect
   end interface
 
   interface 
-    subroutine mld_d_tlu_solver_apply(alpha,sv,x,beta,y,desc_data,trans,work,info)
+    subroutine mld_d_tlu_solver_apply(alpha,sv,x,beta,y,desc_data,&
+         & trans,work,info,init,initu)
       import :: psb_desc_type, mld_d_tlu_solver_type, psb_d_vect_type, psb_dpk_, &
-           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type
+           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
+      implicit none 
       type(psb_desc_type), intent(in)      :: desc_data
       class(mld_d_tlu_solver_type), intent(inout) :: sv
       real(psb_dpk_),intent(inout)         :: x(:)
@@ -114,37 +142,69 @@ module mld_d_tlu_solver
       real(psb_dpk_),intent(in)            :: alpha,beta
       character(len=1),intent(in)           :: trans
       real(psb_dpk_),target, intent(inout) :: work(:)
-      integer, intent(out)                 :: info
+      integer(psb_ipk_), intent(out)        :: info
+      character, intent(in), optional       :: init
+      real(psb_dpk_),intent(inout), optional :: initu(:)
     end subroutine mld_d_tlu_solver_apply
   end interface
 
   interface 
-    subroutine mld_d_tlu_solver_bld(a,desc_a,sv,upd,info,b,amold,vmold)
+    subroutine mld_d_tlu_solver_bld(a,desc_a,sv,info,b,amold,vmold, imold)
       import :: psb_desc_type, mld_d_tlu_solver_type, psb_d_vect_type, psb_dpk_, &
-           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type
+           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type,&
+           & psb_ipk_, psb_i_base_vect_type
+      implicit none 
       type(psb_dspmat_type), intent(in), target           :: a
       Type(psb_desc_type), Intent(in)                     :: desc_a 
       class(mld_d_tlu_solver_type), intent(inout)         :: sv
-      character, intent(in)                               :: upd
+      integer(psb_ipk_), intent(out)                      :: info
-      integer, intent(out)                                :: info
       type(psb_dspmat_type), intent(in), target, optional :: b
       class(psb_d_base_sparse_mat), intent(in), optional  :: amold
       class(psb_d_base_vect_type), intent(in), optional   :: vmold
+      class(psb_i_base_vect_type), intent(in), optional   :: imold
     end subroutine mld_d_tlu_solver_bld
   end interface
 
+  interface 
+    subroutine mld_d_tlu_solver_cnv(sv,info,amold,vmold,imold)
+      import :: mld_d_tlu_solver_type, psb_dpk_, &
+           & psb_d_base_sparse_mat, psb_d_base_vect_type,&
+           & psb_ipk_, psb_i_base_vect_type
+      implicit none 
+      class(mld_d_tlu_solver_type), intent(inout)         :: sv
+      integer(psb_ipk_), intent(out)                      :: info
+      class(psb_d_base_sparse_mat), intent(in), optional  :: amold
+      class(psb_d_base_vect_type), intent(in), optional   :: vmold
+      class(psb_i_base_vect_type), intent(in), optional   :: imold
+    end subroutine mld_d_tlu_solver_cnv
+  end interface
+  
   interface 
     subroutine mld_d_tlu_solver_dmp(sv,ictxt,level,info,prefix,head,solver)
       import :: psb_desc_type, mld_d_tlu_solver_type, psb_d_vect_type, psb_dpk_, &
-           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type
+           & psb_dspmat_type, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
       class(mld_d_tlu_solver_type), intent(in) :: sv
-      integer, intent(in)              :: ictxt,level
+      integer(psb_ipk_), intent(in)              :: ictxt
-      integer, intent(out)             :: info
+      integer(psb_ipk_), intent(in)              :: level
+      integer(psb_ipk_), intent(out)             :: info
       character(len=*), intent(in), optional :: prefix, head
       logical, optional, intent(in)    :: solver
     end subroutine mld_d_tlu_solver_dmp
   end interface
   
+  interface
+    subroutine mld_d_tlu_solver_clone(sv,svout,info)
+      import :: psb_desc_type, psb_dspmat_type,  psb_d_base_sparse_mat, &
+           & psb_d_vect_type, psb_d_base_vect_type, psb_dpk_, &
+           & mld_d_base_solver_type, mld_d_tlu_solver_type, psb_ipk_
+      Implicit None
+      
+      ! Arguments
+      class(mld_d_tlu_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_tlu_solver_clone
+  end interface
 
 contains
 
@@ -168,8 +228,8 @@ contains
 
     ! Arguments
     class(mld_d_tlu_solver_type), intent(inout) :: sv
-    integer, intent(out)                   :: info
+    integer(psb_ipk_), intent(out)                :: info
-    Integer           :: err_act
+    integer(psb_ipk_) :: err_act
     character(len=20) :: name='d_tlu_solver_check'
 
     call psb_erractionsave(err_act)
@@ -181,7 +241,7 @@ contains
     select case(sv%fact_type)
     case(mld_ilu_n_,mld_milu_n_)      
       call mld_check_def(sv%fill_in,&
-           & 'Level',0,is_legal_ml_lev)
+           & 'Level',izero,is_int_non_negative)
     case(mld_ilu_t_)                 
       call mld_check_def(sv%thresh,&
            & 'Eps',dzero,is_legal_d_fact_thrs)
@@ -193,8 +253,8 @@ contains
     return
 
 9999 call psb_error_handler(err_act)
-
     return
+
   end subroutine d_tlu_solver_check
 
 
@@ -204,10 +264,10 @@ contains
 
     ! Arguments
     class(mld_d_tlu_solver_type), intent(inout) :: sv 
-    integer, intent(in)                    :: what 
+    integer(psb_ipk_), intent(in)                 :: what 
-    integer, intent(in)                    :: val
+    integer(psb_ipk_), intent(in)                 :: val
-    integer, intent(out)                   :: info
+    integer(psb_ipk_), intent(out)                :: info
-    Integer :: err_act
+    integer(psb_ipk_)  :: err_act
     character(len=20)  :: name='d_tlu_solver_seti'
 
     info = psb_success_
@@ -219,15 +279,13 @@ contains
     case(mld_sub_fillin_)
       sv%fill_in   = val
     case default
-!!$      write(0,*) name,': Error: invalid WHAT'
+      call sv%mld_d_base_solver_type%set(what,val,info)
-!!$      info = -2
     end select
 
     call psb_erractionrestore(err_act)
     return
 
 9999 call psb_error_handler(err_act)
-
     return
   end subroutine d_tlu_solver_seti
 
@@ -237,22 +295,26 @@ contains
 
     ! Arguments
     class(mld_d_tlu_solver_type), intent(inout) :: sv
-    integer, intent(in)                    :: what 
+    integer(psb_ipk_), intent(in)                 :: what 
     character(len=*), intent(in)                  :: val
-    integer, intent(out)                   :: info
+    integer(psb_ipk_), intent(out)                :: info
-    Integer :: err_act, ival
+    integer(psb_ipk_)  :: err_act, ival
     character(len=20)  :: name='d_tlu_solver_setc'
 
     info = psb_success_
     call psb_erractionsave(err_act)
 
+
     ival =  sv%stringval(val)
     if (ival >= 0) then 
       call sv%set(what,ival,info)
     end if
       
-    if (info /= psb_success_) goto 9999
+    if (info /= psb_success_) then
-
+      info = psb_err_from_subroutine_
+      call psb_errpush(info, name)
+      goto 9999
+    end if
 
     call psb_erractionrestore(err_act)
     return
@@ -268,10 +330,10 @@ contains
 
     ! Arguments
     class(mld_d_tlu_solver_type), intent(inout) :: sv 
-    integer, intent(in)                    :: what 
+    integer(psb_ipk_), intent(in)                 :: what 
     real(psb_dpk_), intent(in)                     :: val
-    integer, intent(out)                   :: info
+    integer(psb_ipk_), intent(out)                :: info
-    Integer :: err_act
+    integer(psb_ipk_)  :: err_act
     character(len=20)  :: name='d_tlu_solver_setr'
 
     call psb_erractionsave(err_act)
@@ -281,27 +343,118 @@ contains
     case(mld_sub_iluthrs_) 
       sv%thresh = val
     case default
-!!$      write(0,*) name,': Error: invalid WHAT'
+      call sv%mld_d_base_solver_type%set(what,val,info)
-!!$      info = -2
-!!$      goto 9999
     end select
 
     call psb_erractionrestore(err_act)
     return
 
 9999 call psb_error_handler(err_act)
-
     return
   end subroutine d_tlu_solver_setr
 
+  subroutine d_tlu_solver_cseti(sv,what,val,info)
+
+    Implicit None
+
+    ! Arguments
+    class(mld_d_tlu_solver_type), intent(inout) :: sv 
+    character(len=*), intent(in)                  :: what 
+    integer(psb_ipk_), intent(in)                 :: val
+    integer(psb_ipk_), intent(out)                :: info
+    integer(psb_ipk_)  :: err_act
+    character(len=20)  :: name='d_tlu_solver_cseti'
+
+    info = psb_success_
+    call psb_erractionsave(err_act)
+
+    select case(psb_toupper(what))
+    case('SUB_SOLVE') 
+      sv%fact_type = val
+    case('SUB_FILLIN')
+      sv%fill_in   = val
+    case default
+      call sv%mld_d_base_solver_type%set(what,val,info)
+    end select
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine d_tlu_solver_cseti
+
+  subroutine d_tlu_solver_csetc(sv,what,val,info)
+
+    Implicit None
+
+    ! Arguments
+    class(mld_d_tlu_solver_type), intent(inout) :: sv
+    character(len=*), intent(in)                  :: what 
+    character(len=*), intent(in)                  :: val
+    integer(psb_ipk_), intent(out)                :: info
+    integer(psb_ipk_)  :: err_act, ival
+    character(len=20)  :: name='d_tlu_solver_csetc'
+
+    info = psb_success_
+    call psb_erractionsave(err_act)
+
+
+    ival =  sv%stringval(val)
+    if (ival >= 0) then 
+      call sv%set(what,ival,info)
+    end if
+      
+    if (info /= psb_success_) then
+      info = psb_err_from_subroutine_
+      call psb_errpush(info, name)
+      goto 9999
+    end if
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine d_tlu_solver_csetc
+  
+  subroutine d_tlu_solver_csetr(sv,what,val,info)
+
+    Implicit None
+
+    ! Arguments
+    class(mld_d_tlu_solver_type), intent(inout) :: sv 
+    character(len=*), intent(in)                  :: what 
+    real(psb_dpk_), intent(in)                     :: val
+    integer(psb_ipk_), intent(out)                :: info
+    integer(psb_ipk_)  :: err_act
+    character(len=20)  :: name='d_tlu_solver_csetr'
+
+    call psb_erractionsave(err_act)
+    info = psb_success_
+
+    select case(psb_toupper(what))
+    case('SUB_ILUTHRS') 
+      sv%thresh = val
+    case default
+      call sv%mld_d_base_solver_type%set(what,val,info)
+    end select
+
+    call psb_erractionrestore(err_act)
+    return
+
+9999 call psb_error_handler(err_act)
+    return
+  end subroutine d_tlu_solver_csetr
+
   subroutine d_tlu_solver_free(sv,info)
 
     Implicit None
 
     ! Arguments
     class(mld_d_tlu_solver_type), intent(inout) :: sv
-    integer, intent(out)                       :: info
+    integer(psb_ipk_), intent(out)                :: info
-    Integer :: err_act
+    integer(psb_ipk_)  :: err_act
     character(len=20)  :: name='d_tlu_solver_free'
 
     call psb_erractionsave(err_act)
@@ -323,7 +476,6 @@ contains
     return
 
 9999 call psb_error_handler(err_act)
-
     return
   end subroutine d_tlu_solver_free
 
@@ -333,28 +485,27 @@ contains
 
     ! Arguments
     class(mld_d_tlu_solver_type), intent(in) :: sv
-    integer, intent(out)                     :: info
+    integer(psb_ipk_), intent(out)             :: info
-    integer, intent(in), optional            :: iout
+    integer(psb_ipk_), intent(in), optional    :: iout
     logical, intent(in), optional       :: coarse
 
     ! Local variables
-    integer      :: err_act
+    integer(psb_ipk_)      :: err_act
-    integer      :: ictxt, me, np
     character(len=20), parameter :: name='mld_d_tlu_solver_descr'
-    integer :: iout_
+    integer(psb_ipk_) :: iout_
 
     call psb_erractionsave(err_act)
     info = psb_success_
     if (present(iout)) then 
       iout_ = iout 
     else
-      iout_ = 6
+      iout_ = psb_out_unit
     endif
     
     write(iout_,*) '  TLU: template for a new solver type'
     write(iout_,*) '       testing with a clone of ILU   '
     write(iout_,*) '  Incomplete factorization solver: ',&
-           &  fact_names(sv%fact_type)
+         &  mld_fact_names(sv%fact_type)
     select case(sv%fact_type)
     case(mld_ilu_n_,mld_milu_n_)      
       write(iout_,*) '  Fill level:',sv%fill_in
@@ -367,7 +518,6 @@ contains
     return
 
 9999 call psb_error_handler(err_act)
-
     return
   end subroutine d_tlu_solver_descr
 
@@ -377,7 +527,7 @@ contains
     ! Arguments
     class(mld_d_tlu_solver_type), intent(in) :: sv
     integer(psb_long_int_k_) :: val
-    integer             :: i
+    integer(psb_ipk_)        :: i
     
     val = 0 
     val = val + sv%dv%get_nrows()
@@ -393,7 +543,7 @@ contains
     ! Arguments
     class(mld_d_tlu_solver_type), intent(in) :: sv
     integer(psb_long_int_k_) :: val
-    integer             :: i
+    integer(psb_ipk_)        :: i
 
     val = 2*psb_sizeof_int + psb_sizeof_dp
     val = val + sv%dv%sizeof()
@@ -403,4 +553,18 @@ contains
     return
   end function d_tlu_solver_sizeof
 
+  function d_tlu_solver_get_fmt() result(val)
+    implicit none 
+    character(len=32)  :: val
+
+    val = "TLU solver"
+  end function d_tlu_solver_get_fmt
+
+  function d_tlu_solver_get_id() result(val)
+    implicit none 
+    integer(psb_ipk_)  :: val
+    
+    val = mld_ilu_n_
+  end function d_tlu_solver_get_id
+  
 end module mld_d_tlu_solver