Fixed get_overlap, adding overlap status in descriptor.

src/modules/psb_const_mod.f90

@@ -59,13 +59,15 @@ module psb_const_mod
   integer, parameter :: psb_dec_type_=1, psb_m_=2,psb_n_=3
   integer, parameter :: psb_n_row_=4,  psb_n_col_=5,psb_ctxt_=6
   integer, parameter :: psb_loc_to_glob_=7
+  integer, parameter :: psb_ovl_state_=8 
+  integer, parameter :: psb_mpi_c_=9
   integer, parameter :: psb_thal_xch_=11
   integer, parameter :: psb_thal_snd_=12
   integer, parameter :: psb_thal_rcv_=13
   integer, parameter :: psb_tovr_xch_=14
   integer, parameter :: psb_tovr_snd_=15
   integer, parameter :: psb_tovr_rcv_=16
-  integer, parameter :: psb_mpi_c_=9,psb_mdata_size_=20
+  integer, parameter :: psb_mdata_size_=20
   integer, parameter :: psb_desc_asb_=3099
   integer, parameter :: psb_desc_bld_=psb_desc_asb_+1
   integer, parameter :: psb_desc_repl_=3199
@@ -73,6 +75,8 @@ module psb_const_mod
   integer, parameter :: psb_desc_upd_asb_=psb_desc_upd_+1
   integer, parameter :: psb_desc_large_asb_=psb_desc_upd_asb_+1
   integer, parameter :: psb_desc_large_bld_=psb_desc_large_asb_+1
+  integer, parameter :: psb_cd_ovl_bld_=psb_desc_large_bld_+1
+  integer, parameter :: psb_cd_ovl_asb_=psb_cd_ovl_bld_+1
   integer, parameter :: nbits=14
   integer, parameter :: hashsize=2**nbits, hashmask=hashsize-1
   integer, parameter :: psb_default_large_threshold=4*1024*1024   ! to be reviewed

src/modules/psb_desc_type.f90

@@ -136,6 +136,28 @@ contains
 
   end function psb_is_asb_desc
 
+  logical function psb_is_ovl_bld(desc)
+    type(psb_desc_type), intent(in) :: desc
+
+    psb_is_ovl_bld = (desc%matrix_data(psb_ovl_state_)==psb_cd_ovl_bld_)
+
+  end function psb_is_ovl_bld
+
+  logical function psb_is_ovl_asb(desc)
+    type(psb_desc_type), intent(in) :: desc
+
+    psb_is_ovl_asb = (desc%matrix_data(psb_ovl_state_)==psb_cd_ovl_asb_)
+
+  end function psb_is_ovl_asb
+
+  logical function psb_is_ovl_ok(desc)
+    type(psb_desc_type), intent(in) :: desc
+
+    psb_is_ovl_ok = (desc%matrix_data(psb_ovl_state_)==psb_cd_ovl_asb_).or.&
+         & (desc%matrix_data(psb_ovl_state_)==psb_cd_ovl_bld_)
+
+  end function psb_is_ovl_ok
+
 
   logical function psb_is_ok_dec(dectype)
     integer :: dectype
@@ -228,6 +250,11 @@ contains
   end function psb_is_large_dec
 
   subroutine psb_cd_set_bld(desc,info)
+    !
+    ! Change state of a descriptor into BUILD. 
+    ! If the descriptor is LARGE, check the  AVL search tree
+    ! and initialize it if necessary.
+    !
     use psb_const_mod
     use psb_error_mod
     use psb_penv_mod
@@ -243,7 +270,7 @@ contains
     if (psb_get_errstatus() /= 0) return 
     info = 0
     call psb_erractionsave(err_act)
-    name = 'psb_cdcpy'
+    name = 'psb_cd_set_bld'
 
     ictxt = psb_cd_get_context(desc)
 

src/modules/psi_mod.f90

@@ -430,6 +430,7 @@ contains
       call psb_errpush(4010,name,a_err='psi_crea_ovr_elem')
       goto 9999
     end if
+    cdesc%matrix_data(psb_ovl_state_)=psb_cd_ovl_asb_
 
     ! finally bnd_elem
     call psi_crea_bnd_elem(idx_out,cdesc,info)

src/tools/psb_cdall.f90

@@ -228,6 +228,7 @@ subroutine psb_cdall(m, n, parts, ictxt, desc_a, info)
       goto 9999
     endif
     loc_row = k 
+
   else
 
     desc_a%matrix_data(psb_dec_type_) = psb_desc_bld_
@@ -376,13 +377,15 @@ subroutine psb_cdall(m, n, parts, ictxt, desc_a, info)
 
   call psb_transfer(ov_idx,desc_a%ovrlap_index,info) 
   if (info == 0) call psb_transfer(ov_el,desc_a%ovrlap_elem,info)
-  deallocate(prc_v,temp_ovrlap,stat=info)
+  if (info == 0) deallocate(prc_v,temp_ovrlap,stat=info)
   if (info /= no_err) then 
     info=4000
     err=info
     call psb_errpush(err,name)
     Goto 9999
   endif
+  ! At this point overlap is OK.
+  desc_a%matrix_data(psb_ovl_state_) = psb_cd_ovl_asb_
 
   ! set fields in desc_a%MATRIX_DATA....
   desc_a%matrix_data(psb_n_row_)  = loc_row

src/tools/psb_cdalv.f90

@@ -325,12 +325,13 @@ subroutine psb_cdalv(m, v, ictxt, desc_a, info, flag)
 
   call psb_transfer(ov_idx,desc_a%ovrlap_index,info) 
   if (info == 0) call psb_transfer(ov_el,desc_a%ovrlap_elem,info)
-  deallocate(temp_ovrlap,stat=info)
+  if (info == 0) deallocate(temp_ovrlap,stat=info)
   if (info /= 0) then 
     info=4000
     call psb_errpush(info,name)
     goto 9999
   endif
+  desc_a%matrix_data(psb_ovl_state_) = psb_cd_ovl_asb_
 
   ! set fields in desc_a%MATRIX_DATA....
   desc_a%matrix_data(psb_n_row_)  = loc_row

src/tools/psb_cddec.f90

@@ -254,6 +254,8 @@ subroutine psb_cddec(nloc, ictxt, desc_a, info)
 
     desc_a%lprm(:)         = 0
 
+    desc_a%matrix_data(psb_ovl_state_) = psb_cd_ovl_bld_
+
     call psi_cnv_dsc(thalo,tovr,desc_a,info)
     if (info /= 0) then
       call psb_errpush(4010,name,a_err='psi_bld_cdesc')

src/tools/psb_dcdovr.f90

@@ -158,6 +158,7 @@ Subroutine psb_dcdovr(a,desc_a,novr,desc_ov,info)
   l_tmp_halo    = novr*(3*Size(desc_a%halo_index))
 
   call psb_cd_set_bld(desc_ov,info)
+  desc_ov%matrix_data(psb_ovl_state_)=psb_cd_ovl_bld_
 
   If(debug) then
     Write(0,*)'Start cdovrbld',me,lworks,lworkr

src/tools/psb_get_overlap.f90

@@ -11,9 +11,10 @@ subroutine psb_get_ovrlap(ovrel,desc,info)
   character(len=20)    :: name
 
   info = 0
-  name='psi_get_overlap'
+  name='psb_get_overlap'
   call psb_erractionsave(err_act)
 
+  if (psb_is_ovl_bld(desc)) then 
     i=0
     j=1
     do while(desc%ovrlap_elem(j) /= -1) 
@@ -21,9 +22,7 @@ subroutine psb_get_ovrlap(ovrel,desc,info)
       j  = j + 2
     enddo
 
-  if (i > 0) then 
-
-    allocate(ovrel(i),stat=info)
+    call psb_realloc(i,ovrel,info)
     if (info /= 0 ) then 
       info = 4000
       call psb_errpush(info,name)
@@ -39,17 +38,10 @@ subroutine psb_get_ovrlap(ovrel,desc,info)
     enddo
 
   else
-
-    if (allocated(ovrel)) then 
-      deallocate(ovrel,stat=info)
-      if (info /= 0) then 
-        call psb_errpush(4010,name,a_err='Deallocate')
+    info = 1122
+    call psb_errpush(info,name)
     goto 9999
   end if
-    end if
-
-  end if
-
   call psb_erractionrestore(err_act)
   return
 

src/tools/psb_zcdovr.f90

@@ -157,11 +157,8 @@ Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info)
   l_tmp_halo    = novr*(3*Size(desc_a%halo_index))
 
   call psb_cd_set_bld(desc_ov,info)
-!!$  if (psb_is_large_desc(desc_a)) then
-!!$    desc_ov%matrix_data(psb_dec_type_) = psb_desc_large_bld_ 
-!!$  else
-!!$    desc_ov%matrix_data(psb_dec_type_) = psb_desc_bld_ 
-!!$  end if
+  desc_ov%matrix_data(psb_ovl_state_)=psb_cd_ovl_bld_
+
   If(debug) then
     Write(0,*)'Start cdovrbld',me,lworks,lworkr
     call psb_barrier(ictxt)