From 7c40630b86b167891e607dee89f79b1f7c652103 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Thu, 24 May 2007 14:27:08 +0000 Subject: [PATCH] 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 | 5 ++++- base/tools/psb_cd_inloc.f90 | 12 ++++++------ base/tools/psb_cdals.f90 | 9 +++++---- base/tools/psb_cdalv.f90 | 9 +++++---- base/tools/psb_cdcpy.f90 | 13 +------------ base/tools/psb_cdrep.f90 | 2 +- base/tools/psb_cdtransfer.f90 | 14 -------------- 7 files changed, 22 insertions(+), 42 deletions(-) diff --git a/base/modules/psb_desc_type.f90 b/base/modules/psb_desc_type.f90 index a0f922db..35a83799 100644 --- a/base/modules/psb_desc_type.f90 +++ b/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 diff --git a/base/tools/psb_cd_inloc.f90 b/base/tools/psb_cd_inloc.f90 index d09c0447..9175062f 100644 --- a/base/tools/psb_cd_inloc.f90 +++ b/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 diff --git a/base/tools/psb_cdals.f90 b/base/tools/psb_cdals.f90 index 2c4974ac..2ed9cd4b 100644 --- a/base/tools/psb_cdals.f90 +++ b/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 diff --git a/base/tools/psb_cdalv.f90 b/base/tools/psb_cdalv.f90 index 64a823f8..ede161bd 100644 --- a/base/tools/psb_cdalv.f90 +++ b/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) diff --git a/base/tools/psb_cdcpy.f90 b/base/tools/psb_cdcpy.f90 index ad0b57ae..9b0efcb2 100644 --- a/base/tools/psb_cdcpy.f90 +++ b/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) - 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 + call ClonePairSearchTree(desc_in%ptree,desc_out%ptree) end if end if diff --git a/base/tools/psb_cdrep.f90 b/base/tools/psb_cdrep.f90 index c2525094..02b5bf68 100644 --- a/base/tools/psb_cdrep.f90 +++ b/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 diff --git a/base/tools/psb_cdtransfer.f90 b/base/tools/psb_cdtransfer.f90 index 056f6b82..dead1f7a 100644 --- a/base/tools/psb_cdtransfer.f90 +++ b/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)