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. history.
2007/10/15: Repackaged the sorting routines in a submodule of their 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. benefit of the multilevel preconditioners.
2007/09/28: Moved gelp and csrp to serial. Changed interface to 2007/09/28: Moved gelp and csrp to serial. Changed interface to

2511
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\ 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\ 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 \ zlcmp_mod.o zlsr.o zlsrx.o \
zalcmp_mod.o zalsr.o zalsrx.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) 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} \subroutine{psb\_sizeof}{Memory occupation}
This function computes the memory occupation of a PSBLAS object. This function computes the memory occupation of a PSBLAS object.
@ -1307,6 +1306,85 @@ Returned as: an integer number.
\end{description} \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: %%% Local Variables:
%%% mode: latex %%% 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 sparsematrices; the interfaces to these routines are available in the
module \verb|psb_util_mod|. 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} %\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 Integer, Optional, Intent(out) :: iter
Real(Kind(1.d0)), Optional, Intent(out) :: err 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) ictxt=psb_cd_get_context(desc_a)
@ -241,6 +247,21 @@ contains
&itmax,iter,err,itrace,istop) &itmax,iter,err,itrace,istop)
end select 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 end subroutine psb_dkrylov
@ -260,7 +281,13 @@ contains
Integer, Optional, Intent(out) :: iter Integer, Optional, Intent(out) :: iter
Real(Kind(1.d0)), Optional, Intent(out) :: err 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) ictxt=psb_cd_get_context(desc_a)
@ -293,8 +320,22 @@ contains
&itmax,iter,err,itrace,istop) &itmax,iter,err,itrace,istop)
end select end select
end subroutine psb_zkrylov 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 end module psb_krylov_mod

Write Preview
Loading…
Cancel
Save