diff --git a/base/serial/impl/psb_c_coo_impl.f90 b/base/serial/impl/psb_c_coo_impl.f90 index 6151937e..44ab661f 100644 --- a/base/serial/impl/psb_c_coo_impl.f90 +++ b/base/serial/impl/psb_c_coo_impl.f90 @@ -2591,9 +2591,11 @@ subroutine psb_c_coo_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='c_coo_csput_impl' logical, parameter :: debug=.false. - integer(psb_ipk_) :: nza, i,j,k, nzl, isza + integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit info = psb_success_ + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() call psb_erractionsave(err_act) if (nz < 0) then @@ -2648,10 +2650,15 @@ subroutine psb_c_coo_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call c_coo_srch_upd(nz,ia,ja,val,a,& & imin,imax,jmin,jmax,info,gtl) - if (info /= psb_success_) then - info = psb_err_invalid_mat_state_ - end if + if (info < 0) then + info = psb_err_internal_error_ + else if (info > 0) then + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Discarded entries not belonging to us.' + info = psb_success_ + end if else ! State is wrong. info = psb_err_invalid_mat_state_ @@ -2798,14 +2805,13 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) endif + else + info = max(info,1) end if end do case(psb_dupl_add_) @@ -2841,14 +2847,13 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if + else + info = max(info,1) end if end do @@ -2893,9 +2898,10 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - info = i - return + info = max(info,3) end if + else + info = max(info,2) end if end do @@ -2929,9 +2935,10 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = i - return + info = max(info,3) end if + else + info = max(info,2) end if end do diff --git a/base/serial/impl/psb_c_csc_impl.f90 b/base/serial/impl/psb_c_csc_impl.f90 index 63875efd..6e208a25 100644 --- a/base/serial/impl/psb_c_csc_impl.f90 +++ b/base/serial/impl/psb_c_csc_impl.f90 @@ -1982,9 +1982,11 @@ subroutine psb_c_csc_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='c_csc_csput' logical, parameter :: debug=.false. - integer(psb_ipk_) :: nza, i,j,k, nzl, isza + integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() info = psb_success_ if (nz <= 0) then @@ -2025,9 +2027,13 @@ subroutine psb_c_csc_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call psb_c_csc_srch_upd(nz,ia,ja,val,a,& & imin,imax,jmin,jmax,info,gtl) - if (info /= psb_success_) then - - info = psb_err_invalid_mat_state_ + if (info < 0) then + info = psb_err_internal_error_ + else if (info > 0) then + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Discarded entries not belonging to us.' + info = psb_success_ end if else @@ -2116,20 +2122,13 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ir,' in: ',i1,i2,& - & ' : ',a%ia(i1:i2-1) - info = i - return + info = max(info,3) end if - else - - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if + else + info = max(info,1) end if end do @@ -2152,19 +2151,13 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ir,' in: ',i1,i2,& - & ' : ',a%ia(i1:i2-1) - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if - + else + info = max(info,1) end if end do @@ -2197,18 +2190,10 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ir,' in: ',i1,i2,& - & ' : ',a%ia(i1:i2-1) - info = i - return + info = max(info,3) end if - else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding col that does not belong to us.' + info = max(info,2) end if end do @@ -2229,17 +2214,10 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ir,' in: ',i1,i2,& - & ' : ',a%ia(i1:i2-1) - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding col that does not belong to us.' + info = max(info,2) end if end do diff --git a/base/serial/impl/psb_c_csr_impl.f90 b/base/serial/impl/psb_c_csr_impl.f90 index c2a925dd..424c68d2 100644 --- a/base/serial/impl/psb_c_csr_impl.f90 +++ b/base/serial/impl/psb_c_csr_impl.f90 @@ -2355,11 +2355,13 @@ subroutine psb_c_csr_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='c_csr_csput' logical, parameter :: debug=.false. - integer(psb_ipk_) :: nza, i,j,k, nzl, isza + integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit call psb_erractionsave(err_act) info = psb_success_ + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() if (nz <= 0) then info = psb_err_iarg_neg_ @@ -2399,8 +2401,13 @@ subroutine psb_c_csr_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call psb_c_csr_srch_upd(nz,ia,ja,val,a,& & imin,imax,jmin,jmax,info,gtl) - if (info /= psb_success_) then + if (info < 0) then info = psb_err_internal_error_ + else if (info > 0) then + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Discarded entries not belonging to us.' + info = psb_success_ end if else @@ -2489,20 +2496,13 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ic,' in: ',i1,i2,& - & ' : ',a%ja(i1:i2-1) - info = i - return - end if - + info = max(info,3) + end if else - - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if + else + info = max(info,1) end if end do @@ -2524,19 +2524,13 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ic,' in: ',i1,i2,& - & ' : ',a%ja(i1:i2-1) - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if - + else + info = max(info,1) end if end do @@ -2570,20 +2564,11 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ic,' in: ',i1,i2,& - & ' : ',a%ja(i1:i2-1) - info = i - return + info = max(info,3) end if - else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if - end do case(psb_dupl_add_) @@ -2601,13 +2586,10 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if end do diff --git a/base/serial/impl/psb_d_coo_impl.f90 b/base/serial/impl/psb_d_coo_impl.f90 index 954bdf69..c4aaedd2 100644 --- a/base/serial/impl/psb_d_coo_impl.f90 +++ b/base/serial/impl/psb_d_coo_impl.f90 @@ -2591,9 +2591,11 @@ subroutine psb_d_coo_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='d_coo_csput_impl' logical, parameter :: debug=.false. - integer(psb_ipk_) :: nza, i,j,k, nzl, isza + integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit info = psb_success_ + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() call psb_erractionsave(err_act) if (nz < 0) then @@ -2648,10 +2650,15 @@ subroutine psb_d_coo_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call d_coo_srch_upd(nz,ia,ja,val,a,& & imin,imax,jmin,jmax,info,gtl) - if (info /= psb_success_) then - info = psb_err_invalid_mat_state_ - end if + if (info < 0) then + info = psb_err_internal_error_ + else if (info > 0) then + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Discarded entries not belonging to us.' + info = psb_success_ + end if else ! State is wrong. info = psb_err_invalid_mat_state_ @@ -2798,14 +2805,13 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) endif + else + info = max(info,1) end if end do case(psb_dupl_add_) @@ -2841,14 +2847,13 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if + else + info = max(info,1) end if end do @@ -2893,9 +2898,10 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - info = i - return + info = max(info,3) end if + else + info = max(info,2) end if end do @@ -2929,9 +2935,10 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = i - return + info = max(info,3) end if + else + info = max(info,2) end if end do diff --git a/base/serial/impl/psb_d_csc_impl.f90 b/base/serial/impl/psb_d_csc_impl.f90 index 18f829a0..e6b2c492 100644 --- a/base/serial/impl/psb_d_csc_impl.f90 +++ b/base/serial/impl/psb_d_csc_impl.f90 @@ -1982,9 +1982,11 @@ subroutine psb_d_csc_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='d_csc_csput' logical, parameter :: debug=.false. - integer(psb_ipk_) :: nza, i,j,k, nzl, isza + integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() info = psb_success_ if (nz <= 0) then @@ -2025,9 +2027,13 @@ subroutine psb_d_csc_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call psb_d_csc_srch_upd(nz,ia,ja,val,a,& & imin,imax,jmin,jmax,info,gtl) - if (info /= psb_success_) then - - info = psb_err_invalid_mat_state_ + if (info < 0) then + info = psb_err_internal_error_ + else if (info > 0) then + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Discarded entries not belonging to us.' + info = psb_success_ end if else @@ -2116,20 +2122,13 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ir,' in: ',i1,i2,& - & ' : ',a%ia(i1:i2-1) - info = i - return + info = max(info,3) end if - else - - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if + else + info = max(info,1) end if end do @@ -2152,19 +2151,13 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ir,' in: ',i1,i2,& - & ' : ',a%ia(i1:i2-1) - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if - + else + info = max(info,1) end if end do @@ -2197,18 +2190,10 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ir,' in: ',i1,i2,& - & ' : ',a%ia(i1:i2-1) - info = i - return + info = max(info,3) end if - else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding col that does not belong to us.' + info = max(info,2) end if end do @@ -2229,17 +2214,10 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ir,' in: ',i1,i2,& - & ' : ',a%ia(i1:i2-1) - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding col that does not belong to us.' + info = max(info,2) end if end do diff --git a/base/serial/impl/psb_d_csr_impl.f90 b/base/serial/impl/psb_d_csr_impl.f90 index eb0a224e..2803e2c7 100644 --- a/base/serial/impl/psb_d_csr_impl.f90 +++ b/base/serial/impl/psb_d_csr_impl.f90 @@ -2355,11 +2355,13 @@ subroutine psb_d_csr_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='d_csr_csput' logical, parameter :: debug=.false. - integer(psb_ipk_) :: nza, i,j,k, nzl, isza + integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit call psb_erractionsave(err_act) info = psb_success_ + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() if (nz <= 0) then info = psb_err_iarg_neg_ @@ -2399,8 +2401,13 @@ subroutine psb_d_csr_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call psb_d_csr_srch_upd(nz,ia,ja,val,a,& & imin,imax,jmin,jmax,info,gtl) - if (info /= psb_success_) then + if (info < 0) then info = psb_err_internal_error_ + else if (info > 0) then + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Discarded entries not belonging to us.' + info = psb_success_ end if else @@ -2489,20 +2496,13 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ic,' in: ',i1,i2,& - & ' : ',a%ja(i1:i2-1) - info = i - return - end if - + info = max(info,3) + end if else - - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if + else + info = max(info,1) end if end do @@ -2524,19 +2524,13 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ic,' in: ',i1,i2,& - & ' : ',a%ja(i1:i2-1) - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if - + else + info = max(info,1) end if end do @@ -2570,20 +2564,11 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ic,' in: ',i1,i2,& - & ' : ',a%ja(i1:i2-1) - info = i - return + info = max(info,3) end if - else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if - end do case(psb_dupl_add_) @@ -2601,13 +2586,10 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if end do diff --git a/base/serial/impl/psb_s_coo_impl.f90 b/base/serial/impl/psb_s_coo_impl.f90 index 11dc6c05..039c2c8a 100644 --- a/base/serial/impl/psb_s_coo_impl.f90 +++ b/base/serial/impl/psb_s_coo_impl.f90 @@ -2591,9 +2591,11 @@ subroutine psb_s_coo_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='s_coo_csput_impl' logical, parameter :: debug=.false. - integer(psb_ipk_) :: nza, i,j,k, nzl, isza + integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit info = psb_success_ + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() call psb_erractionsave(err_act) if (nz < 0) then @@ -2648,10 +2650,15 @@ subroutine psb_s_coo_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call s_coo_srch_upd(nz,ia,ja,val,a,& & imin,imax,jmin,jmax,info,gtl) - if (info /= psb_success_) then - info = psb_err_invalid_mat_state_ - end if + if (info < 0) then + info = psb_err_internal_error_ + else if (info > 0) then + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Discarded entries not belonging to us.' + info = psb_success_ + end if else ! State is wrong. info = psb_err_invalid_mat_state_ @@ -2798,14 +2805,13 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) endif + else + info = max(info,1) end if end do case(psb_dupl_add_) @@ -2841,14 +2847,13 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if + else + info = max(info,1) end if end do @@ -2893,9 +2898,10 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - info = i - return + info = max(info,3) end if + else + info = max(info,2) end if end do @@ -2929,9 +2935,10 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = i - return + info = max(info,3) end if + else + info = max(info,2) end if end do diff --git a/base/serial/impl/psb_s_csc_impl.f90 b/base/serial/impl/psb_s_csc_impl.f90 index 017c8513..1da9df64 100644 --- a/base/serial/impl/psb_s_csc_impl.f90 +++ b/base/serial/impl/psb_s_csc_impl.f90 @@ -1982,9 +1982,11 @@ subroutine psb_s_csc_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='s_csc_csput' logical, parameter :: debug=.false. - integer(psb_ipk_) :: nza, i,j,k, nzl, isza + integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() info = psb_success_ if (nz <= 0) then @@ -2025,9 +2027,13 @@ subroutine psb_s_csc_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call psb_s_csc_srch_upd(nz,ia,ja,val,a,& & imin,imax,jmin,jmax,info,gtl) - if (info /= psb_success_) then - - info = psb_err_invalid_mat_state_ + if (info < 0) then + info = psb_err_internal_error_ + else if (info > 0) then + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Discarded entries not belonging to us.' + info = psb_success_ end if else @@ -2116,20 +2122,13 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ir,' in: ',i1,i2,& - & ' : ',a%ia(i1:i2-1) - info = i - return + info = max(info,3) end if - else - - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if + else + info = max(info,1) end if end do @@ -2152,19 +2151,13 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ir,' in: ',i1,i2,& - & ' : ',a%ia(i1:i2-1) - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if - + else + info = max(info,1) end if end do @@ -2197,18 +2190,10 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ir,' in: ',i1,i2,& - & ' : ',a%ia(i1:i2-1) - info = i - return + info = max(info,3) end if - else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding col that does not belong to us.' + info = max(info,2) end if end do @@ -2229,17 +2214,10 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ir,' in: ',i1,i2,& - & ' : ',a%ia(i1:i2-1) - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding col that does not belong to us.' + info = max(info,2) end if end do diff --git a/base/serial/impl/psb_s_csr_impl.f90 b/base/serial/impl/psb_s_csr_impl.f90 index 4a0514e7..c7708325 100644 --- a/base/serial/impl/psb_s_csr_impl.f90 +++ b/base/serial/impl/psb_s_csr_impl.f90 @@ -2355,11 +2355,13 @@ subroutine psb_s_csr_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='s_csr_csput' logical, parameter :: debug=.false. - integer(psb_ipk_) :: nza, i,j,k, nzl, isza + integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit call psb_erractionsave(err_act) info = psb_success_ + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() if (nz <= 0) then info = psb_err_iarg_neg_ @@ -2399,8 +2401,13 @@ subroutine psb_s_csr_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call psb_s_csr_srch_upd(nz,ia,ja,val,a,& & imin,imax,jmin,jmax,info,gtl) - if (info /= psb_success_) then + if (info < 0) then info = psb_err_internal_error_ + else if (info > 0) then + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Discarded entries not belonging to us.' + info = psb_success_ end if else @@ -2489,20 +2496,13 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ic,' in: ',i1,i2,& - & ' : ',a%ja(i1:i2-1) - info = i - return - end if - + info = max(info,3) + end if else - - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if + else + info = max(info,1) end if end do @@ -2524,19 +2524,13 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ic,' in: ',i1,i2,& - & ' : ',a%ja(i1:i2-1) - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if - + else + info = max(info,1) end if end do @@ -2570,20 +2564,11 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ic,' in: ',i1,i2,& - & ' : ',a%ja(i1:i2-1) - info = i - return + info = max(info,3) end if - else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if - end do case(psb_dupl_add_) @@ -2601,13 +2586,10 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if end do diff --git a/base/serial/impl/psb_z_coo_impl.f90 b/base/serial/impl/psb_z_coo_impl.f90 index 0ea2a21f..5a9b0b8b 100644 --- a/base/serial/impl/psb_z_coo_impl.f90 +++ b/base/serial/impl/psb_z_coo_impl.f90 @@ -2591,9 +2591,11 @@ subroutine psb_z_coo_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='z_coo_csput_impl' logical, parameter :: debug=.false. - integer(psb_ipk_) :: nza, i,j,k, nzl, isza + integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit info = psb_success_ + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() call psb_erractionsave(err_act) if (nz < 0) then @@ -2648,10 +2650,15 @@ subroutine psb_z_coo_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call z_coo_srch_upd(nz,ia,ja,val,a,& & imin,imax,jmin,jmax,info,gtl) - if (info /= psb_success_) then - info = psb_err_invalid_mat_state_ - end if + if (info < 0) then + info = psb_err_internal_error_ + else if (info > 0) then + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Discarded entries not belonging to us.' + info = psb_success_ + end if else ! State is wrong. info = psb_err_invalid_mat_state_ @@ -2798,14 +2805,13 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) endif + else + info = max(info,1) end if end do case(psb_dupl_add_) @@ -2841,14 +2847,13 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if + else + info = max(info,1) end if end do @@ -2893,9 +2898,10 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - info = i - return + info = max(info,3) end if + else + info = max(info,2) end if end do @@ -2929,9 +2935,10 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = i - return + info = max(info,3) end if + else + info = max(info,2) end if end do diff --git a/base/serial/impl/psb_z_csc_impl.f90 b/base/serial/impl/psb_z_csc_impl.f90 index 7b575a41..26617e10 100644 --- a/base/serial/impl/psb_z_csc_impl.f90 +++ b/base/serial/impl/psb_z_csc_impl.f90 @@ -1982,9 +1982,11 @@ subroutine psb_z_csc_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='z_csc_csput' logical, parameter :: debug=.false. - integer(psb_ipk_) :: nza, i,j,k, nzl, isza + integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit call psb_erractionsave(err_act) + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() info = psb_success_ if (nz <= 0) then @@ -2025,9 +2027,13 @@ subroutine psb_z_csc_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call psb_z_csc_srch_upd(nz,ia,ja,val,a,& & imin,imax,jmin,jmax,info,gtl) - if (info /= psb_success_) then - - info = psb_err_invalid_mat_state_ + if (info < 0) then + info = psb_err_internal_error_ + else if (info > 0) then + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Discarded entries not belonging to us.' + info = psb_success_ end if else @@ -2116,20 +2122,13 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ir,' in: ',i1,i2,& - & ' : ',a%ia(i1:i2-1) - info = i - return + info = max(info,3) end if - else - - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if + else + info = max(info,1) end if end do @@ -2152,19 +2151,13 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ir,' in: ',i1,i2,& - & ' : ',a%ia(i1:i2-1) - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if - + else + info = max(info,1) end if end do @@ -2197,18 +2190,10 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ir,' in: ',i1,i2,& - & ' : ',a%ia(i1:i2-1) - info = i - return + info = max(info,3) end if - else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding col that does not belong to us.' + info = max(info,2) end if end do @@ -2229,17 +2214,10 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ir,' in: ',i1,i2,& - & ' : ',a%ia(i1:i2-1) - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding col that does not belong to us.' + info = max(info,2) end if end do diff --git a/base/serial/impl/psb_z_csr_impl.f90 b/base/serial/impl/psb_z_csr_impl.f90 index 7abc354a..49eb8587 100644 --- a/base/serial/impl/psb_z_csr_impl.f90 +++ b/base/serial/impl/psb_z_csr_impl.f90 @@ -2355,11 +2355,13 @@ subroutine psb_z_csr_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) integer(psb_ipk_) :: ierr(5) character(len=20) :: name='z_csr_csput' logical, parameter :: debug=.false. - integer(psb_ipk_) :: nza, i,j,k, nzl, isza + integer(psb_ipk_) :: nza, i,j,k, nzl, isza, debug_level, debug_unit call psb_erractionsave(err_act) info = psb_success_ + debug_unit = psb_get_debug_unit() + debug_level = psb_get_debug_level() if (nz <= 0) then info = psb_err_iarg_neg_ @@ -2399,8 +2401,13 @@ subroutine psb_z_csr_csput(nz,ia,ja,val,a,imin,imax,jmin,jmax,info,gtl) call psb_z_csr_srch_upd(nz,ia,ja,val,a,& & imin,imax,jmin,jmax,info,gtl) - if (info /= psb_success_) then + if (info < 0) then info = psb_err_internal_error_ + else if (info > 0) then + if (debug_level >= psb_debug_serial_) & + & write(debug_unit,*) trim(name),& + & ': Discarded entries not belonging to us.' + info = psb_success_ end if else @@ -2489,20 +2496,13 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ic,' in: ',i1,i2,& - & ' : ',a%ja(i1:i2-1) - info = i - return - end if - + info = max(info,3) + end if else - - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if + else + info = max(info,1) end if end do @@ -2524,19 +2524,13 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ic,' in: ',i1,i2,& - & ' : ',a%ja(i1:i2-1) - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if - + else + info = max(info,1) end if end do @@ -2570,20 +2564,11 @@ contains if (ip>0) then a%val(i1+ip-1) = val(i) else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Was searching ',ic,' in: ',i1,i2,& - & ' : ',a%ja(i1:i2-1) - info = i - return + info = max(info,3) end if - else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if - end do case(psb_dupl_add_) @@ -2601,13 +2586,10 @@ contains if (ip>0) then a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) else - info = i - return + info = max(info,3) end if else - if (debug_level >= psb_debug_serial_) & - & write(debug_unit,*) trim(name),& - & ': Discarding row that does not belong to us.' + info = max(info,2) end if end do