mld2p4-2:

Makefile
 mld_zcoarse_bld.f90
 mld_zmlprec_bld.f90
 mld_zslu_bld.f90
 mld_zumf_bld.f90

Further advance on double complex.

mlprec/Makefile

@@ -27,6 +27,7 @@ INNEROBJS= mld_dcoarse_bld.o  mld_dmlprec_bld.o	 mld_dslu_bld.o mld_dumf_bld.o \
 	mld_ccoarse_bld.o  mld_cmlprec_bld.o mld_cslu_bld.o    mld_cumf_bld.o \
 	mld_cilu0_fact.o   mld_ciluk_fact.o  mld_cilut_fact.o  mld_caggrmap_bld.o \
 	mld_cmlprec_aply.o mld_cslud_bld.o   mld_caggrmat_asb.o   \
+	mld_zcoarse_bld.o  mld_zmlprec_bld.o mld_zslu_bld.o    mld_zumf_bld.o \
 	$(MPFOBJS) 
 #
 

mlprec/mld_zcoarse_bld.f90

@@ -79,11 +79,9 @@ subroutine mld_zcoarse_bld(a,desc_a,p,info)
   integer, intent(out)                      :: info
 
   ! Local variables
-  type(psb_desc_type)   :: desc_ac
-  type(psb_zspmat_type) :: ac
-  character(len=20)     :: name
-  integer               :: ictxt, np, me, err_act
-  integer, allocatable  :: ilaggr(:), nlaggr(:)
+  character(len=20)      :: name
+  integer                :: ictxt, np, me, err_act
+  integer, allocatable   :: ilaggr(:), nlaggr(:)
 
   name='mld_zcoarse_bld'
   if (psb_get_errstatus().ne.0) return 
@@ -125,7 +123,8 @@ subroutine mld_zcoarse_bld(a,desc_a,p,info)
   ! 
   call mld_aggrmap_bld(p%iprcparm(mld_aggr_alg_),p%rprcparm(mld_aggr_thresh_),&
        & a,desc_a,ilaggr,nlaggr,info)
-  if(info /= psb_success_) then
+
+  if (info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmap_bld')
     goto 9999
   end if
@@ -136,6 +135,7 @@ subroutine mld_zcoarse_bld(a,desc_a,p,info)
   ! algorithm specified by p%iprcparm(mld_aggr_kind_)
   !
   call mld_aggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
+
   if(info /= psb_success_) then
     call psb_errpush(psb_err_from_subroutine_,name,a_err='mld_aggrmat_asb')
     goto 9999

mlprec/mld_zmlprec_bld.f90

@@ -69,6 +69,10 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info)
   use psb_sparse_mod
   use mld_inner_mod, mld_protect_name => mld_zmlprec_bld
   use mld_prec_mod
+  use mld_z_jac_smoother
+  use mld_z_as_smoother
+  use mld_z_diag_solver
+  use mld_z_ilu_solver
 
   Implicit None
 
@@ -219,7 +223,8 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info)
            & p%precv(i-1)%base_desc, p%precv(i),info)
 
       if (info /= psb_success_) then 
-        call psb_errpush(psb_err_internal_error_,name,a_err='Init upper level preconditioner')
+        call psb_errpush(psb_err_internal_error_,name,&
+             & a_err='Init upper level preconditioner')
         goto 9999
       endif
 
@@ -250,7 +255,8 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info)
       end if
       allocate(t_prec%precv(newsz),stat=info)
       if (info /= psb_success_) then 
-        call psb_errpush(psb_err_from_subroutine_,name,a_err='prec reallocation')
+        call psb_errpush(psb_err_from_subroutine_,name,&
+             & a_err='prec reallocation')
         goto 9999
       endif
       do i=1,newsz-1
@@ -303,14 +309,72 @@ subroutine mld_zmlprec_bld(a,desc_a,p,info)
       call mld_check_def(p%precv(i)%prec%rprcparm(mld_sub_iluthrs_),&
            & 'Eps',dzero,is_legal_fact_thrs)
     end select
-    call mld_check_def(p%precv(i)%prec%iprcparm(mld_smoother_sweeps_),&
+    call mld_check_def(p%precv(i)%iprcparm(mld_smoother_sweeps_),&
          & 'Jacobi sweeps',1,is_legal_jac_sweeps)
+    call mld_check_def(p%precv(i)%iprcparm(mld_smoother_sweeps_pre_),&
+         & 'Jacobi sweeps',1,is_legal_jac_sweeps)
+    call mld_check_def(p%precv(i)%iprcparm(mld_smoother_sweeps_post_),&
+         & 'Jacobi sweeps',1,is_legal_jac_sweeps)
+
+    !
+    !  Test version for beginning of OO stuff. 
+    ! 
+    if (allocated(p%precv(i)%sm)) then 
+      call p%precv(i)%sm%free(info)
+      if (info == psb_success_) deallocate(p%precv(i)%sm,stat=info)
+      if (info /= psb_success_) then 
+        call psb_errpush(psb_err_alloc_dealloc_,name,&
+             & a_err='One level preconditioner build.')
+        goto 9999
+      endif
+    end if
+    select case (p%precv(i)%prec%iprcparm(mld_smoother_type_)) 
+    case(mld_bjac_, mld_jac_) 
+      allocate(mld_z_jac_smoother_type :: p%precv(i)%sm, stat=info)
+    case(mld_as_)
+      allocate(mld_z_as_smoother_type  :: p%precv(i)%sm, stat=info)
+    case default
+      info = -1 
+    end select
+    if (info /= psb_success_) then 
+      write(0,*) ' Smoother allocation error',info,&
+           & p%precv(i)%prec%iprcparm(mld_smoother_type_)
+      call psb_errpush(psb_err_internal_error_,name,&
+           & a_err='One level preconditioner build.')
+      goto 9999
+    endif
+    call p%precv(i)%sm%set(mld_sub_restr_,p%precv(i)%prec%iprcparm(mld_sub_restr_),info)
+    call p%precv(i)%sm%set(mld_sub_prol_,p%precv(i)%prec%iprcparm(mld_sub_prol_),info)
+    call p%precv(i)%sm%set(mld_sub_ovr_,p%precv(i)%prec%iprcparm(mld_sub_ovr_),info)
+
+    select case (p%precv(i)%prec%iprcparm(mld_sub_solve_)) 
+    case(mld_ilu_n_,mld_milu_n_,mld_ilu_t_) 
+      allocate(mld_z_ilu_solver_type :: p%precv(i)%sm%sv, stat=info)
+      if (info == psb_success_) call  p%precv(i)%sm%sv%set(mld_sub_solve_,&
+           & p%precv(i)%prec%iprcparm(mld_sub_solve_),info)
+      if (info == psb_success_) call  p%precv(i)%sm%sv%set(mld_sub_fillin_,&
+           & p%precv(i)%prec%iprcparm(mld_sub_fillin_),info)
+      if (info == psb_success_) call  p%precv(i)%sm%sv%set(mld_sub_iluthrs_,&
+           & p%precv(i)%prec%rprcparm(mld_sub_iluthrs_),info)
+    case(mld_diag_scale_)
+      allocate(mld_z_diag_solver_type :: p%precv(i)%sm%sv, stat=info)
+    case default
+      info = -1 
+    end select
+
+    if (info /= psb_success_) then 
+      write(0,*) ' Solver allocation error',info,&
+           & p%precv(i)%prec%iprcparm(mld_sub_solve_)
+      call psb_errpush(psb_err_internal_error_,name,&
+           & a_err='One level preconditioner build.')
+      goto 9999
+    endif
 
-    call mld_baseprec_bld(p%precv(i)%base_a,p%precv(i)%base_desc,&
-         & p%precv(i)%prec,info)
+    call p%precv(i)%sm%build(p%precv(i)%base_a,p%precv(i)%base_desc,'F',info)
 
     if (info /= psb_success_) then 
-      call psb_errpush(psb_err_internal_error_,name,a_err='One level preconditioner build.')
+      call psb_errpush(psb_err_internal_error_,name,&
+           & a_err='One level preconditioner build.')
       goto 9999
     endif
 
@@ -336,19 +400,19 @@ contains
   subroutine init_baseprec_av(p,info)
     type(mld_zbaseprec_type), intent(inout) :: p
     integer                                :: info
-    if (allocated(p%av)) then
-      if (size(p%av) /= mld_max_avsz_) then 
-        deallocate(p%av,stat=info)
-        if (info /= psb_success_) return 
-      endif
-    end if
-    if (.not.(allocated(p%av))) then 
-      allocate(p%av(mld_max_avsz_),stat=info)
-      if (info /= psb_success_) return
-    end if
-    do k=1,size(p%av)
-      call psb_nullify_sp(p%av(k))
-    end do
+!!$    if (allocated(p%av)) then
+!!$      if (size(p%av) /= mld_max_avsz_) then 
+!!$        deallocate(p%av,stat=info)
+!!$        if (info /= psb_success_) return 
+!!$      endif
+!!$    end if
+!!$    if (.not.(allocated(p%av))) then 
+!!$      allocate(p%av(mld_max_avsz_),stat=info)
+!!$      if (info /= psb_success_) return
+!!$    end if
+!!$    do k=1,size(p%av)
+!!$      call psb_nullify_sp(p%av(k))
+!!$    end do
 
   end subroutine init_baseprec_av
 
@@ -360,6 +424,35 @@ contains
     !
     val = prec%iprcparm(mld_coarse_solve_)  
     select case (val) 
+    case(mld_jac_)   
+      
+      if (prec%prec%iprcparm(mld_sub_solve_) /= mld_diag_scale_) then 
+        if (me == 0) write(debug_unit,*)&
+             & 'Warning: inconsistent coarse level specification.'
+        if (me == 0) write(debug_unit,*)&
+             & '         Resetting according to the value specified for mld_coarse_solve_.'
+        prec%prec%iprcparm(mld_sub_solve_)    = mld_diag_scale_
+      end if
+      prec%prec%iprcparm(mld_smoother_type_)  = mld_jac_          
+      
+    case(mld_bjac_)   
+      
+      if ((prec%prec%iprcparm(mld_sub_solve_) == mld_diag_scale_).or.&
+           & ( prec%prec%iprcparm(mld_smoother_type_) /= mld_bjac_))  then 
+        if (me == 0) write(debug_unit,*)&
+             & 'Warning: inconsistent coarse level specification.'
+        if (me == 0) write(debug_unit,*)&
+             & '         Resetting according to the value specified for mld_coarse_solve_.'
+!!$#if defined(HAVE_UMF_)
+!!$        prec%prec%iprcparm(mld_sub_solve_)       = mld_umf_
+!!$#elif defined(HAVE_SLU_)
+!!$        prec%prec%iprcparm(mld_sub_solve_)       = mld_slu_
+!!$#else 
+        prec%prec%iprcparm(mld_sub_solve_)       = mld_ilu_n_
+!!$#endif
+      end if
+      prec%prec%iprcparm(mld_smoother_type_)  = mld_bjac_          
+      
     case(mld_umf_, mld_slu_)
       if ((prec%iprcparm(mld_coarse_mat_)  /= mld_repl_mat_).or.&
            & (prec%prec%iprcparm(mld_sub_solve_)  /= val)) then 

mlprec/mld_zslu_bld.f90

@@ -83,8 +83,8 @@ subroutine mld_zslu_bld(a,desc_a,p,info)
   integer, intent(out)                   :: info
 
   ! Local variables
-  integer                  :: nzt,ictxt,me,np,err_act
-  character(len=20)  :: name, ch_err
+  integer           :: ictxt,me,np,err_act
+  character(len=20) :: name, ch_err
 
   if(psb_get_errstatus().ne.0) return 
   info=psb_success_
@@ -94,25 +94,28 @@ subroutine mld_zslu_bld(a,desc_a,p,info)
   ictxt = psb_cd_get_context(desc_a)
 
   call psb_info(ictxt, me, np)
+  
 
-  if (psb_toupper(a%fida) /= 'CSR') then 
-    info=psb_err_unsupported_format_
-    call psb_errpush(info,name,a_err=a%fida)
-    goto 9999
-  endif
-
-  nzt = psb_sp_get_nnzeros(a)
   !
   ! Compute the LU factorization
   !
-  call mld_zslu_fact(a%m,nzt,&
-       & a%aspk,a%ia2,a%ia1,p%iprcparm(mld_slu_ptr_),info)
+  select type(aa=>a%a)
+  type is (psb_z_csr_sparse_mat) 
+    call mld_zslu_fact(aa%get_nrows(),aa%get_nzeros(),&
+       & aa%val,aa%ja,aa%irp,p%iprcparm(mld_slu_ptr_),info)
 
-  if (info /= psb_success_) then
-    ch_err='mld_slu_fact'
-    call psb_errpush(4110,name,a_err=ch_err,i_err=(/info,0,0,0,0/))
+    if (info /= psb_success_) then
+      ch_err='mld_slu_fact'
+      call psb_errpush(4110,name,a_err=ch_err,i_err=(/info,0,0,0,0/))
+      goto 9999
+    end if
+
+  class default 
+    info=psb_err_unsupported_format_
+    ch_err=a%get_fmt()
+    call psb_errpush(info,name,a_err=ch_err)
     goto 9999
-  end if
+  end select
 
   call psb_erractionrestore(err_act)
   return

mlprec/mld_zumf_bld.f90

@@ -89,9 +89,8 @@ subroutine mld_zumf_bld(a,desc_a,p,info)
   integer, intent(out)                    :: info
 
   ! Local variables
-  integer           :: nzt,ictxt,me,np,err_act
-  integer            :: i_err(5)
-  character(len=20)  :: name
+  integer            :: ictxt,me,np,err_act
+  character(len=20)  :: name, ch_err
 
   info=psb_success_
   name='mld_zumf_bld'
@@ -99,27 +98,26 @@ subroutine mld_zumf_bld(a,desc_a,p,info)
   ictxt = psb_cd_get_context(desc_a)
   call psb_info(ictxt, me, np)
 
-  if (psb_toupper(a%fida) /= 'CSC') then
-    info=psb_err_unsupported_format_
-    call psb_errpush(info,name,a_err=a%fida)
-    goto 9999
-  endif
-
-  nzt = psb_sp_get_nnzeros(a)
-
   !
   ! Compute the LU factorization
   !
-  call mld_zumf_fact(a%m,nzt,&
-       & a%aspk,a%ia1,a%ia2,&
-       & p%iprcparm(mld_umf_symptr_),p%iprcparm(mld_umf_numptr_),info)
-
-  if (info /= psb_success_) then
-    i_err(1) = info 
-    info=4110
-    call psb_errpush(info,name,a_err='mld_umf_fact',i_err=i_err)
+  select type(aa=>a%a)
+!!$  type is (psb_z_csc_sparse_mat)
+!!$    call mld_zumf_fact(aa%m,aa%get_nzeros(),&
+!!$         & aa%val,aa%ia,aa%icp,&
+!!$         & p%iprcparm(mld_umf_symptr_),p%iprcparm(mld_umf_numptr_),info)
+!!$    
+!!$    if (info /= psb_success_) then
+!!$      info=4110
+!!$      call psb_errpush(info,name,a_err='mld_umf_fact',i_err=(/info,0,0,0,0/))
+!!$      goto 9999
+!!$    end if
+  class default 
+    info=psb_err_unsupported_format_
+    ch_err = aa%get_fmt()
+    call psb_errpush(info,name,a_err=ch_err)
     goto 9999
-  end if
+  end select
 
   call psb_erractionrestore(err_act)
   return