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

Write Preview
Loading…
Cancel
Save