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 !locals
integer(psb_ipk_) :: np,me,nr,i,err_act 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 integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name 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()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
@ -100,8 +100,7 @@ subroutine psb_calloc_vect(x, desc_a,info,n)
if (info == 0) call x%all(nr,info) if (info == 0) call x%all(nr,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
goto 9999 goto 9999
endif endif
call x%zero() call x%zero()
@ -128,7 +127,7 @@ subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb)
!locals !locals
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ 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 integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name 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_) call psb_bcast(ictxt,exch(1),root=psb_root_)
if (exch(1) /= n_) then if (exch(1) /= n_) then
info=psb_err_parm_differs_among_procs_ info=psb_err_parm_differs_among_procs_
int_err(1)=1 call psb_errpush(info,name,i_err=(/ione/))
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
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()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
@ -204,8 +202,7 @@ subroutine psb_calloc_vect_r2(x, desc_a,info,n,lb)
end if end if
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
goto 9999 goto 9999
endif endif
@ -232,7 +229,7 @@ subroutine psb_calloc_multivect(x, desc_a,info,n)
!locals !locals
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ 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 integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name 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_) call psb_bcast(ictxt,exch(1),root=psb_root_)
if (exch(1) /= n_) then if (exch(1) /= n_) then
info=psb_err_parm_differs_among_procs_ info=psb_err_parm_differs_among_procs_
int_err(1)=1 call psb_errpush(info,name,i_err=(/ione/))
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
endif endif
@ -288,7 +284,7 @@ subroutine psb_calloc_multivect(x, desc_a,info,n)
nr = max(1,desc_a%get_local_rows()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
@ -298,8 +294,7 @@ subroutine psb_calloc_multivect(x, desc_a,info,n)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
goto 9999 goto 9999
endif 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 integer(psb_ipk_), optional, intent(in) :: n, lb
!locals !locals
integer(psb_ipk_) :: np,me,err,nr,i,j,err_act integer(psb_ipk_) :: err,nr,i,j,n_,err_act
integer(psb_ipk_) :: ictxt,n_ integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: int_err(5),exch(3) integer(psb_ipk_) :: exch(3)
character(len=20) :: name character(len=20) :: name
name='psb_geall' name='psb_geall'
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=psb_success_ info = psb_success_
err=0 err = 0
int_err(1)=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=desc_a%get_context() 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_) call psb_bcast(ictxt,exch(1),root=psb_root_)
if (exch(1) /= n_) then if (exch(1) /= n_) then
info=psb_err_parm_differs_among_procs_ info=psb_err_parm_differs_among_procs_
int_err(1)=1 call psb_errpush(info,name,i_err=(/ione/))
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
endif endif
@ -108,15 +106,14 @@ subroutine psb_calloc(x, desc_a, info, n, lb)
nr = max(1,desc_a%get_local_rows()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
call psb_realloc(nr,n_,x,info,lb2=lb) call psb_realloc(nr,n_,x,info,lb2=lb)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr*n_ call psb_errpush(info,name,i_err=(/nr*n_/),a_err='complex(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='complex(psb_spk_)')
goto 9999 goto 9999
endif endif
@ -183,8 +180,8 @@ subroutine psb_callocv(x, desc_a,info,n)
integer(psb_ipk_), optional, intent(in) :: n integer(psb_ipk_), optional, intent(in) :: n
!locals !locals
integer(psb_ipk_) :: np,me,nr,i,err_act integer(psb_ipk_) :: nr,i,err_act
integer(psb_ipk_) :: ictxt, int_err(5) integer(psb_ipk_) :: ictxt, np,me
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name character(len=20) :: name
@ -221,15 +218,14 @@ subroutine psb_callocv(x, desc_a,info,n)
nr = max(1,desc_a%get_local_rows()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
call psb_realloc(nr,x,info) call psb_realloc(nr,x,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='complex(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='complex(psb_spk_)')
goto 9999 goto 9999
endif 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,& & flag_, err_act, novrl, norphan,&
& npr_ov, itmpov, i_pnt & npr_ov, itmpov, i_pnt
integer(psb_lpk_) :: m, n, nrt, il 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(:,:), & integer(psb_ipk_), allocatable :: tmpgidx(:,:), &
& nov(:), ov_idx(:,:), temp_ovrlap(:) & nov(:), ov_idx(:,:), temp_ovrlap(:)
integer(psb_lpk_), allocatable :: vl(:), ix(:), l_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.... !... check m and n parameters....
if (m < 1) then if (m < 1) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 l_err(1) = 1
int_err(2) = m l_err(2) = m
else if (n < 1) then else if (n < 1) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 2 l_err(1) = 2
int_err(2) = n l_err(2) = n
endif endif
if (info /= psb_success_) then 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 goto 9999
end if end if
if (me == psb_root_) then 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_) call psb_bcast(ictxt,exch(1:3),root=psb_root_)
if (exch(1) /= m) then if (exch(1) /= m) then
err=550 err=550
int_err(1)=1 l_err(1)=1
call psb_errpush(err,name,int_err) call psb_errpush(err,name,l_err=l_err)
goto 9999 goto 9999
else if (exch(2) /= n) then else if (exch(2) /= n) then
err=550 err=550
int_err(1)=2 l_err(1)=2
call psb_errpush(err,name,int_err) call psb_errpush(err,name,l_err=l_err)
goto 9999 goto 9999
endif endif
call psb_cd_set_large_threshold(exch(3)) 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) allocate(vl(loc_row),ix(loc_row),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_dealloc_ 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 goto 9999
end if end if
@ -158,7 +158,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
allocate(tmpgidx(m,2),stat=info) allocate(tmpgidx(m,2),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_dealloc_ 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 goto 9999
end if end if
tmpgidx = 0 tmpgidx = 0
@ -166,10 +166,10 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
do i=1,loc_row do i=1,loc_row
if ((v(i)<1).or.(v(i)>m)) then if ((v(i)<1).or.(v(i)>m)) then
info = psb_err_entry_out_of_bounds_ info = psb_err_entry_out_of_bounds_
int_err(1) = i l_err(1) = i
int_err(2) = v(i) l_err(2) = v(i)
int_err(3) = loc_row l_err(3) = loc_row
int_err(4) = m l_err(4) = m
else else
tmpgidx(v(i),1) = me+flag_ tmpgidx(v(i),1) = me+flag_
tmpgidx(v(i),2) = 1 tmpgidx(v(i),2) = 1
@ -192,11 +192,12 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
end if end if
end do end do
if (norphan > 0) then if (norphan > 0) then
int_err(1) = norphan l_err(1) = norphan
int_err(2) = m l_err(2) = m
info = psb_err_inconsistent_index_lists_ info = psb_err_inconsistent_index_lists_
end if end if
end if end if
else else
novrl = 0 novrl = 0
norphan = 0 norphan = 0
@ -204,10 +205,10 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
do i=1,loc_row do i=1,loc_row
if ((v(i)<1).or.(v(i)>m)) then if ((v(i)<1).or.(v(i)>m)) then
info = psb_err_entry_out_of_bounds_ info = psb_err_entry_out_of_bounds_
int_err(1) = i l_err(1) = i
int_err(2) = v(i) l_err(2) = v(i)
int_err(3) = loc_row l_err(3) = loc_row
int_err(4) = m l_err(4) = m
exit exit
endif endif
vl(i) = v(i) vl(i) = v(i)
@ -220,7 +221,7 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
end if end if
if (info /= psb_success_) then 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 goto 9999
end if 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) allocate(nov(0:np),ov_idx(npr_ov,2),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=np + 2*npr_ov l_err(1)=np + 2*npr_ov
call psb_errpush(info,name,i_err=int_err,a_err='integer') call psb_errpush(info,name,l_err=l_err,a_err='integer')
goto 9999 goto 9999
endif endif
nov=0 nov=0
@ -311,8 +312,8 @@ subroutine psb_cd_inloc(v, ictxt, desc, info, globalcheck,idx)
end if end if
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=2*m+psb_mdata_size_ l_err(1)=2*m+psb_mdata_size_
call psb_errpush(info,name,i_err=int_err,a_err='integer') call psb_errpush(info,name,l_err=l_err,a_err='integer')
goto 9999 goto 9999
endif 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,& integer(psb_ipk_) :: counter,j,np,me,loc_row,err,&
& loc_col,nprocs,itmpov, k,glx,& & loc_col,nprocs,itmpov, k,glx,&
& l_ov_ix,l_ov_el,idx, flag_, err_act & l_ov_ix,l_ov_el,idx, flag_, err_act
integer(psb_lpk_) :: m,n,i integer(psb_lpk_) :: m,n,i,exch(3)
integer(psb_ipk_) :: int_err(5),exch(3) integer(psb_lpk_) :: l_err(5)
integer(psb_ipk_), allocatable :: temp_ovrlap(:) integer(psb_ipk_), allocatable :: temp_ovrlap(:)
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_mpk_) :: iictxt integer(psb_mpk_) :: iictxt
@ -83,20 +83,20 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag)
!... check m and n parameters.... !... check m and n parameters....
if (m < 1) then if (m < 1) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 l_err(1) = 1
int_err(2) = m l_err(2) = m
else if (n < 1) then else if (n < 1) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 2 l_err(1) = 2
int_err(2) = n l_err(2) = n
else if (size(v)<m) then else if (size(v)<m) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 2 l_err(1) = 2
int_err(2) = size(v) l_err(2) = size(v)
endif endif
if (info /= psb_success_) then 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 goto 9999
end if end if
@ -109,13 +109,13 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag)
call psb_bcast(ictxt,exch(1:3),root=psb_root_) call psb_bcast(ictxt,exch(1:3),root=psb_root_)
if (exch(1) /= m) then if (exch(1) /= m) then
err=550 err=550
int_err(1)=1 l_err(1)=1
call psb_errpush(err,name,int_err) call psb_errpush(err,name,l_err=l_err)
goto 9999 goto 9999
else if (exch(2) /= n) then else if (exch(2) /= n) then
err=550 err=550
int_err(1)=2 l_err(1)=2
call psb_errpush(err,name,int_err) call psb_errpush(err,name,l_err=l_err)
goto 9999 goto 9999
endif endif
call psb_cd_set_large_threshold(exch(3)) 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 if ((flag_<0).or.(flag_>1)) then
info = 6 info = 6
err=info
call psb_errpush(info,name) call psb_errpush(info,name)
goto 9999 goto 9999
end if end if
@ -142,8 +141,8 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag)
allocate(temp_ovrlap(2),stat=info) allocate(temp_ovrlap(2),stat=info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=2*m+psb_mdata_size_ l_err(1)=2*m+psb_mdata_size_
call psb_errpush(info,name,i_err=int_err,a_err='integer') call psb_errpush(info,name,l_err=l_err,a_err='integer')
goto 9999 goto 9999
endif 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 if (((v(i)-flag_) > np-1).or.((v(i)-flag_) < 0)) then
info=psb_err_partfunc_wrong_pid_ info=psb_err_partfunc_wrong_pid_
int_err(1)=3 l_err(1)=3
int_err(2)=v(i) - flag_ l_err(2)=v(i) - flag_
int_err(3)=i l_err(3)=i
exit exit
end if end if
@ -168,6 +167,11 @@ subroutine psb_cdalv(v, ictxt, desc, info, flag)
counter=counter+1 counter=counter+1
end if end if
enddo enddo
if (info /= psb_success_) then
call psb_errpush(info,name,l_err=l_err)
goto 9999
endif
loc_row=counter 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.... !....locals....
integer(psb_ipk_) :: i,j,np,me, n_col, kh, nh integer(psb_ipk_) :: i,j,np,me, n_col, kh, nh
integer(psb_ipk_) :: dectype 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 integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name 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 if (.not.psb_is_asb_desc(desc_a)) then
info = psb_err_invalid_cd_state_ info = psb_err_invalid_cd_state_
int_err(1) = dectype call psb_errpush(info,name,i_err=(/dectype/))
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
if (iperm(1) /= 0) then if (iperm(1) /= 0) then
if (.not.psb_isaperm(n_row,iperm)) then if (.not.psb_isaperm(n_row,iperm)) then
info = 610 info = 610
int_err(1) = iperm(1) call psb_errpush(info,name,i_err=(/iperm(1)/))
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
endif endif

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

@ -115,7 +115,7 @@ subroutine psb_cdrep(m, ictxt, desc, info)
!locals !locals
integer(psb_ipk_) :: i,np,me,err,err_act integer(psb_ipk_) :: i,np,me,err,err_act
integer(psb_lpk_) :: n 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_) :: thalo(1), tovr(1), text(1)
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
integer(psb_mpk_) :: iictxt integer(psb_mpk_) :: iictxt
@ -136,16 +136,16 @@ subroutine psb_cdrep(m, ictxt, desc, info)
!... check m and n parameters.... !... check m and n parameters....
if (m < 1) then if (m < 1) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 l_err(1) = 1
int_err(2) = m l_err(2) = m
else if (n < 1) then else if (n < 1) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 2 l_err(1) = 2
int_err(2) = n l_err(2) = n
endif endif
if (info /= psb_success_) then 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 goto 9999
end if end if
@ -160,15 +160,15 @@ subroutine psb_cdrep(m, ictxt, desc, info)
call psb_bcast(ictxt,exch(1:2),root=psb_root_) call psb_bcast(ictxt,exch(1:2),root=psb_root_)
if (exch(1) /= m) then if (exch(1) /= m) then
info=psb_err_parm_differs_among_procs_ info=psb_err_parm_differs_among_procs_
int_err(1)=1 l_err(1)=1
else if (exch(2) /= n) then else if (exch(2) /= n) then
info=psb_err_parm_differs_among_procs_ info=psb_err_parm_differs_among_procs_
int_err(1)=2 l_err(1)=2
endif endif
endif endif
if (info /= psb_success_) then 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 goto 9999
end if 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 logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: ictxt, np, me, dupl_,err_act
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -96,15 +95,11 @@ subroutine psb_cins_vect(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x%get_nrows() < desc_a%get_local_rows()) then else if (x%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -180,10 +175,9 @@ subroutine psb_cins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob 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 :: irl(:)
complex(psb_spk_), allocatable :: lval(:) complex(psb_spk_), allocatable :: lval(:)
logical :: local_ logical :: local_
@ -212,15 +206,11 @@ subroutine psb_cins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x%get_nrows() < desc_a%get_local_rows()) then else if (x%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -290,10 +280,9 @@ subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols, n
& loc_rows,loc_cols,err_act, int_err(5), n
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -326,15 +315,11 @@ subroutine psb_cins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x(1)%get_nrows() < desc_a%get_local_rows()) then else if (x(1)%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -412,10 +397,9 @@ subroutine psb_cins_multivect(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -443,15 +427,11 @@ subroutine psb_cins_multivect(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x%get_nrows() < desc_a%get_local_rows()) then else if (x%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif 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 logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob 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 :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -97,15 +96,11 @@ subroutine psb_cinsvi(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (size(x, dim=1) < desc_a%get_local_rows()) then else if (size(x, dim=1) < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -249,16 +244,15 @@ subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,loc_row,j,n,& integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob 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 :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
name = 'psb_cinsi' name = 'psb_cinsi'
@ -280,15 +274,11 @@ subroutine psb_cinsi(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (size(x, dim=1) < desc_a%get_local_rows()) then else if (size(x, dim=1) < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
if (m == 0) return 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_) :: ictxt, dectype
integer(psb_ipk_) :: np,me,loc_row,loc_col,& integer(psb_ipk_) :: np,me,loc_row,loc_col,&
& length_ia1,length_ia2, err_act,m,n & length_ia1,length_ia2, err_act,m,n
integer(psb_ipk_) :: int_err(5)
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=psb_success_ info=psb_success_
@ -87,9 +86,7 @@ subroutine psb_cspalloc(a, desc_a, info, nnz)
if (present(nnz))then if (present(nnz))then
if (nnz < 0) then if (nnz < 0) then
info=45 info=45
int_err(1)=7 call psb_errpush(info,name,i_err=(/7_psb_ipk_,nnz/))
int_err(2)=nnz
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
length_ia1=nnz 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) call a%csall(loc_row,loc_col,info,nz=length_ia1)
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='sp_all' call psb_errpush(info,name,a_err='sp_all')
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
end if 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 !locals
integer(psb_ipk_) :: np,me,nr,i,err_act 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 integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name 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()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
@ -100,8 +100,7 @@ subroutine psb_dalloc_vect(x, desc_a,info,n)
if (info == 0) call x%all(nr,info) if (info == 0) call x%all(nr,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
goto 9999 goto 9999
endif endif
call x%zero() call x%zero()
@ -128,7 +127,7 @@ subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb)
!locals !locals
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ 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 integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name 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_) call psb_bcast(ictxt,exch(1),root=psb_root_)
if (exch(1) /= n_) then if (exch(1) /= n_) then
info=psb_err_parm_differs_among_procs_ info=psb_err_parm_differs_among_procs_
int_err(1)=1 call psb_errpush(info,name,i_err=(/ione/))
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
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()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
@ -204,8 +202,7 @@ subroutine psb_dalloc_vect_r2(x, desc_a,info,n,lb)
end if end if
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
goto 9999 goto 9999
endif endif
@ -232,7 +229,7 @@ subroutine psb_dalloc_multivect(x, desc_a,info,n)
!locals !locals
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ 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 integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name 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_) call psb_bcast(ictxt,exch(1),root=psb_root_)
if (exch(1) /= n_) then if (exch(1) /= n_) then
info=psb_err_parm_differs_among_procs_ info=psb_err_parm_differs_among_procs_
int_err(1)=1 call psb_errpush(info,name,i_err=(/ione/))
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
endif endif
@ -288,7 +284,7 @@ subroutine psb_dalloc_multivect(x, desc_a,info,n)
nr = max(1,desc_a%get_local_rows()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
@ -298,8 +294,7 @@ subroutine psb_dalloc_multivect(x, desc_a,info,n)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
goto 9999 goto 9999
endif 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 integer(psb_ipk_), optional, intent(in) :: n, lb
!locals !locals
integer(psb_ipk_) :: np,me,err,nr,i,j,err_act integer(psb_ipk_) :: err,nr,i,j,n_,err_act
integer(psb_ipk_) :: ictxt,n_ integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: int_err(5),exch(3) integer(psb_ipk_) :: exch(3)
character(len=20) :: name character(len=20) :: name
name='psb_geall' name='psb_geall'
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=psb_success_ info = psb_success_
err=0 err = 0
int_err(1)=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=desc_a%get_context() 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_) call psb_bcast(ictxt,exch(1),root=psb_root_)
if (exch(1) /= n_) then if (exch(1) /= n_) then
info=psb_err_parm_differs_among_procs_ info=psb_err_parm_differs_among_procs_
int_err(1)=1 call psb_errpush(info,name,i_err=(/ione/))
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
endif endif
@ -108,15 +106,14 @@ subroutine psb_dalloc(x, desc_a, info, n, lb)
nr = max(1,desc_a%get_local_rows()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
call psb_realloc(nr,n_,x,info,lb2=lb) call psb_realloc(nr,n_,x,info,lb2=lb)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr*n_ call psb_errpush(info,name,i_err=(/nr*n_/),a_err='real(psb_dpk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_dpk_)')
goto 9999 goto 9999
endif endif
@ -183,8 +180,8 @@ subroutine psb_dallocv(x, desc_a,info,n)
integer(psb_ipk_), optional, intent(in) :: n integer(psb_ipk_), optional, intent(in) :: n
!locals !locals
integer(psb_ipk_) :: np,me,nr,i,err_act integer(psb_ipk_) :: nr,i,err_act
integer(psb_ipk_) :: ictxt, int_err(5) integer(psb_ipk_) :: ictxt, np,me
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name character(len=20) :: name
@ -221,15 +218,14 @@ subroutine psb_dallocv(x, desc_a,info,n)
nr = max(1,desc_a%get_local_rows()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
call psb_realloc(nr,x,info) call psb_realloc(nr,x,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_dpk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_dpk_)')
goto 9999 goto 9999
endif 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 logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: ictxt, np, me, dupl_,err_act
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -96,15 +95,11 @@ subroutine psb_dins_vect(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x%get_nrows() < desc_a%get_local_rows()) then else if (x%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -180,10 +175,9 @@ subroutine psb_dins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob 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 :: irl(:)
real(psb_dpk_), allocatable :: lval(:) real(psb_dpk_), allocatable :: lval(:)
logical :: local_ logical :: local_
@ -212,15 +206,11 @@ subroutine psb_dins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x%get_nrows() < desc_a%get_local_rows()) then else if (x%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -290,10 +280,9 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols, n
& loc_rows,loc_cols,err_act, int_err(5), n
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -326,15 +315,11 @@ subroutine psb_dins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x(1)%get_nrows() < desc_a%get_local_rows()) then else if (x(1)%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -412,10 +397,9 @@ subroutine psb_dins_multivect(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -443,15 +427,11 @@ subroutine psb_dins_multivect(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x%get_nrows() < desc_a%get_local_rows()) then else if (x%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif 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 logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob 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 :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -97,15 +96,11 @@ subroutine psb_dinsvi(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (size(x, dim=1) < desc_a%get_local_rows()) then else if (size(x, dim=1) < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -249,16 +244,15 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,loc_row,j,n,& integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob 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 :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
name = 'psb_dinsi' name = 'psb_dinsi'
@ -280,15 +274,11 @@ subroutine psb_dinsi(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (size(x, dim=1) < desc_a%get_local_rows()) then else if (size(x, dim=1) < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
if (m == 0) return 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_) :: ictxt, dectype
integer(psb_ipk_) :: np,me,loc_row,loc_col,& integer(psb_ipk_) :: np,me,loc_row,loc_col,&
& length_ia1,length_ia2, err_act,m,n & length_ia1,length_ia2, err_act,m,n
integer(psb_ipk_) :: int_err(5)
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=psb_success_ info=psb_success_
@ -87,9 +86,7 @@ subroutine psb_dspalloc(a, desc_a, info, nnz)
if (present(nnz))then if (present(nnz))then
if (nnz < 0) then if (nnz < 0) then
info=45 info=45
int_err(1)=7 call psb_errpush(info,name,i_err=(/7_psb_ipk_,nnz/))
int_err(2)=nnz
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
length_ia1=nnz 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) call a%csall(loc_row,loc_col,info,nz=length_ia1)
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='sp_all' call psb_errpush(info,name,a_err='sp_all')
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
end if 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 integer(psb_ipk_), optional, intent(in) :: n, lb
!locals !locals
integer(psb_ipk_) :: np,me,err,nr,i,j,err_act integer(psb_ipk_) :: err,nr,i,j,n_,err_act
integer(psb_ipk_) :: ictxt,n_ integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: int_err(5),exch(3) integer(psb_ipk_) :: exch(3)
character(len=20) :: name character(len=20) :: name
name='psb_geall' name='psb_geall'
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=psb_success_ info = psb_success_
err=0 err = 0
int_err(1)=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=desc_a%get_context() 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_) call psb_bcast(ictxt,exch(1),root=psb_root_)
if (exch(1) /= n_) then if (exch(1) /= n_) then
info=psb_err_parm_differs_among_procs_ info=psb_err_parm_differs_among_procs_
int_err(1)=1 call psb_errpush(info,name,i_err=(/ione/))
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
endif endif
@ -108,15 +106,14 @@ subroutine psb_ealloc(x, desc_a, info, n, lb)
nr = max(1,desc_a%get_local_rows()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
call psb_realloc(nr,n_,x,info,lb2=lb) call psb_realloc(nr,n_,x,info,lb2=lb)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr*n_ call psb_errpush(info,name,i_err=(/nr*n_/),a_err='integer(psb_epk_)')
call psb_errpush(info,name,int_err,a_err='integer(psb_epk_)')
goto 9999 goto 9999
endif endif
@ -183,8 +180,8 @@ subroutine psb_eallocv(x, desc_a,info,n)
integer(psb_ipk_), optional, intent(in) :: n integer(psb_ipk_), optional, intent(in) :: n
!locals !locals
integer(psb_ipk_) :: np,me,nr,i,err_act integer(psb_ipk_) :: nr,i,err_act
integer(psb_ipk_) :: ictxt, int_err(5) integer(psb_ipk_) :: ictxt, np,me
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name character(len=20) :: name
@ -221,15 +218,14 @@ subroutine psb_eallocv(x, desc_a,info,n)
nr = max(1,desc_a%get_local_rows()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
call psb_realloc(nr,x,info) call psb_realloc(nr,x,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='integer(psb_epk_)')
call psb_errpush(info,name,int_err,a_err='integer(psb_epk_)')
goto 9999 goto 9999
endif 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 logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob 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 :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -97,15 +96,11 @@ subroutine psb_einsvi(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (size(x, dim=1) < desc_a%get_local_rows()) then else if (size(x, dim=1) < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -249,16 +244,15 @@ subroutine psb_einsi(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,loc_row,j,n,& integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob 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 :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
name = 'psb_einsi' name = 'psb_einsi'
@ -280,15 +274,11 @@ subroutine psb_einsi(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (size(x, dim=1) < desc_a%get_local_rows()) then else if (size(x, dim=1) < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
if (m == 0) return 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 !locals
integer(psb_ipk_) :: np,me,nr,i,err_act 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 integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name 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()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
@ -100,8 +100,7 @@ subroutine psb_ialloc_vect(x, desc_a,info,n)
if (info == 0) call x%all(nr,info) if (info == 0) call x%all(nr,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
goto 9999 goto 9999
endif endif
call x%zero() call x%zero()
@ -128,7 +127,7 @@ subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb)
!locals !locals
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ 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 integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name 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_) call psb_bcast(ictxt,exch(1),root=psb_root_)
if (exch(1) /= n_) then if (exch(1) /= n_) then
info=psb_err_parm_differs_among_procs_ info=psb_err_parm_differs_among_procs_
int_err(1)=1 call psb_errpush(info,name,i_err=(/ione/))
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
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()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
@ -204,8 +202,7 @@ subroutine psb_ialloc_vect_r2(x, desc_a,info,n,lb)
end if end if
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
goto 9999 goto 9999
endif endif
@ -232,7 +229,7 @@ subroutine psb_ialloc_multivect(x, desc_a,info,n)
!locals !locals
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ 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 integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name 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_) call psb_bcast(ictxt,exch(1),root=psb_root_)
if (exch(1) /= n_) then if (exch(1) /= n_) then
info=psb_err_parm_differs_among_procs_ info=psb_err_parm_differs_among_procs_
int_err(1)=1 call psb_errpush(info,name,i_err=(/ione/))
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
endif endif
@ -288,7 +284,7 @@ subroutine psb_ialloc_multivect(x, desc_a,info,n)
nr = max(1,desc_a%get_local_rows()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
@ -298,8 +294,7 @@ subroutine psb_ialloc_multivect(x, desc_a,info,n)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
goto 9999 goto 9999
endif 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 logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: ictxt, np, me, dupl_,err_act
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -96,15 +95,11 @@ subroutine psb_iins_vect(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x%get_nrows() < desc_a%get_local_rows()) then else if (x%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -180,10 +175,9 @@ subroutine psb_iins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob 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 :: irl(:)
integer(psb_ipk_), allocatable :: lval(:) integer(psb_ipk_), allocatable :: lval(:)
logical :: local_ logical :: local_
@ -212,15 +206,11 @@ subroutine psb_iins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x%get_nrows() < desc_a%get_local_rows()) then else if (x%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -290,10 +280,9 @@ subroutine psb_iins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols, n
& loc_rows,loc_cols,err_act, int_err(5), n
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -326,15 +315,11 @@ subroutine psb_iins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x(1)%get_nrows() < desc_a%get_local_rows()) then else if (x(1)%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -412,10 +397,9 @@ subroutine psb_iins_multivect(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -443,15 +427,11 @@ subroutine psb_iins_multivect(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x%get_nrows() < desc_a%get_local_rows()) then else if (x%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif 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 !locals
integer(psb_ipk_) :: np,me,nr,i,err_act 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 integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name 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()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
@ -100,8 +100,7 @@ subroutine psb_lalloc_vect(x, desc_a,info,n)
if (info == 0) call x%all(nr,info) if (info == 0) call x%all(nr,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
goto 9999 goto 9999
endif endif
call x%zero() call x%zero()
@ -128,7 +127,7 @@ subroutine psb_lalloc_vect_r2(x, desc_a,info,n,lb)
!locals !locals
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ 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 integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name 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_) call psb_bcast(ictxt,exch(1),root=psb_root_)
if (exch(1) /= n_) then if (exch(1) /= n_) then
info=psb_err_parm_differs_among_procs_ info=psb_err_parm_differs_among_procs_
int_err(1)=1 call psb_errpush(info,name,i_err=(/ione/))
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
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()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
@ -204,8 +202,7 @@ subroutine psb_lalloc_vect_r2(x, desc_a,info,n,lb)
end if end if
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
goto 9999 goto 9999
endif endif
@ -232,7 +229,7 @@ subroutine psb_lalloc_multivect(x, desc_a,info,n)
!locals !locals
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ 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 integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name 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_) call psb_bcast(ictxt,exch(1),root=psb_root_)
if (exch(1) /= n_) then if (exch(1) /= n_) then
info=psb_err_parm_differs_among_procs_ info=psb_err_parm_differs_among_procs_
int_err(1)=1 call psb_errpush(info,name,i_err=(/ione/))
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
endif endif
@ -288,7 +284,7 @@ subroutine psb_lalloc_multivect(x, desc_a,info,n)
nr = max(1,desc_a%get_local_rows()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
@ -298,8 +294,7 @@ subroutine psb_lalloc_multivect(x, desc_a,info,n)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
goto 9999 goto 9999
endif 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 logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: ictxt, np, me, dupl_,err_act
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -96,15 +95,11 @@ subroutine psb_lins_vect(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x%get_nrows() < desc_a%get_local_rows()) then else if (x%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -180,10 +175,9 @@ subroutine psb_lins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob 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 :: irl(:)
integer(psb_lpk_), allocatable :: lval(:) integer(psb_lpk_), allocatable :: lval(:)
logical :: local_ logical :: local_
@ -212,15 +206,11 @@ subroutine psb_lins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x%get_nrows() < desc_a%get_local_rows()) then else if (x%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -290,10 +280,9 @@ subroutine psb_lins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols, n
& loc_rows,loc_cols,err_act, int_err(5), n
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -326,15 +315,11 @@ subroutine psb_lins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x(1)%get_nrows() < desc_a%get_local_rows()) then else if (x(1)%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -412,10 +397,9 @@ subroutine psb_lins_multivect(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -443,15 +427,11 @@ subroutine psb_lins_multivect(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x%get_nrows() < desc_a%get_local_rows()) then else if (x%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif 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 integer(psb_ipk_), optional, intent(in) :: n, lb
!locals !locals
integer(psb_ipk_) :: np,me,err,nr,i,j,err_act integer(psb_ipk_) :: err,nr,i,j,n_,err_act
integer(psb_ipk_) :: ictxt,n_ integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: int_err(5),exch(3) integer(psb_ipk_) :: exch(3)
character(len=20) :: name character(len=20) :: name
name='psb_geall' name='psb_geall'
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=psb_success_ info = psb_success_
err=0 err = 0
int_err(1)=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=desc_a%get_context() 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_) call psb_bcast(ictxt,exch(1),root=psb_root_)
if (exch(1) /= n_) then if (exch(1) /= n_) then
info=psb_err_parm_differs_among_procs_ info=psb_err_parm_differs_among_procs_
int_err(1)=1 call psb_errpush(info,name,i_err=(/ione/))
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
endif endif
@ -108,15 +106,14 @@ subroutine psb_malloc(x, desc_a, info, n, lb)
nr = max(1,desc_a%get_local_rows()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
call psb_realloc(nr,n_,x,info,lb2=lb) call psb_realloc(nr,n_,x,info,lb2=lb)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr*n_ call psb_errpush(info,name,i_err=(/nr*n_/),a_err='integer(psb_mpk_)')
call psb_errpush(info,name,int_err,a_err='integer(psb_mpk_)')
goto 9999 goto 9999
endif endif
@ -183,8 +180,8 @@ subroutine psb_mallocv(x, desc_a,info,n)
integer(psb_ipk_), optional, intent(in) :: n integer(psb_ipk_), optional, intent(in) :: n
!locals !locals
integer(psb_ipk_) :: np,me,nr,i,err_act integer(psb_ipk_) :: nr,i,err_act
integer(psb_ipk_) :: ictxt, int_err(5) integer(psb_ipk_) :: ictxt, np,me
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name character(len=20) :: name
@ -221,15 +218,14 @@ subroutine psb_mallocv(x, desc_a,info,n)
nr = max(1,desc_a%get_local_rows()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
call psb_realloc(nr,x,info) call psb_realloc(nr,x,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='integer(psb_mpk_)')
call psb_errpush(info,name,int_err,a_err='integer(psb_mpk_)')
goto 9999 goto 9999
endif 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 logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob 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 :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -97,15 +96,11 @@ subroutine psb_minsvi(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (size(x, dim=1) < desc_a%get_local_rows()) then else if (size(x, dim=1) < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -249,16 +244,15 @@ subroutine psb_minsi(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,loc_row,j,n,& integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob 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 :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
name = 'psb_minsi' name = 'psb_minsi'
@ -280,15 +274,11 @@ subroutine psb_minsi(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (size(x, dim=1) < desc_a%get_local_rows()) then else if (size(x, dim=1) < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
if (m == 0) return 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 !locals
integer(psb_ipk_) :: np,me,nr,i,err_act 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 integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name 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()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
@ -100,8 +100,7 @@ subroutine psb_salloc_vect(x, desc_a,info,n)
if (info == 0) call x%all(nr,info) if (info == 0) call x%all(nr,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
goto 9999 goto 9999
endif endif
call x%zero() call x%zero()
@ -128,7 +127,7 @@ subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb)
!locals !locals
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ 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 integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name 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_) call psb_bcast(ictxt,exch(1),root=psb_root_)
if (exch(1) /= n_) then if (exch(1) /= n_) then
info=psb_err_parm_differs_among_procs_ info=psb_err_parm_differs_among_procs_
int_err(1)=1 call psb_errpush(info,name,i_err=(/ione/))
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
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()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
@ -204,8 +202,7 @@ subroutine psb_salloc_vect_r2(x, desc_a,info,n,lb)
end if end if
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
goto 9999 goto 9999
endif endif
@ -232,7 +229,7 @@ subroutine psb_salloc_multivect(x, desc_a,info,n)
!locals !locals
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ 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 integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name 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_) call psb_bcast(ictxt,exch(1),root=psb_root_)
if (exch(1) /= n_) then if (exch(1) /= n_) then
info=psb_err_parm_differs_among_procs_ info=psb_err_parm_differs_among_procs_
int_err(1)=1 call psb_errpush(info,name,i_err=(/ione/))
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
endif endif
@ -288,7 +284,7 @@ subroutine psb_salloc_multivect(x, desc_a,info,n)
nr = max(1,desc_a%get_local_rows()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
@ -298,8 +294,7 @@ subroutine psb_salloc_multivect(x, desc_a,info,n)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
goto 9999 goto 9999
endif 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 integer(psb_ipk_), optional, intent(in) :: n, lb
!locals !locals
integer(psb_ipk_) :: np,me,err,nr,i,j,err_act integer(psb_ipk_) :: err,nr,i,j,n_,err_act
integer(psb_ipk_) :: ictxt,n_ integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: int_err(5),exch(3) integer(psb_ipk_) :: exch(3)
character(len=20) :: name character(len=20) :: name
name='psb_geall' name='psb_geall'
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=psb_success_ info = psb_success_
err=0 err = 0
int_err(1)=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=desc_a%get_context() 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_) call psb_bcast(ictxt,exch(1),root=psb_root_)
if (exch(1) /= n_) then if (exch(1) /= n_) then
info=psb_err_parm_differs_among_procs_ info=psb_err_parm_differs_among_procs_
int_err(1)=1 call psb_errpush(info,name,i_err=(/ione/))
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
endif endif
@ -108,15 +106,14 @@ subroutine psb_salloc(x, desc_a, info, n, lb)
nr = max(1,desc_a%get_local_rows()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
call psb_realloc(nr,n_,x,info,lb2=lb) call psb_realloc(nr,n_,x,info,lb2=lb)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr*n_ call psb_errpush(info,name,i_err=(/nr*n_/),a_err='real(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
goto 9999 goto 9999
endif endif
@ -183,8 +180,8 @@ subroutine psb_sallocv(x, desc_a,info,n)
integer(psb_ipk_), optional, intent(in) :: n integer(psb_ipk_), optional, intent(in) :: n
!locals !locals
integer(psb_ipk_) :: np,me,nr,i,err_act integer(psb_ipk_) :: nr,i,err_act
integer(psb_ipk_) :: ictxt, int_err(5) integer(psb_ipk_) :: ictxt, np,me
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name character(len=20) :: name
@ -221,15 +218,14 @@ subroutine psb_sallocv(x, desc_a,info,n)
nr = max(1,desc_a%get_local_rows()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
call psb_realloc(nr,x,info) call psb_realloc(nr,x,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
goto 9999 goto 9999
endif 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 logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: ictxt, np, me, dupl_,err_act
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -96,15 +95,11 @@ subroutine psb_sins_vect(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x%get_nrows() < desc_a%get_local_rows()) then else if (x%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -180,10 +175,9 @@ subroutine psb_sins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob 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 :: irl(:)
real(psb_spk_), allocatable :: lval(:) real(psb_spk_), allocatable :: lval(:)
logical :: local_ logical :: local_
@ -212,15 +206,11 @@ subroutine psb_sins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x%get_nrows() < desc_a%get_local_rows()) then else if (x%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -290,10 +280,9 @@ subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols, n
& loc_rows,loc_cols,err_act, int_err(5), n
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -326,15 +315,11 @@ subroutine psb_sins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x(1)%get_nrows() < desc_a%get_local_rows()) then else if (x(1)%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -412,10 +397,9 @@ subroutine psb_sins_multivect(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -443,15 +427,11 @@ subroutine psb_sins_multivect(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x%get_nrows() < desc_a%get_local_rows()) then else if (x%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif 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 logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob 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 :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -97,15 +96,11 @@ subroutine psb_sinsvi(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (size(x, dim=1) < desc_a%get_local_rows()) then else if (size(x, dim=1) < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -249,16 +244,15 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,loc_row,j,n,& integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob 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 :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
name = 'psb_sinsi' name = 'psb_sinsi'
@ -280,15 +274,11 @@ subroutine psb_sinsi(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (size(x, dim=1) < desc_a%get_local_rows()) then else if (size(x, dim=1) < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
if (m == 0) return 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_) :: ictxt, dectype
integer(psb_ipk_) :: np,me,loc_row,loc_col,& integer(psb_ipk_) :: np,me,loc_row,loc_col,&
& length_ia1,length_ia2, err_act,m,n & length_ia1,length_ia2, err_act,m,n
integer(psb_ipk_) :: int_err(5)
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=psb_success_ info=psb_success_
@ -87,9 +86,7 @@ subroutine psb_sspalloc(a, desc_a, info, nnz)
if (present(nnz))then if (present(nnz))then
if (nnz < 0) then if (nnz < 0) then
info=45 info=45
int_err(1)=7 call psb_errpush(info,name,i_err=(/7_psb_ipk_,nnz/))
int_err(2)=nnz
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
length_ia1=nnz 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) call a%csall(loc_row,loc_col,info,nz=length_ia1)
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='sp_all' call psb_errpush(info,name,a_err='sp_all')
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
end if 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 !locals
integer(psb_ipk_) :: np,me,nr,i,err_act 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 integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name 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()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
@ -100,8 +100,7 @@ subroutine psb_zalloc_vect(x, desc_a,info,n)
if (info == 0) call x%all(nr,info) if (info == 0) call x%all(nr,info)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
goto 9999 goto 9999
endif endif
call x%zero() call x%zero()
@ -128,7 +127,7 @@ subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb)
!locals !locals
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ 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 integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name 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_) call psb_bcast(ictxt,exch(1),root=psb_root_)
if (exch(1) /= n_) then if (exch(1) /= n_) then
info=psb_err_parm_differs_among_procs_ info=psb_err_parm_differs_among_procs_
int_err(1)=1 call psb_errpush(info,name,i_err=(/ione/))
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
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()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
@ -204,8 +202,7 @@ subroutine psb_zalloc_vect_r2(x, desc_a,info,n,lb)
end if end if
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
goto 9999 goto 9999
endif endif
@ -232,7 +229,7 @@ subroutine psb_zalloc_multivect(x, desc_a,info,n)
!locals !locals
integer(psb_ipk_) :: np,me,nr,i,err_act, n_, lb_ 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 integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name 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_) call psb_bcast(ictxt,exch(1),root=psb_root_)
if (exch(1) /= n_) then if (exch(1) /= n_) then
info=psb_err_parm_differs_among_procs_ info=psb_err_parm_differs_among_procs_
int_err(1)=1 call psb_errpush(info,name,i_err=(/ione/))
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
endif endif
@ -288,7 +284,7 @@ subroutine psb_zalloc_multivect(x, desc_a,info,n)
nr = max(1,desc_a%get_local_rows()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
@ -298,8 +294,7 @@ subroutine psb_zalloc_multivect(x, desc_a,info,n)
if (psb_errstatus_fatal()) then if (psb_errstatus_fatal()) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='real(psb_spk_)')
call psb_errpush(info,name,int_err,a_err='real(psb_spk_)')
goto 9999 goto 9999
endif 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 integer(psb_ipk_), optional, intent(in) :: n, lb
!locals !locals
integer(psb_ipk_) :: np,me,err,nr,i,j,err_act integer(psb_ipk_) :: err,nr,i,j,n_,err_act
integer(psb_ipk_) :: ictxt,n_ integer(psb_ipk_) :: ictxt,np,me
integer(psb_ipk_) :: int_err(5),exch(3) integer(psb_ipk_) :: exch(3)
character(len=20) :: name character(len=20) :: name
name='psb_geall' name='psb_geall'
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=psb_success_ info = psb_success_
err=0 err = 0
int_err(1)=0
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
ictxt=desc_a%get_context() 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_) call psb_bcast(ictxt,exch(1),root=psb_root_)
if (exch(1) /= n_) then if (exch(1) /= n_) then
info=psb_err_parm_differs_among_procs_ info=psb_err_parm_differs_among_procs_
int_err(1)=1 call psb_errpush(info,name,i_err=(/ione/))
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
endif endif
@ -108,15 +106,14 @@ subroutine psb_zalloc(x, desc_a, info, n, lb)
nr = max(1,desc_a%get_local_rows()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
call psb_realloc(nr,n_,x,info,lb2=lb) call psb_realloc(nr,n_,x,info,lb2=lb)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr*n_ call psb_errpush(info,name,i_err=(/nr*n_/),a_err='complex(psb_dpk_)')
call psb_errpush(info,name,int_err,a_err='complex(psb_dpk_)')
goto 9999 goto 9999
endif endif
@ -183,8 +180,8 @@ subroutine psb_zallocv(x, desc_a,info,n)
integer(psb_ipk_), optional, intent(in) :: n integer(psb_ipk_), optional, intent(in) :: n
!locals !locals
integer(psb_ipk_) :: np,me,nr,i,err_act integer(psb_ipk_) :: nr,i,err_act
integer(psb_ipk_) :: ictxt, int_err(5) integer(psb_ipk_) :: ictxt, np,me
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name character(len=20) :: name
@ -221,15 +218,14 @@ subroutine psb_zallocv(x, desc_a,info,n)
nr = max(1,desc_a%get_local_rows()) nr = max(1,desc_a%get_local_rows())
else else
info = psb_err_internal_error_ 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 goto 9999
endif endif
call psb_realloc(nr,x,info) call psb_realloc(nr,x,info)
if (info /= psb_success_) then if (info /= psb_success_) then
info=psb_err_alloc_request_ info=psb_err_alloc_request_
int_err(1)=nr call psb_errpush(info,name,i_err=(/nr/),a_err='complex(psb_dpk_)')
call psb_errpush(info,name,int_err,a_err='complex(psb_dpk_)')
goto 9999 goto 9999
endif 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 logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: ictxt, np, me, dupl_,err_act
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -96,15 +95,11 @@ subroutine psb_zins_vect(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x%get_nrows() < desc_a%get_local_rows()) then else if (x%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -180,10 +175,9 @@ subroutine psb_zins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob 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 :: irl(:)
complex(psb_dpk_), allocatable :: lval(:) complex(psb_dpk_), allocatable :: lval(:)
logical :: local_ logical :: local_
@ -212,15 +206,11 @@ subroutine psb_zins_vect_v(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x%get_nrows() < desc_a%get_local_rows()) then else if (x%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -290,10 +280,9 @@ subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols, n
& loc_rows,loc_cols,err_act, int_err(5), n
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -326,15 +315,11 @@ subroutine psb_zins_vect_r2(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x(1)%get_nrows() < desc_a%get_local_rows()) then else if (x(1)%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -412,10 +397,9 @@ subroutine psb_zins_multivect(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob integer(psb_lpk_) :: mglob
integer(psb_ipk_) :: np, me, dupl_ integer(psb_ipk_) :: ictxt, np, me, dupl_, err_act
integer(psb_ipk_), allocatable :: irl(:) integer(psb_ipk_), allocatable :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -443,15 +427,11 @@ subroutine psb_zins_multivect(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (x%get_nrows() < desc_a%get_local_rows()) then else if (x%get_nrows() < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif 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 logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,& integer(psb_ipk_) :: i, loc_rows,loc_cols,err_act
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob 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 :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
@ -97,15 +96,11 @@ subroutine psb_zinsvi(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (size(x, dim=1) < desc_a%get_local_rows()) then else if (size(x, dim=1) < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
@ -249,16 +244,15 @@ subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl,local)
logical, intent(in), optional :: local logical, intent(in), optional :: local
!locals..... !locals.....
integer(psb_ipk_) :: ictxt,i,loc_row,j,n,& integer(psb_ipk_) :: i,loc_row,j,n, loc_rows,loc_cols,err_act
& loc_rows,loc_cols,err_act, int_err(5)
integer(psb_lpk_) :: mglob 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 :: irl(:)
logical :: local_ logical :: local_
character(len=20) :: name character(len=20) :: name
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=psb_success_ info = psb_success_
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
name = 'psb_zinsi' name = 'psb_zinsi'
@ -280,15 +274,11 @@ subroutine psb_zinsi(m, irw, val, x, desc_a, info, dupl,local)
!... check parameters.... !... check parameters....
if (m < 0) then if (m < 0) then
info = psb_err_iarg_neg_ info = psb_err_iarg_neg_
int_err(1) = 1 call psb_errpush(info,name,i_err=(/ione,m/))
int_err(2) = m
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
else if (size(x, dim=1) < desc_a%get_local_rows()) then else if (size(x, dim=1) < desc_a%get_local_rows()) then
info = 310 info = 310
int_err(1) = 5 call psb_errpush(info,name,i_err=(/5_psb_ipk_,4_psb_ipk_/))
int_err(2) = 4
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
if (m == 0) return 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_) :: ictxt, dectype
integer(psb_ipk_) :: np,me,loc_row,loc_col,& integer(psb_ipk_) :: np,me,loc_row,loc_col,&
& length_ia1,length_ia2, err_act,m,n & length_ia1,length_ia2, err_act,m,n
integer(psb_ipk_) :: int_err(5)
integer(psb_ipk_) :: debug_level, debug_unit integer(psb_ipk_) :: debug_level, debug_unit
character(len=20) :: name, ch_err character(len=20) :: name
if(psb_get_errstatus() /= 0) return if(psb_get_errstatus() /= 0) return
info=psb_success_ info=psb_success_
@ -87,9 +86,7 @@ subroutine psb_zspalloc(a, desc_a, info, nnz)
if (present(nnz))then if (present(nnz))then
if (nnz < 0) then if (nnz < 0) then
info=45 info=45
int_err(1)=7 call psb_errpush(info,name,i_err=(/7_psb_ipk_,nnz/))
int_err(2)=nnz
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
endif endif
length_ia1=nnz 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) call a%csall(loc_row,loc_col,info,nz=length_ia1)
if(info /= psb_success_) then if(info /= psb_success_) then
info=psb_err_from_subroutine_ info=psb_err_from_subroutine_
ch_err='sp_all' call psb_errpush(info,name,a_err='sp_all')
call psb_errpush(info,name,int_err)
goto 9999 goto 9999
end if end if

Write Preview
Loading…
Cancel
Save