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

psblas3:

Browse Source 
base/serial/impl/psb_c_coo_impl.f90
 base/serial/impl/psb_c_csc_impl.f90
 base/serial/impl/psb_c_csr_impl.f90
 base/serial/impl/psb_d_coo_impl.f90
 base/serial/impl/psb_d_csc_impl.f90
 base/serial/impl/psb_d_csr_impl.f90
 base/serial/impl/psb_s_coo_impl.f90
 base/serial/impl/psb_s_csc_impl.f90
 base/serial/impl/psb_s_csr_impl.f90
 base/serial/impl/psb_z_coo_impl.f90
 base/serial/impl/psb_z_csc_impl.f90
 base/serial/impl/psb_z_csr_impl.f90

Changed behaviour of CSPUT in update to ignore (at most a warning)
indices not belonging.
psblas-3.2.0
Salvatore Filippone 11 years ago
parent 5f54a9e599
commit 62502546b1
12 changed files with 276 additions and 408 deletions
Show Stats Download Patch File Download Diff File

43
base/serial/impl/psb_c_coo_impl.f90
Unescape Escape View File

@ -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) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='c_coo_csput_impl' character(len=20) :: name='c_coo_csput_impl'
logical, parameter :: debug=.false. 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_ info = psb_success_
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (nz < 0) then 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,& call c_coo_srch_upd(nz,ia,ja,val,a,&
& imin,imax,jmin,jmax,info,gtl) & 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 else
! State is wrong. ! State is wrong.
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
@ -2798,14 +2805,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
info = i info = max(info,3)
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
endif endif
else
info = max(info,1)
end if end if
end do end do
case(psb_dupl_add_) case(psb_dupl_add_)
@ -2841,14 +2847,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
info = i info = max(info,3)
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
else
info = max(info,1)
end if end if
end do end do
@ -2893,9 +2898,10 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
info = i info = max(info,3)
return
end if end if
else
info = max(info,2)
end if end if
end do end do
@ -2929,9 +2935,10 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
info = i info = max(info,3)
return
end if end if
else
info = max(info,2)
end if end if
end do end do

66
base/serial/impl/psb_c_csc_impl.f90
Unescape Escape View File

@ -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) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='c_csc_csput' character(len=20) :: name='c_csc_csput'
logical, parameter :: debug=.false. 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) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
if (nz <= 0) then 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,& call psb_c_csc_srch_upd(nz,ia,ja,val,a,&
& imin,imax,jmin,jmax,info,gtl) & imin,imax,jmin,jmax,info,gtl)
if (info /= psb_success_) then if (info < 0) then
info = psb_err_internal_error_
info = psb_err_invalid_mat_state_ 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 end if
else else
@ -2116,20 +2122,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ir,' in: ',i1,i2,&
& ' : ',a%ia(i1:i2-1)
info = i
return
end if end if
else else
info = max(info,2)
if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
else
info = max(info,1)
end if end if
end do end do
@ -2152,19 +2151,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ir,' in: ',i1,i2,&
& ' : ',a%ia(i1:i2-1)
info = i
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
else
info = max(info,1)
end if end if
end do end do
@ -2197,18 +2190,10 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ir,' in: ',i1,i2,&
& ' : ',a%ia(i1:i2-1)
info = i
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding col that does not belong to us.'
end if end if
end do end do
@ -2229,17 +2214,10 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ir,' in: ',i1,i2,&
& ' : ',a%ia(i1:i2-1)
info = i
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding col that does not belong to us.'
end if end if
end do end do

60
base/serial/impl/psb_c_csr_impl.f90
Unescape Escape View File

@ -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) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='c_csr_csput' character(len=20) :: name='c_csr_csput'
logical, parameter :: debug=.false. 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) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
if (nz <= 0) then if (nz <= 0) then
info = psb_err_iarg_neg_ 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,& call psb_c_csr_srch_upd(nz,ia,ja,val,a,&
& imin,imax,jmin,jmax,info,gtl) & imin,imax,jmin,jmax,info,gtl)
if (info /= psb_success_) then if (info < 0) then
info = psb_err_internal_error_ 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 end if
else else
@ -2489,20 +2496,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ic,' in: ',i1,i2,&
& ' : ',a%ja(i1:i2-1)
info = i
return
end if end if
else else
info = max(info,2)
if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
else
info = max(info,1)
end if end if
end do end do
@ -2524,19 +2524,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ic,' in: ',i1,i2,&
& ' : ',a%ja(i1:i2-1)
info = i
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
else
info = max(info,1)
end if end if
end do end do
@ -2570,20 +2564,11 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ic,' in: ',i1,i2,&
& ' : ',a%ja(i1:i2-1)
info = i
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
end do end do
case(psb_dupl_add_) case(psb_dupl_add_)
@ -2601,13 +2586,10 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
info = i info = max(info,3)
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
end do end do

43
base/serial/impl/psb_d_coo_impl.f90
Unescape Escape View File

@ -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) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='d_coo_csput_impl' character(len=20) :: name='d_coo_csput_impl'
logical, parameter :: debug=.false. 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_ info = psb_success_
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (nz < 0) then 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,& call d_coo_srch_upd(nz,ia,ja,val,a,&
& imin,imax,jmin,jmax,info,gtl) & 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 else
! State is wrong. ! State is wrong.
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
@ -2798,14 +2805,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
info = i info = max(info,3)
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
endif endif
else
info = max(info,1)
end if end if
end do end do
case(psb_dupl_add_) case(psb_dupl_add_)
@ -2841,14 +2847,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
info = i info = max(info,3)
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
else
info = max(info,1)
end if end if
end do end do
@ -2893,9 +2898,10 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
info = i info = max(info,3)
return
end if end if
else
info = max(info,2)
end if end if
end do end do
@ -2929,9 +2935,10 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
info = i info = max(info,3)
return
end if end if
else
info = max(info,2)
end if end if
end do end do

66
base/serial/impl/psb_d_csc_impl.f90
Unescape Escape View File

@ -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) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='d_csc_csput' character(len=20) :: name='d_csc_csput'
logical, parameter :: debug=.false. 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) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
if (nz <= 0) then 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,& call psb_d_csc_srch_upd(nz,ia,ja,val,a,&
& imin,imax,jmin,jmax,info,gtl) & imin,imax,jmin,jmax,info,gtl)
if (info /= psb_success_) then if (info < 0) then
info = psb_err_internal_error_
info = psb_err_invalid_mat_state_ 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 end if
else else
@ -2116,20 +2122,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ir,' in: ',i1,i2,&
& ' : ',a%ia(i1:i2-1)
info = i
return
end if end if
else else
info = max(info,2)
if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
else
info = max(info,1)
end if end if
end do end do
@ -2152,19 +2151,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ir,' in: ',i1,i2,&
& ' : ',a%ia(i1:i2-1)
info = i
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
else
info = max(info,1)
end if end if
end do end do
@ -2197,18 +2190,10 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ir,' in: ',i1,i2,&
& ' : ',a%ia(i1:i2-1)
info = i
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding col that does not belong to us.'
end if end if
end do end do
@ -2229,17 +2214,10 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ir,' in: ',i1,i2,&
& ' : ',a%ia(i1:i2-1)
info = i
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding col that does not belong to us.'
end if end if
end do end do

60
base/serial/impl/psb_d_csr_impl.f90
Unescape Escape View File

@ -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) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='d_csr_csput' character(len=20) :: name='d_csr_csput'
logical, parameter :: debug=.false. 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) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
if (nz <= 0) then if (nz <= 0) then
info = psb_err_iarg_neg_ 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,& call psb_d_csr_srch_upd(nz,ia,ja,val,a,&
& imin,imax,jmin,jmax,info,gtl) & imin,imax,jmin,jmax,info,gtl)
if (info /= psb_success_) then if (info < 0) then
info = psb_err_internal_error_ 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 end if
else else
@ -2489,20 +2496,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ic,' in: ',i1,i2,&
& ' : ',a%ja(i1:i2-1)
info = i
return
end if end if
else else
info = max(info,2)
if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
else
info = max(info,1)
end if end if
end do end do
@ -2524,19 +2524,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ic,' in: ',i1,i2,&
& ' : ',a%ja(i1:i2-1)
info = i
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
else
info = max(info,1)
end if end if
end do end do
@ -2570,20 +2564,11 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ic,' in: ',i1,i2,&
& ' : ',a%ja(i1:i2-1)
info = i
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
end do end do
case(psb_dupl_add_) case(psb_dupl_add_)
@ -2601,13 +2586,10 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
info = i info = max(info,3)
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
end do end do

43
base/serial/impl/psb_s_coo_impl.f90
Unescape Escape View File

@ -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) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='s_coo_csput_impl' character(len=20) :: name='s_coo_csput_impl'
logical, parameter :: debug=.false. 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_ info = psb_success_
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (nz < 0) then 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,& call s_coo_srch_upd(nz,ia,ja,val,a,&
& imin,imax,jmin,jmax,info,gtl) & 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 else
! State is wrong. ! State is wrong.
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
@ -2798,14 +2805,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
info = i info = max(info,3)
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
endif endif
else
info = max(info,1)
end if end if
end do end do
case(psb_dupl_add_) case(psb_dupl_add_)
@ -2841,14 +2847,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
info = i info = max(info,3)
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
else
info = max(info,1)
end if end if
end do end do
@ -2893,9 +2898,10 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
info = i info = max(info,3)
return
end if end if
else
info = max(info,2)
end if end if
end do end do
@ -2929,9 +2935,10 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
info = i info = max(info,3)
return
end if end if
else
info = max(info,2)
end if end if
end do end do

66
base/serial/impl/psb_s_csc_impl.f90
Unescape Escape View File

@ -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) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='s_csc_csput' character(len=20) :: name='s_csc_csput'
logical, parameter :: debug=.false. 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) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
if (nz <= 0) then 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,& call psb_s_csc_srch_upd(nz,ia,ja,val,a,&
& imin,imax,jmin,jmax,info,gtl) & imin,imax,jmin,jmax,info,gtl)
if (info /= psb_success_) then if (info < 0) then
info = psb_err_internal_error_
info = psb_err_invalid_mat_state_ 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 end if
else else
@ -2116,20 +2122,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ir,' in: ',i1,i2,&
& ' : ',a%ia(i1:i2-1)
info = i
return
end if end if
else else
info = max(info,2)
if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
else
info = max(info,1)
end if end if
end do end do
@ -2152,19 +2151,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ir,' in: ',i1,i2,&
& ' : ',a%ia(i1:i2-1)
info = i
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
else
info = max(info,1)
end if end if
end do end do
@ -2197,18 +2190,10 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ir,' in: ',i1,i2,&
& ' : ',a%ia(i1:i2-1)
info = i
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding col that does not belong to us.'
end if end if
end do end do
@ -2229,17 +2214,10 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ir,' in: ',i1,i2,&
& ' : ',a%ia(i1:i2-1)
info = i
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding col that does not belong to us.'
end if end if
end do end do

60
base/serial/impl/psb_s_csr_impl.f90
Unescape Escape View File

@ -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) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='s_csr_csput' character(len=20) :: name='s_csr_csput'
logical, parameter :: debug=.false. 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) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
if (nz <= 0) then if (nz <= 0) then
info = psb_err_iarg_neg_ 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,& call psb_s_csr_srch_upd(nz,ia,ja,val,a,&
& imin,imax,jmin,jmax,info,gtl) & imin,imax,jmin,jmax,info,gtl)
if (info /= psb_success_) then if (info < 0) then
info = psb_err_internal_error_ 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 end if
else else
@ -2489,20 +2496,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ic,' in: ',i1,i2,&
& ' : ',a%ja(i1:i2-1)
info = i
return
end if end if
else else
info = max(info,2)
if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
else
info = max(info,1)
end if end if
end do end do
@ -2524,19 +2524,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ic,' in: ',i1,i2,&
& ' : ',a%ja(i1:i2-1)
info = i
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
else
info = max(info,1)
end if end if
end do end do
@ -2570,20 +2564,11 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ic,' in: ',i1,i2,&
& ' : ',a%ja(i1:i2-1)
info = i
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
end do end do
case(psb_dupl_add_) case(psb_dupl_add_)
@ -2601,13 +2586,10 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
info = i info = max(info,3)
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
end do end do

43
base/serial/impl/psb_z_coo_impl.f90
Unescape Escape View File

@ -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) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='z_coo_csput_impl' character(len=20) :: name='z_coo_csput_impl'
logical, parameter :: debug=.false. 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_ info = psb_success_
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
call psb_erractionsave(err_act) call psb_erractionsave(err_act)
if (nz < 0) then 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,& call z_coo_srch_upd(nz,ia,ja,val,a,&
& imin,imax,jmin,jmax,info,gtl) & 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 else
! State is wrong. ! State is wrong.
info = psb_err_invalid_mat_state_ info = psb_err_invalid_mat_state_
@ -2798,14 +2805,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
info = i info = max(info,3)
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
endif endif
else
info = max(info,1)
end if end if
end do end do
case(psb_dupl_add_) case(psb_dupl_add_)
@ -2841,14 +2847,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
info = i info = max(info,3)
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
else
info = max(info,1)
end if end if
end do end do
@ -2893,9 +2898,10 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
info = i info = max(info,3)
return
end if end if
else
info = max(info,2)
end if end if
end do end do
@ -2929,9 +2935,10 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
info = i info = max(info,3)
return
end if end if
else
info = max(info,2)
end if end if
end do end do

66
base/serial/impl/psb_z_csc_impl.f90
Unescape Escape View File

@ -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) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='z_csc_csput' character(len=20) :: name='z_csc_csput'
logical, parameter :: debug=.false. 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) call psb_erractionsave(err_act)
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
info = psb_success_ info = psb_success_
if (nz <= 0) then 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,& call psb_z_csc_srch_upd(nz,ia,ja,val,a,&
& imin,imax,jmin,jmax,info,gtl) & imin,imax,jmin,jmax,info,gtl)
if (info /= psb_success_) then if (info < 0) then
info = psb_err_internal_error_
info = psb_err_invalid_mat_state_ 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 end if
else else
@ -2116,20 +2122,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ir,' in: ',i1,i2,&
& ' : ',a%ia(i1:i2-1)
info = i
return
end if end if
else else
info = max(info,2)
if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
else
info = max(info,1)
end if end if
end do end do
@ -2152,19 +2151,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ir,' in: ',i1,i2,&
& ' : ',a%ia(i1:i2-1)
info = i
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
else
info = max(info,1)
end if end if
end do end do
@ -2197,18 +2190,10 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ir,' in: ',i1,i2,&
& ' : ',a%ia(i1:i2-1)
info = i
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding col that does not belong to us.'
end if end if
end do end do
@ -2229,17 +2214,10 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ir,' in: ',i1,i2,&
& ' : ',a%ia(i1:i2-1)
info = i
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding col that does not belong to us.'
end if end if
end do end do

60
base/serial/impl/psb_z_csr_impl.f90
Unescape Escape View File

@ -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) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name='z_csr_csput' character(len=20) :: name='z_csr_csput'
logical, parameter :: debug=.false. 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) call psb_erractionsave(err_act)
info = psb_success_ info = psb_success_
debug_unit = psb_get_debug_unit()
debug_level = psb_get_debug_level()
if (nz <= 0) then if (nz <= 0) then
info = psb_err_iarg_neg_ 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,& call psb_z_csr_srch_upd(nz,ia,ja,val,a,&
& imin,imax,jmin,jmax,info,gtl) & imin,imax,jmin,jmax,info,gtl)
if (info /= psb_success_) then if (info < 0) then
info = psb_err_internal_error_ 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 end if
else else
@ -2489,20 +2496,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ic,' in: ',i1,i2,&
& ' : ',a%ja(i1:i2-1)
info = i
return
end if end if
else else
info = max(info,2)
if (debug_level >= psb_debug_serial_) &
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
else
info = max(info,1)
end if end if
end do end do
@ -2524,19 +2524,13 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ic,' in: ',i1,i2,&
& ' : ',a%ja(i1:i2-1)
info = i
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
else
info = max(info,1)
end if end if
end do end do
@ -2570,20 +2564,11 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = val(i) a%val(i1+ip-1) = val(i)
else else
if (debug_level >= psb_debug_serial_) & info = max(info,3)
& write(debug_unit,*) trim(name),&
& ': Was searching ',ic,' in: ',i1,i2,&
& ' : ',a%ja(i1:i2-1)
info = i
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
end do end do
case(psb_dupl_add_) case(psb_dupl_add_)
@ -2601,13 +2586,10 @@ contains
if (ip>0) then if (ip>0) then
a%val(i1+ip-1) = a%val(i1+ip-1) + val(i) a%val(i1+ip-1) = a%val(i1+ip-1) + val(i)
else else
info = i info = max(info,3)
return
end if end if
else else
if (debug_level >= psb_debug_serial_) & info = max(info,2)
& write(debug_unit,*) trim(name),&
& ': Discarding row that does not belong to us.'
end if end if
end do end do

Write Preview
Loading…
Cancel
Save