diff --git a/base/internals/psi_bld_tmphalo.f90 b/base/internals/psi_bld_tmphalo.f90 index 1842f92e..3fa0f52f 100644 --- a/base/internals/psi_bld_tmphalo.f90 +++ b/base/internals/psi_bld_tmphalo.f90 @@ -100,8 +100,8 @@ subroutine psi_bld_tmphalo(desc,info) helem(i) = n_row+i ! desc%loc_to_glob(n_row+i) end do - call desc%indxmap%l2gip(helem(1:nh),info) - call desc%indxmap%fnd_owner(helem(1:nh),hproc,info) + call desc%l2gip(helem(1:nh),info) + call desc%fnd_owner(helem(1:nh),hproc,info) if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='fnd_owner') diff --git a/base/internals/psi_crea_index.f90 b/base/internals/psi_crea_index.f90 index a9746e03..3c1a5c7b 100644 --- a/base/internals/psi_crea_index.f90 +++ b/base/internals/psi_crea_index.f90 @@ -81,7 +81,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,nxch,nsnd,nrcv,info debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc_a%indxmap%get_ctxt() + ictxt = desc_a%get_ctxt() call psb_info(ictxt,me,np) if (np == -1) then @@ -107,8 +107,8 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,nxch,nsnd,nrcv,info & write(debug_unit,*) me,' ',trim(name),': calling extract_dep_list' mode = 1 - call psi_extract_dep_list(desc_a%indxmap%get_ctxt(),& - & desc_a%indxmap%is_bld(), desc_a%indxmap%is_upd(),& + call psi_extract_dep_list(ictxt,& + & desc_a%is_bld(), desc_a%is_upd(),& & index_in, dep_list,length_dl,np,max(1,dl_lda),mode,info) if (info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='extrct_dl') diff --git a/base/internals/psi_desc_index.F90 b/base/internals/psi_desc_index.F90 index a3a91cc7..1549ccea 100644 --- a/base/internals/psi_desc_index.F90 +++ b/base/internals/psi_desc_index.F90 @@ -145,8 +145,8 @@ subroutine psi_desc_index(desc,index_in,dep_list,& debug_unit = psb_get_debug_unit() debug_level = psb_get_debug_level() - ictxt = desc%indxmap%get_ctxt() - icomm = desc%indxmap%get_mpic() + ictxt = desc%get_context() + icomm = desc%get_mpic() call psb_info(ictxt,me,np) if (np == -1) then info = psb_err_context_error_ @@ -261,7 +261,7 @@ subroutine psi_desc_index(desc,index_in,dep_list,& end do else - call desc%indxmap%l2g(index_in(i+1:i+nerv),& + call desc%l2g(index_in(i+1:i+nerv),& & sndbuf(bsdindx(proc+1)+1:bsdindx(proc+1)+nerv),& & info) @@ -310,13 +310,13 @@ subroutine psi_desc_index(desc,index_in,dep_list,& i = i + 1 nerv = sdsz(proc+1) desc_index(i) = nerv - call desc%indxmap%g2l(sndbuf(bsdindx(proc+1)+1:bsdindx(proc+1)+nerv),& + call desc%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 - call desc%indxmap%g2l(rcvbuf(brvindx(proc+1)+1:brvindx(proc+1)+nesd),& + call desc%g2l(rcvbuf(brvindx(proc+1)+1:brvindx(proc+1)+nesd),& & desc_index(i+1:i+nesd),info) i = i + nesd + 1 end do diff --git a/base/internals/psi_fnd_owner.F90 b/base/internals/psi_fnd_owner.F90 index a133650e..b477e4c6 100644 --- a/base/internals/psi_fnd_owner.F90 +++ b/base/internals/psi_fnd_owner.F90 @@ -109,10 +109,10 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info) goto 9999 end if - call desc%indxmap%fnd_owner(idx(1:nv),iprc,info) + call desc%fnd_owner(idx(1:nv),iprc,info) if (info /= psb_success_) then - call psb_errpush(psb_err_from_subroutine_,name,a_err='indxmap%fnd_owner') + call psb_errpush(psb_err_from_subroutine_,name,a_err='desc%fnd_owner') goto 9999 end if call psb_erractionrestore(err_act) diff --git a/base/modules/psb_desc_mod.F90 b/base/modules/psb_desc_mod.F90 index de8020ef..c9cfb1e9 100644 --- a/base/modules/psb_desc_mod.F90 +++ b/base/modules/psb_desc_mod.F90 @@ -219,7 +219,8 @@ module psb_desc_mod procedure, pass(desc) :: is_repl => psb_is_repl_desc procedure, pass(desc) :: get_mpic => psb_cd_get_mpic procedure, pass(desc) :: get_dectype => psb_cd_get_dectype - procedure, pass(desc) :: get_context => psb_cd_get_context + procedure, pass(desc) :: get_context => psb_cd_get_context + procedure, pass(desc) :: get_ctxt => psb_cd_get_context procedure, pass(desc) :: get_local_rows => psb_cd_get_local_rows procedure, pass(desc) :: get_local_cols => psb_cd_get_local_cols procedure, pass(desc) :: get_global_rows => psb_cd_get_global_rows @@ -232,6 +233,7 @@ module psb_desc_mod procedure, pass(desc) :: nullify => nullify_desc procedure, pass(desc) :: get_fmt => cd_get_fmt + procedure, pass(desc) :: fnd_owner => cd_fnd_owner procedure, pass(desc) :: l2gs1 => cd_l2gs1 procedure, pass(desc) :: l2gs2 => cd_l2gs2 procedure, pass(desc) :: l2gv1 => cd_l2gv1 @@ -282,7 +284,7 @@ module psb_desc_mod private :: nullify_desc, cd_get_fmt,& & cd_l2gs1, cd_l2gs2, cd_l2gv1, cd_l2gv2, cd_g2ls1,& & cd_g2ls2, cd_g2lv1, cd_g2lv2, cd_g2ls1_ins,& - & cd_g2ls2_ins, cd_g2lv1_ins, cd_g2lv2_ins + & cd_g2ls2_ins, cd_g2lv1_ins, cd_g2lv2_ins, cd_fnd_owner integer(psb_ipk_), private, save :: cd_large_threshold=psb_default_large_threshold @@ -1434,4 +1436,44 @@ contains end subroutine cd_g2lv2_ins + + subroutine cd_fnd_owner(idx,iprc,desc,info) + use psb_error_mod + implicit none + integer(psb_ipk_), intent(in) :: idx(:) + integer(psb_ipk_), allocatable, intent(out) :: iprc(:) + class(psb_desc_type), intent(in) :: desc + integer(psb_ipk_), intent(out) :: info + integer(psb_ipk_) :: err_act + character(len=20) :: name='cd_fnd_owner' + logical, parameter :: debug=.false. + + + info = psb_success_ + call psb_erractionsave(err_act) + + if (allocated(desc%indxmap)) then + call desc%indxmap%fnd_owner(idx,iprc,info) + else + info = psb_err_invalid_cd_state_ + end if + if (info /= psb_success_) then + call psb_errpush(info,name) + goto 9999 + end if + + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act == psb_act_abort_) then + call psb_error() + return + end if + Return + + end subroutine cd_fnd_owner + + end module psb_desc_mod diff --git a/base/modules/psb_indx_map_mod.f90 b/base/modules/psb_indx_map_mod.f90 index ebebba42..be3553b0 100644 --- a/base/modules/psb_indx_map_mod.f90 +++ b/base/modules/psb_indx_map_mod.f90 @@ -75,7 +75,7 @@ module psb_indx_map_mod !! !! 1. Each global index I is owned by at least one process; !! - !! 2. On each process, indices from 1 to N_ROW (desc%indxmap%get_lr()) + !! 2. On each process, indices from 1 to N_ROW (desc%get_local_rows()) !! are locally owned; the value of N_ROW can be determined upon allocation !! based on the index distribution (see also the interface to CDALL). !! diff --git a/base/serial/impl/psb_d_coo_impl.f90 b/base/serial/impl/psb_d_coo_impl.f90 index 819c6c95..9a1e26c3 100644 --- a/base/serial/impl/psb_d_coo_impl.f90 +++ b/base/serial/impl/psb_d_coo_impl.f90 @@ -2725,7 +2725,7 @@ contains subroutine d_coo_srch_upd(nz,ia,ja,val,a,& & imin,imax,jmin,jmax,info,gtl) - + use psb_const_mod use psb_realloc_mod use psb_string_mod @@ -3412,6 +3412,7 @@ subroutine psb_d_fix_coo_inner(nzin,dupl,ia,ja,val,nzout,info,idir) use psb_d_base_mat_mod, psb_protect_name => psb_d_fix_coo_inner use psb_string_mod use psb_ip_reord_mod + use psb_sort_mod implicit none integer(psb_ipk_), intent(in) :: nzin, dupl @@ -3422,10 +3423,12 @@ subroutine psb_d_fix_coo_inner(nzin,dupl,ia,ja,val,nzout,info,idir) !locals integer(psb_ipk_), allocatable :: iaux(:) integer(psb_ipk_) :: nza, nzl,iret,idir_, dupl_ - integer(psb_ipk_) :: i,j, irw, icl, err_act + integer(psb_ipk_) :: i,j, irw, icl, err_act, ixp,ki,kx integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: ierr(5) character(len=20) :: name = 'psb_fixcoo' + real(psb_dpk_), allocatable :: vtx(:) + integer(psb_ipk_), allocatable :: itx(:), jtx(:) info = psb_success_ @@ -3455,86 +3458,398 @@ subroutine psb_d_fix_coo_inner(nzin,dupl,ia,ja,val,nzout,info,idir) case(0) ! Row major order - call msort_up(nzin,ia(1:),iaux(1:),iret) - if (iret == 0) & - & call psb_ip_reord(nzin,val,ia,ja,iaux) - i = 1 - j = i - do while (i <= nzin) - do while ((ia(j) == ia(i))) - j = j+1 - if (j > nzin) exit + if (.false.) then + + call msort_up(nzin,ia(1:),iaux(1:),iret) + if (iret == 0) & + & call psb_ip_reord(nzin,val,ia,ja,iaux) + i = 1 + j = i + do while (i <= nzin) + do while ((ia(j) == ia(i))) + j = j+1 + if (j > nzin) exit + enddo + nzl = j - i + call msort_up(nzl,ja(i:),iaux(1:),iret) + if (iret == 0) & + & call psb_ip_reord(nzl,val(i:i+nzl-1),& + & ja(i:i+nzl-1),iaux) + i = j enddo - nzl = j - i - call msort_up(nzl,ja(i:),iaux(1:),iret) + + i = 1 + irw = ia(i) + icl = ja(i) + j = 1 + + select case(dupl_) + case(psb_dupl_ovwrt_) + + do + j = j + 1 + if (j > nzin) exit + if ((ia(j) == irw).and.(ja(j) == icl)) then + val(i) = val(j) + else + i = i+1 + val(i) = val(j) + ia(i) = ia(j) + ja(i) = ja(j) + irw = ia(i) + icl = ja(i) + endif + enddo + + case(psb_dupl_add_) + + do + j = j + 1 + if (j > nzin) exit + if ((ia(j) == irw).and.(ja(j) == icl)) then + val(i) = val(i) + val(j) + else + i = i+1 + val(i) = val(j) + ia(i) = ia(j) + ja(i) = ja(j) + irw = ia(i) + icl = ja(i) + endif + enddo + + case(psb_dupl_err_) + do + j = j + 1 + if (j > nzin) exit + if ((ia(j) == irw).and.(ja(j) == icl)) then + call psb_errpush(psb_err_duplicate_coo,name) + goto 9999 + else + i = i+1 + val(i) = val(j) + ia(i) = ia(j) + ja(i) = ja(j) + irw = ia(i) + icl = ja(i) + endif + enddo + case default + write(psb_err_unit,*) 'Error in fix_coo: unsafe dupl',dupl_ + info =-7 + end select + +!!$ write(0,*) 'End of fix_coo ia',ia(1:i) +!!$ write(0,*) 'End of fix_coo ja',ja(1:i) + + else if (.true.) then + + call msort_up(nzin,ia(1:),iaux(1:),iret) if (iret == 0) & - & call psb_ip_reord(nzl,val(i:i+nzl-1),& - & ia(i:i+nzl-1),ja(i:i+nzl-1),iaux) - i = j - enddo + & call psb_ip_reord(nzin,val,ia,ja,iaux) - i = 1 - irw = ia(i) - icl = ja(i) - j = 1 + i = 1 + j = 1 + ki = 0 + select case(dupl_) + case(psb_dupl_ovwrt_) + + do while (i <= nzin) + do while ((ia(j) == ia(i))) + j = j+1 + if (j > nzin) exit + enddo + nzl = j - i + call msort_up(nzl,ja(i:),iaux(1:),iret) + if (iret == 0) & + & call psb_ip_reord(nzl,val(i:i+nzl-1),& + & ja(i:i+nzl-1),iaux) + kx = 0 + ki = ki + 1 + val(ki) = val(i+kx) + ia(ki) = ia(i+kx) + ja(ki) = ja(i+kx) + irw = ia(ki) + icl = ja(ki) + + do kx = 1,nzl-1 + if (ja(i+kx) == icl) then + val(ki) = val(i+kx) + else + ki = ki+1 + val(ki) = val(i+kx) + ja(ki) = ja(i+kx) + ia(ki) = irw + icl = ja(ki) + endif + enddo - select case(dupl_) - case(psb_dupl_ovwrt_) + i = j + enddo - do - j = j + 1 - if (j > nzin) exit - if ((ia(j) == irw).and.(ja(j) == icl)) then - val(i) = val(j) - else - i = i+1 - val(i) = val(j) - ia(i) = ia(j) - ja(i) = ja(j) - irw = ia(i) - icl = ja(i) - endif - enddo + case(psb_dupl_add_) - case(psb_dupl_add_) - do - j = j + 1 - if (j > nzin) exit - if ((ia(j) == irw).and.(ja(j) == icl)) then - val(i) = val(i) + val(j) - else - i = i+1 - val(i) = val(j) - ia(i) = ia(j) - ja(i) = ja(j) - irw = ia(i) - icl = ja(i) - endif - enddo + do while (i <= nzin) + do while ((ia(j) == ia(i))) + j = j+1 + if (j > nzin) exit + enddo + nzl = j - i + call msort_up(nzl,ja(i:),iaux(1:),iret) + if (iret == 0) & + & call psb_ip_reord(nzl,val(i:i+nzl-1),& + & ja(i:i+nzl-1),iaux) + kx = 0 + ki = ki + 1 + val(ki) = val(i+kx) + ia(ki) = ia(i+kx) + ja(ki) = ja(i+kx) + irw = ia(ki) + icl = ja(ki) + do kx = 1,nzl-1 + if (ja(i+kx) == icl) then + val(ki) = val(ki) + val(i+kx) + else + ki = ki+1 + val(ki) = val(i+kx) + ja(ki) = ja(i+kx) + ia(ki) = irw + icl = ja(ki) +!!$ write(0,*) 'ki icl kx',ki,icl,kx,' ja',ja(ki) + endif - case(psb_dupl_err_) - do - j = j + 1 - if (j > nzin) exit - if ((ia(j) == irw).and.(ja(j) == icl)) then - call psb_errpush(psb_err_duplicate_coo,name) - goto 9999 - else - i = i+1 - val(i) = val(j) - ia(i) = ia(j) - ja(i) = ja(j) - irw = ia(i) - icl = ja(i) - endif - enddo - case default - write(psb_err_unit,*) 'Error in fix_coo: unsafe dupl',dupl_ - info =-7 - end select + enddo + i = j + enddo + + case(psb_dupl_err_) + + + do while (i <= nzin) + do while ((ia(j) == ia(i))) + j = j+1 + if (j > nzin) exit + enddo + nzl = j - i + + if (.false.) then + call msort_up(nzl,ja(i:),iaux(1:),iret) + if (iret == 0) & + & call psb_ip_reord(nzl,val(i:i+nzl-1),& + & ja(i:i+nzl-1),iaux) + kx = 0 + ki = ki + 1 + val(ki) = val(i+kx) + ia(ki) = ia(i+kx) + ja(ki) = ja(i+kx) + irw = ia(ki) + icl = ja(ki) + do kx = 1,nzl-1 + if (ja(i+kx) == icl) then + call psb_errpush(psb_err_duplicate_coo,name) + goto 9999 + else + ki = ki+1 + val(ki) = val(i+kx) + ja(ki) = ja(i+kx) + ia(ki) = irw + icl = ja(ki) + endif + + enddo + + else + + call psb_msort(ja(i:i+nzl-1),ix=iaux,dir=psb_sort_up_) + kx = 0 + ki = ki + 1 + val(ki) = val(i+iaux(1+kx)-1) + ia(ki) = ia(i+kx) + ja(ki) = ja(i+kx) + irw = ia(ki) + icl = ja(ki) + do kx = 1,nzl-1 + if (ja(i+kx) == icl) then + call psb_errpush(psb_err_duplicate_coo,name) + goto 9999 + else + ki = ki+1 + val(ki) = val(i+iaux(1+kx)-1) + ja(ki) = ja(i+kx) + ia(ki) = irw + icl = ja(ki) + endif + + enddo + end if + + i = j + enddo + + case default + write(psb_err_unit,*) 'Error in fix_coo: unsafe dupl',dupl_ + info =-7 + end select + + i = ki + else if (.false.) then + + + allocate(itx(nzin),jtx(nzin),vtx(nzin),stat=info) + if (info /= psb_success_) return + call psb_msort(ia(1:nzin),ix=iaux,dir=psb_sort_up_) + do i=1, nzin + ixp = iaux(i) + vtx(i) = val(ixp) + itx(i) = ia(i) + jtx(i) = ja(ixp) + end do +!!$ call psb_msort(itx(1:nzin),ix=iaux,dir=psb_sort_up_) +!!$ do i=1, nzin +!!$ ixp = iaux(i) +!!$ val(i) = vtx(ixp) +!!$ ia(i) = itx(i) +!!$ ja(i) = jtx(ixp) +!!$ end do +!!$ + i = 1 + j = i + ki = 1 + do while (i <= nzin) + do while ((itx(j) == itx(i))) + j = j+1 + if (j > nzin) exit + enddo + nzl = j - i + call msort_up(nzl,jtx(i:),iaux(1:),iret) + if (iret == 0) & + & call psb_ip_reord(nzl,vtx(i:i+nzl-1),& + & jtx(i:i+nzl-1),iaux) + + ia(ki:ki+nzl-1) = itx(i:i+nzl-1) + val(ki) = vtx(i) + ja(ki) = jtx(i) + icl = jtx(i) + kx = 0 + select case(dupl_) + case(psb_dupl_ovwrt_) + do + kx = kx + 1 + if (kx >= nzl) exit + if (jtx(i+kx) == icl) then + val(ki) = vtx(i+kx) + else + ki = ki+1 + val(ki) = vtx(i+kx) + ja(ki) = ja(i+kx) + icl = ja(i+kx) + endif + enddo + + case(psb_dupl_add_) + + do + kx = kx + 1 + if (kx >= nzl) exit + if (jtx(i+kx) == icl) then + val(ki) = val(ki) + vtx(i+kx) + else + ki = ki+1 + val(ki) = vtx(i+kx) + ja(ki) = ja(i+kx) + icl = ja(i+kx) + endif + enddo + + case(psb_dupl_err_) + do + kx = kx + 1 + if (kx >= nzl) exit + if (jtx(i+kx) == icl) then + call psb_errpush(psb_err_duplicate_coo,name) + goto 9999 + else + ki = ki+1 + val(ki) = vtx(i+kx) + ja(ki) = ja(i+kx) + icl = ja(i+kx) + endif + enddo + case default + write(psb_err_unit,*) 'Error in fix_coo: unsafe dupl',dupl_ + info =-7 + end select + + i = j + enddo + i = ki +!!$ +!!$ i = 1 +!!$ irw = ia(i) +!!$ icl = ja(i) +!!$ j = 1 +!!$ +!!$ select case(dupl_) +!!$ case(psb_dupl_ovwrt_) +!!$ +!!$ do +!!$ j = j + 1 +!!$ if (j > nzin) exit +!!$ if ((ia(j) == irw).and.(ja(j) == icl)) then +!!$ val(i) = val(j) +!!$ else +!!$ i = i+1 +!!$ val(i) = val(j) +!!$ ia(i) = ia(j) +!!$ ja(i) = ja(j) +!!$ irw = ia(i) +!!$ icl = ja(i) +!!$ endif +!!$ enddo +!!$ +!!$ case(psb_dupl_add_) +!!$ +!!$ do +!!$ j = j + 1 +!!$ if (j > nzin) exit +!!$ if ((ia(j) == irw).and.(ja(j) == icl)) then +!!$ val(i) = val(i) + val(j) +!!$ else +!!$ i = i+1 +!!$ val(i) = val(j) +!!$ ia(i) = ia(j) +!!$ ja(i) = ja(j) +!!$ irw = ia(i) +!!$ icl = ja(i) +!!$ endif +!!$ enddo +!!$ +!!$ case(psb_dupl_err_) +!!$ do +!!$ j = j + 1 +!!$ if (j > nzin) exit +!!$ if ((ia(j) == irw).and.(ja(j) == icl)) then +!!$ call psb_errpush(psb_err_duplicate_coo,name) +!!$ goto 9999 +!!$ else +!!$ i = i+1 +!!$ val(i) = val(j) +!!$ ia(i) = ia(j) +!!$ ja(i) = ja(j) +!!$ irw = ia(i) +!!$ icl = ja(i) +!!$ endif +!!$ enddo +!!$ case default +!!$ write(psb_err_unit,*) 'Error in fix_coo: unsafe dupl',dupl_ +!!$ info =-7 +!!$ end select +!!$ +!!$ end if + end if if(debug_level >= psb_debug_serial_)& & write(debug_unit,*) trim(name),': end second loop' diff --git a/base/tools/psb_cdins.f90 b/base/tools/psb_cdins.f90 index 71baa89a..4c206e56 100644 --- a/base/tools/psb_cdins.f90 +++ b/base/tools/psb_cdins.f90 @@ -118,9 +118,9 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla) end if if (present(ila).and.present(jla)) then - call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) + call desc_a%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) if (info == psb_success_) & - & call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0)) + & call desc_a%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0)) else if (present(ila).or.present(jla)) then write(psb_err_unit,*) 'Inconsistent call : ',present(ila),present(jla) @@ -131,10 +131,10 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla) call psb_errpush(info,name) goto 9999 end if - call desc_a%indxmap%g2l(ia(1:nz),ila_(1:nz),info,owned=.true.) + call desc_a%g2l(ia(1:nz),ila_(1:nz),info,owned=.true.) if (info == psb_success_) then jla_(1:nz) = ja(1:nz) - call desc_a%indxmap%g2lip_ins(jla_(1:nz),info,mask=(ila_(1:nz)>0)) + call desc_a%g2lip_ins(jla_(1:nz),info,mask=(ila_(1:nz)>0)) end if deallocate(ila_,jla_,stat=info) end if @@ -249,7 +249,7 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx) end if if (present(jla)) then - call desc%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=mask,lidx=lidx) + call desc%g2l_ins(ja(1:nz),jla(1:nz),info,mask=mask,lidx=lidx) else allocate(jla_(nz),stat=info) if (info /= psb_success_) then @@ -257,7 +257,7 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx) call psb_errpush(info,name) goto 9999 end if - call desc%indxmap%g2l_ins(ja(1:nz),jla_(1:nz),info,mask=mask,lidx=lidx) + call desc%g2l_ins(ja(1:nz),jla_(1:nz),info,mask=mask,lidx=lidx) deallocate(jla_) end if diff --git a/base/tools/psb_dspins.f90 b/base/tools/psb_dspins.f90 index 56a3be17..af05d760 100644 --- a/base/tools/psb_dspins.f90 +++ b/base/tools/psb_dspins.f90 @@ -128,8 +128,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) goto 9999 end if - call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) - call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0)) + call desc_a%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) + call desc_a%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0)) if (info /= psb_success_) then ierr(1) = info @@ -174,8 +174,8 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) goto 9999 end if - call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info) - call desc_a%indxmap%g2l(ja(1:nz),jla(1:nz),info) + call desc_a%g2l(ia(1:nz),ila(1:nz),info) + call desc_a%g2l(ja(1:nz),jla(1:nz),info) call a%csput(nz,ila,jla,val,ione,nrow,ione,ncol,info) if (info /= psb_success_) then @@ -277,8 +277,8 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) goto 9999 end if - call desc_ar%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) - call desc_ac%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info, mask=(ila(1:nz)>0)) + call desc_ar%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) + call desc_ac%g2l_ins(ja(1:nz),jla(1:nz),info, mask=(ila(1:nz)>0)) if (psb_errstatus_fatal()) then ierr(1) = info diff --git a/base/tools/psb_glob_to_loc.f90 b/base/tools/psb_glob_to_loc.f90 index 7a8a1a08..777c426e 100644 --- a/base/tools/psb_glob_to_loc.f90 +++ b/base/tools/psb_glob_to_loc.f90 @@ -94,7 +94,7 @@ subroutine psb_glob_to_loc2v(x,y,desc_a,info,iact,owned) act = psb_toupper(act) n = size(x) - call desc_a%indxmap%g2l(x(1:n),y(1:n),info,owned=owned) + call desc_a%g2l(x(1:n),y(1:n),info,owned=owned) select case(act) case('E','I') @@ -217,7 +217,7 @@ subroutine psb_glob_to_loc1v(x,desc_a,info,iact,owned) act = psb_toupper(act) - call desc_a%indxmap%g2lip(x,info,owned=owned) + call desc_a%g2lip(x,info,owned=owned) select case(act) case('E','I') diff --git a/base/tools/psb_loc_to_glob.f90 b/base/tools/psb_loc_to_glob.f90 index 67e07409..a6d0adb6 100644 --- a/base/tools/psb_loc_to_glob.f90 +++ b/base/tools/psb_loc_to_glob.f90 @@ -80,7 +80,7 @@ subroutine psb_loc_to_glob2v(x,y,desc_a,info,iact) endif act=psb_toupper(act) - call desc_a%indxmap%l2g(x,y,info) + call desc_a%l2g(x,y,info) if (info /= psb_success_) then select case(act) @@ -190,7 +190,7 @@ subroutine psb_loc_to_glob1v(x,desc_a,info,iact) endif act = psb_toupper(act) - call desc_a%indxmap%l2gip(x,info) + call desc_a%l2gip(x,info) if (info /= psb_success_) then select case(act) diff --git a/test/fileread/cf_sample.f90 b/test/fileread/cf_sample.f90 index c3f81611..a4a45d04 100644 --- a/test/fileread/cf_sample.f90 +++ b/test/fileread/cf_sample.f90 @@ -283,7 +283,7 @@ program cf_sample write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize write(psb_out_unit,'("Storage type for DESC_A : ",a)')& - & desc_a%indxmap%get_fmt() + & desc_a%get_fmt() end if call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_) diff --git a/test/fileread/df_sample.f90 b/test/fileread/df_sample.f90 index c4062374..f1fee276 100644 --- a/test/fileread/df_sample.f90 +++ b/test/fileread/df_sample.f90 @@ -289,7 +289,7 @@ program df_sample write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize write(psb_out_unit,'("Storage type for DESC_A : ",a)')& - & desc_a%indxmap%get_fmt() + & desc_a%get_fmt() end if !!$ call psb_precdump(prec,info,prefix=trim(mtrx_file)//'_') diff --git a/test/fileread/sf_sample.f90 b/test/fileread/sf_sample.f90 index c6f64b16..7b200d97 100644 --- a/test/fileread/sf_sample.f90 +++ b/test/fileread/sf_sample.f90 @@ -286,7 +286,7 @@ program sf_sample write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize write(psb_out_unit,'("Storage type for DESC_A : ",a)')& - & desc_a%indxmap%get_fmt() + & desc_a%get_fmt() end if !!$ call psb_precdump(prec,info,prefix=trim(mtrx_file)//'_') diff --git a/test/fileread/zf_sample.f90 b/test/fileread/zf_sample.f90 index 71bf3c4e..c87928de 100644 --- a/test/fileread/zf_sample.f90 +++ b/test/fileread/zf_sample.f90 @@ -283,7 +283,7 @@ program zf_sample write(psb_out_unit,'("Total memory occupation for PREC: ",i12)')precsize write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize write(psb_out_unit,'("Storage type for DESC_A : ",a)')& - & desc_a%indxmap%get_fmt() + & desc_a%get_fmt() end if call psb_gather(x_col_glob,x_col,desc_a,info,root=psb_root_) diff --git a/test/kernel/d_file_spmv.f90 b/test/kernel/d_file_spmv.f90 index 21357761..3d139d3e 100644 --- a/test/kernel/d_file_spmv.f90 +++ b/test/kernel/d_file_spmv.f90 @@ -275,7 +275,7 @@ program d_file_spmv write(psb_out_unit,'("MBYTES/S : ",F20.3)') bdwdth bdwdth = times*nbytes/(tt2*1.d6) write(psb_out_unit,'("MBYTES/S (trans): ",F20.3)') bdwdth - write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%indxmap%get_fmt() + write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt() end if diff --git a/test/kernel/pdgenspmv.f90 b/test/kernel/pdgenspmv.f90 index b734d6af..fe9b33ce 100644 --- a/test/kernel/pdgenspmv.f90 +++ b/test/kernel/pdgenspmv.f90 @@ -169,7 +169,7 @@ program pdgenspmv write(psb_out_unit,'("MBYTES/S : ",F20.3)') bdwdth bdwdth = times*nbytes/(tt2*1.d6) write(psb_out_unit,'("MBYTES/S (trans): ",F20.3)') bdwdth - write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%indxmap%get_fmt() + write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%get_fmt() write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize end if diff --git a/test/pargen/runs/ppde.inp b/test/pargen/runs/ppde.inp index e86827e4..ad9aac03 100644 --- a/test/pargen/runs/ppde.inp +++ b/test/pargen/runs/ppde.inp @@ -2,7 +2,7 @@ BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES BJAC Preconditioner NONE DIAG BJAC CSR Storage format for matrix A: CSR COO JAD -040 Domain size (acutal system is this**3) +100 Domain size (acutal system is this**3) 2 Stopping criterion 1000 MAXIT 01 ITRACE