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

Fixed problem in update for upd_srch_

Browse Source
psblas3-type-indexed
Salvatore Filippone 19 years ago
parent f1de4b3561
commit f0dd140326
2 changed files with 405 additions and 322 deletions
Show Stats Download Patch File Download Diff File

5
Changelog
Unescape Escape View File

@ -1,6 +1,11 @@
Changelog. A lot less detailed than usual, at least for past Changelog. A lot less detailed than usual, at least for past
history. history.
2006/06/14: Defined ExtRow, probably to be renamed to GetRow.
This way we may close the mat objects.
Next we will rewrite SMMP to only make use of GetRow,
not to rely on CSR storage format.
2006/05/29: Added BLACS-like routines for data communication, 2006/05/29: Added BLACS-like routines for data communication,
broadcasts, reductions, send/receive. broadcasts, reductions, send/receive.

104
src/serial/psb_update_mod.f90
Unescape Escape View File

@ -174,6 +174,7 @@ contains
integer, intent(out) :: info integer, intent(out) :: info
integer, intent(in), optional :: ng,gtl(*) integer, intent(in), optional :: ng,gtl(*)
logical, parameter :: debug=.false.
integer :: i,ir,ic,check_flag, ilr, ilc, ip, & integer :: i,ir,ic,check_flag, ilr, ilc, ip, &
& i1,i2,nc,lb,ub,m,nnz,dupl & i1,i2,nc,lb,ub,m,nnz,dupl
@ -201,6 +202,7 @@ contains
if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then
ir = gtl(ir) ir = gtl(ir)
ic = gtl(ic) ic = gtl(ic)
if ((ir > 0).and.(ir <= a%m)) then
i1 = a%ia2(ir) i1 = a%ia2(ir)
i2 = a%ia2(ir+1) i2 = a%ia2(ir+1)
nc=i2-i1 nc=i2-i1
@ -211,7 +213,8 @@ contains
if (ip>0) then if (ip>0) then
a%aspk(i1+ip-1) = val(i) a%aspk(i1+ip-1) = val(i)
else else
write(0,*)'Was searching ',ic,' in: ',i1,i2,' : ',a%ia1(i1:i2-1) if (debug) &
& write(0,*)'Was searching ',ic,' in: ',i1,i2,' : ',a%ia1(i1:i2-1)
info = i info = i
return return
end if end if
@ -238,12 +241,16 @@ contains
if (ip>0) then if (ip>0) then
a%aspk(ip) = val(i) a%aspk(ip) = val(i)
else else
write(0,*)'Was searching ',ic,' in: ',i1,i2,' : ',a%ia1(i1:i2-1) if (debug) write(0,*)'Was searching ',ic,&
& ' in: ',i1,i2,' : ',a%ia1(i1:i2-1)
info = i info = i
return return
end if end if
end if end if
else
if (debug) write(0,*) 'Discarding row that does not belong to us.'
end if
end if end if
end do end do
@ -257,22 +264,29 @@ contains
if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then
ir = gtl(ir) ir = gtl(ir)
ic = gtl(ic) ic = gtl(ic)
if ((ir > 0).and.(ir <= a%m)) then
i1 = a%ia2(ir) i1 = a%ia2(ir)
i2 = a%ia2(ir+1) i2 = a%ia2(ir+1)
nc = i2-i1 nc = i2-i1
!!$ write(0,*) 'ir ic ',ir,ic,i1,i2,a%m,a%k
call issrch(ip,ic,nc,a%ia1(i1:i2-1)) call issrch(ip,ic,nc,a%ia1(i1:i2-1))
if (ip>0) then if (ip>0) then
a%aspk(i1+ip-1) = a%aspk(i1+ip-1) + val(i) a%aspk(i1+ip-1) = a%aspk(i1+ip-1) + val(i)
else else
if (debug) write(0,*)'Was searching ',ic,&
& ' in: ',i1,i2,' : ',a%ia1(i1:i2-1)
info = i info = i
return return
end if end if
else
if (debug) write(0,*) 'Discarding row that does not belong to us.'
end if
end if end if
end do end do
case default case default
info = -3 info = -3
write(0,*) 'Duplicate handling: ',dupl if (debug) write(0,*) 'Duplicate handling: ',dupl
end select end select
else else
@ -287,6 +301,9 @@ contains
do i=1, nz do i=1, nz
ir = ia(i) ir = ia(i)
ic = ja(i) ic = ja(i)
if ((ir > 0).and.(ir <= a%m)) then
i1 = a%ia2(ir) i1 = a%ia2(ir)
i2 = a%ia2(ir+1) i2 = a%ia2(ir+1)
nc=i2-i1 nc=i2-i1
@ -297,7 +314,8 @@ contains
if (ip>0) then if (ip>0) then
a%aspk(i1+ip-1) = val(i) a%aspk(i1+ip-1) = val(i)
else else
write(0,*)'Was searching ',ic,' in: ',i1,i2,' : ',a%ia1(i1:i2-1) if (debug) write(0,*)'Was searching ',ic,&
& ' in: ',i1,i2,' : ',a%ia1(i1:i2-1)
info = i info = i
return return
end if end if
@ -324,12 +342,16 @@ contains
if (ip>0) then if (ip>0) then
a%aspk(ip) = val(i) a%aspk(ip) = val(i)
else else
write(0,*)'Was searching ',ic,' in: ',i1,i2,' : ',a%ia1(i1:i2-1) if (debug) write(0,*)'Was searching ',ic,&
& ' in: ',i1,i2,' : ',a%ia1(i1:i2-1)
info = i info = i
return return
end if end if
end if end if
else
if (debug) write(0,*) 'Discarding row that does not belong to us.'
end if
end do end do
case(psb_dupl_add_) case(psb_dupl_add_)
@ -339,6 +361,7 @@ contains
do i=1, nz do i=1, nz
ir = ia(i) ir = ia(i)
ic = ja(i) ic = ja(i)
if ((ir > 0).and.(ir <= a%m)) then
i1 = a%ia2(ir) i1 = a%ia2(ir)
i2 = a%ia2(ir+1) i2 = a%ia2(ir+1)
nc = i2-i1 nc = i2-i1
@ -349,11 +372,14 @@ contains
info = i info = i
return return
end if end if
else
if (debug) write(0,*) 'Discarding row that does not belong to us.'
end if
end do end do
case default case default
info = -3 info = -3
write(0,*) 'Duplicate handling: ',dupl if (debug) write(0,*) 'Duplicate handling: ',dupl
end select end select
end if end if
@ -372,6 +398,7 @@ contains
integer, intent(in), optional :: ng,gtl(*) integer, intent(in), optional :: ng,gtl(*)
integer :: i,ir,ic,check_flag, ilr, ilc, ip, & integer :: i,ir,ic,check_flag, ilr, ilc, ip, &
& i1,i2,nc,lb,ub,m,nnz,dupl,isrt & i1,i2,nc,lb,ub,m,nnz,dupl,isrt
logical, parameter :: debug=.false.
info = 0 info = 0
@ -402,6 +429,7 @@ contains
ic = ja(i) ic = ja(i)
if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then
ir = gtl(ir) ir = gtl(ir)
if ((ir > 0).and.(ir <= a%m)) then
ic = gtl(ic) ic = gtl(ic)
if (ir /= ilr) then if (ir /= ilr) then
call ibsrch(i1,ir,nnz,a%ia1) call ibsrch(i1,ir,nnz,a%ia1)
@ -426,6 +454,9 @@ contains
info = i info = i
return return
end if end if
else
if (debug) write(0,*) 'Discarding row does not belong'
endif
end if end if
end do end do
case(psb_dupl_add_) case(psb_dupl_add_)
@ -436,6 +467,8 @@ contains
if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then
ir = gtl(ir) ir = gtl(ir)
ic = gtl(ic) ic = gtl(ic)
if ((ir > 0).and.(ir <= a%m)) then
if (ir /= ilr) then if (ir /= ilr) then
call ibsrch(i1,ir,nnz,a%ia1) call ibsrch(i1,ir,nnz,a%ia1)
i2 = i1 i2 = i1
@ -459,12 +492,16 @@ contains
info = i info = i
return return
end if end if
else
if (debug) write(0,*) 'Discarding row does not belong'
end if
end if end if
end do end do
case default case default
info = -3 info = -3
write(0,*) 'Duplicate handling: ',dupl if (debug) write(0,*) 'Duplicate handling: ',dupl
end select end select
else else
@ -476,6 +513,8 @@ contains
do i=1, nz do i=1, nz
ir = ia(i) ir = ia(i)
ic = ja(i) ic = ja(i)
if ((ir > 0).and.(ir <= a%m)) then
if (ir /= ilr) then if (ir /= ilr) then
call ibsrch(i1,ir,nnz,a%ia1) call ibsrch(i1,ir,nnz,a%ia1)
i2 = i1 i2 = i1
@ -499,6 +538,7 @@ contains
info = i info = i
return return
end if end if
end if
end do end do
case(psb_dupl_add_) case(psb_dupl_add_)
@ -506,6 +546,8 @@ contains
do i=1, nz do i=1, nz
ir = ia(i) ir = ia(i)
ic = ja(i) ic = ja(i)
if ((ir > 0).and.(ir <= a%m)) then
if (ir /= ilr) then if (ir /= ilr) then
call ibsrch(i1,ir,nnz,a%ia1) call ibsrch(i1,ir,nnz,a%ia1)
i2 = i1 i2 = i1
@ -529,11 +571,12 @@ contains
info = i info = i
return return
end if end if
end if
end do end do
case default case default
info = -3 info = -3
write(0,*) 'Duplicate handling: ',dupl if (debug) write(0,*) 'Duplicate handling: ',dupl
end select end select
end if end if
@ -556,6 +599,7 @@ contains
integer :: i,ir,ic,check_flag, ilr, ilc, ip, & integer :: i,ir,ic,check_flag, ilr, ilc, ip, &
& i1,i2,nc,lb,ub,m,nnz,dupl & i1,i2,nc,lb,ub,m,nnz,dupl
logical, parameter :: debug=.false.
info = 0 info = 0
dupl = psb_sp_getifld(psb_dupl_,a,info) dupl = psb_sp_getifld(psb_dupl_,a,info)
@ -580,6 +624,7 @@ contains
if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then
ir = gtl(ir) ir = gtl(ir)
ic = gtl(ic) ic = gtl(ic)
if ((ir > 0).and.(ir <= a%m)) then
i1 = a%ia2(ir) i1 = a%ia2(ir)
i2 = a%ia2(ir+1) i2 = a%ia2(ir+1)
nc=i2-i1 nc=i2-i1
@ -623,6 +668,10 @@ contains
end if end if
end if end if
else
if (debug) write(0,*) 'Discarding row does not belong'
endif
end if end if
end do end do
@ -636,6 +685,7 @@ contains
if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then
ir = gtl(ir) ir = gtl(ir)
ic = gtl(ic) ic = gtl(ic)
if ((ir > 0).and.(ir <= a%m)) then
i1 = a%ia2(ir) i1 = a%ia2(ir)
i2 = a%ia2(ir+1) i2 = a%ia2(ir+1)
nc = i2-i1 nc = i2-i1
@ -646,12 +696,15 @@ contains
info = i info = i
return return
end if end if
else
if (debug) write(0,*) 'Discarding row does not belong'
endif
end if end if
end do end do
case default case default
info = -3 info = -3
write(0,*) 'Duplicate handling: ',dupl if (debug) write(0,*) 'Duplicate handling: ',dupl
end select end select
else else
@ -666,6 +719,7 @@ contains
do i=1, nz do i=1, nz
ir = ia(i) ir = ia(i)
ic = ja(i) ic = ja(i)
if ((ir > 0).and.(ir <= a%m)) then
i1 = a%ia2(ir) i1 = a%ia2(ir)
i2 = a%ia2(ir+1) i2 = a%ia2(ir+1)
nc=i2-i1 nc=i2-i1
@ -709,6 +763,9 @@ contains
end if end if
end if end if
else
if (debug) write(0,*) 'Discarding row does not belong'
endif
end do end do
case(psb_dupl_add_) case(psb_dupl_add_)
@ -718,6 +775,7 @@ contains
do i=1, nz do i=1, nz
ir = ia(i) ir = ia(i)
ic = ja(i) ic = ja(i)
if ((ir > 0).and.(ir <= a%m)) then
i1 = a%ia2(ir) i1 = a%ia2(ir)
i2 = a%ia2(ir+1) i2 = a%ia2(ir+1)
nc = i2-i1 nc = i2-i1
@ -728,11 +786,14 @@ contains
info = i info = i
return return
end if end if
else
if (debug) write(0,*) 'Discarding row does not belong'
endif
end do end do
case default case default
info = -3 info = -3
write(0,*) 'Duplicate handling: ',dupl if (debug) write(0,*) 'Duplicate handling: ',dupl
end select end select
end if end if
@ -751,6 +812,7 @@ contains
integer, intent(in), optional :: ng,gtl(*) integer, intent(in), optional :: ng,gtl(*)
integer :: i,ir,ic,check_flag, ilr, ilc, ip, & integer :: i,ir,ic,check_flag, ilr, ilc, ip, &
& i1,i2,nc,lb,ub,m,nnz,dupl,isrt & i1,i2,nc,lb,ub,m,nnz,dupl,isrt
logical, parameter :: debug=.false.
info = 0 info = 0
@ -782,6 +844,7 @@ contains
if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then
ir = gtl(ir) ir = gtl(ir)
ic = gtl(ic) ic = gtl(ic)
if ((ir > 0).and.(ir <= a%m)) then
if (ir /= ilr) then if (ir /= ilr) then
call ibsrch(i1,ir,nnz,a%ia1) call ibsrch(i1,ir,nnz,a%ia1)
i2 = i1 i2 = i1
@ -805,6 +868,9 @@ contains
info = i info = i
return return
end if end if
else
if (debug) write(0,*) 'Discarding row does not belong'
endif
end if end if
end do end do
case(psb_dupl_add_) case(psb_dupl_add_)
@ -815,6 +881,7 @@ contains
if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then
ir = gtl(ir) ir = gtl(ir)
ic = gtl(ic) ic = gtl(ic)
if ((ir > 0).and.(ir <= a%m)) then
if (ir /= ilr) then if (ir /= ilr) then
call ibsrch(i1,ir,nnz,a%ia1) call ibsrch(i1,ir,nnz,a%ia1)
i2 = i1 i2 = i1
@ -838,12 +905,15 @@ contains
info = i info = i
return return
end if end if
else
if (debug) write(0,*) 'Discarding row does not belong'
endif
end if end if
end do end do
case default case default
info = -3 info = -3
write(0,*) 'Duplicate handling: ',dupl if (debug) write(0,*) 'Duplicate handling: ',dupl
end select end select
else else
@ -855,6 +925,7 @@ contains
do i=1, nz do i=1, nz
ir = ia(i) ir = ia(i)
ic = ja(i) ic = ja(i)
if ((ir > 0).and.(ir <= a%m)) then
if (ir /= ilr) then if (ir /= ilr) then
call ibsrch(i1,ir,nnz,a%ia1) call ibsrch(i1,ir,nnz,a%ia1)
i2 = i1 i2 = i1
@ -878,6 +949,9 @@ contains
info = i info = i
return return
end if end if
else
if (debug) write(0,*) 'Discarding row does not belong'
endif
end do end do
case(psb_dupl_add_) case(psb_dupl_add_)
@ -885,6 +959,7 @@ contains
do i=1, nz do i=1, nz
ir = ia(i) ir = ia(i)
ic = ja(i) ic = ja(i)
if ((ir > 0).and.(ir <= a%m)) then
if (ir /= ilr) then if (ir /= ilr) then
call ibsrch(i1,ir,nnz,a%ia1) call ibsrch(i1,ir,nnz,a%ia1)
i2 = i1 i2 = i1
@ -908,11 +983,14 @@ contains
info = i info = i
return return
end if end if
else
if (debug) write(0,*) 'Discarding row does not belong'
endif
end do end do
case default case default
info = -3 info = -3
write(0,*) 'Duplicate handling: ',dupl if (debug) write(0,*) 'Duplicate handling: ',dupl
end select end select
end if end if

Write Preview
Loading…
Cancel
Save