diff --git a/base/internals/psi_idx_ins_cnv.f90 b/base/internals/psi_idx_ins_cnv.f90 index 50ec4277..172ec92c 100644 --- a/base/internals/psi_idx_ins_cnv.f90 +++ b/base/internals/psi_idx_ins_cnv.f90 @@ -81,13 +81,13 @@ subroutine psi_idx_ins_cnv1(nv,idxin,desc,info,mask,lidx) ncol = desc%get_local_cols() call psb_info(ictxt, me, np) - - if ((.not.allocated(desc%indxmap)).or.& - & (.not.desc%is_bld())) then - info = psb_err_invalid_cd_state_ - call psb_errpush(info,name) - goto 9999 - endif +!!$ +!!$ if ((.not.allocated(desc%indxmap)).or.& +!!$ & (.not.desc%is_bld())) then +!!$ info = psb_err_invalid_cd_state_ +!!$ call psb_errpush(info,name) +!!$ goto 9999 +!!$ endif if (nv < 0) then info = 1111 @@ -219,12 +219,12 @@ subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask,lidx) call psb_info(ictxt, me, np) - if ((.not.allocated(desc%indxmap)).or.& - & (.not.desc%is_bld())) then - info = psb_err_invalid_cd_state_ - call psb_errpush(info,name) - goto 9999 - endif +!!$ if ((.not.allocated(desc%indxmap)).or.& +!!$ & (.not.desc%is_bld())) then +!!$ info = psb_err_invalid_cd_state_ +!!$ call psb_errpush(info,name) +!!$ goto 9999 +!!$ endif if (nv < 0) then info = 1111 diff --git a/base/modules/psb_cd_tools_mod.f90 b/base/modules/psb_cd_tools_mod.f90 index af337fb2..6595325e 100644 --- a/base/modules/psb_cd_tools_mod.f90 +++ b/base/modules/psb_cd_tools_mod.f90 @@ -91,15 +91,14 @@ module psb_cd_tools_mod end interface interface psb_cdins - subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla,dontcheck) + subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla) import :: psb_ipk_, psb_desc_type type(psb_desc_type), intent(inout) :: desc_a integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(out) :: ila(:), jla(:) - logical, intent(in), optional :: dontcheck end subroutine psb_cdinsrc - subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx,dontcheck) + subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx) import :: psb_ipk_, psb_desc_type type(psb_desc_type), intent(inout) :: desc integer(psb_ipk_), intent(in) :: nz,ja(:) @@ -107,7 +106,6 @@ module psb_cd_tools_mod integer(psb_ipk_), optional, intent(out) :: jla(:) logical, optional, target, intent(in) :: mask(:) integer(psb_ipk_), intent(in), optional :: lidx(:) - logical, intent(in), optional :: dontcheck end subroutine psb_cdinsc end interface diff --git a/base/tools/psb_cdins.f90 b/base/tools/psb_cdins.f90 index 7c4920ef..8f34a2eb 100644 --- a/base/tools/psb_cdins.f90 +++ b/base/tools/psb_cdins.f90 @@ -45,7 +45,7 @@ ! ila(:) - integer(psb_ipk_), optional The row indices in local numbering ! jla(:) - integer(psb_ipk_), optional The col indices in local numbering ! -subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla, dontcheck) +subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla) use psb_base_mod, psb_protect_name => psb_cdinsrc use psi_mod implicit none @@ -55,7 +55,6 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla, dontcheck) integer(psb_ipk_), intent(in) :: nz,ia(:),ja(:) integer(psb_ipk_), intent(out) :: info integer(psb_ipk_), optional, intent(out) :: ila(:), jla(:) - logical, intent(in), optional :: dontcheck !LOCALS..... integer(psb_ipk_) :: ictxt,dectype,mglob, nglob @@ -64,25 +63,17 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla, dontcheck) logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), allocatable :: ila_(:), jla_(:) - logical :: dontcheck_ character(len=20) :: name info = psb_success_ name = 'psb_cdins' call psb_erractionsave(err_act) - if (present(dontcheck)) then - dontcheck_ = dontcheck - else - dontcheck_ = .false. - end if - if (.not. dontcheck) then - if (.not.desc_a%is_bld()) then - info = psb_err_invalid_cd_state_ - call psb_errpush(info,name) - goto 9999 - endif - end if + if (.not.desc_a%is_bld()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + endif ictxt = desc_a%get_context() dectype = desc_a%get_dectype() @@ -127,22 +118,31 @@ subroutine psb_cdinsrc(nz,ia,ja,desc_a,info,ila,jla, dontcheck) end if if (present(ila).and.present(jla)) then - call psi_idx_cnv(nz,ia,ila,desc_a,info,owned=.true.) + call desc_a%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) if (info == psb_success_) & - & call psb_cdins(nz,ja,desc_a,info,jla=jla,mask=(ila(1:nz)>0),dontcheck=.true.) + & call desc_a%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=(ila(1:nz)>0)) +!!$ call psi_idx_cnv(nz,ia,ila,desc_a,info,owned=.true.) +!!$ if (info == psb_success_) & +!!$ & call psb_cdins(nz,ja,desc_a,info,jla=jla,mask=(ila(1:nz)>0)) else if (present(ila).or.present(jla)) then write(psb_err_unit,*) 'Inconsistent call : ',present(ila),present(jla) endif - allocate(ila_(nz),stat=info) + allocate(ila_(nz),jla_(nz),stat=info) if (info /= psb_success_) then info = psb_err_alloc_dealloc_ call psb_errpush(info,name) goto 9999 end if - call psi_idx_cnv(nz,ia,ila_,desc_a,info,owned=.true.) - if (info == psb_success_) & - & call psb_cdins(nz,ja,desc_a,info,mask=(ila_(1:nz)>0),dontcheck=.true.) + call desc_a%indxmap%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)) + end if + +!!$ call psi_idx_cnv(nz,ia,ila_,desc_a,info,owned=.true.) +!!$ if (info == psb_success_) & +!!$ & call psb_cdins(nz,ja,desc_a,info,mask=(ila_(1:nz)>0)) deallocate(ila_) end if if (info /= psb_success_) goto 9999 @@ -176,7 +176,7 @@ end subroutine psb_cdinsrc ! mask(:) - logical, optional, target ! lidx(:) - integer(psb_ipk_), optional User-defined local col indices ! -subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx,dontcheck) +subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx) use psb_base_mod, psb_protect_name => psb_cdinsc use psi_mod implicit none @@ -188,7 +188,6 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx,dontcheck) integer(psb_ipk_), optional, intent(out) :: jla(:) logical, optional, target, intent(in) :: mask(:) integer(psb_ipk_), intent(in), optional :: lidx(:) - logical, intent(in), optional :: dontcheck !LOCALS..... @@ -199,26 +198,18 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx,dontcheck) logical, parameter :: debug=.false. integer(psb_ipk_), parameter :: relocsz=200 integer(psb_ipk_), allocatable :: ila_(:), jla_(:) - logical :: dontcheck_ character(len=20) :: name info = psb_success_ name = 'psb_cdins' call psb_erractionsave(err_act) - if (present(dontcheck)) then - dontcheck_ = dontcheck - else - dontcheck_ = .false. - end if - - if (.not. dontcheck) then - if (.not.desc%is_bld()) then - info = psb_err_invalid_cd_state_ - call psb_errpush(info,name) - goto 9999 - endif - end if + + if (.not.desc%is_bld()) then + info = psb_err_invalid_cd_state_ + call psb_errpush(info,name) + goto 9999 + endif ictxt = desc%get_context() dectype = desc%get_dectype() @@ -265,7 +256,9 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx,dontcheck) end if if (present(jla)) then - call psi_idx_ins_cnv(nz,ja,jla,desc,info,mask=mask,lidx=lidx) +!!$ call psi_idx_ins_cnv(nz,ja,jla,desc,info,mask=mask,lidx=lidx) + call desc%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info,mask=mask,lidx=lidx) + else allocate(jla_(nz),stat=info) if (info /= psb_success_) then @@ -273,7 +266,8 @@ subroutine psb_cdinsc(nz,ja,desc,info,jla,mask,lidx,dontcheck) call psb_errpush(info,name) goto 9999 end if - call psi_idx_ins_cnv(nz,ja,jla_,desc,info,mask=mask,lidx=lidx) +!!$ call psi_idx_ins_cnv(nz,ja,jla_,desc,info,mask=mask,lidx=lidx) + call desc%indxmap%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 4f2cd0b0..62c8b657 100644 --- a/base/tools/psb_dspins.f90 +++ b/base/tools/psb_dspins.f90 @@ -133,7 +133,9 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) & a_err='allocate',i_err=ierr) goto 9999 end if - call psb_cdins(nz,ia,ja,desc_a,info,ila=ila,jla=jla,dontcheck=.true.) +!!$ call psb_cdins(nz,ia,ja,desc_a,info,ila=ila,jla=jla,good_desc=.true.) + 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)) if (info /= psb_success_) then ierr(1) = info @@ -178,8 +180,10 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild,local) goto 9999 end if - call psb_glob_to_loc(ia(1:nz),ila(1:nz),desc_a,info,iact='I') - call psb_glob_to_loc(ja(1:nz),jla(1:nz),desc_a,info,iact='I') +!!$ call psb_glob_to_loc(ia(1:nz),ila(1:nz),desc_a,info,iact='I') +!!$ call psb_glob_to_loc(ja(1:nz),jla(1:nz),desc_a,info,iact='I') + 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 a%csput(nz,ila,jla,val,ione,nrow,ione,ncol,info) if (info /= psb_success_) then @@ -280,11 +284,11 @@ subroutine psb_dspins_2desc(nz,ia,ja,val,a,desc_ar,desc_ac,info) & a_err='allocate',i_err=ierr) goto 9999 end if - ila(1:nz) = ia(1:nz) - call psb_glob_to_loc(ia(1:nz),ila(1:nz),desc_ar,info,iact='I',owned=.true.) - - call psb_cdins(nz,ja,desc_ac,info,jla=jla, mask=(ila(1:nz)>0),dontcheck=.true.) + call desc_ar%indxmap%g2l(ia(1:nz),ila(1:nz),info,owned=.true.) + +!!$ call psb_cdins(nz,ja,desc_ac,info,jla=jla, mask=(ila(1:nz)>0)) + call desc_ac%indxmap%g2l_ins(ja(1:nz),jla(1:nz),info, mask=(ila(1:nz)>0)) if (psb_errstatus_fatal()) then ierr(1) = info