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

Defined heapsort and mergesort for real/complex data.

Browse Source 
Updated docs.
psblas3-type-indexed
Salvatore Filippone 17 years ago
parent f60c55af4b
commit 16b8058ab6
15 changed files with 8853 additions and 5828 deletions
Show Stats Download Patch File Download Diff File

2
Changelog
Unescape Escape View File

@ -2,7 +2,7 @@ Changelog. A lot less detailed than usual, at least for past
history.
2007/10/15: Repackaged the sorting routines in a submodule of their
own, while adding some heap managing utilities for the
own, adding some heap management and heapsort utilities for the
benefit of the multilevel preconditioners.
2007/09/28: Moved gelp and csrp to serial. Changed interface to

2531
base/modules/psb_sort_mod.f90
View File

File diff suppressed because it is too large Load Diff

4
base/serial/aux/Makefile
Unescape Escape View File

@ -5,10 +5,10 @@ include ../../../Make.inc
FOBJS = isr.o isrx.o iasr.o iasrx.o msort_up.o msort_dw.o\
isaperm.o ibsrch.o issrch.o imsr.o imsrx.o imsru.o\
dsr.o dsrx.o dasr.o dasrx.o \
dsr.o dsrx.o dasr.o dasrx.o dmsr.o dmsrx.o dmsort_up.o dmsort_dw.o \
zlcmp_mod.o zlsr.o zlsrx.o \
zalcmp_mod.o zalsr.o zalsrx.o \
zacmp_mod.o zasr.o zasrx.o
zacmp_mod.o zasr.o zasrx.o zamsr.o zamsrx.o zamsort_up.o zamsort_dw.o
OBJS=$(FOBJS)

172
base/serial/aux/dmsort_dw.f90
Unescape Escape View File

@ -0,0 +1,172 @@
!
! Parallel Sparse BLAS v2.0
! (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
! Alfredo Buttari University of Rome Tor Vergata
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
! File: msort_dw.f90
!
! Subroutine: msort_dw
! This subroutine sorts an integer array into ascending order.
!
! Arguments:
! n - integer Input: size of the array
! k - real(*) input: array of keys to be sorted
! l - integer(0:n+1) output: link list
! iret - integer output: 0 Normal termination
! 1 the array was already sorted
! *
! REFERENCES = (1) D. E. Knuth *
! The Art of Computer Programming, *
! vol.3: Sorting and Searching *
! Addison-Wesley, 1973 *
! *
! call msort_dw(n,x,iaux,iret)
!
! if (iret == 0) then
! lp = iaux(0)
! k = 1
! do
! if ((lp==0).or.(k>n)) exit
! do
! if (lp >= k) exit
! lp = iaux(lp)
! end do
! iswap = x(lp)
! x(lp) = x(k)
! x(k) = iswap
! lswap = iaux(lp)
! iaux(lp) = iaux(k)
! iaux(k) = lp
! lp = lswap
! k = k + 1
! enddo
! end if
!
!
subroutine dmsort_dw(n,k,l,iret)
implicit none
integer n, iret
real(kind(1.d0)) :: k(n)
integer l(0:n+1)
!
integer p,q,s,t
intrinsic iabs,isign
! ..
iret = 0
! first step: we are preparing ordered sublists, exploiting
! what order was already in the input data; negative links
! mark the end of the sublists
l(0) = 1
t = n + 1
do p = 1,n - 1
if (k(p) >= k(p+1)) then
l(p) = p + 1
else
l(t) = - (p+1)
t = p
end if
end do
l(t) = 0
l(n) = 0
! see if the input was already sorted
if (l(n+1) == 0) then
iret = 1
return
else
l(n+1) = iabs(l(n+1))
end if
mergepass: do
! otherwise, begin a pass through the list.
! throughout all the subroutine we have:
! p, q: pointing to the sublists being merged
! s: pointing to the most recently processed record
! t: pointing to the end of previously completed sublist
s = 0
t = n + 1
p = l(s)
q = l(t)
if (q == 0) exit mergepass
outer: do
if (k(p) < k(q)) then
l(s) = isign(q,l(s))
s = q
q = l(q)
if (q > 0) then
do
if (k(p) >= k(q)) cycle outer
s = q
q = l(q)
if (q <= 0) exit
end do
end if
l(s) = p
s = t
do
t = p
p = l(p)
if (p <= 0) exit
end do
else
l(s) = isign(p,l(s))
s = p
p = l(p)
if (p>0) then
do
if (k(p) < k(q)) cycle outer
s = p
p = l(p)
if (p <= 0) exit
end do
end if
! otherwise, one sublist ended, and we append to it the rest
! of the other one.
l(s) = q
s = t
do
t = q
q = l(q)
if (q <= 0) exit
end do
end if
p = -p
q = -q
if (q == 0) then
l(s) = isign(p,l(s))
l(t) = 0
exit outer
end if
end do outer
end do mergepass
end subroutine dmsort_dw

172
base/serial/aux/dmsort_up.f90
Unescape Escape View File

@ -0,0 +1,172 @@
!
! Parallel Sparse BLAS v2.0
! (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
! Alfredo Buttari University of Rome Tor Vergata
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
! File: msort_up.f90
!
! Subroutine: msort_up
! This subroutine sorts an integer array into ascending order.
!
! Arguments:
! n - integer Input: size of the array
! k - integer(*) input: array of keys to be sorted
! l - integer(0:n+1) output: link list
! iret - integer output: 0 Normal termination
! 1 the array was already sorted
! *
! REFERENCES = (1) D. E. Knuth *
! The Art of Computer Programming, *
! vol.3: Sorting and Searching *
! Addison-Wesley, 1973 *
! *
! call msort_up(n,x,iaux,iret)
!
! if (iret == 0) then
! lp = iaux(0)
! k = 1
! do
! if ((lp==0).or.(k>n)) exit
! do
! if (lp >= k) exit
! lp = iaux(lp)
! end do
! iswap = x(lp)
! x(lp) = x(k)
! x(k) = iswap
! lswap = iaux(lp)
! iaux(lp) = iaux(k)
! iaux(k) = lp
! lp = lswap
! k = k + 1
! enddo
! end if
!
!
subroutine dmsort_up(n,k,l,iret)
implicit none
integer n, iret
real(kind(1.d0)) k(n)
integer l(0:n+1)
!
integer p,q,s,t
intrinsic iabs,isign
! ..
iret = 0
! first step: we are preparing ordered sublists, exploiting
! what order was already in the input data; negative links
! mark the end of the sublists
l(0) = 1
t = n + 1
do p = 1,n - 1
if (k(p) <= k(p+1)) then
l(p) = p + 1
else
l(t) = - (p+1)
t = p
end if
end do
l(t) = 0
l(n) = 0
! see if the input was already sorted
if (l(n+1) == 0) then
iret = 1
return
else
l(n+1) = iabs(l(n+1))
end if
mergepass: do
! otherwise, begin a pass through the list.
! throughout all the subroutine we have:
! p, q: pointing to the sublists being merged
! s: pointing to the most recently processed record
! t: pointing to the end of previously completed sublist
s = 0
t = n + 1
p = l(s)
q = l(t)
if (q == 0) exit mergepass
outer: do
if (k(p) > k(q)) then
l(s) = isign(q,l(s))
s = q
q = l(q)
if (q > 0) then
do
if (k(p) <= k(q)) cycle outer
s = q
q = l(q)
if (q <= 0) exit
end do
end if
l(s) = p
s = t
do
t = p
p = l(p)
if (p <= 0) exit
end do
else
l(s) = isign(p,l(s))
s = p
p = l(p)
if (p>0) then
do
if (k(p) > k(q)) cycle outer
s = p
p = l(p)
if (p <= 0) exit
end do
end if
! otherwise, one sublist ended, and we append to it the rest
! of the other one.
l(s) = q
s = t
do
t = q
q = l(q)
if (q <= 0) exit
end do
end if
p = -p
q = -q
if (q == 0) then
l(s) = isign(p,l(s))
l(t) = 0
exit outer
end if
end do outer
end do mergepass
end subroutine dmsort_up

91
base/serial/aux/dmsr.f90
Unescape Escape View File

@ -0,0 +1,91 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! File: imsr.f90
! Subroutine:
! Parameters:
subroutine dmsr(n,x,idir)
use psb_serial_mod
implicit none
integer :: n, idir
real(kind(1.d0)) :: x(n)
integer, allocatable :: iaux(:)
integer :: lswap, iret, info, lp, k
real(kind(1.d0)) :: swap
if (n<0) then
!!$ write(0,*) 'Error: IMSR: N<0'
return
endif
if (n<=1) return
allocate(iaux(0:n+1),stat=info)
if (info/=0) then
write(0,*) 'IMSR: memory allocation failed',info
return
endif
if (idir==psb_sort_up_) then
call dmsort_up(n,x,iaux,iret)
else
call dmsort_dw(n,x,iaux,iret)
end if
if (iret == 0) then
lp = iaux(0)
k = 1
do
if ((lp==0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
end if
deallocate(iaux,stat=info)
if (info/=0) then
write(0,*) 'IMSR: memory deallocation failed',info
endif
return
end subroutine dmsr

101
base/serial/aux/dmsrx.f90
Unescape Escape View File

@ -0,0 +1,101 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! File: imsrx.f90
! Subroutine:
! Parameters:
subroutine dmsrx(n,x,indx,idir,flag)
use psb_serial_mod
implicit none
integer :: n,idir,flag
real(kind(1.d0)) :: x(n)
integer :: indx(n)
integer, allocatable :: iaux(:)
integer :: iret, info, lp, k,lswap, ixswap
real(kind(1.d0)) :: swap
if (n<0) then
write(0,*) 'Error: DMSRX: N<0'
return
endif
if (n==0) return
if (flag == psb_sort_ovw_idx_) then
do k=1,n
indx(k) = k
enddo
end if
if (n==1) return
allocate(iaux(0:n+1),stat=info)
if (info/=0) then
write(0,*) 'DMSRX: memory allocation failed',info
return
endif
if (idir == psb_sort_up_) then
call dmsort_up(n,x,iaux,iret)
else
call dmsort_dw(n,x,iaux,iret)
end if
if (iret /= 1) then
lp = iaux(0)
k = 1
do
if ((lp==0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
ixswap = indx(lp)
indx(lp) = indx(k)
indx(k) = ixswap
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
end if
deallocate(iaux,stat=info)
if (info/=0) then
write(0,*) 'DMSRX: memory deallocation failed',info
endif
return
end subroutine dmsrx

173
base/serial/aux/zamsort_dw.f90
Unescape Escape View File

@ -0,0 +1,173 @@
!
! Parallel Sparse BLAS v2.0
! (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
! Alfredo Buttari University of Rome Tor Vergata
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
! File: msort_dw.f90
!
! Subroutine: msort_dw
! This subroutine sorts an integer array into ascending order.
!
! Arguments:
! n - integer Input: size of the array
! k - real(*) input: array of keys to be sorted
! l - integer(0:n+1) output: link list
! iret - integer output: 0 Normal termination
! 1 the array was already sorted
! *
! REFERENCES = (1) D. E. Knuth *
! The Art of Computer Programming, *
! vol.3: Sorting and Searching *
! Addison-Wesley, 1973 *
! *
! call msort_dw(n,x,iaux,iret)
!
! if (iret == 0) then
! lp = iaux(0)
! k = 1
! do
! if ((lp==0).or.(k>n)) exit
! do
! if (lp >= k) exit
! lp = iaux(lp)
! end do
! iswap = x(lp)
! x(lp) = x(k)
! x(k) = iswap
! lswap = iaux(lp)
! iaux(lp) = iaux(k)
! iaux(k) = lp
! lp = lswap
! k = k + 1
! enddo
! end if
!
!
subroutine zamsort_dw(n,k,l,iret)
use zacmp_mod
implicit none
integer n, iret
complex(kind(1.d0)) :: k(n)
integer l(0:n+1)
!
integer p,q,s,t
intrinsic iabs,isign
! ..
iret = 0
! first step: we are preparing ordered sublists, exploiting
! what order was already in the input data; negative links
! mark the end of the sublists
l(0) = 1
t = n + 1
do p = 1,n - 1
if (k(p) >= k(p+1)) then
l(p) = p + 1
else
l(t) = - (p+1)
t = p
end if
end do
l(t) = 0
l(n) = 0
! see if the input was already sorted
if (l(n+1) == 0) then
iret = 1
return
else
l(n+1) = iabs(l(n+1))
end if
mergepass: do
! otherwise, begin a pass through the list.
! throughout all the subroutine we have:
! p, q: pointing to the sublists being merged
! s: pointing to the most recently processed record
! t: pointing to the end of previously completed sublist
s = 0
t = n + 1
p = l(s)
q = l(t)
if (q == 0) exit mergepass
outer: do
if (k(p) < k(q)) then
l(s) = isign(q,l(s))
s = q
q = l(q)
if (q > 0) then
do
if (k(p) >= k(q)) cycle outer
s = q
q = l(q)
if (q <= 0) exit
end do
end if
l(s) = p
s = t
do
t = p
p = l(p)
if (p <= 0) exit
end do
else
l(s) = isign(p,l(s))
s = p
p = l(p)
if (p>0) then
do
if (k(p) < k(q)) cycle outer
s = p
p = l(p)
if (p <= 0) exit
end do
end if
! otherwise, one sublist ended, and we append to it the rest
! of the other one.
l(s) = q
s = t
do
t = q
q = l(q)
if (q <= 0) exit
end do
end if
p = -p
q = -q
if (q == 0) then
l(s) = isign(p,l(s))
l(t) = 0
exit outer
end if
end do outer
end do mergepass
end subroutine zamsort_dw

173
base/serial/aux/zamsort_up.f90
Unescape Escape View File

@ -0,0 +1,173 @@
!
! Parallel Sparse BLAS v2.0
! (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
! Alfredo Buttari University of Rome Tor Vergata
!
! Redistribution and use in source and binary forms, with or without
! modification, are permitted provided that the following conditions
! are met:
! 1. Redistributions of source code must retain the above copyright
! notice, this list of conditions and the following disclaimer.
! 2. Redistributions in binary form must reproduce the above copyright
! notice, this list of conditions, and the following disclaimer in the
! documentation and/or other materials provided with the distribution.
! 3. The name of the PSBLAS group or the names of its contributors may
! not be used to endorse or promote products derived from this
! software without specific written permission.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
! ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
! TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
! BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
! CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
! SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
! INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
! CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
! ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
! POSSIBILITY OF SUCH DAMAGE.
!
! File: msort_up.f90
!
! Subroutine: msort_up
! This subroutine sorts an integer array into ascending order.
!
! Arguments:
! n - integer Input: size of the array
! k - integer(*) input: array of keys to be sorted
! l - integer(0:n+1) output: link list
! iret - integer output: 0 Normal termination
! 1 the array was already sorted
! *
! REFERENCES = (1) D. E. Knuth *
! The Art of Computer Programming, *
! vol.3: Sorting and Searching *
! Addison-Wesley, 1973 *
! *
! call msort_up(n,x,iaux,iret)
!
! if (iret == 0) then
! lp = iaux(0)
! k = 1
! do
! if ((lp==0).or.(k>n)) exit
! do
! if (lp >= k) exit
! lp = iaux(lp)
! end do
! iswap = x(lp)
! x(lp) = x(k)
! x(k) = iswap
! lswap = iaux(lp)
! iaux(lp) = iaux(k)
! iaux(k) = lp
! lp = lswap
! k = k + 1
! enddo
! end if
!
!
subroutine zamsort_up(n,k,l,iret)
use zacmp_mod
implicit none
integer n, iret
complex(kind(1.d0)) k(n)
integer l(0:n+1)
!
integer p,q,s,t
intrinsic iabs,isign
! ..
iret = 0
! first step: we are preparing ordered sublists, exploiting
! what order was already in the input data; negative links
! mark the end of the sublists
l(0) = 1
t = n + 1
do p = 1,n - 1
if (k(p) <= k(p+1)) then
l(p) = p + 1
else
l(t) = - (p+1)
t = p
end if
end do
l(t) = 0
l(n) = 0
! see if the input was already sorted
if (l(n+1) == 0) then
iret = 1
return
else
l(n+1) = iabs(l(n+1))
end if
mergepass: do
! otherwise, begin a pass through the list.
! throughout all the subroutine we have:
! p, q: pointing to the sublists being merged
! s: pointing to the most recently processed record
! t: pointing to the end of previously completed sublist
s = 0
t = n + 1
p = l(s)
q = l(t)
if (q == 0) exit mergepass
outer: do
if (k(p) > k(q)) then
l(s) = isign(q,l(s))
s = q
q = l(q)
if (q > 0) then
do
if (k(p) <= k(q)) cycle outer
s = q
q = l(q)
if (q <= 0) exit
end do
end if
l(s) = p
s = t
do
t = p
p = l(p)
if (p <= 0) exit
end do
else
l(s) = isign(p,l(s))
s = p
p = l(p)
if (p>0) then
do
if (k(p) > k(q)) cycle outer
s = p
p = l(p)
if (p <= 0) exit
end do
end if
! otherwise, one sublist ended, and we append to it the rest
! of the other one.
l(s) = q
s = t
do
t = q
q = l(q)
if (q <= 0) exit
end do
end if
p = -p
q = -q
if (q == 0) then
l(s) = isign(p,l(s))
l(t) = 0
exit outer
end if
end do outer
end do mergepass
end subroutine zamsort_up

91
base/serial/aux/zamsr.f90
Unescape Escape View File

@ -0,0 +1,91 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! File: imsr.f90
! Subroutine:
! Parameters:
subroutine zamsr(n,x,idir)
use psb_serial_mod
implicit none
integer :: n, idir
complex(kind(1.d0)) :: x(n)
integer, allocatable :: iaux(:)
integer :: lswap, iret, info, lp, k
complex(kind(1.d0)) :: swap
if (n<0) then
!!$ write(0,*) 'Error: IMSR: N<0'
return
endif
if (n<=1) return
allocate(iaux(0:n+1),stat=info)
if (info/=0) then
write(0,*) 'IMSR: memory allocation failed',info
return
endif
if (idir==psb_asort_up_) then
call dmsort_up(n,x,iaux,iret)
else
call dmsort_dw(n,x,iaux,iret)
end if
if (iret == 0) then
lp = iaux(0)
k = 1
do
if ((lp==0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
end if
deallocate(iaux,stat=info)
if (info/=0) then
write(0,*) 'IMSR: memory deallocation failed',info
endif
return
end subroutine zamsr

101
base/serial/aux/zamsrx.f90
Unescape Escape View File

@ -0,0 +1,101 @@
!!$
!!$ Parallel Sparse BLAS v2.0
!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata
!!$ Alfredo Buttari University of Rome Tor Vergata
!!$
!!$ Redistribution and use in source and binary forms, with or without
!!$ modification, are permitted provided that the following conditions
!!$ are met:
!!$ 1. Redistributions of source code must retain the above copyright
!!$ notice, this list of conditions and the following disclaimer.
!!$ 2. Redistributions in binary form must reproduce the above copyright
!!$ notice, this list of conditions, and the following disclaimer in the
!!$ documentation and/or other materials provided with the distribution.
!!$ 3. The name of the PSBLAS group or the names of its contributors may
!!$ not be used to endorse or promote products derived from this
!!$ software without specific written permission.
!!$
!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
! File: imsrx.f90
! Subroutine:
! Parameters:
subroutine zamsrx(n,x,indx,idir,flag)
use psb_serial_mod
implicit none
integer :: n,idir,flag
complex(kind(1.d0)) :: x(n)
integer :: indx(n)
integer, allocatable :: iaux(:)
integer :: iret, info, lp, k,lswap, ixswap
complex(kind(1.d0)) :: swap
if (n<0) then
write(0,*) 'Error: DMSRX: N<0'
return
endif
if (n==0) return
if (flag == psb_sort_ovw_idx_) then
do k=1,n
indx(k) = k
enddo
end if
if (n==1) return
allocate(iaux(0:n+1),stat=info)
if (info/=0) then
write(0,*) 'DMSRX: memory allocation failed',info
return
endif
if (idir == psb_asort_up_) then
call zamsort_up(n,x,iaux,iret)
else
call zamsort_dw(n,x,iaux,iret)
end if
if (iret /= 1) then
lp = iaux(0)
k = 1
do
if ((lp==0).or.(k>n)) exit
do
if (lp >= k) exit
lp = iaux(lp)
end do
swap = x(lp)
x(lp) = x(k)
x(k) = swap
ixswap = indx(lp)
indx(lp) = indx(k)
indx(k) = ixswap
lswap = iaux(lp)
iaux(lp) = iaux(k)
iaux(k) = lp
lp = lswap
k = k + 1
enddo
end if
deallocate(iaux,stat=info)
if (info/=0) then
write(0,*) 'DMSRX: memory deallocation failed',info
endif
return
end subroutine zamsrx

80
docs/pdf/toolsrout.tex
Unescape Escape View File

@ -1270,7 +1270,6 @@ An integer value; 0 means no error has been detected.
\subroutine{psb\_sizeof}{Memory occupation}
This function computes the memory occupation of a PSBLAS object.
@ -1307,6 +1306,85 @@ Returned as: an integer number.
\end{description}
\subroutine{}{Sorting utilities}
\subroutine*{psb\_msort}{Sorting by the Merge-sort algorithm}
\subroutine*{psb\_qsort}{Sorting by the Quicksort algorithm}
\subroutine*{psb\_hsort}{Sorting by the Heapsort algorithm}
\syntax{call psb\_msort}{x,ix,dir,flag}
\syntax*{call psb\_qsort}{x,ix,dir,flag}
\syntax*{call psb\_hsort}{x,ix,dir,flag}
These serial routines sort a sequence $X$ into ascending or
descending order. The argument meaning is identical for the three
calls; the only difference is the algorithm used to accomplish the
task (see Usage Notes below).
\begin{description}
\item[Type:] Asynchronous.
\item[\bf On Entry ]
\item[x] The sequence to be sorted.\\
Type:{\bf required}.\\
Specified as: an integer, real or complex array of rank 1.
\item[ix] A vector of indices.\\
Type:{\bf optional}.\\
Specified as: an integer array of (at least) the same size as $X$.
\item[dir] The desired ordering.\\
Type:{\bf optional}.\\
Specified as: an integer value: \verb|psb_sort_up_|,
\verb|psb_sort_down_|, \verb|psb_asort_up_|, \verb|psb_asort_down_|;
default \verb|psb_sort_up_|.
\item[flag] Whether to keep the original values in $IX$.\\
Type:{\bf optional}.\\
Specified as: an integer value \verb|psb_sort_ovw_idx_| or
\verb|psb_sort_keep_idx_|; default \verb|psb_sort_ovw_idx_|.
\end{description}
\begin{description}
\item[\bf On Return]
\item[x] The sequence of values, in the chosen ordering.\\
Type:{\bf required}.\\
Specified as: an integer, real or complex array of rank 1.
\item[ix] A vector of indices.\\
Type: {\bf Optional} \\
An integer array of rank 1, whose entries are moved to the same
position as the corresponding entries in $x$.
\end{description}
\section*{Usage notes}
\begin{enumerate}
\item The sorting can be performed in the up/down direction; for
complex data the sorting must be done on the absolute values;
\item The routines return the items in the chosen ordering; the
output difference is the handling of ties (i.e. items with an
equal value) in the original input. With the merge-sort algorithm
ties are preserved in the same order as they had in the original
sequence, while this is not guaranteed for quicksort;
\item If $flag = psb\_sort\_ovw\_idx\_$ then the entries in $ix(1:n)$
where $n$ is the size of $x$ are initialized to $ix(i) \leftarrow
i$; thus, upon return from the subroutine, for each
index $i$ we have in $ix(i)$ the position that the item $x(i)$
occupied in the original data sequence;
\item If $flag = psb\_sort\_keep\_idx\_$ the routine will assume that
the entries in $ix(:)$ have already been initialized by the user;
\item The three sorting algorithms have a similar $O(n \log n)$ expected
running time; in the average case quicksort will be the
fastest and merge-sort the slowest. However note that:
\begin{enumerate}
\item The worst case running time for quicksort is $O(n^2)$; the algorithm
implemented here follows the well-known median-of-three heuristics,
but the worst case may still apply;
\item The worst case running time for merge-sort and heap-sort is
$O(n\log n)$ as the average case;
\item The merge-sort algorithm is implemented to take advantage of
subsequences that may be already in the desired ordering prior to
the subroutine call; this situation is relatively common when
dealing with groups of indices of sparse matrix entries, thus
merge-sort is often the preferred choice when a sorting is needed
by other routines in the library.
\end{enumerate}
\end{enumerate}
%%% Local Variables:
%%% mode: latex

71
docs/pdf/util.tex
Unescape Escape View File

@ -5,77 +5,6 @@ We have some utitlities available for input and output of
sparsematrices; the interfaces to these routines are available in the
module \verb|psb_util_mod|.
%% \subroutine{}{Sorting utilities}
%% \subroutine*{psb\_msort}{Sorting by the Merge-sort algorithm}
%% \subroutine*{psb\_qsort}{Sorting by the Quicksort algorithm}
%% \syntax{call psb\_msort}{x,ix,dir,flag}
%% \syntax*{call psb\_qsort}{x,ix,dir,flag}
%% These serial routines sort a sequence $X$ into ascending or
%% descending order. The argument meaning is identical for the two
%% calls; the only difference is the algorithm used to accomplish the
%% task (see Usage Notes below).
%% \begin{description}
%% \item[\bf On Entry ]
%% \item[x] The sequence to be sorted.\\
%% Type:{\bf required}.\\
%% Specified as: an integer array of rank 1.
%% \item[ix] A vector of indices.\\
%% Type:{\bf optional}.\\
%% Specified as: an integer array of (at least) the same size as $X$.
%% \item[dir] The desired ordering.\\
%% Type:{\bf optional}.\\
%% Specified as: an integer value \verb|psb_sort_up_| or
%% \verb|psb_sort_down_|; default \verb|psb_sort_up_|.
%% \item[flag] Whether to keep the original values in $IX$.\\
%% Type:{\bf optional}.\\
%% Specified as: an integer value \verb|psb_sort_ovw_idx_| or
%% \verb|psb_sort_keep_idx_|; default \verb|psb_sort_ovw_idx_|.
%% \end{description}
%% \begin{description}
%% \item[\bf On Return]
%% \item[x] The sequence of values, in the chosen ordering.\\
%% Type:{\bf required}.\\
%% Specified as: an integer array of rank 1.
%% \item[ix] A vector of indices.\\
%% Type: {\bf Optional} \\
%% An integer array of rank 1, whose entries are moved to the same
%% position as the corresponding entries in $x$.
%% \end{description}
%% \section*{Usage notes}
%% \begin{enumerate}
%% \item The two routines return the items in the chosen ordering; the
%% only output difference is the handling of ties (i.e. items with an
%% equal value) in the original input. With the merge-sort algorithm
%% ties are preserved in the same order as they had in the original
%% sequence, while this is not guaranteed for quicksort
%% \item If $flag = psb\_sort\_ovw\_idx\_$ then the entries in $ix(1:n)$
%% where $n$ is the size of $x$ are initialized to $ix(i) \leftarrow
%% i$; thus, upon return from the subroutine, for each
%% index $i$ we have in $ix(i)$ the position that the item $x(i)$
%% occupied in the original data sequence;
%% \item If $flag = psb\_sort\_keep\_idx\_$ the routine will assume that
%% the entries in $ix(:)$ have already been initialized by the user;
%% \item The two sorting algorithms have a similar $O(n \log n)$ expected
%% running time; in the average case quicksort will be the
%% fastest. However note that:
%% \begin{enumerate}
%% \item The worst case running time for quicksort is $O(n^2)$; the algorithm
%% implemented here follows the well-known median-of-three heuristics,
%% but the worst case may still apply;
%% \item The worst case running time for merge-sort is the same as the
%% average case;
%% \item The merge-sort algorithm is implemented to take advantage of
%% subsequences that may be already in the desired ordering at the
%% beginning; this situation is relatively common when dealing with
%% indices of sparse matrix entries, thus merge-sort is the
%% preferred choice when a sorting is needed by other routines in the
%% library.
%% \end{enumerate}
%% \end{enumerate}
%\subroutine{PSB\_HBIO\_MOD}{Input/Output in Harwell-Boeing format}

10872
docs/userguide.pdf
View File

File diff suppressed because one or more lines are too long

47
krylov/psb_krylov_mod.f90
Unescape Escape View File

@ -209,7 +209,13 @@ contains
Integer, Optional, Intent(out) :: iter
Real(Kind(1.d0)), Optional, Intent(out) :: err
integer :: ictxt,me,np
integer :: ictxt,me,np,err_act
character(len=20) :: name
info = 0
name = 'psb_krylov'
call psb_erractionsave(err_act)
ictxt=psb_cd_get_context(desc_a)
@ -240,6 +246,21 @@ contains
call psb_bicgstab(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,istop)
end select
if(info/=0) then
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
end subroutine psb_dkrylov
@ -260,7 +281,13 @@ contains
Integer, Optional, Intent(out) :: iter
Real(Kind(1.d0)), Optional, Intent(out) :: err
integer :: ictxt,me,np
integer :: ictxt,me,np,err_act
character(len=20) :: name
info = 0
name = 'psb_krylov'
call psb_erractionsave(err_act)
ictxt=psb_cd_get_context(desc_a)
@ -292,11 +319,25 @@ contains
call psb_bicgstab(a,prec,b,x,eps,desc_a,info,&
&itmax,iter,err,itrace,istop)
end select
if(info/=0) then
call psb_errpush(info,name)
goto 9999
end if
call psb_erractionrestore(err_act)
return
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
call psb_error(ictxt)
return
end if
end subroutine psb_zkrylov
end module psb_krylov_mod

Write Preview
Loading…
Cancel
Save