Fixed bug in CDALL whereas SET_BLD using matrix_data(psb_ctxt_) was

called before the entry was set.

base/modules/psb_desc_type.f90

@@ -479,11 +479,13 @@ contains
 
     ictxt = psb_cd_get_context(desc)
 
+    if (debug) write(0,*)'Entered CDSETBLD',ictxt
     ! check on blacs grid 
     call psb_info(ictxt, me, np)
-    if (debug) write(0,*) me,'Entered CDCPY'
+    if (debug) write(0,*) me,'Entered CDSETBLD'
 
     if (psb_is_large_desc(desc)) then 
+      if (debug) write(0,*) me,'SET_BLD: alocating ptree'
       if (.not.allocated(desc%ptree)) then 
         allocate(desc%ptree(2),stat=info)
         if (info /= 0) then 
@@ -502,6 +504,7 @@ contains
     end if
     desc%matrix_data(psb_dec_type_) = psb_desc_bld_ 
 
+    if (debug) write(0,*) me,'SET_BLD: done'
     call psb_erractionrestore(err_act)
     return
 

base/tools/psb_cd_inloc.f90

@@ -177,6 +177,12 @@ subroutine psb_cd_inloc(v, ictxt, desc_a, info)
     goto 9999
   endif
 
+  desc_a%matrix_data(psb_m_)        = m
+  desc_a%matrix_data(psb_n_)        = n
+  ! This has to be set BEFORE any call to SET_BLD
+  desc_a%matrix_data(psb_ctxt_)     = ictxt
+  call psb_get_mpicomm(ictxt,desc_a%matrix_data(psb_mpi_c_))
+
 
   if (debug) write(*,*) 'PSB_CDALL:  starting main loop' ,info
   counter = 0
@@ -380,12 +386,6 @@ subroutine psb_cd_inloc(v, ictxt, desc_a, info)
   end if
   desc_a%ext_index(:) = -1
 
-  desc_a%matrix_data(psb_m_)        = m
-  desc_a%matrix_data(psb_n_)        = n
-  desc_a%matrix_data(psb_ctxt_)     = ictxt
-  call psb_get_mpicomm(ictxt,desc_a%matrix_data(psb_mpi_c_))
-
-
   call psb_erractionrestore(err_act)
   return
 

base/tools/psb_cdals.f90

@@ -134,6 +134,11 @@ subroutine psb_cdals(m, n, parts, ictxt, desc_a, info)
     call psb_errpush(err,name,int_err)
     goto 9999
   endif
+  desc_a%matrix_data(psb_m_)        = m
+  desc_a%matrix_data(psb_n_)        = n
+  ! This has to be set BEFORE any call to SET_BLD
+  desc_a%matrix_data(psb_ctxt_)     = ictxt
+  call psb_get_mpicomm(ictxt,desc_a%matrix_data(psb_mpi_c_))
 
 
   if (debug) write(*,*) 'PSB_CDALL:  starting main loop' ,info
@@ -408,10 +413,6 @@ subroutine psb_cdals(m, n, parts, ictxt, desc_a, info)
   end if
   desc_a%ext_index(:) = -1
 
-  desc_a%matrix_data(psb_m_)        = m
-  desc_a%matrix_data(psb_n_)        = n
-  desc_a%matrix_data(psb_ctxt_)     = ictxt
-  call psb_get_mpicomm(ictxt,desc_a%matrix_data(psb_mpi_c_))
 
   call psb_erractionrestore(err_act)
   return

base/tools/psb_cdalv.f90

@@ -147,6 +147,11 @@ subroutine psb_cdalv(v, ictxt, desc_a, info, flag)
     goto 9999
   endif
 
+  desc_a%matrix_data(psb_m_)        = m
+  desc_a%matrix_data(psb_n_)        = n
+  ! This has to be set BEFORE any call to SET_BLD
+  desc_a%matrix_data(psb_ctxt_)     = ictxt
+  call psb_get_mpicomm(ictxt,desc_a%matrix_data(psb_mpi_c_))
 
   if (debug) write(*,*) 'PSB_CDALL:  starting main loop' ,info
   counter = 0
@@ -352,10 +357,6 @@ subroutine psb_cdalv(v, ictxt, desc_a, info, flag)
   end if
   desc_a%ext_index(:) = -1
 
-  desc_a%matrix_data(psb_m_)        = m
-  desc_a%matrix_data(psb_n_)        = n
-  desc_a%matrix_data(psb_ctxt_)     = ictxt
-  call psb_get_mpicomm(ictxt,desc_a%matrix_data(psb_mpi_c_))
 
 
   call psb_erractionrestore(err_act)

base/tools/psb_cdcpy.f90

@@ -97,18 +97,7 @@ subroutine psb_cdcpy(desc_in, desc_out, info)
         info=4000
         goto 9999
       endif
-      if (.true.) then 
+      call ClonePairSearchTree(desc_in%ptree,desc_out%ptree)
-        call ClonePairSearchTree(desc_in%ptree,desc_out%ptree)
-      else
-        call InitPairSearchTree(desc_out%ptree,info)
-        do idx=1, psb_cd_get_local_cols(desc_out)
-          gidx = desc_out%loc_to_glob(idx)
-          call SearchInsKeyVal(desc_out%ptree,gidx,idx,lidx,info)        
-          if (lidx /= idx) then 
-            write(0,*) 'Warning from cdcpy: mismatch in PTREE ',idx,lidx
-          endif
-        enddo
-      end if
     end if
   end if
 

base/tools/psb_cdrep.f90

@@ -193,9 +193,9 @@ subroutine psb_cdrep(m, ictxt, desc_a, info)
   desc_a%matrix_data(psb_n_)        = n
   desc_a%matrix_data(psb_n_row_)    = m
   desc_a%matrix_data(psb_n_col_)    = n
-  desc_a%matrix_data(psb_dec_type_) = psb_desc_bld_
   desc_a%matrix_data(psb_ctxt_)     = ictxt
   call psb_get_mpicomm(ictxt,desc_a%matrix_data(psb_mpi_c_))
+  desc_a%matrix_data(psb_dec_type_) = psb_desc_bld_
 
   do i=1,m
     desc_a%glob_to_loc(i) = i

base/tools/psb_cdtransfer.f90

@@ -86,21 +86,7 @@ subroutine psb_cdtransfer(desc_in, desc_out, info)
   if (info == 0)  call psb_transfer( desc_in%idx_space   ,    desc_out%idx_space    , info)
   if (info == 0)  call psb_transfer( desc_in%hashv       ,    desc_out%hashv        , info)
   if (info == 0)  call psb_transfer( desc_in%glb_lc      ,    desc_out%glb_lc       , info)
-  ! Why doesn't transfer work below? Dunno..... 
   if (info == 0)  call psb_transfer( desc_in%ptree       ,    desc_out%ptree        , info)
-  if (.false.) then
-    if (info == 0) then 
-      if (allocated(desc_in%ptree)) then 
-        allocate(desc_out%ptree(2),stat=info)
-        if (info /= 0) then 
-          info=4000
-          goto 9999
-        endif
-        desc_out%ptree(1:2) = desc_in%ptree(1:2)
-        deallocate(desc_in%ptree,stat=info)
-      end if
-    end if
-  endif
   if (info /= 0) then
     info = 4010
     call psb_errpush(info,name)