mld2p4-299:

mlprec/impl/mld_daggrmat_asb.f90

@@ -259,7 +259,10 @@ subroutine mld_daggrmat_asb(a,desc_a,ilaggr,nlaggr,p,info)
   !  op_restr => PR^T   i.e. restriction  operator
   !  op_prol => PR     i.e. prolongation operator
   !  
-
+!!$  write(0,*) 'allocated DSC_AC ',allocated(p%desc_ac%v_halo_index%v),&
+!!$       & allocated(p%desc_ac%v_ext_index%v),&
+!!$       & allocated(p%desc_ac%v_ovrlap_index%v),&
+!!$       &allocated(p%desc_ac%v_ovr_mst_idx%v)
   p%map = psb_linmap(psb_map_aggr_,desc_a,&
        & p%desc_ac,op_restr,op_prol,ilaggr,nlaggr)
   if (info == psb_success_) call op_prol%free()

mlprec/impl/mld_dmlprec_aply.f90

@@ -362,7 +362,8 @@ subroutine mld_dmlprec_aply(alpha,p,x,beta,y,desc_data,trans,work,info)
   nr2l  = p%precv(level)%base_desc%get_local_rows()
   allocate(mlprec_wrk(level)%x2l(nc2l),mlprec_wrk(level)%y2l(nc2l),&
        & stat=info)
-  if (info /= psb_success_) then 
+  if (info /= psb_success_) then
+    write(0,*) 'Allocation Error at level ',0  
     info=psb_err_alloc_request_
     call psb_errpush(info,name,&
          & i_err=(/ione*(size(x)+size(y)),izero,izero,izero,izero/),&
@@ -446,6 +447,7 @@ contains
            & mlprec_wrk(level)%y2l(nc2l),&
            & stat=info)
       if (info /= psb_success_) then 
+        write(0,*) 'Allocation Error at level',level, nc2l
         info=psb_err_alloc_request_
         call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),&
              & a_err='real(psb_dpk_)')
@@ -522,7 +524,7 @@ contains
             call psb_map_X2Y(done,mlprec_wrk(level-1)%x2l,&
                  & dzero,mlprec_wrk(level)%x2l,&
                  & p%precv(level)%map,info,work=work)
-
+!!$            write(0,*) 'inner_ml map_x2y :',level,info
             if (info /= psb_success_) then
               call psb_errpush(psb_err_internal_error_,name,&
                    & a_err='Error during restriction')
@@ -534,14 +536,23 @@ contains
 
           if (level < nlev) then 
             call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) 
-            if (info /= psb_success_) goto 9999      
+            if (info /= psb_success_) then
+              call psb_errpush(psb_err_internal_error_,name,&
+                   & a_err='Error in recursive call')
+              goto 9999
+            end if
             !
             ! Apply the prolongator
             !  
             call psb_map_Y2X(done,mlprec_wrk(level+1)%y2l,&
                  & dzero,mlprec_wrk(level)%y2l,&
                  & p%precv(level+1)%map,info,work=work)
-            if (info /= psb_success_) goto 9999
+
+            if (info /= psb_success_) then
+              call psb_errpush(psb_err_internal_error_,name,&
+                   & a_err='Error during prolongation')
+              goto 9999
+            end if
             !
             ! Compute the residual
             !
@@ -926,6 +937,7 @@ subroutine mld_dmlprec_aply_vect(alpha,p,x,beta,y,desc_data,trans,work,info)
     if (psb_errstatus_fatal()) then 
       nc2l = p%precv(level)%base_desc%get_local_cols()
       info=psb_err_alloc_request_
+      write(0,*) 'Allocation Error at level ',0  
       call psb_errpush(info,name,i_err=(/2*nc2l,izero,izero,izero,izero/),&
            & a_err='real(psb_dpk_)')
       goto 9999      
@@ -1089,7 +1101,7 @@ contains
             call psb_map_X2Y(done,mlprec_wrk(level-1)%vx2l,&
                  & dzero,mlprec_wrk(level)%vx2l,&
                  & p%precv(level)%map,info,work=work)
-
+!!$            write(0,*) 'inner_ml map_x2y :',level,info
             if (info /= psb_success_) then
               call psb_errpush(psb_err_internal_error_,name,&
                    & a_err='Error during restriction')
@@ -1101,6 +1113,11 @@ contains
 
           if (level < nlev) then 
             call inner_ml_aply(level+1,p,mlprec_wrk,trans,work,info) 
+            if (info /= psb_success_) then
+              call psb_errpush(psb_err_internal_error_,name,&
+                   & a_err='Error in recursive call')
+              goto 9999
+            end if
             if (info /= psb_success_) goto 9999      
             !
             ! Apply the prolongator
@@ -1108,6 +1125,11 @@ contains
             call psb_map_Y2X(done,mlprec_wrk(level+1)%vy2l,&
                  & dzero,mlprec_wrk(level)%vy2l,&
                  & p%precv(level+1)%map,info,work=work)
+            if (info /= psb_success_) then
+              call psb_errpush(psb_err_internal_error_,name,&
+                   & a_err='Error during prolongation')
+              goto 9999
+            end if
             if (info /= psb_success_) goto 9999
             !
             ! Compute the residual

mlprec/impl/mld_dmlprec_bld.f90

@@ -175,7 +175,7 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold)
   endif
 
 
-
+!!$  write(0,*) 'DMLPRECBLD: CASIZE ',casize
   if (casize>0) then 
     ! 
     ! New strategy to build according to coarse size. 
@@ -291,6 +291,11 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold)
       current => newnode
       ! First do a move_alloc.
       ! This handles the AC, DESC_AC and MAP fields
+!!$      associate(this=>current%item%map)
+!!$        if (i>1) write(0,*) 'List realloc loop input:',i,&
+!!$             & allocated(this%p_desc_X%v_halo_index%v),&
+!!$             & allocated(this%p_desc_Y%v_halo_index%v)
+!!$      end associate
       if (info == psb_success_) &
            & call mld_move_alloc(current%item,p%precv(i),info)
       ! Now set the smoother/solver parts. 
@@ -320,6 +325,11 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold)
         p%precv(i)%map%p_desc_X => p%precv(i-1)%base_desc
         p%precv(i)%map%p_desc_Y => p%precv(i)%base_desc
       end if
+!!$      associate(this =>p%precv(i)%map) 
+!!$        if (i>1) write(0,*) 'List realloc loop output:',i,&
+!!$             & allocated(this%p_desc_X%v_halo_index%v),&
+!!$             & allocated(this%p_desc_Y%v_halo_index%v)
+!!$      end associate
 
       newnode => current%next
       deallocate(current) 
@@ -501,6 +511,14 @@ subroutine mld_dmlprec_bld(a,desc_a,p,info,amold,vmold)
     if (debug_level >= psb_debug_outer_) &
          & write(debug_unit,*) me,' ',trim(name),&
          & 'Return from ',i,' call to mlprcbld ',info      
+    
+!!$    associate(this =>p%precv(i)%map) 
+!!$      if (i>1) write(0,*) 'After sm build at level:',i,&
+!!$           & allocated(this%p_desc_X%v_halo_index%v),&
+!!$           & allocated(this%p_desc_Y%v_halo_index%v)
+!!$    end associate
+    
+
   end do
 
 

mlprec/impl/mld_dprecbld.f90

@@ -58,7 +58,7 @@
 !    info    -  integer, output.
 !               Error code.              
 !  
-subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold)
+subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold,imold)
 
   use psb_base_mod
   use mld_d_inner_mod
@@ -73,6 +73,7 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold)
   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
 !!$  character, intent(in), optional         :: upd
 
   ! Local Variables
@@ -164,22 +165,22 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold)
       call psb_errpush(psb_err_internal_error_,name,a_err='Base level precbuild.')
       goto 9999
     end if
-
+    
-      call p%precv(1)%check(info)
+    call p%precv(1)%check(info)
-      if (info /= psb_success_) then 
+    if (info /= psb_success_) then 
-        write(0,*) ' Smoother check error',info
+      write(0,*) ' Smoother check error',info
-        call psb_errpush(psb_err_internal_error_,name,&
+      call psb_errpush(psb_err_internal_error_,name,&
-             & a_err='One level preconditioner check.')
+           & a_err='One level preconditioner check.')
-        goto 9999
+      goto 9999
-      endif
+    endif
-
+    
-      call p%precv(1)%sm%build(a,desc_a,upd_,info,amold=amold,vmold=vmold)
+    call p%precv(1)%sm%build(a,desc_a,upd_,info,amold=amold,vmold=vmold)
-      if (info /= psb_success_) then 
+    if (info /= psb_success_) then 
-        call psb_errpush(psb_err_internal_error_,name,&
+      call psb_errpush(psb_err_internal_error_,name,&
-             & a_err='One level preconditioner build.')
+           & a_err='One level preconditioner build.')
-        goto 9999
+      goto 9999
-      endif
+    endif
-
+    
     !
     ! Number of levels > 1
     !
@@ -188,7 +189,7 @@ subroutine mld_dprecbld(a,desc_a,p,info,amold,vmold)
     ! Build the multilevel preconditioner
     ! 
     call  mld_mlprec_bld(a,desc_a,p,info,amold=amold,vmold=vmold)
-
+    
     if (info /= psb_success_) then 
       call psb_errpush(psb_err_internal_error_,name,&
            & a_err='Multilevel preconditioner build.')

mlprec/mld_base_prec_type.F90

@@ -65,7 +65,7 @@ module mld_base_prec_type
   !
   use psb_const_mod
   use psb_base_mod, only :&
-       & psb_desc_type,&
+       & psb_desc_type, psb_i_vect_type, psb_i_base_vect_type,&
        & psb_ipk_, psb_dpk_, psb_spk_, psb_long_int_k_,  &
        & psb_cdfree, psb_halo_, psb_none_, psb_sum_, psb_avg_, &
        & psb_nohalo_, psb_square_root_, psb_toupper, psb_root_,&

mlprec/mld_d_inner_mod.f90

@@ -48,8 +48,8 @@ module mld_d_inner_mod
   use mld_d_prec_type
 
   interface mld_mlprec_bld
-    subroutine mld_dmlprec_bld(a,desc_a,prec,info, amold, vmold)
+    subroutine mld_dmlprec_bld(a,desc_a,prec,info, amold, vmold,imold)
-      use psb_base_mod, only : psb_dspmat_type, psb_desc_type, &
+      use psb_base_mod, only : psb_dspmat_type, psb_desc_type, psb_i_base_vect_type, &
            & psb_dpk_, psb_d_base_sparse_mat, psb_d_base_vect_type, psb_ipk_
       use mld_d_prec_type, only : mld_dprec_type
       implicit none
@@ -59,6 +59,7 @@ module mld_d_inner_mod
       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
 !!$      character, intent(in),optional             :: upd
     end subroutine mld_dmlprec_bld
   end interface mld_mlprec_bld

mlprec/mld_d_prec_mod.f90

@@ -72,10 +72,10 @@ module mld_d_prec_mod
 !!$  interface mld_inner_precset
 
   interface mld_precbld
-    subroutine mld_dprecbld(a,desc_a,prec,info,amold,vmold)
+    subroutine mld_dprecbld(a,desc_a,prec,info,amold,vmold,imold)
       import :: psb_dspmat_type, psb_desc_type, psb_dpk_, &
            & psb_d_base_sparse_mat, psb_d_base_vect_type, &
-           & mld_dprec_type, psb_ipk_
+           & psb_i_base_vect_type, mld_dprec_type, psb_ipk_
       implicit none
       type(psb_dspmat_type), intent(in), target          :: a
       type(psb_desc_type), intent(inout), target           :: desc_a
@@ -83,6 +83,7 @@ module mld_d_prec_mod
       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
 !!$      character, intent(in),optional             :: upd
     end subroutine mld_dprecbld
   end interface