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

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

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

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

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

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

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

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

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

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

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

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

Write Preview
Loading…
Cancel
Save