diff --git a/base/internals/psi_crea_index.f90 b/base/internals/psi_crea_index.f90 index da3c05f3..56be421e 100644 --- a/base/internals/psi_crea_index.f90 +++ b/base/internals/psi_crea_index.f90 @@ -44,9 +44,6 @@ ! mapping parts are used. ! index_in(:) - integer The index list, build format ! index_out(:) - integer(psb_ipk_), allocatable The index list, assembled format -! glob_idx - logical Whether the input indices are in local or global -! numbering; the global numbering is used when -! converting the overlap exchange lists. ! nxch - integer The number of data exchanges on the calling process ! nsnd - integer Total send buffer size on the calling process ! nrcv - integer Total receive buffer size on the calling process diff --git a/base/internals/psi_desc_index.F90 b/base/internals/psi_desc_index.F90 index c3963db1..19073225 100644 --- a/base/internals/psi_desc_index.F90 +++ b/base/internals/psi_desc_index.F90 @@ -302,7 +302,6 @@ subroutine psi_i_desc_index(desc,index_in,dep_list,& desc_index(i) = nerv call desc%indxmap%g2l(sndbuf(bsdindx(proc+1)+1:bsdindx(proc+1)+nerv),& & desc_index(i+1:i+nerv),info) - i = i + nerv + 1 nesd = rvsz(proc+1) desc_index(i) = nesd diff --git a/base/modules/auxil/psb_hash_mod.F90 b/base/modules/auxil/psb_hash_mod.F90 index 48b808dd..4f107e70 100644 --- a/base/modules/auxil/psb_hash_mod.F90 +++ b/base/modules/auxil/psb_hash_mod.F90 @@ -96,11 +96,11 @@ module psb_hash_mod end interface hashval interface psb_hash_searchinskey - module procedure psb_hash_searchinskey + module procedure psb_hash_isearchinskey end interface psb_hash_searchinskey interface psb_hash_searchkey - module procedure psb_hash_searchkey + module procedure psb_hash_isearchkey end interface psb_hash_searchkey #endif @@ -372,7 +372,7 @@ contains type(psb_hash_type), intent(inout) :: hash integer(psb_ipk_), intent(out) :: info type(psb_hash_type) :: nhash - integer(psb_ipk_) :: key, val, nextval,i + integer(psb_lpk_) :: key, val, nextval,i info = HashOk @@ -457,7 +457,7 @@ contains end do end subroutine psb_hash_lsearchinskey - recursive subroutine psb_hash_searchinskey(key,val,nextval,hash,info) + recursive subroutine psb_hash_isearchinskey(key,val,nextval,hash,info) integer(psb_ipk_), intent(in) :: key,nextval type(psb_hash_type) :: hash integer(psb_ipk_), intent(out) :: val, info @@ -515,9 +515,9 @@ contains hk = hk - hd if (hk < 0) hk = hk + hsize end do - end subroutine psb_hash_searchinskey + end subroutine psb_hash_isearchinskey - subroutine psb_hash_searchkey(key,val,hash,info) + subroutine psb_hash_isearchkey(key,val,hash,info) integer(psb_ipk_), intent(in) :: key type(psb_hash_type) :: hash integer(psb_ipk_), intent(out) :: val, info @@ -554,7 +554,7 @@ contains hk = hk - hd if (hk < 0) hk = hk + hsize end do - end subroutine psb_hash_searchkey + end subroutine psb_hash_isearchkey subroutine psb_hash_lsearchkey(key,val,hash,info) integer(psb_lpk_), intent(in) :: key diff --git a/base/modules/desc/psb_gen_block_map_mod.f90 b/base/modules/desc/psb_gen_block_map_mod.f90 index 4b2f2ce6..cd5b8833 100644 --- a/base/modules/desc/psb_gen_block_map_mod.f90 +++ b/base/modules/desc/psb_gen_block_map_mod.f90 @@ -784,8 +784,8 @@ contains integer(psb_ipk_), intent(out) :: info logical, intent(in), optional :: mask(:) logical, intent(in), optional :: owned - integer(psb_ipk_) :: i, nv, is, ip, lip - integer(psb_lpk_) :: tidx + integer(psb_ipk_) :: i, nv, is + integer(psb_lpk_) :: tidx, ip, lip integer(psb_mpk_) :: ictxt, iam, np logical :: owned_ @@ -795,7 +795,7 @@ contains if (present(mask)) then if (size(mask) < size(idx)) then -!!$ write(0,*) 'Block g2l: size of mask', size(mask),size(idx) + !write(0,*) 'Block g2l: size of mask', size(mask),size(idx) info = -1 return end if @@ -812,7 +812,8 @@ contains if (idxmap%is_asb()) then do i=1, is if (mask(i)) then - if ((idxmap%min_glob_row <= idx(i)).and.(idx(i) <= idxmap%max_glob_row)) then + if ((idxmap%min_glob_row <= idx(i)).and. & + & (idx(i) <= idxmap%max_glob_row)) then idx(i) = idx(i) - idxmap%min_glob_row + 1 else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)& &.and.(.not.owned_)) then @@ -828,7 +829,8 @@ contains else if (idxmap%is_valid()) then do i=1,is if (mask(i)) then - if ((idxmap%min_glob_row <= idx(i)).and.(idx(i) <= idxmap%max_glob_row)) then + if ((idxmap%min_glob_row <= idx(i)).and.& + & (idx(i) <= idxmap%max_glob_row)) then idx(i) = idx(i) - idxmap%min_glob_row + 1 else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)& &.and.(.not.owned_)) then @@ -850,7 +852,8 @@ contains if (idxmap%is_asb()) then do i=1, is - if ((idxmap%min_glob_row <= idx(i)).and.(idx(i) <= idxmap%max_glob_row)) then + if ((idxmap%min_glob_row <= idx(i)).and.& + & (idx(i) <= idxmap%max_glob_row)) then idx(i) = idx(i) - idxmap%min_glob_row + 1 else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)& &.and.(.not.owned_)) then @@ -865,7 +868,8 @@ contains else if (idxmap%is_valid()) then do i=1,is - if ((idxmap%min_glob_row <= idx(i)).and.(idx(i) <= idxmap%max_glob_row)) then + if ((idxmap%min_glob_row <= idx(i)).and.& + & (idx(i) <= idxmap%max_glob_row)) then idx(i) = idx(i) - idxmap%min_glob_row + 1 else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)& &.and.(.not.owned_)) then @@ -877,7 +881,6 @@ contains end if end do else -!!$ write(0,*) 'Block status: invalid ',idxmap%get_state() idx(1:is) = -1 info = -1 end if @@ -897,8 +900,8 @@ contains logical, intent(in), optional :: mask(:) logical, intent(in), optional :: owned - integer(psb_ipk_) :: i, nv, is, ip, lip, im - integer(psb_lpk_) :: tidx + integer(psb_ipk_) :: i, nv, is, im + integer(psb_lpk_) :: tidx, ip, lip integer(psb_mpk_) :: ictxt, iam, np logical :: owned_ @@ -926,14 +929,16 @@ contains if (idxmap%is_asb()) then do i=1, im if (mask(i)) then - if ((idxmap%min_glob_row <= idxin(i)).and.(idxin(i) <= idxmap%max_glob_row)) then + if ((idxmap%min_glob_row <= idxin(i)).and.& + & (idxin(i) <= idxmap%max_glob_row)) then idxout(i) = idxin(i) - idxmap%min_glob_row + 1 else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)& &.and.(.not.owned_)) then nv = size(idxmap%srt_l2g,1) tidx = idxin(i) idxout(i) = psb_bsrch(tidx,nv,idxmap%srt_l2g(:,1)) - if (idxout(i) > 0) idxout(i) = idxmap%srt_l2g(idxout(i),2)+idxmap%local_rows + if (idxout(i) > 0) & + & idxout(i) = idxmap%srt_l2g(idxout(i),2)+idxmap%local_rows else idxout(i) = -1 end if @@ -942,7 +947,8 @@ contains else if (idxmap%is_valid()) then do i=1,im if (mask(i)) then - if ((idxmap%min_glob_row <= idxin(i)).and.(idxin(i) <= idxmap%max_glob_row)) then + if ((idxmap%min_glob_row <= idxin(i)).and.& + & (idxin(i) <= idxmap%max_glob_row)) then idxout(i) = idxin(i) - idxmap%min_glob_row + 1 else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)& &.and.(.not.owned_)) then @@ -964,14 +970,16 @@ contains if (idxmap%is_asb()) then do i=1, im - if ((idxmap%min_glob_row <= idxin(i)).and.(idxin(i) <= idxmap%max_glob_row)) then + if ((idxmap%min_glob_row <= idxin(i)).and.& + & (idxin(i) <= idxmap%max_glob_row)) then idxout(i) = idxin(i) - idxmap%min_glob_row + 1 else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)& &.and.(.not.owned_)) then nv = size(idxmap%srt_l2g,1) tidx = idxin(i) idxout(i) = psb_bsrch(tidx,nv,idxmap%srt_l2g(:,1)) - if (idxout(i) > 0) idxout(i) = idxmap%srt_l2g(idxout(i),2)+idxmap%local_rows + if (idxout(i) > 0) & + & idxout(i) = idxmap%srt_l2g(idxout(i),2)+idxmap%local_rows else idxout(i) = -1 end if @@ -979,7 +987,8 @@ contains else if (idxmap%is_valid()) then do i=1,im - if ((idxmap%min_glob_row <= idxin(i)).and.(idxin(i) <= idxmap%max_glob_row)) then + if ((idxmap%min_glob_row <= idxin(i)).and.& + & (idxin(i) <= idxmap%max_glob_row)) then idxout(i) = idxin(i) - idxmap%min_glob_row + 1 else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)& &.and.(.not.owned_)) then @@ -1532,7 +1541,8 @@ contains do i=1, is if (mask(i)) then - if ((idxmap%min_glob_row <= idx(i)).and.(idx(i) <= idxmap%max_glob_row)) then + if ((idxmap%min_glob_row <= idx(i)).and.& + & (idx(i) <= idxmap%max_glob_row)) then idx(i) = idx(i) - idxmap%min_glob_row + 1 else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then @@ -1572,7 +1582,8 @@ contains do i=1, is - if ((idxmap%min_glob_row <= idx(i)).and.(idx(i) <= idxmap%max_glob_row)) then + if ((idxmap%min_glob_row <= idx(i)).and.& + & (idx(i) <= idxmap%max_glob_row)) then idx(i) = idx(i) - idxmap%min_glob_row + 1 else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then if (lidx(i) <= idxmap%local_rows) then @@ -1612,7 +1623,8 @@ contains if (present(mask)) then do i=1, is if (mask(i)) then - if ((idxmap%min_glob_row <= idx(i)).and.(idx(i) <= idxmap%max_glob_row)) then + if ((idxmap%min_glob_row <= idx(i)).and.& + & (idx(i) <= idxmap%max_glob_row)) then idx(i) = idx(i) - idxmap%min_glob_row + 1 else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then nv = idxmap%local_cols-idxmap%local_rows @@ -1648,7 +1660,8 @@ contains do i=1, is - if ((idxmap%min_glob_row <= idx(i)).and.(idx(i) <= idxmap%max_glob_row)) then + if ((idxmap%min_glob_row <= idx(i)).and.& + & (idx(i) <= idxmap%max_glob_row)) then idx(i) = idx(i) - idxmap%min_glob_row + 1 else if ((1<= idx(i)).and.(idx(i) <= idxmap%global_rows)) then nv = idxmap%local_cols-idxmap%local_rows @@ -1705,7 +1718,7 @@ contains info = 0 - + is = size(idxin) im = min(is,size(idxout)) @@ -1734,7 +1747,8 @@ contains do i=1, im if (mask(i)) then - if ((idxmap%min_glob_row <= idxin(i)).and.(idxin(i) <= idxmap%max_glob_row)) then + if ((idxmap%min_glob_row <= idxin(i)).and.& + & (idxin(i) <= idxmap%max_glob_row)) then idxout(i) = idxin(i) - idxmap%min_glob_row + 1 else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then @@ -1774,7 +1788,8 @@ contains do i=1, im - if ((idxmap%min_glob_row <= idxin(i)).and.(idxin(i) <= idxmap%max_glob_row)) then + if ((idxmap%min_glob_row <= idxin(i)).and.& + & (idxin(i) <= idxmap%max_glob_row)) then idxout(i) = idxin(i) - idxmap%min_glob_row + 1 else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then if (lidx(i) <= idxmap%local_rows) then @@ -1814,7 +1829,8 @@ contains if (present(mask)) then do i=1, im if (mask(i)) then - if ((idxmap%min_glob_row <= idxin(i)).and.(idxin(i) <= idxmap%max_glob_row)) then + if ((idxmap%min_glob_row <= idxin(i)).and.& + & (idxin(i) <= idxmap%max_glob_row)) then idxout(i) = idxin(i) - idxmap%min_glob_row + 1 else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then nv = idxmap%local_cols-idxmap%local_rows @@ -1850,7 +1866,8 @@ contains do i=1, im - if ((idxmap%min_glob_row <= idxin(i)).and.(idxin(i) <= idxmap%max_glob_row)) then + if ((idxmap%min_glob_row <= idxin(i)).and.& + & (idxin(i) <= idxmap%max_glob_row)) then idxout(i) = idxin(i) - idxmap%min_glob_row + 1 else if ((1<= idxin(i)).and.(idxin(i) <= idxmap%global_rows)) then nv = idxmap%local_cols-idxmap%local_rows @@ -1889,7 +1906,6 @@ contains end if if (is > im) then -!!$ write(0,*) 'g2lv2_ins err -3' info = -3 end if @@ -1910,7 +1926,6 @@ contains nv = size(idx) allocate(iprc(nv),stat=info) if (info /= 0) then -!!$ write(0,*) 'Memory allocation failure in repl_map_fnd-owner' return end if do i=1, nv @@ -1993,9 +2008,9 @@ contains class(psb_gen_block_map), intent(inout) :: idxmap integer(psb_ipk_), intent(out) :: info - integer(psb_ipk_) :: nhal + integer(psb_ipk_) :: nhal, i integer(psb_mpk_) :: ictxt, iam, np - + logical :: debug=.false. info = 0 ictxt = idxmap%get_ctxt() call psb_info(ictxt,iam,np) @@ -2008,7 +2023,12 @@ contains call psb_msort(idxmap%srt_l2g(:,1),& & ix=idxmap%srt_l2g(:,2),dir=psb_sort_up_) - + if (debug) then + do i=1, nhal + write(0,*) iam,' block_l2g:',idxmap%srt_l2g(i,1:2) + end do + end if + call psb_free(idxmap%hash,info) call idxmap%set_state(psb_desc_asb_) end subroutine block_asb diff --git a/base/tools/psb_cd_inloc.f90 b/base/tools/psb_cd_inloc.f90 index 01d76be8..d8fcf970 100644 --- a/base/tools/psb_cd_inloc.f90 +++ b/base/tools/psb_cd_inloc.f90 @@ -69,7 +69,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) integer(psb_ipk_) :: debug_level, debug_unit integer(psb_mpk_) :: iictxt real(psb_dpk_) :: t0, t1, t2, t3, t4, t5 - logical :: do_timings=.true. + logical :: do_timings=.false. logical :: check_, islarge character(len=20) :: name @@ -143,7 +143,6 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) & write(debug_unit,*) me,' ',trim(name),': doing global checks' islarge = psb_cd_is_large_size(m) - write(0,*) exch(3),m,islarge,check_ allocate(vl(loc_row),ix(loc_row),stat=info) if (info /= psb_success_) then @@ -161,7 +160,6 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) ! if (check_.or.(.not.islarge)) then - write(0,*) 'Doing globalchecks ' allocate(tmpgidx(m,2),stat=info) if (info /= psb_success_) then info=psb_err_alloc_dealloc_ @@ -206,7 +204,6 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) end if else - write(0,*) 'No globalchecks ' novrl = 0 norphan = 0 npr_ov = 0 diff --git a/test/pargen/runs/ppde.inp b/test/pargen/runs/ppde.inp index eb7a35ee..6aa0b3da 100644 --- a/test/pargen/runs/ppde.inp +++ b/test/pargen/runs/ppde.inp @@ -2,8 +2,8 @@ BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES FCG CGR BJAC Preconditioner NONE DIAG BJAC CSR Storage format for matrix A: CSR COO -004 Domain size (acutal system is this**3 (pde3d) or **2 (pde2d) ) -1 Partition: 1 BLOCK 3 3D +040 Domain size (acutal system is this**3 (pde3d) or **2 (pde2d) ) +3 Partition: 1 BLOCK 3 3D 2 Stopping criterion 1 2 1000 MAXIT -1 ITRACE