From 9c153be7ffbeec771816321a56006640c8d48d60 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Mon, 30 Jan 2012 18:25:28 +0000 Subject: [PATCH] psblas3-integer8: base/serial/psb_cnumbmm.f90 base/serial/psb_csymbmm.f90 base/serial/psb_dnumbmm.f90 base/serial/psb_dsymbmm.f90 base/serial/psb_snumbmm.f90 base/serial/psb_sort_impl.f90 base/serial/psb_ssymbmm.f90 base/serial/psb_znumbmm.f90 base/serial/psb_zsymbmm.f90 base/serial/psi_serial_impl.f90 Next batch. --- base/serial/psb_cnumbmm.f90 | 8 +- base/serial/psb_csymbmm.f90 | 6 +- base/serial/psb_dnumbmm.f90 | 8 +- base/serial/psb_dsymbmm.f90 | 6 +- base/serial/psb_snumbmm.f90 | 8 +- base/serial/psb_sort_impl.f90 | 177 +++++++++++++++++++--------- base/serial/psb_ssymbmm.f90 | 6 +- base/serial/psb_znumbmm.f90 | 8 +- base/serial/psb_zsymbmm.f90 | 6 +- base/serial/psi_serial_impl.f90 | 198 +++++++++++++++++++++----------- 10 files changed, 280 insertions(+), 151 deletions(-) diff --git a/base/serial/psb_cnumbmm.f90 b/base/serial/psb_cnumbmm.f90 index 9e56aaaf..c644b110 100644 --- a/base/serial/psb_cnumbmm.f90 +++ b/base/serial/psb_cnumbmm.f90 @@ -122,7 +122,7 @@ subroutine psb_cbase_numbmm(a,b,c) ! Note: we still have to test about possible performance hits. ! ! - call psb_ensure_size(size(c%ja),c%val,info) + call psb_ensure_size(ione*size(c%ja),c%val,info) select type(a) type is (psb_c_csr_sparse_mat) select type(b) @@ -169,9 +169,9 @@ contains mb = b%get_nrows() nb = b%get_ncols() - call cnumbmm(ma,na,nb,a%irp,a%ja,0,a%val,& - & b%irp,b%ja,0,b%val,& - & c%irp,c%ja,0,c%val,temp) + call cnumbmm(ma,na,nb,a%irp,a%ja,izero,a%val,& + & b%irp,b%ja,izero,b%val,& + & c%irp,c%ja,izero,c%val,temp) end subroutine csr_numbmm diff --git a/base/serial/psb_csymbmm.f90 b/base/serial/psb_csymbmm.f90 index 9b1fcfb8..155bf45f 100644 --- a/base/serial/psb_csymbmm.f90 +++ b/base/serial/psb_csymbmm.f90 @@ -177,9 +177,9 @@ contains nze = max(ma+1,2*ma) call c%allocate(ma,nb,nze) - call symbmm(ma,na,nb,a%irp,a%ja,0,& - & b%irp,b%ja,0,& - & c%irp,c%ja,0,itemp) + call symbmm(ma,na,nb,a%irp,a%ja,izero,& + & b%irp,b%ja,izero,& + & c%irp,c%ja,izero,itemp) end subroutine csr_symbmm subroutine gen_symbmm(a,b,c,index,info) diff --git a/base/serial/psb_dnumbmm.f90 b/base/serial/psb_dnumbmm.f90 index 7055a452..3d6c7058 100644 --- a/base/serial/psb_dnumbmm.f90 +++ b/base/serial/psb_dnumbmm.f90 @@ -122,7 +122,7 @@ subroutine psb_dbase_numbmm(a,b,c) ! Note: we still have to test about possible performance hits. ! ! - call psb_ensure_size(size(c%ja),c%val,info) + call psb_ensure_size(ione*size(c%ja),c%val,info) select type(a) type is (psb_d_csr_sparse_mat) select type(b) @@ -169,9 +169,9 @@ contains mb = b%get_nrows() nb = b%get_ncols() - call dnumbmm(ma,na,nb,a%irp,a%ja,0,a%val,& - & b%irp,b%ja,0,b%val,& - & c%irp,c%ja,0,c%val,temp) + call dnumbmm(ma,na,nb,a%irp,a%ja,izero,a%val,& + & b%irp,b%ja,izero,b%val,& + & c%irp,c%ja,izero,c%val,temp) end subroutine csr_numbmm diff --git a/base/serial/psb_dsymbmm.f90 b/base/serial/psb_dsymbmm.f90 index d1d45d27..53960542 100644 --- a/base/serial/psb_dsymbmm.f90 +++ b/base/serial/psb_dsymbmm.f90 @@ -177,9 +177,9 @@ contains nze = max(ma+1,2*ma) call c%allocate(ma,nb,nze) - call symbmm(ma,na,nb,a%irp,a%ja,0,& - & b%irp,b%ja,0,& - & c%irp,c%ja,0,itemp) + call symbmm(ma,na,nb,a%irp,a%ja,izero,& + & b%irp,b%ja,izero,& + & c%irp,c%ja,izero,itemp) end subroutine csr_symbmm subroutine gen_symbmm(a,b,c,index,info) diff --git a/base/serial/psb_snumbmm.f90 b/base/serial/psb_snumbmm.f90 index b00d3a0b..4af9f72e 100644 --- a/base/serial/psb_snumbmm.f90 +++ b/base/serial/psb_snumbmm.f90 @@ -122,7 +122,7 @@ subroutine psb_sbase_numbmm(a,b,c) ! Note: we still have to test about possible performance hits. ! ! - call psb_ensure_size(size(c%ja),c%val,info) + call psb_ensure_size(ione*size(c%ja),c%val,info) select type(a) type is (psb_s_csr_sparse_mat) select type(b) @@ -169,9 +169,9 @@ contains mb = b%get_nrows() nb = b%get_ncols() - call snumbmm(ma,na,nb,a%irp,a%ja,0,a%val,& - & b%irp,b%ja,0,b%val,& - & c%irp,c%ja,0,c%val,temp) + call snumbmm(ma,na,nb,a%irp,a%ja,izero,a%val,& + & b%irp,b%ja,izero,b%val,& + & c%irp,c%ja,izero,c%val,temp) end subroutine csr_numbmm diff --git a/base/serial/psb_sort_impl.f90 b/base/serial/psb_sort_impl.f90 index 52cd3d72..1616b7f2 100644 --- a/base/serial/psb_sort_impl.f90 +++ b/base/serial/psb_sort_impl.f90 @@ -85,7 +85,7 @@ logical function psb_isaperm(n,eip) ip(i) = -j i = j enddo - ip(m) = iabs(ip(m)) + ip(m) = abs(ip(m)) if (j /= m) then psb_isaperm = .false. goto 9999 @@ -195,6 +195,7 @@ subroutine imsort(x,ix,dir,flag) integer(psb_ipk_) :: dir_, flag_, n, err_act + integer(psb_ipk_) :: ierr(5) character(len=20) :: name name='psb_msort' @@ -209,7 +210,8 @@ subroutine imsort(x,ix,dir,flag) case( psb_sort_up_, psb_sort_down_) ! OK keep going case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/3,dir_,0,0,0/)) + ierr(1) = 3; ierr(2) = dir_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -217,7 +219,8 @@ subroutine imsort(x,ix,dir,flag) if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if if (present(flag)) then @@ -229,7 +232,8 @@ subroutine imsort(x,ix,dir,flag) case( psb_sort_ovw_idx_, psb_sort_keep_idx_) ! OK keep going case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/4,flag_,0,0,0/)) + ierr(1) = 4; ierr(2) = flag_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -256,6 +260,7 @@ subroutine smsort(x,ix,dir,flag) integer(psb_ipk_) :: dir_, flag_, n, err_act + integer(psb_ipk_) :: ierr(5) character(len=20) :: name name='psb_msort' @@ -270,7 +275,8 @@ subroutine smsort(x,ix,dir,flag) case( psb_sort_up_, psb_sort_down_) ! OK keep going case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/3,dir_,0,0,0/)) + ierr(1) = 3; ierr(2) = dir_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -278,7 +284,8 @@ subroutine smsort(x,ix,dir,flag) if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if if (present(flag)) then @@ -290,7 +297,8 @@ subroutine smsort(x,ix,dir,flag) case( psb_sort_ovw_idx_, psb_sort_keep_idx_) ! OK keep going case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/4,flag_,0,0,0/)) + ierr(1) = 4; ierr(2) = flag_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -316,6 +324,7 @@ subroutine dmsort(x,ix,dir,flag) integer(psb_ipk_) :: dir_, flag_, n, err_act + integer(psb_ipk_) :: ierr(5) character(len=20) :: name name='psb_msort' @@ -330,7 +339,8 @@ subroutine dmsort(x,ix,dir,flag) case( psb_sort_up_, psb_sort_down_) ! OK keep going case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/3,dir_,0,0,0/)) + ierr(1) = 3; ierr(2) = dir_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -338,7 +348,8 @@ subroutine dmsort(x,ix,dir,flag) if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if if (present(flag)) then @@ -350,7 +361,8 @@ subroutine dmsort(x,ix,dir,flag) case( psb_sort_ovw_idx_, psb_sort_keep_idx_) ! OK keep going case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/4,flag_,0,0,0/)) + ierr(1) = 4; ierr(2) = flag_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -376,6 +388,7 @@ subroutine camsort(x,ix,dir,flag) integer(psb_ipk_) :: dir_, flag_, n, err_act + integer(psb_ipk_) :: ierr(5) character(len=20) :: name name='psb_msort' @@ -390,7 +403,8 @@ subroutine camsort(x,ix,dir,flag) case( psb_asort_up_, psb_asort_down_) ! OK keep going case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/3,dir_,0,0,0/)) + ierr(1) = 3; ierr(2) = dir_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -398,7 +412,8 @@ subroutine camsort(x,ix,dir,flag) if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if if (present(flag)) then @@ -410,7 +425,8 @@ subroutine camsort(x,ix,dir,flag) case( psb_sort_ovw_idx_, psb_sort_keep_idx_) ! OK keep going case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/4,flag_,0,0,0/)) + ierr(1) = 4; ierr(2) = flag_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -436,6 +452,7 @@ subroutine zamsort(x,ix,dir,flag) integer(psb_ipk_) :: dir_, flag_, n, err_act + integer(psb_ipk_) :: ierr(5) character(len=20) :: name name='psb_msort' @@ -450,7 +467,8 @@ subroutine zamsort(x,ix,dir,flag) case( psb_asort_up_, psb_asort_down_) ! OK keep going case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/3,dir_,0,0,0/)) + ierr(1) = 3; ierr(2) = dir_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -458,7 +476,8 @@ subroutine zamsort(x,ix,dir,flag) if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if if (present(flag)) then @@ -470,7 +489,8 @@ subroutine zamsort(x,ix,dir,flag) case( psb_sort_ovw_idx_, psb_sort_keep_idx_) ! OK keep going case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/4,flag_,0,0,0/)) + ierr(1) = 4; ierr(2) = flag_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -497,6 +517,7 @@ subroutine imsort_u(x,nout,dir) integer(psb_ipk_) :: dir_, n, err_act + integer(psb_ipk_) :: ierr(5) character(len=20) :: name name='psb_msort_u' @@ -511,7 +532,8 @@ subroutine imsort_u(x,nout,dir) case( psb_sort_up_, psb_sort_down_) ! OK keep going case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/3,dir_,0,0,0/)) + ierr(1) = 3; ierr(2) = dir_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -538,6 +560,7 @@ subroutine iqsort(x,ix,dir,flag) integer(psb_ipk_) :: dir_, flag_, n, err_act + integer(psb_ipk_) :: ierr(5) character(len=20) :: name name='psb_qsort' @@ -552,7 +575,8 @@ subroutine iqsort(x,ix,dir,flag) case( psb_sort_ovw_idx_, psb_sort_keep_idx_) ! OK keep going case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/4,flag_,0,0,0/)) + ierr(1) = 4; ierr(2) = flag_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -568,7 +592,8 @@ subroutine iqsort(x,ix,dir,flag) case( psb_sort_up_, psb_sort_down_) if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if @@ -581,7 +606,8 @@ subroutine iqsort(x,ix,dir,flag) ! OK keep going if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if @@ -591,7 +617,8 @@ subroutine iqsort(x,ix,dir,flag) end if case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/3,dir_,0,0,0/)) + ierr(1) = 3; ierr(2) = dir_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -615,6 +642,7 @@ subroutine sqsort(x,ix,dir,flag) integer(psb_ipk_) :: dir_, flag_, n, err_act + integer(psb_ipk_) :: ierr(5) character(len=20) :: name name='psb_qsort' @@ -629,7 +657,8 @@ subroutine sqsort(x,ix,dir,flag) case( psb_sort_ovw_idx_, psb_sort_keep_idx_) ! OK keep going case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/4,flag_,0,0,0/)) + ierr(1) = 4; ierr(2) = flag_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -645,7 +674,8 @@ subroutine sqsort(x,ix,dir,flag) case( psb_sort_up_, psb_sort_down_) if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if @@ -658,7 +688,8 @@ subroutine sqsort(x,ix,dir,flag) ! OK keep going if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if @@ -668,7 +699,8 @@ subroutine sqsort(x,ix,dir,flag) end if case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/3,dir_,0,0,0/)) + ierr(1) = 3; ierr(2) = dir_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -691,6 +723,7 @@ subroutine dqsort(x,ix,dir,flag) integer(psb_ipk_) :: dir_, flag_, n, err_act + integer(psb_ipk_) :: ierr(5) character(len=20) :: name name='psb_qsort' @@ -705,7 +738,8 @@ subroutine dqsort(x,ix,dir,flag) case( psb_sort_ovw_idx_, psb_sort_keep_idx_) ! OK keep going case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/4,flag_,0,0,0/)) + ierr(1) = 4; ierr(2) = flag_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -721,7 +755,8 @@ subroutine dqsort(x,ix,dir,flag) case( psb_sort_up_, psb_sort_down_) if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if @@ -734,7 +769,8 @@ subroutine dqsort(x,ix,dir,flag) ! OK keep going if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if @@ -744,7 +780,8 @@ subroutine dqsort(x,ix,dir,flag) end if case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/3,dir_,0,0,0/)) + ierr(1) = 3; ierr(2) = dir_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -768,6 +805,7 @@ subroutine cqsort(x,ix,dir,flag) integer(psb_ipk_) :: dir_, flag_, n, err_act + integer(psb_ipk_) :: ierr(5) character(len=20) :: name name='psb_qsort' @@ -782,7 +820,8 @@ subroutine cqsort(x,ix,dir,flag) case( psb_sort_ovw_idx_, psb_sort_keep_idx_) ! OK keep going case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/4,flag_,0,0,0/)) + ierr(1) = 4; ierr(2) = flag_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -798,7 +837,8 @@ subroutine cqsort(x,ix,dir,flag) case( psb_lsort_up_, psb_lsort_down_) if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if @@ -811,7 +851,8 @@ subroutine cqsort(x,ix,dir,flag) ! OK keep going if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if @@ -824,7 +865,8 @@ subroutine cqsort(x,ix,dir,flag) ! OK keep going if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if @@ -834,7 +876,8 @@ subroutine cqsort(x,ix,dir,flag) end if case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/3,dir_,0,0,0/)) + ierr(1) = 3; ierr(2) = dir_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -858,6 +901,7 @@ subroutine zqsort(x,ix,dir,flag) integer(psb_ipk_) :: dir_, flag_, n, err_act + integer(psb_ipk_) :: ierr(5) character(len=20) :: name name='psb_qsort' @@ -872,7 +916,8 @@ subroutine zqsort(x,ix,dir,flag) case( psb_sort_ovw_idx_, psb_sort_keep_idx_) ! OK keep going case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/4,flag_,0,0,0/)) + ierr(1) = 4; ierr(2) = flag_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -888,7 +933,8 @@ subroutine zqsort(x,ix,dir,flag) case( psb_lsort_up_, psb_lsort_down_) if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if @@ -901,7 +947,8 @@ subroutine zqsort(x,ix,dir,flag) ! OK keep going if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if @@ -914,7 +961,8 @@ subroutine zqsort(x,ix,dir,flag) ! OK keep going if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if @@ -924,7 +972,8 @@ subroutine zqsort(x,ix,dir,flag) end if case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/3,dir_,0,0,0/)) + ierr(1) = 3; ierr(2) = dir_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -952,6 +1001,7 @@ subroutine ihsort(x,ix,dir,flag) integer(psb_ipk_) :: key integer(psb_ipk_) :: index + integer(psb_ipk_) :: ierr(5) character(len=20) :: name name='psb_hsort' @@ -966,7 +1016,8 @@ subroutine ihsort(x,ix,dir,flag) case( psb_sort_ovw_idx_, psb_sort_keep_idx_) ! OK keep going case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/4,flag_,0,0,0/)) + ierr(1) = 4; ierr(2) = flag_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -980,7 +1031,8 @@ subroutine ihsort(x,ix,dir,flag) case(psb_sort_up_,psb_sort_down_,psb_asort_up_,psb_asort_down_) ! OK case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/3,dir_,0,0,0/)) + ierr(1) = 3; ierr(2) = dir_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -997,7 +1049,8 @@ subroutine ihsort(x,ix,dir,flag) if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if if (flag_ == psb_sort_ovw_idx_) then @@ -1061,6 +1114,7 @@ subroutine shsort(x,ix,dir,flag) real(psb_spk_) :: key integer(psb_ipk_) :: index + integer(psb_ipk_) :: ierr(5) character(len=20) :: name name='psb_hsort' @@ -1075,7 +1129,8 @@ subroutine shsort(x,ix,dir,flag) case( psb_sort_ovw_idx_, psb_sort_keep_idx_) ! OK keep going case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/4,flag_,0,0,0/)) + ierr(1) = 4; ierr(2) = flag_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -1089,7 +1144,8 @@ subroutine shsort(x,ix,dir,flag) case(psb_sort_up_,psb_sort_down_,psb_asort_up_,psb_asort_down_) ! OK case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/3,dir_,0,0,0/)) + ierr(1) = 3; ierr(2) = dir_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -1106,7 +1162,8 @@ subroutine shsort(x,ix,dir,flag) if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if if (flag_ == psb_sort_ovw_idx_) then @@ -1170,6 +1227,7 @@ subroutine dhsort(x,ix,dir,flag) real(psb_dpk_) :: key integer(psb_ipk_) :: index + integer(psb_ipk_) :: ierr(5) character(len=20) :: name name='psb_hsort' @@ -1184,7 +1242,8 @@ subroutine dhsort(x,ix,dir,flag) case( psb_sort_ovw_idx_, psb_sort_keep_idx_) ! OK keep going case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/4,flag_,0,0,0/)) + ierr(1) = 4; ierr(2) = flag_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -1198,7 +1257,8 @@ subroutine dhsort(x,ix,dir,flag) case(psb_sort_up_,psb_sort_down_,psb_asort_up_,psb_asort_down_) ! OK case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/3,dir_,0,0,0/)) + ierr(1) = 3; ierr(2) = dir_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -1215,7 +1275,8 @@ subroutine dhsort(x,ix,dir,flag) if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if if (flag_ == psb_sort_ovw_idx_) then @@ -1279,6 +1340,7 @@ subroutine chsort(x,ix,dir,flag) complex(psb_spk_) :: key integer(psb_ipk_) :: index + integer(psb_ipk_) :: ierr(5) character(len=20) :: name name='psb_hsort' @@ -1293,7 +1355,8 @@ subroutine chsort(x,ix,dir,flag) case( psb_sort_ovw_idx_, psb_sort_keep_idx_) ! OK keep going case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/4,flag_,0,0,0/)) + ierr(1) = 4; ierr(2) = flag_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -1307,7 +1370,8 @@ subroutine chsort(x,ix,dir,flag) case(psb_asort_up_,psb_asort_down_) ! OK case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/3,dir_,0,0,0/)) + ierr(1) = 3; ierr(2) = dir_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -1324,7 +1388,8 @@ subroutine chsort(x,ix,dir,flag) if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if if (flag_ == psb_sort_ovw_idx_) then @@ -1388,6 +1453,7 @@ subroutine zhsort(x,ix,dir,flag) complex(psb_dpk_) :: key integer(psb_ipk_) :: index + integer(psb_ipk_) :: ierr(5) character(len=20) :: name name='psb_hsort' @@ -1402,7 +1468,8 @@ subroutine zhsort(x,ix,dir,flag) case( psb_sort_ovw_idx_, psb_sort_keep_idx_) ! OK keep going case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/4,flag_,0,0,0/)) + ierr(1) = 4; ierr(2) = flag_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -1416,7 +1483,8 @@ subroutine zhsort(x,ix,dir,flag) case(psb_asort_up_,psb_asort_down_) ! OK case default - call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=(/3,dir_,0,0,0/)) + ierr(1) = 3; ierr(2) = dir_; + call psb_errpush(psb_err_input_value_invalid_i_,name,i_err=ierr) goto 9999 end select @@ -1433,7 +1501,8 @@ subroutine zhsort(x,ix,dir,flag) if (present(ix)) then if (size(ix) < n) then - call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=(/2,size(ix),0,0,0/)) + ierr(1) = 2; ierr(2) = size(ix); + call psb_errpush(psb_err_input_asize_invalid_i_,name,i_err=ierr) goto 9999 end if if (flag_ == psb_sort_ovw_idx_) then diff --git a/base/serial/psb_ssymbmm.f90 b/base/serial/psb_ssymbmm.f90 index ea6db42f..fa87f43a 100644 --- a/base/serial/psb_ssymbmm.f90 +++ b/base/serial/psb_ssymbmm.f90 @@ -177,9 +177,9 @@ contains nze = max(ma+1,2*ma) call c%allocate(ma,nb,nze) - call symbmm(ma,na,nb,a%irp,a%ja,0,& - & b%irp,b%ja,0,& - & c%irp,c%ja,0,itemp) + call symbmm(ma,na,nb,a%irp,a%ja,izero,& + & b%irp,b%ja,izero,& + & c%irp,c%ja,izero,itemp) end subroutine csr_symbmm subroutine gen_symbmm(a,b,c,index,info) diff --git a/base/serial/psb_znumbmm.f90 b/base/serial/psb_znumbmm.f90 index 211e483c..91c13132 100644 --- a/base/serial/psb_znumbmm.f90 +++ b/base/serial/psb_znumbmm.f90 @@ -122,7 +122,7 @@ subroutine psb_zbase_numbmm(a,b,c) ! Note: we still have to test about possible performance hits. ! ! - call psb_ensure_size(size(c%ja),c%val,info) + call psb_ensure_size(ione*size(c%ja),c%val,info) select type(a) type is (psb_z_csr_sparse_mat) select type(b) @@ -169,9 +169,9 @@ contains mb = b%get_nrows() nb = b%get_ncols() - call znumbmm(ma,na,nb,a%irp,a%ja,0,a%val,& - & b%irp,b%ja,0,b%val,& - & c%irp,c%ja,0,c%val,temp) + call znumbmm(ma,na,nb,a%irp,a%ja,izero,a%val,& + & b%irp,b%ja,izero,b%val,& + & c%irp,c%ja,izero,c%val,temp) end subroutine csr_numbmm diff --git a/base/serial/psb_zsymbmm.f90 b/base/serial/psb_zsymbmm.f90 index 1f56b6c3..3fde5b80 100644 --- a/base/serial/psb_zsymbmm.f90 +++ b/base/serial/psb_zsymbmm.f90 @@ -177,9 +177,9 @@ contains nze = max(ma+1,2*ma) call c%allocate(ma,nb,nze) - call symbmm(ma,na,nb,a%irp,a%ja,0,& - & b%irp,b%ja,0,& - & c%irp,c%ja,0,itemp) + call symbmm(ma,na,nb,a%irp,a%ja,izero,& + & b%irp,b%ja,izero,& + & c%irp,c%ja,izero,itemp) end subroutine csr_symbmm subroutine gen_symbmm(a,b,c,index,info) diff --git a/base/serial/psi_serial_impl.f90 b/base/serial/psi_serial_impl.f90 index 1e7f693d..6de95b7a 100644 --- a/base/serial/psi_serial_impl.f90 +++ b/base/serial/psi_serial_impl.f90 @@ -856,6 +856,8 @@ subroutine psi_saxpbyv(m,alpha, x, beta, y, info) real(psb_spk_), intent (in) :: alpha, beta integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: lx, ly + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err name='psb_geaxpby' @@ -865,21 +867,26 @@ subroutine psi_saxpbyv(m,alpha, x, beta, y, info) if (m < 0) then info = psb_err_iarg_neg_ - call psb_errpush(info,name,i_err=(/1,m,0,0,0/)) + ierr(1) = 1; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if (size(x) < m) then - info = 36 - call psb_errpush(info,name,i_err=(/3,m,0,0,0/)) + lx = size(x,1) + ly = size(y,1) + if (lx < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 3; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if (size(y) < m) then - info = 36 - call psb_errpush(info,name,i_err=(/5,m,0,0,0/)) + if (ly < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 5; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if (m>0) call saxpby(m,1,alpha,x,size(x,1),beta,y,size(y,1),info) + if (m>0) call saxpby(m,ione,alpha,x,lx,beta,y,ly,info) call psb_erractionrestore(err_act) return @@ -904,6 +911,8 @@ subroutine psi_saxpby(m,n,alpha, x, beta, y, info) real(psb_spk_), intent (in) :: alpha, beta integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: lx, ly + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err name='psb_geaxpby' @@ -913,27 +922,33 @@ subroutine psi_saxpby(m,n,alpha, x, beta, y, info) if (m < 0) then info = psb_err_iarg_neg_ - call psb_errpush(info,name,i_err=(/1,m,0,0,0/)) + ierr(1) = 1; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if if (n < 0) then info = psb_err_iarg_neg_ - call psb_errpush(info,name,i_err=(/2,n,0,0,0/)) + ierr(1) = 2; ierr(2) = n + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if (size(x,1) < m) then - info = 36 - call psb_errpush(info,name,i_err=(/4,m,0,0,0/)) + lx = size(x,1) + ly = size(y,1) + if (lx < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 4; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if (size(y,1) < m) then - info = 36 - call psb_errpush(info,name,i_err=(/6,m,0,0,0/)) + if (ly < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 6; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if ((m>0).and.(n>0)) call saxpby(m,n,alpha,x,size(x,1),beta,y,size(y,1),info) - + if ((m>0).and.(n>0)) & + & call saxpby(m,n,alpha,x,lx,beta,y,ly,info) call psb_erractionrestore(err_act) return @@ -958,6 +973,8 @@ subroutine psi_daxpbyv(m,alpha, x, beta, y, info) real(psb_dpk_), intent (in) :: alpha, beta integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: lx, ly + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err name='psb_geaxpby' @@ -967,21 +984,26 @@ subroutine psi_daxpbyv(m,alpha, x, beta, y, info) if (m < 0) then info = psb_err_iarg_neg_ - call psb_errpush(info,name,i_err=(/1,m,0,0,0/)) + ierr(1) = 1; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if (size(x) < m) then - info = 36 - call psb_errpush(info,name,i_err=(/3,m,0,0,0/)) + lx = size(x,1) + ly = size(y,1) + if (lx < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 3; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if (size(y) < m) then - info = 36 - call psb_errpush(info,name,i_err=(/5,m,0,0,0/)) + if (ly < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 5; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if (m>0) call daxpby(m,1,alpha,x,size(x,1),beta,y,size(y,1),info) + if (m>0) call daxpby(m,ione,alpha,x,lx,beta,y,ly,info) call psb_erractionrestore(err_act) return @@ -1006,6 +1028,8 @@ subroutine psi_daxpby(m,n,alpha, x, beta, y, info) real(psb_dpk_), intent (in) :: alpha, beta integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: lx, ly + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err name='psb_geaxpby' @@ -1015,26 +1039,32 @@ subroutine psi_daxpby(m,n,alpha, x, beta, y, info) if (m < 0) then info = psb_err_iarg_neg_ - call psb_errpush(info,name,i_err=(/1,m,0,0,0/)) + ierr(1) = 1; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if if (n < 0) then info = psb_err_iarg_neg_ - call psb_errpush(info,name,i_err=(/2,n,0,0,0/)) + ierr(1) = 2; ierr(2) = n + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if (size(x,1) < m) then - info = 36 - call psb_errpush(info,name,i_err=(/4,m,0,0,0/)) + lx = size(x,1) + ly = size(y,1) + if (lx < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 4; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if (size(y,1) < m) then - info = 36 - call psb_errpush(info,name,i_err=(/6,m,0,0,0/)) + if (ly < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 6; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if ((m>0).and.(n>0)) call daxpby(m,n,alpha,x,size(x,1),beta,y,size(y,1),info) + if ((m>0).and.(n>0)) call daxpby(m,n,alpha,x,lx,beta,y,ly,info) call psb_erractionrestore(err_act) return @@ -1059,6 +1089,8 @@ subroutine psi_caxpbyv(m,alpha, x, beta, y, info) complex(psb_spk_), intent (in) :: alpha, beta integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: lx, ly + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err name='psb_geaxpby' @@ -1068,21 +1100,26 @@ subroutine psi_caxpbyv(m,alpha, x, beta, y, info) if (m < 0) then info = psb_err_iarg_neg_ - call psb_errpush(info,name,i_err=(/1,m,0,0,0/)) + ierr(1) = 1; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if (size(x) < m) then - info = 36 - call psb_errpush(info,name,i_err=(/3,m,0,0,0/)) + lx = size(x,1) + ly = size(y,1) + if (lx < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 3; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if (size(y) < m) then - info = 36 - call psb_errpush(info,name,i_err=(/5,m,0,0,0/)) + if (ly < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 5; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if (m>0) call caxpby(m,1,alpha,x,size(x,1),beta,y,size(y,1),info) + if (m>0) call caxpby(m,ione,alpha,x,lx,beta,y,ly,info) call psb_erractionrestore(err_act) return @@ -1107,6 +1144,8 @@ subroutine psi_caxpby(m,n,alpha, x, beta, y, info) complex(psb_spk_), intent (in) :: alpha, beta integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: lx, ly + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err name='psb_geaxpby' @@ -1116,26 +1155,32 @@ subroutine psi_caxpby(m,n,alpha, x, beta, y, info) if (m < 0) then info = psb_err_iarg_neg_ - call psb_errpush(info,name,i_err=(/1,m,0,0,0/)) + ierr(1) = 1; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if if (n < 0) then info = psb_err_iarg_neg_ - call psb_errpush(info,name,i_err=(/2,n,0,0,0/)) + ierr(1) = 2; ierr(2) = n + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if (size(x,1) < m) then - info = 36 - call psb_errpush(info,name,i_err=(/4,m,0,0,0/)) + lx = size(x,1) + ly = size(y,1) + if (lx < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 4; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if (size(y,1) < m) then - info = 36 - call psb_errpush(info,name,i_err=(/6,m,0,0,0/)) + if (ly < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 6; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if ((m>0).and.(n>0)) call caxpby(m,n,alpha,x,size(x,1),beta,y,size(y,1),info) + if ((m>0).and.(n>0)) call caxpby(m,n,alpha,x,lx,beta,y,ly,info) call psb_erractionrestore(err_act) return @@ -1160,6 +1205,8 @@ subroutine psi_zaxpbyv(m,alpha, x, beta, y, info) complex(psb_dpk_), intent (in) :: alpha, beta integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: lx, ly + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err name='psb_geaxpby' @@ -1169,21 +1216,26 @@ subroutine psi_zaxpbyv(m,alpha, x, beta, y, info) if (m < 0) then info = psb_err_iarg_neg_ - call psb_errpush(info,name,i_err=(/1,m,0,0,0/)) + ierr(1) = 1; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if (size(x) < m) then - info = 36 - call psb_errpush(info,name,i_err=(/3,m,0,0,0/)) + lx = size(x,1) + ly = size(y,1) + if (lx < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 3; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if (size(y) < m) then - info = 36 - call psb_errpush(info,name,i_err=(/5,m,0,0,0/)) + if (ly < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 5; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if (m>0) call zaxpby(m,1,alpha,x,size(x,1),beta,y,size(y,1),info) + if (m>0) call zaxpby(m,ione,alpha,x,lx,beta,y,ly,info) call psb_erractionrestore(err_act) return @@ -1208,6 +1260,8 @@ subroutine psi_zaxpby(m,n,alpha, x, beta, y, info) complex(psb_dpk_), intent (in) :: alpha, beta integer(psb_ipk_), intent(out) :: info integer(psb_ipk_) :: err_act + integer(psb_ipk_) :: lx, ly + integer(psb_ipk_) :: ierr(5) character(len=20) :: name, ch_err name='psb_geaxpby' @@ -1217,26 +1271,32 @@ subroutine psi_zaxpby(m,n,alpha, x, beta, y, info) if (m < 0) then info = psb_err_iarg_neg_ - call psb_errpush(info,name,i_err=(/1,m,0,0,0/)) + ierr(1) = 1; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if if (n < 0) then info = psb_err_iarg_neg_ - call psb_errpush(info,name,i_err=(/2,n,0,0,0/)) + ierr(1) = 2; ierr(2) = n + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if (size(x,1) < m) then - info = 36 - call psb_errpush(info,name,i_err=(/4,m,0,0,0/)) + lx = size(x,1) + ly = size(y,1) + if (lx < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 4; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if (size(y,1) < m) then - info = 36 - call psb_errpush(info,name,i_err=(/6,m,0,0,0/)) + if (ly < m) then + info = psb_err_input_asize_small_i_ + ierr(1) = 6; ierr(2) = m + call psb_errpush(info,name,i_err=ierr) goto 9999 end if - if ((m>0).and.(n>0)) call zaxpby(m,n,alpha,x,size(x,1),beta,y,size(y,1),info) + if ((m>0).and.(n>0)) call zaxpby(m,n,alpha,x,lx,beta,y,ly,info) call psb_erractionrestore(err_act) return