diff --git a/base/tools/psb_callc.f90 b/base/tools/psb_callc.f90 index 7a661525..6464ab3b 100644 --- a/base/tools/psb_callc.f90 +++ b/base/tools/psb_callc.f90 @@ -55,7 +55,7 @@ subroutine psb_calloc_vect(x, desc_a,info,n) !locals integer(psb_ipk_) :: np,me,nr,i,err_act - integer(psb_ipk_) :: ictxt, int_err(5) + integer(psb_ipk_) :: ictxt integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -92,7 +92,7 @@ subroutine psb_calloc_vect(x, desc_a,info,n) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif @@ -100,8 +100,7 @@ subroutine psb_calloc_vect(x, desc_a,info,n) if (info == 0) call x%all(nr,info) if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)') goto 9999 endif call x%zero() @@ -128,7 +127,7 @@ subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb) !locals integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, int_err(5), exch(1) + integer(psb_ipk_) :: ictxt, exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -175,8 +174,7 @@ subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb) call psb_bcast(ictxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ - int_err(1)=1 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione/)) goto 9999 endif endif @@ -189,7 +187,7 @@ subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif @@ -204,8 +202,7 @@ subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb) end if if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)') goto 9999 endif @@ -232,7 +229,7 @@ subroutine psb_calloc_multivect(x, desc_a,info,n) !locals integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, int_err(5), exch(1) + integer(psb_ipk_) :: ictxt, exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -274,8 +271,7 @@ subroutine psb_calloc_multivect(x, desc_a,info,n) call psb_bcast(ictxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ - int_err(1)=1 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione/)) goto 9999 endif endif @@ -288,7 +284,7 @@ subroutine psb_calloc_multivect(x, desc_a,info,n) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif @@ -298,8 +294,7 @@ subroutine psb_calloc_multivect(x, desc_a,info,n) if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)') goto 9999 endif diff --git a/base/tools/psb_callc_a.f90 b/base/tools/psb_callc_a.f90 index 1c6d3bef..28a5d39c 100644 --- a/base/tools/psb_callc_a.f90 +++ b/base/tools/psb_callc_a.f90 @@ -54,16 +54,15 @@ subroutine psb_calloc(x, desc_a, info, n, lb) integer(psb_ipk_), optional, intent(in) :: n, lb !locals - integer(psb_ipk_) :: np,me,err,nr,i,j,err_act - integer(psb_ipk_) :: ictxt,n_ - integer(psb_ipk_) :: int_err(5),exch(3) + integer(psb_ipk_) :: err,nr,i,j,n_,err_act + integer(psb_ipk_) :: ictxt,np,me + integer(psb_ipk_) :: exch(3) character(len=20) :: name name='psb_geall' if(psb_get_errstatus() /= 0) return - info=psb_success_ - err=0 - int_err(1)=0 + info = psb_success_ + err = 0 call psb_erractionsave(err_act) ictxt=desc_a%get_context() @@ -95,8 +94,7 @@ subroutine psb_calloc(x, desc_a, info, n, lb) call psb_bcast(ictxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ - int_err(1)=1 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione/)) goto 9999 endif endif @@ -108,15 +106,14 @@ subroutine psb_calloc(x, desc_a, info, n, lb) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif call psb_realloc(nr,n_,x,info,lb2=lb) if (info /= psb_success_) then info=psb_err_alloc_request_ - int_err(1)=nr*n_ - call psb_errpush(info,name,int_err,a_err='complex(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr*n_/),a_err='complex(psb_spk_)') goto 9999 endif @@ -183,8 +180,8 @@ subroutine psb_callocv(x, desc_a,info,n) integer(psb_ipk_), optional, intent(in) :: n !locals - integer(psb_ipk_) :: np,me,nr,i,err_act - integer(psb_ipk_) :: ictxt, int_err(5) + integer(psb_ipk_) :: nr,i,err_act + integer(psb_ipk_) :: ictxt, np,me integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -221,15 +218,14 @@ subroutine psb_callocv(x, desc_a,info,n) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif call psb_realloc(nr,x,info) if (info /= psb_success_) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='complex(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='complex(psb_spk_)') goto 9999 endif diff --git a/base/tools/psb_cd_inloc.f90 b/base/tools/psb_cd_inloc.f90 index d5f4f2a7..905a8826 100644 --- a/base/tools/psb_cd_inloc.f90 +++ b/base/tools/psb_cd_inloc.f90 @@ -62,7 +62,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) & flag_, err_act, novrl, norphan,& & npr_ov, itmpov, i_pnt integer(psb_lpk_) :: m, n, nrt, il - integer(psb_ipk_) :: int_err(5),exch(3) + integer(psb_lpk_) :: l_err(5),exch(3) integer(psb_ipk_), allocatable :: tmpgidx(:,:), & & nov(:), ov_idx(:,:), temp_ovrlap(:) integer(psb_lpk_), allocatable :: vl(:), ix(:), l_temp_ovrlap(:) @@ -101,16 +101,16 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) !... check m and n parameters.... if (m < 1) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m + l_err(1) = 1 + l_err(2) = m else if (n < 1) then info = psb_err_iarg_neg_ - int_err(1) = 2 - int_err(2) = n + l_err(1) = 2 + l_err(2) = n endif if (info /= psb_success_) then - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,l_err=l_err) goto 9999 end if if (me == psb_root_) then @@ -122,13 +122,13 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) call psb_bcast(ictxt,exch(1:3),root=psb_root_) if (exch(1) /= m) then err=550 - int_err(1)=1 - call psb_errpush(err,name,int_err) + l_err(1)=1 + call psb_errpush(err,name,l_err=l_err) goto 9999 else if (exch(2) /= n) then err=550 - int_err(1)=2 - call psb_errpush(err,name,int_err) + l_err(1)=2 + call psb_errpush(err,name,l_err=l_err) goto 9999 endif call psb_cd_set_large_threshold(exch(3)) @@ -142,7 +142,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) allocate(vl(loc_row),ix(loc_row),stat=info) if (info /= psb_success_) then info=psb_err_alloc_dealloc_ - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,l_err=l_err) goto 9999 end if @@ -158,7 +158,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) allocate(tmpgidx(m,2),stat=info) if (info /= psb_success_) then info=psb_err_alloc_dealloc_ - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,l_err=l_err) goto 9999 end if tmpgidx = 0 @@ -166,10 +166,10 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) do i=1,loc_row if ((v(i)<1).or.(v(i)>m)) then info = psb_err_entry_out_of_bounds_ - int_err(1) = i - int_err(2) = v(i) - int_err(3) = loc_row - int_err(4) = m + l_err(1) = i + l_err(2) = v(i) + l_err(3) = loc_row + l_err(4) = m else tmpgidx(v(i),1) = me+flag_ tmpgidx(v(i),2) = 1 @@ -192,11 +192,12 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) end if end do if (norphan > 0) then - int_err(1) = norphan - int_err(2) = m + l_err(1) = norphan + l_err(2) = m info = psb_err_inconsistent_index_lists_ end if end if + else novrl = 0 norphan = 0 @@ -204,10 +205,10 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) do i=1,loc_row if ((v(i)<1).or.(v(i)>m)) then info = psb_err_entry_out_of_bounds_ - int_err(1) = i - int_err(2) = v(i) - int_err(3) = loc_row - int_err(4) = m + l_err(1) = i + l_err(2) = v(i) + l_err(3) = loc_row + l_err(4) = m exit endif vl(i) = v(i) @@ -220,7 +221,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) end if if (info /= psb_success_) then - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,l_err=l_err) goto 9999 end if @@ -265,8 +266,8 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) allocate(nov(0:np),ov_idx(npr_ov,2),stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - int_err(1)=np + 2*npr_ov - call psb_errpush(info,name,i_err=int_err,a_err='integer') + l_err(1)=np + 2*npr_ov + call psb_errpush(info,name,l_err=l_err,a_err='integer') goto 9999 endif nov=0 @@ -311,8 +312,8 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx) end if if (info /= psb_success_) then info=psb_err_alloc_request_ - int_err(1)=2*m+psb_mdata_size_ - call psb_errpush(info,name,i_err=int_err,a_err='integer') + l_err(1)=2*m+psb_mdata_size_ + call psb_errpush(info,name,l_err=l_err,a_err='integer') goto 9999 endif diff --git a/base/tools/psb_cdalv.f90 b/base/tools/psb_cdalv.f90 index 633bffbe..1e433eaa 100644 --- a/base/tools/psb_cdalv.f90 +++ b/base/tools/psb_cdalv.f90 @@ -60,8 +60,8 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag) integer(psb_ipk_) :: counter,j,np,me,loc_row,err,& & loc_col,nprocs,itmpov, k,glx,& & l_ov_ix,l_ov_el,idx, flag_, err_act - integer(psb_lpk_) :: m,n,i - integer(psb_ipk_) :: int_err(5),exch(3) + integer(psb_lpk_) :: m,n,i,exch(3) + integer(psb_lpk_) :: l_err(5) integer(psb_ipk_), allocatable :: temp_ovrlap(:) integer(psb_ipk_) :: debug_level, debug_unit integer(psb_mpk_) :: iictxt @@ -83,20 +83,20 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag) !... check m and n parameters.... if (m < 1) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m + l_err(1) = 1 + l_err(2) = m else if (n < 1) then info = psb_err_iarg_neg_ - int_err(1) = 2 - int_err(2) = n + l_err(1) = 2 + l_err(2) = n else if (size(v)1)) then info = 6 - err=info call psb_errpush(info,name) goto 9999 end if @@ -142,8 +141,8 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag) allocate(temp_ovrlap(2),stat=info) if (info /= psb_success_) then info=psb_err_alloc_request_ - int_err(1)=2*m+psb_mdata_size_ - call psb_errpush(info,name,i_err=int_err,a_err='integer') + l_err(1)=2*m+psb_mdata_size_ + call psb_errpush(info,name,l_err=l_err,a_err='integer') goto 9999 endif @@ -157,9 +156,9 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag) if (((v(i)-flag_) > np-1).or.((v(i)-flag_) < 0)) then info=psb_err_partfunc_wrong_pid_ - int_err(1)=3 - int_err(2)=v(i) - flag_ - int_err(3)=i + l_err(1)=3 + l_err(2)=v(i) - flag_ + l_err(3)=i exit end if @@ -168,6 +167,11 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag) counter=counter+1 end if enddo + if (info /= psb_success_) then + call psb_errpush(info,name,l_err=l_err) + goto 9999 + endif + loc_row=counter ! diff --git a/base/tools/psb_cdren.f90 b/base/tools/psb_cdren.f90 index 3df0750f..95568a8e 100644 --- a/base/tools/psb_cdren.f90 +++ b/base/tools/psb_cdren.f90 @@ -58,7 +58,7 @@ subroutine psb_cdren(trans,iperm,desc_a,info) !....locals.... integer(psb_ipk_) :: i,j,np,me, n_col, kh, nh integer(psb_ipk_) :: dectype - integer(psb_ipk_) :: ictxt,n_row, int_err(5), err_act + integer(psb_ipk_) :: ictxt,n_row, err_act integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -84,16 +84,14 @@ subroutine psb_cdren(trans,iperm,desc_a,info) if (.not.psb_is_asb_desc(desc_a)) then info = psb_err_invalid_cd_state_ - int_err(1) = dectype - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/dectype/)) goto 9999 endif if (iperm(1) /= 0) then if (.not.psb_isaperm(n_row,iperm)) then info = 610 - int_err(1) = iperm(1) - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/iperm(1)/)) goto 9999 endif endif diff --git a/base/tools/psb_cdrep.f90 b/base/tools/psb_cdrep.f90 index 44c88627..61f0ac2a 100644 --- a/base/tools/psb_cdrep.f90 +++ b/base/tools/psb_cdrep.f90 @@ -115,7 +115,7 @@ subroutine psb_cdrep(m, ictxt, desc, info) !locals integer(psb_ipk_) :: i,np,me,err,err_act integer(psb_lpk_) :: n - integer(psb_ipk_) :: int_err(5),exch(2) + integer(psb_lpk_) :: l_err(5),exch(2) integer(psb_ipk_) :: thalo(1), tovr(1), text(1) integer(psb_ipk_) :: debug_level, debug_unit integer(psb_mpk_) :: iictxt @@ -136,16 +136,16 @@ subroutine psb_cdrep(m, ictxt, desc, info) !... check m and n parameters.... if (m < 1) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m + l_err(1) = 1 + l_err(2) = m else if (n < 1) then info = psb_err_iarg_neg_ - int_err(1) = 2 - int_err(2) = n + l_err(1) = 2 + l_err(2) = n endif if (info /= psb_success_) then - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,l_err=l_err) goto 9999 end if @@ -160,15 +160,15 @@ subroutine psb_cdrep(m, ictxt, desc, info) call psb_bcast(ictxt,exch(1:2),root=psb_root_) if (exch(1) /= m) then info=psb_err_parm_differs_among_procs_ - int_err(1)=1 + l_err(1)=1 else if (exch(2) /= n) then info=psb_err_parm_differs_among_procs_ - int_err(1)=2 + l_err(1)=2 endif endif if (info /= psb_success_) then - call psb_errpush(info,name,i_err=int_err) + call psb_errpush(info,name,l_err=l_err) goto 9999 end if diff --git a/base/tools/psb_cins.f90 b/base/tools/psb_cins.f90 index 1308f61f..a069c33b 100644 --- a/base/tools/psb_cins.f90 +++ b/base/tools/psb_cins.f90 @@ -65,10 +65,9 @@ subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_,err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -96,15 +95,11 @@ subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -180,10 +175,9 @@ subroutine psb_cins_vect_v(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) complex(psb_spk_), allocatable :: lval(:) logical :: local_ @@ -212,15 +206,11 @@ subroutine psb_cins_vect_v(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -290,10 +280,9 @@ subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5), n + integer(psb_ipk_) :: i, loc_rows,loc_cols, n integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -326,15 +315,11 @@ subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x(1)%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -412,10 +397,9 @@ subroutine psb_cins_multivect(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -443,15 +427,11 @@ subroutine psb_cins_multivect(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif diff --git a/base/tools/psb_cins_a.f90 b/base/tools/psb_cins_a.f90 index 60d31419..cc2aeb71 100644 --- a/base/tools/psb_cins_a.f90 +++ b/base/tools/psb_cins_a.f90 @@ -66,10 +66,9 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt,np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -97,15 +96,11 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -249,16 +244,15 @@ subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,loc_row,j,n,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np,me,dupl_ + integer(psb_ipk_) :: ictxt,np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name if(psb_get_errstatus() /= 0) return - info=psb_success_ + info = psb_success_ call psb_erractionsave(err_act) name = 'psb_cinsi' @@ -280,15 +274,11 @@ subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif if (m == 0) return diff --git a/base/tools/psb_cspalloc.f90 b/base/tools/psb_cspalloc.f90 index f954cc42..30f51063 100644 --- a/base/tools/psb_cspalloc.f90 +++ b/base/tools/psb_cspalloc.f90 @@ -55,9 +55,8 @@ subroutine psb_cspalloc(a, desc_a, info, nnz) integer(psb_ipk_) :: ictxt, dectype integer(psb_ipk_) :: np,me,loc_row,loc_col,& & length_ia1,length_ia2, err_act,m,n - integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: debug_level, debug_unit - character(len=20) :: name, ch_err + character(len=20) :: name if(psb_get_errstatus() /= 0) return info=psb_success_ @@ -87,9 +86,7 @@ subroutine psb_cspalloc(a, desc_a, info, nnz) if (present(nnz))then if (nnz < 0) then info=45 - int_err(1)=7 - int_err(2)=nnz - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/7_psb_ipk_,nnz/)) goto 9999 endif length_ia1=nnz @@ -105,8 +102,7 @@ subroutine psb_cspalloc(a, desc_a, info, nnz) call a%csall(loc_row,loc_col,info,nz=length_ia1) if(info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='sp_all' - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,a_err='sp_all') goto 9999 end if diff --git a/base/tools/psb_dallc.f90 b/base/tools/psb_dallc.f90 index d2bdd981..ac812ca7 100644 --- a/base/tools/psb_dallc.f90 +++ b/base/tools/psb_dallc.f90 @@ -55,7 +55,7 @@ subroutine psb_dalloc_vect(x, desc_a,info,n) !locals integer(psb_ipk_) :: np,me,nr,i,err_act - integer(psb_ipk_) :: ictxt, int_err(5) + integer(psb_ipk_) :: ictxt integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -92,7 +92,7 @@ subroutine psb_dalloc_vect(x, desc_a,info,n) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif @@ -100,8 +100,7 @@ subroutine psb_dalloc_vect(x, desc_a,info,n) if (info == 0) call x%all(nr,info) if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)') goto 9999 endif call x%zero() @@ -128,7 +127,7 @@ subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb) !locals integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, int_err(5), exch(1) + integer(psb_ipk_) :: ictxt, exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -175,8 +174,7 @@ subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb) call psb_bcast(ictxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ - int_err(1)=1 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione/)) goto 9999 endif endif @@ -189,7 +187,7 @@ subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif @@ -204,8 +202,7 @@ subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb) end if if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)') goto 9999 endif @@ -232,7 +229,7 @@ subroutine psb_dalloc_multivect(x, desc_a,info,n) !locals integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, int_err(5), exch(1) + integer(psb_ipk_) :: ictxt, exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -274,8 +271,7 @@ subroutine psb_dalloc_multivect(x, desc_a,info,n) call psb_bcast(ictxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ - int_err(1)=1 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione/)) goto 9999 endif endif @@ -288,7 +284,7 @@ subroutine psb_dalloc_multivect(x, desc_a,info,n) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif @@ -298,8 +294,7 @@ subroutine psb_dalloc_multivect(x, desc_a,info,n) if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)') goto 9999 endif diff --git a/base/tools/psb_dallc_a.f90 b/base/tools/psb_dallc_a.f90 index e294a337..5be99bf8 100644 --- a/base/tools/psb_dallc_a.f90 +++ b/base/tools/psb_dallc_a.f90 @@ -54,16 +54,15 @@ subroutine psb_dalloc(x, desc_a, info, n, lb) integer(psb_ipk_), optional, intent(in) :: n, lb !locals - integer(psb_ipk_) :: np,me,err,nr,i,j,err_act - integer(psb_ipk_) :: ictxt,n_ - integer(psb_ipk_) :: int_err(5),exch(3) + integer(psb_ipk_) :: err,nr,i,j,n_,err_act + integer(psb_ipk_) :: ictxt,np,me + integer(psb_ipk_) :: exch(3) character(len=20) :: name name='psb_geall' if(psb_get_errstatus() /= 0) return - info=psb_success_ - err=0 - int_err(1)=0 + info = psb_success_ + err = 0 call psb_erractionsave(err_act) ictxt=desc_a%get_context() @@ -95,8 +94,7 @@ subroutine psb_dalloc(x, desc_a, info, n, lb) call psb_bcast(ictxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ - int_err(1)=1 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione/)) goto 9999 endif endif @@ -108,15 +106,14 @@ subroutine psb_dalloc(x, desc_a, info, n, lb) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif call psb_realloc(nr,n_,x,info,lb2=lb) if (info /= psb_success_) then info=psb_err_alloc_request_ - int_err(1)=nr*n_ - call psb_errpush(info,name,int_err,a_err='real(psb_dpk_)') + call psb_errpush(info,name,i_err=(/nr*n_/),a_err='real(psb_dpk_)') goto 9999 endif @@ -183,8 +180,8 @@ subroutine psb_dallocv(x, desc_a,info,n) integer(psb_ipk_), optional, intent(in) :: n !locals - integer(psb_ipk_) :: np,me,nr,i,err_act - integer(psb_ipk_) :: ictxt, int_err(5) + integer(psb_ipk_) :: nr,i,err_act + integer(psb_ipk_) :: ictxt, np,me integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -221,15 +218,14 @@ subroutine psb_dallocv(x, desc_a,info,n) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif call psb_realloc(nr,x,info) if (info /= psb_success_) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='real(psb_dpk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_dpk_)') goto 9999 endif diff --git a/base/tools/psb_dins.f90 b/base/tools/psb_dins.f90 index d23a2b7d..84d5a015 100644 --- a/base/tools/psb_dins.f90 +++ b/base/tools/psb_dins.f90 @@ -65,10 +65,9 @@ subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_,err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -96,15 +95,11 @@ subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -180,10 +175,9 @@ subroutine psb_dins_vect_v(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) real(psb_dpk_), allocatable :: lval(:) logical :: local_ @@ -212,15 +206,11 @@ subroutine psb_dins_vect_v(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -290,10 +280,9 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5), n + integer(psb_ipk_) :: i, loc_rows,loc_cols, n integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -326,15 +315,11 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x(1)%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -412,10 +397,9 @@ subroutine psb_dins_multivect(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -443,15 +427,11 @@ subroutine psb_dins_multivect(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif diff --git a/base/tools/psb_dins_a.f90 b/base/tools/psb_dins_a.f90 index 159268b5..f2c5e0ea 100644 --- a/base/tools/psb_dins_a.f90 +++ b/base/tools/psb_dins_a.f90 @@ -66,10 +66,9 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt,np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -97,15 +96,11 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -249,16 +244,15 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,loc_row,j,n,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np,me,dupl_ + integer(psb_ipk_) :: ictxt,np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name if(psb_get_errstatus() /= 0) return - info=psb_success_ + info = psb_success_ call psb_erractionsave(err_act) name = 'psb_dinsi' @@ -280,15 +274,11 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif if (m == 0) return diff --git a/base/tools/psb_dspalloc.f90 b/base/tools/psb_dspalloc.f90 index 34a329db..f702f326 100644 --- a/base/tools/psb_dspalloc.f90 +++ b/base/tools/psb_dspalloc.f90 @@ -55,9 +55,8 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) integer(psb_ipk_) :: ictxt, dectype integer(psb_ipk_) :: np,me,loc_row,loc_col,& & length_ia1,length_ia2, err_act,m,n - integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: debug_level, debug_unit - character(len=20) :: name, ch_err + character(len=20) :: name if(psb_get_errstatus() /= 0) return info=psb_success_ @@ -87,9 +86,7 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) if (present(nnz))then if (nnz < 0) then info=45 - int_err(1)=7 - int_err(2)=nnz - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/7_psb_ipk_,nnz/)) goto 9999 endif length_ia1=nnz @@ -105,8 +102,7 @@ subroutine psb_dspalloc(a, desc_a, info, nnz) call a%csall(loc_row,loc_col,info,nz=length_ia1) if(info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='sp_all' - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,a_err='sp_all') goto 9999 end if diff --git a/base/tools/psb_eallc_a.f90 b/base/tools/psb_eallc_a.f90 index 4cbec2e7..4e36442f 100644 --- a/base/tools/psb_eallc_a.f90 +++ b/base/tools/psb_eallc_a.f90 @@ -54,16 +54,15 @@ subroutine psb_ealloc(x, desc_a, info, n, lb) integer(psb_ipk_), optional, intent(in) :: n, lb !locals - integer(psb_ipk_) :: np,me,err,nr,i,j,err_act - integer(psb_ipk_) :: ictxt,n_ - integer(psb_ipk_) :: int_err(5),exch(3) + integer(psb_ipk_) :: err,nr,i,j,n_,err_act + integer(psb_ipk_) :: ictxt,np,me + integer(psb_ipk_) :: exch(3) character(len=20) :: name name='psb_geall' if(psb_get_errstatus() /= 0) return - info=psb_success_ - err=0 - int_err(1)=0 + info = psb_success_ + err = 0 call psb_erractionsave(err_act) ictxt=desc_a%get_context() @@ -95,8 +94,7 @@ subroutine psb_ealloc(x, desc_a, info, n, lb) call psb_bcast(ictxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ - int_err(1)=1 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione/)) goto 9999 endif endif @@ -108,15 +106,14 @@ subroutine psb_ealloc(x, desc_a, info, n, lb) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif call psb_realloc(nr,n_,x,info,lb2=lb) if (info /= psb_success_) then info=psb_err_alloc_request_ - int_err(1)=nr*n_ - call psb_errpush(info,name,int_err,a_err='integer(psb_epk_)') + call psb_errpush(info,name,i_err=(/nr*n_/),a_err='integer(psb_epk_)') goto 9999 endif @@ -183,8 +180,8 @@ subroutine psb_eallocv(x, desc_a,info,n) integer(psb_ipk_), optional, intent(in) :: n !locals - integer(psb_ipk_) :: np,me,nr,i,err_act - integer(psb_ipk_) :: ictxt, int_err(5) + integer(psb_ipk_) :: nr,i,err_act + integer(psb_ipk_) :: ictxt, np,me integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -221,15 +218,14 @@ subroutine psb_eallocv(x, desc_a,info,n) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif call psb_realloc(nr,x,info) if (info /= psb_success_) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='integer(psb_epk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='integer(psb_epk_)') goto 9999 endif diff --git a/base/tools/psb_eins_a.f90 b/base/tools/psb_eins_a.f90 index 590f5f77..634c5799 100644 --- a/base/tools/psb_eins_a.f90 +++ b/base/tools/psb_eins_a.f90 @@ -66,10 +66,9 @@ subroutine psb_einsvi(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt,np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -97,15 +96,11 @@ subroutine psb_einsvi(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -249,16 +244,15 @@ subroutine psb_einsi(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,loc_row,j,n,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np,me,dupl_ + integer(psb_ipk_) :: ictxt,np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name if(psb_get_errstatus() /= 0) return - info=psb_success_ + info = psb_success_ call psb_erractionsave(err_act) name = 'psb_einsi' @@ -280,15 +274,11 @@ subroutine psb_einsi(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif if (m == 0) return diff --git a/base/tools/psb_iallc.f90 b/base/tools/psb_iallc.f90 index 41c196b0..8f0ab312 100644 --- a/base/tools/psb_iallc.f90 +++ b/base/tools/psb_iallc.f90 @@ -55,7 +55,7 @@ subroutine psb_ialloc_vect(x, desc_a,info,n) !locals integer(psb_ipk_) :: np,me,nr,i,err_act - integer(psb_ipk_) :: ictxt, int_err(5) + integer(psb_ipk_) :: ictxt integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -92,7 +92,7 @@ subroutine psb_ialloc_vect(x, desc_a,info,n) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif @@ -100,8 +100,7 @@ subroutine psb_ialloc_vect(x, desc_a,info,n) if (info == 0) call x%all(nr,info) if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)') goto 9999 endif call x%zero() @@ -128,7 +127,7 @@ subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb) !locals integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, int_err(5), exch(1) + integer(psb_ipk_) :: ictxt, exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -175,8 +174,7 @@ subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb) call psb_bcast(ictxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ - int_err(1)=1 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione/)) goto 9999 endif endif @@ -189,7 +187,7 @@ subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif @@ -204,8 +202,7 @@ subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb) end if if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)') goto 9999 endif @@ -232,7 +229,7 @@ subroutine psb_ialloc_multivect(x, desc_a,info,n) !locals integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, int_err(5), exch(1) + integer(psb_ipk_) :: ictxt, exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -274,8 +271,7 @@ subroutine psb_ialloc_multivect(x, desc_a,info,n) call psb_bcast(ictxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ - int_err(1)=1 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione/)) goto 9999 endif endif @@ -288,7 +284,7 @@ subroutine psb_ialloc_multivect(x, desc_a,info,n) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif @@ -298,8 +294,7 @@ subroutine psb_ialloc_multivect(x, desc_a,info,n) if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)') goto 9999 endif diff --git a/base/tools/psb_iins.f90 b/base/tools/psb_iins.f90 index 1fd8bcd2..8b8eea7e 100644 --- a/base/tools/psb_iins.f90 +++ b/base/tools/psb_iins.f90 @@ -65,10 +65,9 @@ subroutine psb_iins_vect(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_,err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -96,15 +95,11 @@ subroutine psb_iins_vect(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -180,10 +175,9 @@ subroutine psb_iins_vect_v(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: lval(:) logical :: local_ @@ -212,15 +206,11 @@ subroutine psb_iins_vect_v(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -290,10 +280,9 @@ subroutine psb_iins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5), n + integer(psb_ipk_) :: i, loc_rows,loc_cols, n integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -326,15 +315,11 @@ subroutine psb_iins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x(1)%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -412,10 +397,9 @@ subroutine psb_iins_multivect(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -443,15 +427,11 @@ subroutine psb_iins_multivect(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif diff --git a/base/tools/psb_lallc.f90 b/base/tools/psb_lallc.f90 index c79be292..66731177 100644 --- a/base/tools/psb_lallc.f90 +++ b/base/tools/psb_lallc.f90 @@ -55,7 +55,7 @@ subroutine psb_lalloc_vect(x, desc_a,info,n) !locals integer(psb_ipk_) :: np,me,nr,i,err_act - integer(psb_ipk_) :: ictxt, int_err(5) + integer(psb_ipk_) :: ictxt integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -92,7 +92,7 @@ subroutine psb_lalloc_vect(x, desc_a,info,n) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif @@ -100,8 +100,7 @@ subroutine psb_lalloc_vect(x, desc_a,info,n) if (info == 0) call x%all(nr,info) if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)') goto 9999 endif call x%zero() @@ -128,7 +127,7 @@ subroutine psb_lalloc_vect_r2(x, desc_a,info,n,lb) !locals integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, int_err(5), exch(1) + integer(psb_ipk_) :: ictxt, exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -175,8 +174,7 @@ subroutine psb_lalloc_vect_r2(x, desc_a,info,n,lb) call psb_bcast(ictxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ - int_err(1)=1 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione/)) goto 9999 endif endif @@ -189,7 +187,7 @@ subroutine psb_lalloc_vect_r2(x, desc_a,info,n,lb) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif @@ -204,8 +202,7 @@ subroutine psb_lalloc_vect_r2(x, desc_a,info,n,lb) end if if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)') goto 9999 endif @@ -232,7 +229,7 @@ subroutine psb_lalloc_multivect(x, desc_a,info,n) !locals integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, int_err(5), exch(1) + integer(psb_ipk_) :: ictxt, exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -274,8 +271,7 @@ subroutine psb_lalloc_multivect(x, desc_a,info,n) call psb_bcast(ictxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ - int_err(1)=1 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione/)) goto 9999 endif endif @@ -288,7 +284,7 @@ subroutine psb_lalloc_multivect(x, desc_a,info,n) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif @@ -298,8 +294,7 @@ subroutine psb_lalloc_multivect(x, desc_a,info,n) if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)') goto 9999 endif diff --git a/base/tools/psb_lins.f90 b/base/tools/psb_lins.f90 index bfae871b..b0d02018 100644 --- a/base/tools/psb_lins.f90 +++ b/base/tools/psb_lins.f90 @@ -65,10 +65,9 @@ subroutine psb_lins_vect(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_,err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -96,15 +95,11 @@ subroutine psb_lins_vect(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -180,10 +175,9 @@ subroutine psb_lins_vect_v(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) integer(psb_lpk_), allocatable :: lval(:) logical :: local_ @@ -212,15 +206,11 @@ subroutine psb_lins_vect_v(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -290,10 +280,9 @@ subroutine psb_lins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5), n + integer(psb_ipk_) :: i, loc_rows,loc_cols, n integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -326,15 +315,11 @@ subroutine psb_lins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x(1)%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -412,10 +397,9 @@ subroutine psb_lins_multivect(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -443,15 +427,11 @@ subroutine psb_lins_multivect(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif diff --git a/base/tools/psb_mallc_a.f90 b/base/tools/psb_mallc_a.f90 index 65388bf5..8764fa00 100644 --- a/base/tools/psb_mallc_a.f90 +++ b/base/tools/psb_mallc_a.f90 @@ -54,16 +54,15 @@ subroutine psb_malloc(x, desc_a, info, n, lb) integer(psb_ipk_), optional, intent(in) :: n, lb !locals - integer(psb_ipk_) :: np,me,err,nr,i,j,err_act - integer(psb_ipk_) :: ictxt,n_ - integer(psb_ipk_) :: int_err(5),exch(3) + integer(psb_ipk_) :: err,nr,i,j,n_,err_act + integer(psb_ipk_) :: ictxt,np,me + integer(psb_ipk_) :: exch(3) character(len=20) :: name name='psb_geall' if(psb_get_errstatus() /= 0) return - info=psb_success_ - err=0 - int_err(1)=0 + info = psb_success_ + err = 0 call psb_erractionsave(err_act) ictxt=desc_a%get_context() @@ -95,8 +94,7 @@ subroutine psb_malloc(x, desc_a, info, n, lb) call psb_bcast(ictxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ - int_err(1)=1 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione/)) goto 9999 endif endif @@ -108,15 +106,14 @@ subroutine psb_malloc(x, desc_a, info, n, lb) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif call psb_realloc(nr,n_,x,info,lb2=lb) if (info /= psb_success_) then info=psb_err_alloc_request_ - int_err(1)=nr*n_ - call psb_errpush(info,name,int_err,a_err='integer(psb_mpk_)') + call psb_errpush(info,name,i_err=(/nr*n_/),a_err='integer(psb_mpk_)') goto 9999 endif @@ -183,8 +180,8 @@ subroutine psb_mallocv(x, desc_a,info,n) integer(psb_ipk_), optional, intent(in) :: n !locals - integer(psb_ipk_) :: np,me,nr,i,err_act - integer(psb_ipk_) :: ictxt, int_err(5) + integer(psb_ipk_) :: nr,i,err_act + integer(psb_ipk_) :: ictxt, np,me integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -221,15 +218,14 @@ subroutine psb_mallocv(x, desc_a,info,n) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif call psb_realloc(nr,x,info) if (info /= psb_success_) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='integer(psb_mpk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='integer(psb_mpk_)') goto 9999 endif diff --git a/base/tools/psb_mins_a.f90 b/base/tools/psb_mins_a.f90 index fce1f2b8..c5f1360b 100644 --- a/base/tools/psb_mins_a.f90 +++ b/base/tools/psb_mins_a.f90 @@ -66,10 +66,9 @@ subroutine psb_minsvi(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt,np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -97,15 +96,11 @@ subroutine psb_minsvi(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -249,16 +244,15 @@ subroutine psb_minsi(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,loc_row,j,n,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np,me,dupl_ + integer(psb_ipk_) :: ictxt,np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name if(psb_get_errstatus() /= 0) return - info=psb_success_ + info = psb_success_ call psb_erractionsave(err_act) name = 'psb_minsi' @@ -280,15 +274,11 @@ subroutine psb_minsi(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif if (m == 0) return diff --git a/base/tools/psb_sallc.f90 b/base/tools/psb_sallc.f90 index cb529869..9cbb6f8f 100644 --- a/base/tools/psb_sallc.f90 +++ b/base/tools/psb_sallc.f90 @@ -55,7 +55,7 @@ subroutine psb_salloc_vect(x, desc_a,info,n) !locals integer(psb_ipk_) :: np,me,nr,i,err_act - integer(psb_ipk_) :: ictxt, int_err(5) + integer(psb_ipk_) :: ictxt integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -92,7 +92,7 @@ subroutine psb_salloc_vect(x, desc_a,info,n) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif @@ -100,8 +100,7 @@ subroutine psb_salloc_vect(x, desc_a,info,n) if (info == 0) call x%all(nr,info) if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)') goto 9999 endif call x%zero() @@ -128,7 +127,7 @@ subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb) !locals integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, int_err(5), exch(1) + integer(psb_ipk_) :: ictxt, exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -175,8 +174,7 @@ subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb) call psb_bcast(ictxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ - int_err(1)=1 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione/)) goto 9999 endif endif @@ -189,7 +187,7 @@ subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif @@ -204,8 +202,7 @@ subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb) end if if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)') goto 9999 endif @@ -232,7 +229,7 @@ subroutine psb_salloc_multivect(x, desc_a,info,n) !locals integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, int_err(5), exch(1) + integer(psb_ipk_) :: ictxt, exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -274,8 +271,7 @@ subroutine psb_salloc_multivect(x, desc_a,info,n) call psb_bcast(ictxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ - int_err(1)=1 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione/)) goto 9999 endif endif @@ -288,7 +284,7 @@ subroutine psb_salloc_multivect(x, desc_a,info,n) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif @@ -298,8 +294,7 @@ subroutine psb_salloc_multivect(x, desc_a,info,n) if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)') goto 9999 endif diff --git a/base/tools/psb_sallc_a.f90 b/base/tools/psb_sallc_a.f90 index 4711125e..226956e3 100644 --- a/base/tools/psb_sallc_a.f90 +++ b/base/tools/psb_sallc_a.f90 @@ -54,16 +54,15 @@ subroutine psb_salloc(x, desc_a, info, n, lb) integer(psb_ipk_), optional, intent(in) :: n, lb !locals - integer(psb_ipk_) :: np,me,err,nr,i,j,err_act - integer(psb_ipk_) :: ictxt,n_ - integer(psb_ipk_) :: int_err(5),exch(3) + integer(psb_ipk_) :: err,nr,i,j,n_,err_act + integer(psb_ipk_) :: ictxt,np,me + integer(psb_ipk_) :: exch(3) character(len=20) :: name name='psb_geall' if(psb_get_errstatus() /= 0) return - info=psb_success_ - err=0 - int_err(1)=0 + info = psb_success_ + err = 0 call psb_erractionsave(err_act) ictxt=desc_a%get_context() @@ -95,8 +94,7 @@ subroutine psb_salloc(x, desc_a, info, n, lb) call psb_bcast(ictxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ - int_err(1)=1 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione/)) goto 9999 endif endif @@ -108,15 +106,14 @@ subroutine psb_salloc(x, desc_a, info, n, lb) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif call psb_realloc(nr,n_,x,info,lb2=lb) if (info /= psb_success_) then info=psb_err_alloc_request_ - int_err(1)=nr*n_ - call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr*n_/),a_err='real(psb_spk_)') goto 9999 endif @@ -183,8 +180,8 @@ subroutine psb_sallocv(x, desc_a,info,n) integer(psb_ipk_), optional, intent(in) :: n !locals - integer(psb_ipk_) :: np,me,nr,i,err_act - integer(psb_ipk_) :: ictxt, int_err(5) + integer(psb_ipk_) :: nr,i,err_act + integer(psb_ipk_) :: ictxt, np,me integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -221,15 +218,14 @@ subroutine psb_sallocv(x, desc_a,info,n) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif call psb_realloc(nr,x,info) if (info /= psb_success_) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)') goto 9999 endif diff --git a/base/tools/psb_sins.f90 b/base/tools/psb_sins.f90 index 83ce8d42..95803319 100644 --- a/base/tools/psb_sins.f90 +++ b/base/tools/psb_sins.f90 @@ -65,10 +65,9 @@ subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_,err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -96,15 +95,11 @@ subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -180,10 +175,9 @@ subroutine psb_sins_vect_v(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) real(psb_spk_), allocatable :: lval(:) logical :: local_ @@ -212,15 +206,11 @@ subroutine psb_sins_vect_v(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -290,10 +280,9 @@ subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5), n + integer(psb_ipk_) :: i, loc_rows,loc_cols, n integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -326,15 +315,11 @@ subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x(1)%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -412,10 +397,9 @@ subroutine psb_sins_multivect(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -443,15 +427,11 @@ subroutine psb_sins_multivect(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif diff --git a/base/tools/psb_sins_a.f90 b/base/tools/psb_sins_a.f90 index b1f60d71..46edc92b 100644 --- a/base/tools/psb_sins_a.f90 +++ b/base/tools/psb_sins_a.f90 @@ -66,10 +66,9 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt,np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -97,15 +96,11 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -249,16 +244,15 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,loc_row,j,n,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np,me,dupl_ + integer(psb_ipk_) :: ictxt,np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name if(psb_get_errstatus() /= 0) return - info=psb_success_ + info = psb_success_ call psb_erractionsave(err_act) name = 'psb_sinsi' @@ -280,15 +274,11 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif if (m == 0) return diff --git a/base/tools/psb_sspalloc.f90 b/base/tools/psb_sspalloc.f90 index 91181526..ff518631 100644 --- a/base/tools/psb_sspalloc.f90 +++ b/base/tools/psb_sspalloc.f90 @@ -55,9 +55,8 @@ subroutine psb_sspalloc(a, desc_a, info, nnz) integer(psb_ipk_) :: ictxt, dectype integer(psb_ipk_) :: np,me,loc_row,loc_col,& & length_ia1,length_ia2, err_act,m,n - integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: debug_level, debug_unit - character(len=20) :: name, ch_err + character(len=20) :: name if(psb_get_errstatus() /= 0) return info=psb_success_ @@ -87,9 +86,7 @@ subroutine psb_sspalloc(a, desc_a, info, nnz) if (present(nnz))then if (nnz < 0) then info=45 - int_err(1)=7 - int_err(2)=nnz - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/7_psb_ipk_,nnz/)) goto 9999 endif length_ia1=nnz @@ -105,8 +102,7 @@ subroutine psb_sspalloc(a, desc_a, info, nnz) call a%csall(loc_row,loc_col,info,nz=length_ia1) if(info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='sp_all' - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,a_err='sp_all') goto 9999 end if diff --git a/base/tools/psb_zallc.f90 b/base/tools/psb_zallc.f90 index 0951bec8..e01f0af2 100644 --- a/base/tools/psb_zallc.f90 +++ b/base/tools/psb_zallc.f90 @@ -55,7 +55,7 @@ subroutine psb_zalloc_vect(x, desc_a,info,n) !locals integer(psb_ipk_) :: np,me,nr,i,err_act - integer(psb_ipk_) :: ictxt, int_err(5) + integer(psb_ipk_) :: ictxt integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -92,7 +92,7 @@ subroutine psb_zalloc_vect(x, desc_a,info,n) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif @@ -100,8 +100,7 @@ subroutine psb_zalloc_vect(x, desc_a,info,n) if (info == 0) call x%all(nr,info) if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)') goto 9999 endif call x%zero() @@ -128,7 +127,7 @@ subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb) !locals integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, int_err(5), exch(1) + integer(psb_ipk_) :: ictxt, exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -175,8 +174,7 @@ subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb) call psb_bcast(ictxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ - int_err(1)=1 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione/)) goto 9999 endif endif @@ -189,7 +187,7 @@ subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif @@ -204,8 +202,7 @@ subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb) end if if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)') goto 9999 endif @@ -232,7 +229,7 @@ subroutine psb_zalloc_multivect(x, desc_a,info,n) !locals integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ - integer(psb_ipk_) :: ictxt, int_err(5), exch(1) + integer(psb_ipk_) :: ictxt, exch(1) integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -274,8 +271,7 @@ subroutine psb_zalloc_multivect(x, desc_a,info,n) call psb_bcast(ictxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ - int_err(1)=1 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione/)) goto 9999 endif endif @@ -288,7 +284,7 @@ subroutine psb_zalloc_multivect(x, desc_a,info,n) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif @@ -298,8 +294,7 @@ subroutine psb_zalloc_multivect(x, desc_a,info,n) if (psb_errstatus_fatal()) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='real(psb_spk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)') goto 9999 endif diff --git a/base/tools/psb_zallc_a.f90 b/base/tools/psb_zallc_a.f90 index edd61c70..8baec201 100644 --- a/base/tools/psb_zallc_a.f90 +++ b/base/tools/psb_zallc_a.f90 @@ -54,16 +54,15 @@ subroutine psb_zalloc(x, desc_a, info, n, lb) integer(psb_ipk_), optional, intent(in) :: n, lb !locals - integer(psb_ipk_) :: np,me,err,nr,i,j,err_act - integer(psb_ipk_) :: ictxt,n_ - integer(psb_ipk_) :: int_err(5),exch(3) + integer(psb_ipk_) :: err,nr,i,j,n_,err_act + integer(psb_ipk_) :: ictxt,np,me + integer(psb_ipk_) :: exch(3) character(len=20) :: name name='psb_geall' if(psb_get_errstatus() /= 0) return - info=psb_success_ - err=0 - int_err(1)=0 + info = psb_success_ + err = 0 call psb_erractionsave(err_act) ictxt=desc_a%get_context() @@ -95,8 +94,7 @@ subroutine psb_zalloc(x, desc_a, info, n, lb) call psb_bcast(ictxt,exch(1),root=psb_root_) if (exch(1) /= n_) then info=psb_err_parm_differs_among_procs_ - int_err(1)=1 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione/)) goto 9999 endif endif @@ -108,15 +106,14 @@ subroutine psb_zalloc(x, desc_a, info, n, lb) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif call psb_realloc(nr,n_,x,info,lb2=lb) if (info /= psb_success_) then info=psb_err_alloc_request_ - int_err(1)=nr*n_ - call psb_errpush(info,name,int_err,a_err='complex(psb_dpk_)') + call psb_errpush(info,name,i_err=(/nr*n_/),a_err='complex(psb_dpk_)') goto 9999 endif @@ -183,8 +180,8 @@ subroutine psb_zallocv(x, desc_a,info,n) integer(psb_ipk_), optional, intent(in) :: n !locals - integer(psb_ipk_) :: np,me,nr,i,err_act - integer(psb_ipk_) :: ictxt, int_err(5) + integer(psb_ipk_) :: nr,i,err_act + integer(psb_ipk_) :: ictxt, np,me integer(psb_ipk_) :: debug_level, debug_unit character(len=20) :: name @@ -221,15 +218,14 @@ subroutine psb_zallocv(x, desc_a,info,n) nr = max(1,desc_a%get_local_rows()) else info = psb_err_internal_error_ - call psb_errpush(info,name,int_err,a_err='Invalid desc_a') + call psb_errpush(info,name,a_err='Invalid desc_a') goto 9999 endif call psb_realloc(nr,x,info) if (info /= psb_success_) then info=psb_err_alloc_request_ - int_err(1)=nr - call psb_errpush(info,name,int_err,a_err='complex(psb_dpk_)') + call psb_errpush(info,name,i_err=(/nr/),a_err='complex(psb_dpk_)') goto 9999 endif diff --git a/base/tools/psb_zins.f90 b/base/tools/psb_zins.f90 index 7bb53878..e87f3a11 100644 --- a/base/tools/psb_zins.f90 +++ b/base/tools/psb_zins.f90 @@ -65,10 +65,9 @@ subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_,err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -96,15 +95,11 @@ subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -180,10 +175,9 @@ subroutine psb_zins_vect_v(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) complex(psb_dpk_), allocatable :: lval(:) logical :: local_ @@ -212,15 +206,11 @@ subroutine psb_zins_vect_v(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -290,10 +280,9 @@ subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5), n + integer(psb_ipk_) :: i, loc_rows,loc_cols, n integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -326,15 +315,11 @@ subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x(1)%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -412,10 +397,9 @@ subroutine psb_zins_multivect(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -443,15 +427,11 @@ subroutine psb_zins_multivect(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (x%get_nrows() < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif diff --git a/base/tools/psb_zins_a.f90 b/base/tools/psb_zins_a.f90 index 2568177a..71c4cfc8 100644 --- a/base/tools/psb_zins_a.f90 +++ b/base/tools/psb_zins_a.f90 @@ -66,10 +66,9 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np, me, dupl_ + integer(psb_ipk_) :: ictxt,np, me, dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name @@ -97,15 +96,11 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif @@ -249,16 +244,15 @@ subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl,local) logical, intent(in), optional :: local !locals..... - integer(psb_ipk_) :: ictxt,i,loc_row,j,n,& - & loc_rows,loc_cols,err_act, int_err(5) + integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act integer(psb_lpk_) :: mglob - integer(psb_ipk_) :: np,me,dupl_ + integer(psb_ipk_) :: ictxt,np,me,dupl_ integer(psb_ipk_), allocatable :: irl(:) logical :: local_ character(len=20) :: name if(psb_get_errstatus() /= 0) return - info=psb_success_ + info = psb_success_ call psb_erractionsave(err_act) name = 'psb_zinsi' @@ -280,15 +274,11 @@ subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl,local) !... check parameters.... if (m < 0) then info = psb_err_iarg_neg_ - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/ione,m/)) goto 9999 else if (size(x, dim=1) < desc_a%get_local_rows()) then info = 310 - int_err(1) = 5 - int_err(2) = 4 - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/)) goto 9999 endif if (m == 0) return diff --git a/base/tools/psb_zspalloc.f90 b/base/tools/psb_zspalloc.f90 index 6687825f..057ba7dc 100644 --- a/base/tools/psb_zspalloc.f90 +++ b/base/tools/psb_zspalloc.f90 @@ -55,9 +55,8 @@ subroutine psb_zspalloc(a, desc_a, info, nnz) integer(psb_ipk_) :: ictxt, dectype integer(psb_ipk_) :: np,me,loc_row,loc_col,& & length_ia1,length_ia2, err_act,m,n - integer(psb_ipk_) :: int_err(5) integer(psb_ipk_) :: debug_level, debug_unit - character(len=20) :: name, ch_err + character(len=20) :: name if(psb_get_errstatus() /= 0) return info=psb_success_ @@ -87,9 +86,7 @@ subroutine psb_zspalloc(a, desc_a, info, nnz) if (present(nnz))then if (nnz < 0) then info=45 - int_err(1)=7 - int_err(2)=nnz - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,i_err=(/7_psb_ipk_,nnz/)) goto 9999 endif length_ia1=nnz @@ -105,8 +102,7 @@ subroutine psb_zspalloc(a, desc_a, info, nnz) call a%csall(loc_row,loc_col,info,nz=length_ia1) if(info /= psb_success_) then info=psb_err_from_subroutine_ - ch_err='sp_all' - call psb_errpush(info,name,int_err) + call psb_errpush(info,name,a_err='sp_all') goto 9999 end if