diff --git a/base/internals/psb_indx_map_fnd_owner.F90 b/base/internals/psb_indx_map_fnd_owner.F90 index 9777c9f3..9d2eea6c 100644 --- a/base/internals/psb_indx_map_fnd_owner.F90 +++ b/base/internals/psb_indx_map_fnd_owner.F90 @@ -230,7 +230,7 @@ subroutine psb_indx_map_fnd_owner(idx,iprc,idxmap,info) do if (j > size(answers,1)) then ! Last resort attempt. - j = psb_ibsrch(ih,size(answers,1),answers(:,1)) + j = psb_ibsrch(ih,size(answers,1,kind=psb_ipk_),answers(:,1)) if (j == -1) then write(psb_err_unit,*) me,'psi_fnd_owner: searching for ',ih, & & 'not found : ',size(answers,1),':',answers(:,1) diff --git a/base/internals/psi_desc_index.F90 b/base/internals/psi_desc_index.F90 index cf0d79b3..fb697f67 100644 --- a/base/internals/psi_desc_index.F90 +++ b/base/internals/psi_desc_index.F90 @@ -183,7 +183,7 @@ subroutine psi_desc_index(desc,index_in,dep_list,& i = i + nerv + 1 end do ihinsz=i - call mpi_alltoall(sdsz,1,psb_mpi_integer,rvsz,1,mpi_integer,icomm,info) + call mpi_alltoall(sdsz,1,psb_mpi_integer,rvsz,1,psb_mpi_integer,icomm,info) if(info /= psb_success_) then call psb_errpush(psb_err_from_subroutine_,name,a_err='mpi_alltoall') goto 9999 diff --git a/base/internals/psi_extrct_dl.F90 b/base/internals/psi_extrct_dl.F90 index 1aa1f5bf..e075dfea 100644 --- a/base/internals/psi_extrct_dl.F90 +++ b/base/internals/psi_extrct_dl.F90 @@ -132,7 +132,8 @@ subroutine psi_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& #endif ! ....scalar parameters... logical :: is_bld, is_upd - integer(psb_ipk_) :: np,dl_lda,mode, info, ictxt + integer(psb_mpik_) :: ictxt + integer(psb_ipk_) :: np,dl_lda,mode, info ! ....array parameters.... integer(psb_ipk_) :: desc_str(*),dep_list(dl_lda,0:np),length_dl(0:np) @@ -141,9 +142,10 @@ subroutine psi_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& integer(psb_ipk_) :: int_err(5) ! .....local scalars... - integer(psb_ipk_) :: i,me,nprow,pointer_dep_list,proc,j,err_act - integer(psb_ipk_) :: err, icomm + integer(psb_ipk_) :: i,pointer_dep_list,proc,j,err_act + integer(psb_ipk_) :: err integer(psb_ipk_) :: debug_level, debug_unit + integer(psb_mpik_) :: icomm, me, npr character name*20 name='psi_extrct_dl' @@ -153,7 +155,7 @@ subroutine psi_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& info = psb_success_ - call psb_info(ictxt,me,nprow) + call psb_info(ictxt,me,npr) do i=0,np length_dl(i) = 0 enddo @@ -173,7 +175,7 @@ subroutine psi_extract_dep_list(ictxt,is_bld,is_upd,desc_str,dep_list,& if ((desc_str(i+1) /= 0).or.(desc_str(i+2) /= 0)) then ! ..if number of element to be exchanged !=0 proc=desc_str(i) - if ((proc < 0).or.(proc >= nprow)) then + if ((proc < 0).or.(proc >= npr)) then if (debug_level >= psb_debug_inner_)& & write(debug_unit,*) me,' ',trim(name),': error ',i,desc_str(i) info = 9999 diff --git a/base/internals/psi_idx_cnv.f90 b/base/internals/psi_idx_cnv.f90 index 46a456d3..034115ca 100644 --- a/base/internals/psi_idx_cnv.f90 +++ b/base/internals/psi_idx_cnv.f90 @@ -322,7 +322,7 @@ subroutine psi_idx_cnvs(idxin,idxout,desc,info,mask,owned) mask_=.true. end if iout = idxin - call psi_idx_cnv(1,iout,desc,info,mask=mask_,owned=owned) + call psi_idx_cnv(ione,iout,desc,info,mask=mask_,owned=owned) idxout=iout(1) return @@ -347,7 +347,7 @@ subroutine psi_idx_cnvs1(idxin,desc,info,mask,owned) end if iout(1) = idxin - call psi_idx_cnv(1,iout,desc,info,mask=mask_,owned=owned) + call psi_idx_cnv(ione,iout,desc,info,mask=mask_,owned=owned) idxin = iout(1) return diff --git a/base/internals/psi_idx_ins_cnv.f90 b/base/internals/psi_idx_ins_cnv.f90 index db692d61..f48c46dc 100644 --- a/base/internals/psi_idx_ins_cnv.f90 +++ b/base/internals/psi_idx_ins_cnv.f90 @@ -325,7 +325,7 @@ subroutine psi_idx_ins_cnvs2(idxin,idxout,desc,info,mask) end if iout(1) = idxin - call psi_idx_ins_cnv(1,iout,desc,info,mask_) + call psi_idx_ins_cnv(ione,iout,desc,info,mask_) idxout = iout(1) return @@ -395,7 +395,7 @@ subroutine psi_idx_ins_cnvs1(idxin,desc,info,mask) end if iout(1) = idxin - call psi_idx_ins_cnv(1,iout,desc,info,mask_) + call psi_idx_ins_cnv(ione,iout,desc,info,mask_) idxin = iout(1) return diff --git a/base/internals/psi_ovrl_upd.f90 b/base/internals/psi_ovrl_upd.f90 index 72e9e4d9..d456f41c 100644 --- a/base/internals/psi_ovrl_upd.f90 +++ b/base/internals/psi_ovrl_upd.f90 @@ -42,6 +42,7 @@ subroutine psi_sovrl_updr1(x,desc_a,update,info) ! locals integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err name='psi_sovrl_updr1' @@ -82,7 +83,8 @@ subroutine psi_sovrl_updr1(x,desc_a,update,info) case default ! wrong value for choice argument info = psb_err_iarg_invalid_value_ - call psb_errpush(info,name,i_err=(/3,update,0,0,0/)) + ierr(1) = 3; ierr(2)=update; + call psb_errpush(info,name,i_err=ierr) goto 9999 end select @@ -112,6 +114,7 @@ subroutine psi_sovrl_updr2(x,desc_a,update,info) ! locals integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err name='psi_sovrl_updr2' @@ -152,7 +155,8 @@ subroutine psi_sovrl_updr2(x,desc_a,update,info) case default ! wrong value for choice argument info = psb_err_iarg_invalid_value_ - call psb_errpush(info,name,i_err=(/3,update,0,0,0/)) + ierr(1) = 3; ierr(2)=update; + call psb_errpush(info,name,i_err=ierr) goto 9999 end select @@ -181,6 +185,7 @@ subroutine psi_dovrl_updr1(x,desc_a,update,info) ! locals integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err name='psi_dovrl_updr1' @@ -221,7 +226,8 @@ subroutine psi_dovrl_updr1(x,desc_a,update,info) case default ! wrong value for choice argument info = psb_err_iarg_invalid_value_ - call psb_errpush(info,name,i_err=(/3,update,0,0,0/)) + ierr(1) = 3; ierr(2)=update; + call psb_errpush(info,name,i_err=ierr) goto 9999 end select @@ -251,6 +257,7 @@ subroutine psi_dovrl_updr2(x,desc_a,update,info) ! locals integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err name='psi_dovrl_updr2' @@ -291,7 +298,8 @@ subroutine psi_dovrl_updr2(x,desc_a,update,info) case default ! wrong value for choice argument info = psb_err_iarg_invalid_value_ - call psb_errpush(info,name,i_err=(/3,update,0,0,0/)) + ierr(1) = 3; ierr(2)=update; + call psb_errpush(info,name,i_err=ierr) goto 9999 end select @@ -320,6 +328,7 @@ subroutine psi_covrl_updr1(x,desc_a,update,info) ! locals integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err name='psi_covrl_updr1' @@ -360,7 +369,8 @@ subroutine psi_covrl_updr1(x,desc_a,update,info) case default ! wrong value for choice argument info = psb_err_iarg_invalid_value_ - call psb_errpush(info,name,i_err=(/3,update,0,0,0/)) + ierr(1) = 3; ierr(2)=update; + call psb_errpush(info,name,i_err=ierr) goto 9999 end select @@ -390,6 +400,7 @@ subroutine psi_covrl_updr2(x,desc_a,update,info) ! locals integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err name='psi_covrl_updr2' @@ -430,7 +441,8 @@ subroutine psi_covrl_updr2(x,desc_a,update,info) case default ! wrong value for choice argument info = psb_err_iarg_invalid_value_ - call psb_errpush(info,name,i_err=(/3,update,0,0,0/)) + ierr(1) = 3; ierr(2)=update; + call psb_errpush(info,name,i_err=ierr) goto 9999 end select @@ -459,6 +471,7 @@ subroutine psi_zovrl_updr1(x,desc_a,update,info) ! locals integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err name='psi_zovrl_updr1' @@ -499,7 +512,8 @@ subroutine psi_zovrl_updr1(x,desc_a,update,info) case default ! wrong value for choice argument info = psb_err_iarg_invalid_value_ - call psb_errpush(info,name,i_err=(/3,update,0,0,0/)) + ierr(1) = 3; ierr(2)=update; + call psb_errpush(info,name,i_err=ierr) goto 9999 end select @@ -529,6 +543,7 @@ subroutine psi_zovrl_updr2(x,desc_a,update,info) ! locals integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err name='psi_zovrl_updr2' @@ -569,7 +584,8 @@ subroutine psi_zovrl_updr2(x,desc_a,update,info) case default ! wrong value for choice argument info = psb_err_iarg_invalid_value_ - call psb_errpush(info,name,i_err=(/3,update,0,0,0/)) + ierr(1) = 3; ierr(2)=update; + call psb_errpush(info,name,i_err=ierr) goto 9999 end select @@ -598,6 +614,7 @@ subroutine psi_iovrl_updr1(x,desc_a,update,info) ! locals integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err name='psi_iovrl_updr1' @@ -639,7 +656,8 @@ subroutine psi_iovrl_updr1(x,desc_a,update,info) case default ! wrong value for choice argument info = psb_err_iarg_invalid_value_ - call psb_errpush(info,name,i_err=(/3,update,0,0,0/)) + ierr(1) = 3; ierr(2)=update; + call psb_errpush(info,name,i_err=ierr) goto 9999 end select @@ -669,6 +687,7 @@ subroutine psi_iovrl_updr2(x,desc_a,update,info) ! locals integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err name='psi_iovrl_updr2' @@ -710,7 +729,8 @@ subroutine psi_iovrl_updr2(x,desc_a,update,info) case default ! wrong value for choice argument info = psb_err_iarg_invalid_value_ - call psb_errpush(info,name,i_err=(/3,update,0,0,0/)) + ierr(1) = 3; ierr(2)=update; + call psb_errpush(info,name,i_err=ierr) goto 9999 end select @@ -743,6 +763,7 @@ subroutine psi_sovrl_upd_vect(x,desc_a,update,info) ! locals real(psb_spk_), allocatable :: xs(:) integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -791,7 +812,8 @@ subroutine psi_sovrl_upd_vect(x,desc_a,update,info) case default ! wrong value for choice argument info = psb_err_iarg_invalid_value_ - call psb_errpush(info,name,i_err=(/3,update,0,0,0/)) + ierr(1) = 3; ierr(2)=update; + call psb_errpush(info,name,i_err=ierr) goto 9999 end select call x%sct(nx,desc_a%ovrlap_elem(:,1),xs,szero) @@ -825,6 +847,7 @@ subroutine psi_dovrl_upd_vect(x,desc_a,update,info) ! locals real(psb_dpk_), allocatable :: xs(:) integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -873,7 +896,8 @@ subroutine psi_dovrl_upd_vect(x,desc_a,update,info) case default ! wrong value for choice argument info = psb_err_iarg_invalid_value_ - call psb_errpush(info,name,i_err=(/3,update,0,0,0/)) + ierr(1) = 3; ierr(2)=update; + call psb_errpush(info,name,i_err=ierr) goto 9999 end select call x%sct(nx,desc_a%ovrlap_elem(:,1),xs,dzero) @@ -908,6 +932,7 @@ subroutine psi_covrl_upd_vect(x,desc_a,update,info) ! locals complex(psb_spk_), allocatable :: xs(:) integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -956,7 +981,8 @@ subroutine psi_covrl_upd_vect(x,desc_a,update,info) case default ! wrong value for choice argument info = psb_err_iarg_invalid_value_ - call psb_errpush(info,name,i_err=(/3,update,0,0,0/)) + ierr(1) = 3; ierr(2)=update; + call psb_errpush(info,name,i_err=ierr) goto 9999 end select call x%sct(nx,desc_a%ovrlap_elem(:,1),xs,czero) @@ -990,6 +1016,7 @@ subroutine psi_zovrl_upd_vect(x,desc_a,update,info) ! locals complex(psb_dpk_), allocatable :: xs(:) integer(psb_ipk_) :: ictxt, np, me, err_act, i, idx, ndm, nx + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err @@ -1038,7 +1065,8 @@ subroutine psi_zovrl_upd_vect(x,desc_a,update,info) case default ! wrong value for choice argument info = psb_err_iarg_invalid_value_ - call psb_errpush(info,name,i_err=(/3,update,0,0,0/)) + ierr(1) = 3; ierr(2)=update; + call psb_errpush(info,name,i_err=ierr) goto 9999 end select call x%sct(nx,desc_a%ovrlap_elem(:,1),xs,zzero)