fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Fixed compilation with new error handling interface.

Browse Source
ILmat
Salvatore Filippone 8 years ago
parent 38b79f430a
commit b880b7c672
32 changed files with 363 additions and 610 deletions
Show Stats Download Patch File Download Diff File

27
base/tools/psb_callc.f90
Unescape Escape View File

@ -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

28
base/tools/psb_callc_a.f90
Unescape Escape View File

@ -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

55
base/tools/psb_cd_inloc.f90
Unescape Escape View File

@ -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

42
base/tools/psb_cdalv.f90
Unescape Escape View File

@ -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)<m) then
info = psb_err_iarg_neg_
int_err(1) = 2
int_err(2) = size(v)
l_err(1) = 2
l_err(2) = size(v)
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
@ -109,13 +109,13 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag)
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))
@ -131,7 +131,6 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag)
if ((flag_<0).or.(flag_>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
!

8
base/tools/psb_cdren.f90
Unescape Escape View File

@ -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

18
base/tools/psb_cdrep.f90
Unescape Escape View File

@ -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

52
base/tools/psb_cins.f90
Unescape Escape View File

@ -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

28
base/tools/psb_cins_a.f90
Unescape Escape View File

@ -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

10
base/tools/psb_cspalloc.f90
Unescape Escape View File

@ -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

27
base/tools/psb_dallc.f90
Unescape Escape View File

@ -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

28
base/tools/psb_dallc_a.f90
Unescape Escape View File

@ -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

52
base/tools/psb_dins.f90
Unescape Escape View File

@ -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

28
base/tools/psb_dins_a.f90
Unescape Escape View File

@ -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

10
base/tools/psb_dspalloc.f90
Unescape Escape View File

@ -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

28
base/tools/psb_eallc_a.f90
Unescape Escape View File

@ -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

28
base/tools/psb_eins_a.f90
Unescape Escape View File

@ -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

27
base/tools/psb_iallc.f90
Unescape Escape View File

@ -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

52
base/tools/psb_iins.f90
Unescape Escape View File

@ -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

27
base/tools/psb_lallc.f90
Unescape Escape View File

@ -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

52
base/tools/psb_lins.f90
Unescape Escape View File

@ -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

28
base/tools/psb_mallc_a.f90
Unescape Escape View File

@ -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

28
base/tools/psb_mins_a.f90
Unescape Escape View File

@ -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

27
base/tools/psb_sallc.f90
Unescape Escape View File

@ -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

28
base/tools/psb_sallc_a.f90
Unescape Escape View File

@ -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

52
base/tools/psb_sins.f90
Unescape Escape View File

@ -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

28
base/tools/psb_sins_a.f90
Unescape Escape View File

@ -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

10
base/tools/psb_sspalloc.f90
Unescape Escape View File

@ -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

27
base/tools/psb_zallc.f90
Unescape Escape View File

@ -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

28
base/tools/psb_zallc_a.f90
Unescape Escape View File

@ -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

52
base/tools/psb_zins.f90
Unescape Escape View File

@ -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

28
base/tools/psb_zins_a.f90
Unescape Escape View File

@ -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

10
base/tools/psb_zspalloc.f90
Unescape Escape View File

@ -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

Write Preview
Loading…
Cancel
Save