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

psblas3:

Browse Source 
base/modules/Makefile
 base/modules/psb_c_sort_mod.f90
 base/modules/psb_d_sort_mod.f90
 base/modules/psb_i_sort_mod.f90
 base/modules/psb_s_sort_mod.f90
 base/modules/psb_sort_mod.f90
 base/modules/psb_z_sort_mod.f90
 base/serial/Makefile
 base/serial/aux/Makefile
 base/serial/impl/psb_c_coo_impl.f90
 base/serial/impl/psb_c_csc_impl.f90
 base/serial/impl/psb_c_csr_impl.f90
 base/serial/impl/psb_d_coo_impl.f90
 base/serial/impl/psb_d_csc_impl.f90
 base/serial/impl/psb_d_csr_impl.f90
 base/serial/impl/psb_s_coo_impl.f90
 base/serial/impl/psb_s_csc_impl.f90
 base/serial/impl/psb_s_csr_impl.f90
 base/serial/impl/psb_z_coo_impl.f90
 base/serial/impl/psb_z_csc_impl.f90
 base/serial/impl/psb_z_csr_impl.f90
 base/serial/sort/Makefile
 base/serial/sort/psb_c_hsort_impl.f90
 base/serial/sort/psb_c_isort_impl.f90
 base/serial/sort/psb_c_msort_impl.f90
 base/serial/sort/psb_c_qsort_impl.f90
 base/serial/sort/psb_d_hsort_impl.f90
 base/serial/sort/psb_d_isort_impl.f90
 base/serial/sort/psb_d_msort_impl.f90
 base/serial/sort/psb_d_qsort_impl.f90
 base/serial/sort/psb_i_hsort_impl.f90
 base/serial/sort/psb_i_isort_impl.f90
 base/serial/sort/psb_i_msort_impl.f90
 base/serial/sort/psb_i_qsort_impl.f90
 base/serial/sort/psb_s_isort_impl.f90
 base/serial/sort/psb_s_msort_impl.f90
 base/serial/sort/psb_s_qsort_impl.f90
 base/serial/sort/psb_z_hsort_impl.f90
 base/serial/sort/psb_z_isort_impl.f90
 base/serial/sort/psb_z_msort_impl.f90
 base/serial/sort/psb_z_qsort_impl.f90
 base/serial/sort/psi_alcx_mod.f90

New sort implementations.
Fix all methods calling them.
psblas-3.4-maint
Salvatore Filippone 10 years ago
parent 15c73b4d41
commit 26906c1efc
42 changed files with 2617 additions and 3582 deletions
Show Stats Download Patch File Download Diff File

2
base/modules/Makefile
Unescape Escape View File

@ -138,6 +138,8 @@ psb_s_comm_mod.o: psb_s_vect_mod.o psb_desc_mod.o psb_mat_mod.o
psb_d_comm_mod.o: psb_d_vect_mod.o psb_desc_mod.o psb_mat_mod.o
psb_c_comm_mod.o: psb_c_vect_mod.o psb_desc_mod.o psb_mat_mod.o
psb_z_comm_mod.o: psb_z_vect_mod.o psb_desc_mod.o psb_mat_mod.o
psb_sort_mod.o: psb_i_sort_mod.o psb_s_sort_mod.o psb_d_sort_mod.o \
psb_c_sort_mod.o psb_z_sort_mod.o psb_ip_reord_mod.o psi_serial_mod.o
psb_base_mod.o: $(MODULES)

48
base/modules/psb_c_sort_mod.f90
Unescape Escape View File

@ -79,6 +79,54 @@ module psb_c_sort_mod
end subroutine psb_cmsort
end interface psb_msort
interface
subroutine psi_c_lmsort_up(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
complex(psb_spk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_c_lmsort_up
subroutine psi_c_lmsort_dw(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
complex(psb_spk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_c_lmsort_dw
subroutine psi_c_almsort_up(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
complex(psb_spk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_c_almsort_up
subroutine psi_c_almsort_dw(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
complex(psb_spk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_c_almsort_dw
end interface
interface
subroutine psi_c_amsort_up(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
complex(psb_spk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_c_amsort_up
subroutine psi_c_amsort_dw(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
complex(psb_spk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_c_amsort_dw
end interface
interface psb_qsort
subroutine psb_cqsort(x,ix,dir,flag)
import

34
base/modules/psb_d_sort_mod.f90
Unescape Escape View File

@ -79,6 +79,40 @@ module psb_d_sort_mod
end subroutine psb_dmsort
end interface psb_msort
interface
subroutine psi_d_msort_up(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
real(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_d_msort_up
subroutine psi_d_msort_dw(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
real(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_d_msort_dw
end interface
interface
subroutine psi_d_amsort_up(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
real(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_d_amsort_up
subroutine psi_d_amsort_dw(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
real(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_d_amsort_dw
end interface
interface psb_qsort
subroutine psb_dqsort(x,ix,dir,flag)
import

34
base/modules/psb_i_sort_mod.f90
Unescape Escape View File

@ -120,6 +120,40 @@ module psb_i_sort_mod
end subroutine psb_imsort
end interface psb_msort
interface
subroutine psi_i_msort_up(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
integer(psb_ipk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_i_msort_up
subroutine psi_i_msort_dw(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
integer(psb_ipk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_i_msort_dw
end interface
interface
subroutine psi_i_amsort_up(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
integer(psb_ipk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_i_amsort_up
subroutine psi_i_amsort_dw(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
integer(psb_ipk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_i_amsort_dw
end interface
interface psb_qsort
subroutine psb_iqsort(x,ix,dir,flag)
import

34
base/modules/psb_s_sort_mod.f90
Unescape Escape View File

@ -79,6 +79,40 @@ module psb_s_sort_mod
end subroutine psb_smsort
end interface psb_msort
interface
subroutine psi_s_msort_up(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
real(psb_spk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_s_msort_up
subroutine psi_s_msort_dw(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
real(psb_spk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_s_msort_dw
end interface
interface
subroutine psi_s_amsort_up(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
real(psb_spk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_s_amsort_up
subroutine psi_s_amsort_dw(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
real(psb_spk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_s_amsort_dw
end interface
interface psb_qsort
subroutine psb_sqsort(x,ix,dir,flag)
import

1399
base/modules/psb_sort_mod.f90
View File

File diff suppressed because it is too large Load Diff

48
base/modules/psb_z_sort_mod.f90
Unescape Escape View File

@ -79,6 +79,54 @@ module psb_z_sort_mod
end subroutine psb_zmsort
end interface psb_msort
interface
subroutine psi_z_lmsort_up(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
complex(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_z_lmsort_up
subroutine psi_z_lmsort_dw(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
complex(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_z_lmsort_dw
subroutine psi_z_almsort_up(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
complex(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_z_almsort_up
subroutine psi_z_almsort_dw(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
complex(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_z_almsort_dw
end interface
interface
subroutine psi_z_amsort_up(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
complex(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_z_amsort_up
subroutine psi_z_amsort_dw(n,k,l,iret)
import
implicit none
integer(psb_ipk_) :: n, iret
complex(psb_dpk_) :: k(n)
integer(psb_ipk_) :: l(0:n+1)
end subroutine psi_z_amsort_dw
end interface
interface psb_qsort
subroutine psb_zqsort(x,ix,dir,flag)
import

9
base/serial/Makefile
Unescape Escape View File

@ -1,7 +1,7 @@
include ../../Make.inc
FOBJS = psb_lsame.o psi_serial_impl.o psb_sort_impl.o \
FOBJS = psb_lsame.o psi_serial_impl.o \
psb_srwextd.o psb_drwextd.o psb_crwextd.o psb_zrwextd.o \
psb_sspspmm.o psb_dspspmm.o psb_cspspmm.o psb_zspspmm.o \
psb_ssymbmm.o psb_dsymbmm.o psb_csymbmm.o psb_zsymbmm.o \
@ -11,13 +11,14 @@ FOBJS = psb_lsame.o psi_serial_impl.o psb_sort_impl.o \
psb_sgelp.o psb_dgelp.o psb_cgelp.o psb_zgelp.o \
psb_samax_s.o psb_damax_s.o psb_camax_s.o psb_zamax_s.o \
psb_sasum_s.o psb_dasum_s.o psb_casum_s.o psb_zasum_s.o
# psb_sort_impl.o
LIBDIR=..
INCDIR=..
MODDIR=../modules
FINCLUDES=$(FMFLAG). $(FMFLAG)$(MODDIR) $(FMFLAG)$(INCDIR)
lib: auxd f77d impld lib1 $(FOBJS)
lib: auxd f77d impld sortd lib1 $(FOBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(FOBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME)
@ -34,10 +35,14 @@ f77d:
impld:
cd impl && $(MAKE) lib
sortd:
cd sort && $(MAKE) lib
clean:
/bin/rm -f $(FOBJS) *$(.mod)
(cd aux; $(MAKE) clean)
(cd f77; $(MAKE) clean)
(cd impl; $(MAKE) clean)
(cd sort; $(MAKE) clean)
veryclean: clean

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

@ -3,18 +3,19 @@ include ../../../Make.inc
# The object files
#
FOBJS = isr.o isrx.o iasr.o iasrx.o msort_up.o msort_dw.o\
imsr.o imsrx.o imsru.o iamsort_up.o iamsort_dw.o idot.o inrm2.o\
dsr.o dsrx.o dasr.o dasrx.o dmsr.o dmsrx.o \
dmsort_up.o dmsort_dw.o damsort_up.o damsort_dw.o \
ssr.o ssrx.o sasr.o sasrx.o smsr.o smsrx.o \
smsort_up.o smsort_dw.o samsort_up.o samsort_dw.o \
clcmp_mod.o clsr.o clsrx.o \
calcmp_mod.o calsr.o calsrx.o \
cacmp_mod.o casr.o casrx.o camsr.o camsrx.o camsort_up.o camsort_dw.o\
zlcmp_mod.o zlsr.o zlsrx.o \
zalcmp_mod.o zalsr.o zalsrx.o \
zacmp_mod.o zasr.o zasrx.o zamsr.o zamsrx.o zamsort_up.o zamsort_dw.o
FOBJS = idot.o inrm2.o
# FOBJS = isr.o isrx.o iasr.o iasrx.o msort_up.o msort_dw.o\
# imsr.o imsrx.o imsru.o iamsort_up.o iamsort_dw.o idot.o inrm2.o\
# dsr.o dsrx.o dasr.o dasrx.o dmsr.o dmsrx.o \
# dmsort_up.o dmsort_dw.o damsort_up.o damsort_dw.o \
# ssr.o ssrx.o sasr.o sasrx.o smsr.o smsrx.o \
# smsort_up.o smsort_dw.o samsort_up.o samsort_dw.o \
# clcmp_mod.o clsr.o clsrx.o \
# calcmp_mod.o calsr.o calsrx.o \
# cacmp_mod.o casr.o casrx.o camsr.o camsrx.o camsort_up.o camsort_dw.o\
# zlcmp_mod.o zlsr.o zlsrx.o \
# zalcmp_mod.o zalsr.o zalsrx.o \
# zacmp_mod.o zasr.o zasrx.o zamsr.o zamsrx.o zamsort_up.o zamsort_dw.o
OBJS=$(FOBJS)

16
base/serial/impl/psb_c_coo_impl.f90
Unescape Escape View File

@ -3382,7 +3382,7 @@ subroutine psb_c_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
imx = i+nzl-1
if (nzl > 0) then
call msort_up(nzl,ja(i:imx),ix2,iret)
call psi_i_msort_up(nzl,ja(i:imx),ix2,iret)
if (iret == 0) &
& call psb_ip_reord(nzl,val(i:imx),&
& ia(i:imx),ja(i:imx),ix2)
@ -3493,7 +3493,7 @@ subroutine psb_c_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
imx = i+nzl-1
if (nzl > 0) then
call msort_up(nzl,jas(i:imx),ix2,iret)
call psi_i_msort_up(nzl,jas(i:imx),ix2,iret)
if (iret == 0) &
& call psb_ip_reord(nzl,vs(i:imx),&
& ias(i:imx),jas(i:imx),ix2)
@ -3586,7 +3586,7 @@ subroutine psb_c_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
! If we did not have enough memory for buffers,
! let's try in place.
!
call msort_up(nzin,ia(1:),iaux(1:),iret)
call psi_i_msort_up(nzin,ia(1:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux)
i = 1
@ -3598,7 +3598,7 @@ subroutine psb_c_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
if (j > nzin) exit
enddo
nzl = j - i
call msort_up(nzl,ja(i:),iaux(1:),iret)
call psi_i_msort_up(nzl,ja(i:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzl,val(i:i+nzl-1),&
& ia(i:i+nzl-1),ja(i:i+nzl-1),iaux)
@ -3704,7 +3704,7 @@ subroutine psb_c_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
imx = i+nzl-1
if (nzl > 0) then
call msort_up(nzl,ia(i:imx),ix2,iret)
call psi_i_msort_up(nzl,ia(i:imx),ix2,iret)
if (iret == 0) &
& call psb_ip_reord(nzl,val(i:imx),&
& ia(i:imx),ja(i:imx),ix2)
@ -3813,7 +3813,7 @@ subroutine psb_c_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
imx = i+nzl-1
if (nzl > 0) then
call msort_up(nzl,ias(i:imx),ix2,iret)
call psi_i_msort_up(nzl,ias(i:imx),ix2,iret)
if (iret == 0) &
& call psb_ip_reord(nzl,vs(i:imx),&
& ias(i:imx),jas(i:imx),ix2)
@ -3900,7 +3900,7 @@ subroutine psb_c_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
else if (.not.use_buffers) then
call msort_up(nzin,ja(1:),iaux(1:),iret)
call psi_i_msort_up(nzin,ja(1:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux)
i = 1
@ -3911,7 +3911,7 @@ subroutine psb_c_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
if (j > nzin) exit
enddo
nzl = j - i
call msort_up(nzl,ia(i:),iaux(1:),iret)
call psi_i_msort_up(nzl,ia(i:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzl,val(i:i+nzl-1),&
& ia(i:i+nzl-1),ja(i:i+nzl-1),iaux)

1
base/serial/impl/psb_c_csc_impl.f90
Unescape Escape View File

@ -2846,7 +2846,6 @@ contains
integer(psb_ipk_) :: ma,na,mb,nb
integer(psb_ipk_), allocatable :: icol(:), idxs(:), iaux(:)
complex(psb_spk_), allocatable :: col(:)
type(psb_int_heap) :: heap
integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, &
& nzc,nnzre, isz, ipb, irwsz, nrc, nze
complex(psb_spk_) :: cfb

1
base/serial/impl/psb_c_csr_impl.f90
Unescape Escape View File

@ -3085,7 +3085,6 @@ contains
integer(psb_ipk_) :: ma,na,mb,nb
integer(psb_ipk_), allocatable :: irow(:), idxs(:)
complex(psb_spk_), allocatable :: row(:)
type(psb_int_heap) :: heap
integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, &
& nzc,nnzre, isz, ipb, irwsz, nrc, nze
complex(psb_spk_) :: cfb

16
base/serial/impl/psb_d_coo_impl.f90
Unescape Escape View File

@ -3382,7 +3382,7 @@ subroutine psb_d_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
imx = i+nzl-1
if (nzl > 0) then
call msort_up(nzl,ja(i:imx),ix2,iret)
call psi_i_msort_up(nzl,ja(i:imx),ix2,iret)
if (iret == 0) &
& call psb_ip_reord(nzl,val(i:imx),&
& ia(i:imx),ja(i:imx),ix2)
@ -3493,7 +3493,7 @@ subroutine psb_d_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
imx = i+nzl-1
if (nzl > 0) then
call msort_up(nzl,jas(i:imx),ix2,iret)
call psi_i_msort_up(nzl,jas(i:imx),ix2,iret)
if (iret == 0) &
& call psb_ip_reord(nzl,vs(i:imx),&
& ias(i:imx),jas(i:imx),ix2)
@ -3586,7 +3586,7 @@ subroutine psb_d_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
! If we did not have enough memory for buffers,
! let's try in place.
!
call msort_up(nzin,ia(1:),iaux(1:),iret)
call psi_i_msort_up(nzin,ia(1:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux)
i = 1
@ -3598,7 +3598,7 @@ subroutine psb_d_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
if (j > nzin) exit
enddo
nzl = j - i
call msort_up(nzl,ja(i:),iaux(1:),iret)
call psi_i_msort_up(nzl,ja(i:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzl,val(i:i+nzl-1),&
& ia(i:i+nzl-1),ja(i:i+nzl-1),iaux)
@ -3704,7 +3704,7 @@ subroutine psb_d_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
imx = i+nzl-1
if (nzl > 0) then
call msort_up(nzl,ia(i:imx),ix2,iret)
call psi_i_msort_up(nzl,ia(i:imx),ix2,iret)
if (iret == 0) &
& call psb_ip_reord(nzl,val(i:imx),&
& ia(i:imx),ja(i:imx),ix2)
@ -3813,7 +3813,7 @@ subroutine psb_d_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
imx = i+nzl-1
if (nzl > 0) then
call msort_up(nzl,ias(i:imx),ix2,iret)
call psi_i_msort_up(nzl,ias(i:imx),ix2,iret)
if (iret == 0) &
& call psb_ip_reord(nzl,vs(i:imx),&
& ias(i:imx),jas(i:imx),ix2)
@ -3900,7 +3900,7 @@ subroutine psb_d_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
else if (.not.use_buffers) then
call msort_up(nzin,ja(1:),iaux(1:),iret)
call psi_i_msort_up(nzin,ja(1:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux)
i = 1
@ -3911,7 +3911,7 @@ subroutine psb_d_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
if (j > nzin) exit
enddo
nzl = j - i
call msort_up(nzl,ia(i:),iaux(1:),iret)
call psi_i_msort_up(nzl,ia(i:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzl,val(i:i+nzl-1),&
& ia(i:i+nzl-1),ja(i:i+nzl-1),iaux)

1
base/serial/impl/psb_d_csc_impl.f90
Unescape Escape View File

@ -2846,7 +2846,6 @@ contains
integer(psb_ipk_) :: ma,na,mb,nb
integer(psb_ipk_), allocatable :: icol(:), idxs(:), iaux(:)
real(psb_dpk_), allocatable :: col(:)
type(psb_int_heap) :: heap
integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, &
& nzc,nnzre, isz, ipb, irwsz, nrc, nze
real(psb_dpk_) :: cfb

1
base/serial/impl/psb_d_csr_impl.f90
Unescape Escape View File

@ -3085,7 +3085,6 @@ contains
integer(psb_ipk_) :: ma,na,mb,nb
integer(psb_ipk_), allocatable :: irow(:), idxs(:)
real(psb_dpk_), allocatable :: row(:)
type(psb_int_heap) :: heap
integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, &
& nzc,nnzre, isz, ipb, irwsz, nrc, nze
real(psb_dpk_) :: cfb

16
base/serial/impl/psb_s_coo_impl.f90
Unescape Escape View File

@ -3382,7 +3382,7 @@ subroutine psb_s_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
imx = i+nzl-1
if (nzl > 0) then
call msort_up(nzl,ja(i:imx),ix2,iret)
call psi_i_msort_up(nzl,ja(i:imx),ix2,iret)
if (iret == 0) &
& call psb_ip_reord(nzl,val(i:imx),&
& ia(i:imx),ja(i:imx),ix2)
@ -3493,7 +3493,7 @@ subroutine psb_s_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
imx = i+nzl-1
if (nzl > 0) then
call msort_up(nzl,jas(i:imx),ix2,iret)
call psi_i_msort_up(nzl,jas(i:imx),ix2,iret)
if (iret == 0) &
& call psb_ip_reord(nzl,vs(i:imx),&
& ias(i:imx),jas(i:imx),ix2)
@ -3586,7 +3586,7 @@ subroutine psb_s_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
! If we did not have enough memory for buffers,
! let's try in place.
!
call msort_up(nzin,ia(1:),iaux(1:),iret)
call psi_i_msort_up(nzin,ia(1:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux)
i = 1
@ -3598,7 +3598,7 @@ subroutine psb_s_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
if (j > nzin) exit
enddo
nzl = j - i
call msort_up(nzl,ja(i:),iaux(1:),iret)
call psi_i_msort_up(nzl,ja(i:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzl,val(i:i+nzl-1),&
& ia(i:i+nzl-1),ja(i:i+nzl-1),iaux)
@ -3704,7 +3704,7 @@ subroutine psb_s_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
imx = i+nzl-1
if (nzl > 0) then
call msort_up(nzl,ia(i:imx),ix2,iret)
call psi_i_msort_up(nzl,ia(i:imx),ix2,iret)
if (iret == 0) &
& call psb_ip_reord(nzl,val(i:imx),&
& ia(i:imx),ja(i:imx),ix2)
@ -3813,7 +3813,7 @@ subroutine psb_s_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
imx = i+nzl-1
if (nzl > 0) then
call msort_up(nzl,ias(i:imx),ix2,iret)
call psi_i_msort_up(nzl,ias(i:imx),ix2,iret)
if (iret == 0) &
& call psb_ip_reord(nzl,vs(i:imx),&
& ias(i:imx),jas(i:imx),ix2)
@ -3900,7 +3900,7 @@ subroutine psb_s_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
else if (.not.use_buffers) then
call msort_up(nzin,ja(1:),iaux(1:),iret)
call psi_i_msort_up(nzin,ja(1:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux)
i = 1
@ -3911,7 +3911,7 @@ subroutine psb_s_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
if (j > nzin) exit
enddo
nzl = j - i
call msort_up(nzl,ia(i:),iaux(1:),iret)
call psi_i_msort_up(nzl,ia(i:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzl,val(i:i+nzl-1),&
& ia(i:i+nzl-1),ja(i:i+nzl-1),iaux)

1
base/serial/impl/psb_s_csc_impl.f90
Unescape Escape View File

@ -2846,7 +2846,6 @@ contains
integer(psb_ipk_) :: ma,na,mb,nb
integer(psb_ipk_), allocatable :: icol(:), idxs(:), iaux(:)
real(psb_spk_), allocatable :: col(:)
type(psb_int_heap) :: heap
integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, &
& nzc,nnzre, isz, ipb, irwsz, nrc, nze
real(psb_spk_) :: cfb

1
base/serial/impl/psb_s_csr_impl.f90
Unescape Escape View File

@ -3085,7 +3085,6 @@ contains
integer(psb_ipk_) :: ma,na,mb,nb
integer(psb_ipk_), allocatable :: irow(:), idxs(:)
real(psb_spk_), allocatable :: row(:)
type(psb_int_heap) :: heap
integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, &
& nzc,nnzre, isz, ipb, irwsz, nrc, nze
real(psb_spk_) :: cfb

16
base/serial/impl/psb_z_coo_impl.f90
Unescape Escape View File

@ -3382,7 +3382,7 @@ subroutine psb_z_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
imx = i+nzl-1
if (nzl > 0) then
call msort_up(nzl,ja(i:imx),ix2,iret)
call psi_i_msort_up(nzl,ja(i:imx),ix2,iret)
if (iret == 0) &
& call psb_ip_reord(nzl,val(i:imx),&
& ia(i:imx),ja(i:imx),ix2)
@ -3493,7 +3493,7 @@ subroutine psb_z_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
imx = i+nzl-1
if (nzl > 0) then
call msort_up(nzl,jas(i:imx),ix2,iret)
call psi_i_msort_up(nzl,jas(i:imx),ix2,iret)
if (iret == 0) &
& call psb_ip_reord(nzl,vs(i:imx),&
& ias(i:imx),jas(i:imx),ix2)
@ -3586,7 +3586,7 @@ subroutine psb_z_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
! If we did not have enough memory for buffers,
! let's try in place.
!
call msort_up(nzin,ia(1:),iaux(1:),iret)
call psi_i_msort_up(nzin,ia(1:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux)
i = 1
@ -3598,7 +3598,7 @@ subroutine psb_z_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
if (j > nzin) exit
enddo
nzl = j - i
call msort_up(nzl,ja(i:),iaux(1:),iret)
call psi_i_msort_up(nzl,ja(i:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzl,val(i:i+nzl-1),&
& ia(i:i+nzl-1),ja(i:i+nzl-1),iaux)
@ -3704,7 +3704,7 @@ subroutine psb_z_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
imx = i+nzl-1
if (nzl > 0) then
call msort_up(nzl,ia(i:imx),ix2,iret)
call psi_i_msort_up(nzl,ia(i:imx),ix2,iret)
if (iret == 0) &
& call psb_ip_reord(nzl,val(i:imx),&
& ia(i:imx),ja(i:imx),ix2)
@ -3813,7 +3813,7 @@ subroutine psb_z_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
imx = i+nzl-1
if (nzl > 0) then
call msort_up(nzl,ias(i:imx),ix2,iret)
call psi_i_msort_up(nzl,ias(i:imx),ix2,iret)
if (iret == 0) &
& call psb_ip_reord(nzl,vs(i:imx),&
& ias(i:imx),jas(i:imx),ix2)
@ -3900,7 +3900,7 @@ subroutine psb_z_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
else if (.not.use_buffers) then
call msort_up(nzin,ja(1:),iaux(1:),iret)
call psi_i_msort_up(nzin,ja(1:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux)
i = 1
@ -3911,7 +3911,7 @@ subroutine psb_z_fix_coo_inner(nr,nc,nzin,dupl,ia,ja,val,nzout,info,idir)
if (j > nzin) exit
enddo
nzl = j - i
call msort_up(nzl,ia(i:),iaux(1:),iret)
call psi_i_msort_up(nzl,ia(i:),iaux(1:),iret)
if (iret == 0) &
& call psb_ip_reord(nzl,val(i:i+nzl-1),&
& ia(i:i+nzl-1),ja(i:i+nzl-1),iaux)

1
base/serial/impl/psb_z_csc_impl.f90
Unescape Escape View File

@ -2846,7 +2846,6 @@ contains
integer(psb_ipk_) :: ma,na,mb,nb
integer(psb_ipk_), allocatable :: icol(:), idxs(:), iaux(:)
complex(psb_dpk_), allocatable :: col(:)
type(psb_int_heap) :: heap
integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, &
& nzc,nnzre, isz, ipb, irwsz, nrc, nze
complex(psb_dpk_) :: cfb

1
base/serial/impl/psb_z_csr_impl.f90
Unescape Escape View File

@ -3085,7 +3085,6 @@ contains
integer(psb_ipk_) :: ma,na,mb,nb
integer(psb_ipk_), allocatable :: irow(:), idxs(:)
complex(psb_dpk_), allocatable :: row(:)
type(psb_int_heap) :: heap
integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, &
& nzc,nnzre, isz, ipb, irwsz, nrc, nze
complex(psb_dpk_) :: cfb

3
base/serial/sort/Makefile
Unescape Escape View File

@ -4,12 +4,13 @@ include ../../../Make.inc
# The object files
#
BOBJS=psi_lcx_mod.o psi_alcx_mod.o psi_acx_mod.o
IOBJS=psb_i_hsort_impl.o psb_i_isort_impl.o psb_i_msort_impl.o psb_i_qsort_impl.o
SOBJS=psb_s_hsort_impl.o psb_s_isort_impl.o psb_s_msort_impl.o psb_s_qsort_impl.o
DOBJS=psb_d_hsort_impl.o psb_d_isort_impl.o psb_d_msort_impl.o psb_d_qsort_impl.o
COBJS=psb_c_hsort_impl.o psb_c_isort_impl.o psb_c_msort_impl.o psb_c_qsort_impl.o
ZOBJS=psb_z_hsort_impl.o psb_z_isort_impl.o psb_z_msort_impl.o psb_z_qsort_impl.o
OBJS=$(BOBJS) $(SOBJS) $(DOBJS) $(COBJS) $(ZOBJS)
OBJS=$(BOBJS) $(IOBJS) $(SOBJS) $(DOBJS) $(COBJS) $(ZOBJS)
#
# Where the library should go, and how it is called.

34
base/serial/sort/psb_c_hsort_impl.f90
Unescape Escape View File

@ -50,7 +50,7 @@ subroutine psb_chsort(x,ix,dir,flag)
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, n, i, l, err_act,info
real(psb_spk_) :: key
complex(psb_spk_) :: key
integer(psb_ipk_) :: index
integer(psb_ipk_) :: ierr(5)
@ -391,7 +391,7 @@ contains
end subroutine psi_c_insert_heap
subroutine psi_c_heap_get_first(key,last,heap,dir,info)
use psb_c_sort_mod, psb_protect_name => psi_c_insert_heap
use psb_c_sort_mod, psb_protect_name => psi_c_heap_get_first
implicit none
!
@ -633,7 +633,7 @@ contains
end subroutine psi_c_heap_get_first
subroutine psi_c_idx_insert_heap(key,index,last,heap,idxs,dir,info)
use psb_c_sort_mod, psb_protect_name => psi_c_idx_insert_idx_heap
use psb_c_sort_mod, psb_protect_name => psi_c_idx_insert_heap
implicit none
!
@ -869,7 +869,7 @@ end subroutine psi_c_idx_insert_heap
subroutine psi_c_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
use psb_c_sort_mod, psb_protect_name => psi_c_insert_heap
use psb_c_sort_mod, psb_protect_name => psi_c_idx_heap_get_first
implicit none
!
@ -905,22 +905,22 @@ subroutine psi_c_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
info = -4
case (psb_asort_up_)
call fix_aup(last,heap)
call fix_aup(last,heap,idxs)
case (psb_asort_down_)
call fix_adw(last,heap)
call fix_adw(last,heap,idxs)
case (psb_alsort_up_)
call fix_alup(last,heap)
call fix_alup(last,heap,idxs)
case (psb_alsort_down_)
call fix_aldw(last,heap)
call fix_aldw(last,heap,idxs)
case (psb_lsort_up_)
call fix_lup(last,heap)
call fix_lup(last,heap,idxs)
case (psb_lsort_down_)
call fix_ldw(last,heap)
call fix_ldw(last,heap,idxs)
case default
write(psb_err_unit,*) 'Invalid direction in heap ',dir
@ -933,7 +933,7 @@ contains
use psi_acx_mod
integer(psb_ipk_), intent(in) :: last
complex(psb_spk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:)
integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp
complex(psb_spk_) :: temp
@ -968,7 +968,7 @@ contains
use psi_acx_mod
integer(psb_ipk_), intent(in) :: last
complex(psb_spk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:)
integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp
complex(psb_spk_) :: temp
@ -1002,7 +1002,7 @@ contains
use psi_lcx_mod
integer(psb_ipk_), intent(in) :: last
complex(psb_spk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:)
integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp
complex(psb_spk_) :: temp
@ -1036,7 +1036,7 @@ contains
use psi_lcx_mod
integer(psb_ipk_), intent(in) :: last
complex(psb_spk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:)
integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp
complex(psb_spk_) :: temp
@ -1070,7 +1070,7 @@ contains
use psi_alcx_mod
integer(psb_ipk_), intent(in) :: last
complex(psb_spk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:)
integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp
complex(psb_spk_) :: temp
@ -1104,7 +1104,7 @@ contains
use psi_alcx_mod
integer(psb_ipk_), intent(in) :: last
complex(psb_spk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:)
integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp
complex(psb_spk_) :: temp
@ -1134,7 +1134,7 @@ contains
end subroutine fix_aldw
end subroutine psi_c_heap_get_first
end subroutine psi_c_idx_heap_get_first

24
base/serial/sort/psb_c_isort_impl.f90
Unescape Escape View File

@ -137,13 +137,13 @@ subroutine psb_cisort(x,ix,dir,flag)
return
end subroutine psb_cisort
subroutine psi_clisrx_up(n,x,ix)
subroutine psi_clisrx_up(n,x,idx)
use psb_c_sort_mod, psb_protect_name => psi_clisrx_up
use psb_error_mod
use psi_lcx_mod
implicit none
complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
complex(psb_spk_) :: xx
@ -167,13 +167,13 @@ subroutine psi_clisrx_up(n,x,ix)
end subroutine psi_clisrx_up
subroutine psi_clisrx_dw(n,x,ix)
subroutine psi_clisrx_dw(n,x,idx)
use psb_c_sort_mod, psb_protect_name => psi_clisrx_dw
use psb_error_mod
use psi_lcx_mod
implicit none
complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
complex(psb_spk_) :: xx
@ -246,13 +246,13 @@ subroutine psi_clisr_dw(n,x)
enddo
end subroutine psi_clisr_dw
subroutine psi_calisrx_up(n,x,ix)
subroutine psi_calisrx_up(n,x,idx)
use psb_c_sort_mod, psb_protect_name => psi_calisrx_up
use psb_error_mod
use psi_alcx_mod
implicit none
complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
complex(psb_spk_) :: xx
@ -275,13 +275,13 @@ subroutine psi_calisrx_up(n,x,ix)
enddo
end subroutine psi_calisrx_up
subroutine psi_calisrx_dw(n,x,ix)
subroutine psi_calisrx_dw(n,x,idx)
use psb_c_sort_mod, psb_protect_name => psi_calisrx_dw
use psb_error_mod
use psi_alcx_mod
implicit none
complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
complex(psb_spk_) :: xx
@ -354,12 +354,12 @@ subroutine psi_calisr_dw(n,x)
enddo
end subroutine psi_calisr_dw
subroutine psi_caisrx_up(n,x,ix)
subroutine psi_caisrx_up(n,x,idx)
use psb_c_sort_mod, psb_protect_name => psi_caisrx_up
use psb_error_mod
implicit none
complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
complex(psb_spk_) :: xx
@ -382,12 +382,12 @@ subroutine psi_caisrx_up(n,x,ix)
enddo
end subroutine psi_caisrx_up
subroutine psi_caisrx_dw(n,x,ix)
subroutine psi_caisrx_dw(n,x,idx)
use psb_c_sort_mod, psb_protect_name => psi_caisrx_dw
use psb_error_mod
implicit none
complex(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
complex(psb_spk_) :: xx

48
base/serial/sort/psb_c_msort_impl.f90
Unescape Escape View File

@ -115,19 +115,19 @@ subroutine psb_cmsort(x,ix,dir,flag)
goto 9999
endif
select case(idir)
select case(dir_)
case (psb_lsort_up_)
call in_lmsort_up(n,x,iaux,iret)
call psi_c_lmsort_up(n,x,iaux,iret)
case (psb_lsort_down_)
call in_lmsort_dw(n,x,iaux,iret)
case (psb_asort_up_)
call in_amsort_up(n,x,iaux,iret)
case (psb_asort_down_)
call in_amsort_dw(n,x,iaux,iret)
call psi_c_lmsort_dw(n,x,iaux,iret)
case (psb_alsort_up_)
call in_almsort_up(n,x,iaux,iret)
call psi_c_almsort_up(n,x,iaux,iret)
case (psb_alsort_down_)
call in_almsort_dw(n,x,iaux,iret)
call psi_c_almsort_dw(n,x,iaux,iret)
case (psb_asort_up_)
call psi_c_amsort_up(n,x,iaux,iret)
case (psb_asort_down_)
call psi_c_amsort_dw(n,x,iaux,iret)
end select
!
! Do the actual reordering, since the inner routines
@ -135,7 +135,7 @@ subroutine psb_cmsort(x,ix,dir,flag)
!
if (iret == 0 ) then
if (present(ix)) then
call psb_ip_reord(n,x,indx,iaux)
call psb_ip_reord(n,x,ix,iaux)
else
call psb_ip_reord(n,x,iaux)
end if
@ -147,9 +147,10 @@ subroutine psb_cmsort(x,ix,dir,flag)
return
contains
subroutine in_lmsort_up(n,k,l,iret)
end subroutine psb_cmsort
subroutine psi_c_lmsort_up(n,k,l,iret)
use psb_const_mod
use psi_lcx_mod
implicit none
@ -252,9 +253,9 @@ contains
end do outer
end do mergepass
end subroutine in_lmsort_up
end subroutine psi_c_lmsort_up
subroutine in_lmsort_dw(n,k,l,iret)
subroutine psi_c_lmsort_dw(n,k,l,iret)
use psb_const_mod
use psi_lcx_mod
implicit none
@ -357,9 +358,9 @@ contains
end do outer
end do mergepass
end subroutine in_lmsort_dw
end subroutine psi_c_lmsort_dw
subroutine in_amsort_up(n,k,l,iret)
subroutine psi_c_amsort_up(n,k,l,iret)
use psb_const_mod
use psi_acx_mod
implicit none
@ -462,9 +463,9 @@ contains
end do outer
end do mergepass
end subroutine in_amsort_up
end subroutine psi_c_amsort_up
subroutine in_amsort_dw(n,k,l,iret)
subroutine psi_c_amsort_dw(n,k,l,iret)
use psb_const_mod
use psi_acx_mod
implicit none
@ -567,9 +568,9 @@ contains
end do outer
end do mergepass
end subroutine in_amsort_dw
end subroutine psi_c_amsort_dw
subroutine in_almsort_up(n,k,l,iret)
subroutine psi_c_almsort_up(n,k,l,iret)
use psb_const_mod
use psi_alcx_mod
implicit none
@ -672,9 +673,9 @@ contains
end do outer
end do mergepass
end subroutine in_almsort_up
end subroutine psi_c_almsort_up
subroutine in_almsort_dw(n,k,l,iret)
subroutine psi_c_almsort_dw(n,k,l,iret)
use psb_const_mod
use psi_alcx_mod
implicit none
@ -777,6 +778,5 @@ contains
end do outer
end do mergepass
end subroutine in_almsort_dw
end subroutine psi_c_almsort_dw
end subroutine psb_cmsort

875
base/serial/sort/psb_c_qsort_impl.f90
View File

File diff suppressed because it is too large Load Diff

2
base/serial/sort/psb_d_hsort_impl.f90
Unescape Escape View File

@ -50,7 +50,7 @@ subroutine psb_dhsort(x,ix,dir,flag)
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, n, i, l, err_act,info
real(psb_spk_) :: key
real(psb_dpk_) :: key
integer(psb_ipk_) :: index
integer(psb_ipk_) :: ierr(5)

16
base/serial/sort/psb_d_isort_impl.f90
Unescape Escape View File

@ -129,12 +129,12 @@ subroutine psb_disort(x,ix,dir,flag)
return
end subroutine psb_disort
subroutine psi_disrx_up(n,x,ix)
subroutine psi_disrx_up(n,x,idx)
use psb_d_sort_mod, psb_protect_name => psi_disrx_up
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
real(psb_dpk_) :: xx
@ -157,12 +157,12 @@ subroutine psi_disrx_up(n,x,ix)
enddo
end subroutine psi_disrx_up
subroutine psi_disrx_dw(n,x,ix)
subroutine psi_disrx_dw(n,x,idx)
use psb_d_sort_mod, psb_protect_name => psi_disrx_dw
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
real(psb_dpk_) :: xx
@ -234,12 +234,12 @@ subroutine psi_disr_dw(n,x)
enddo
end subroutine psi_disr_dw
subroutine psi_daisrx_up(n,x,ix)
subroutine psi_daisrx_up(n,x,idx)
use psb_d_sort_mod, psb_protect_name => psi_daisrx_up
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
real(psb_dpk_) :: xx
@ -262,12 +262,12 @@ subroutine psi_daisrx_up(n,x,ix)
enddo
end subroutine psi_daisrx_up
subroutine psi_daisrx_dw(n,x,ix)
subroutine psi_daisrx_dw(n,x,idx)
use psb_d_sort_mod, psb_protect_name => psi_daisrx_dw
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
real(psb_dpk_) :: xx

33
base/serial/sort/psb_d_msort_impl.f90
Unescape Escape View File

@ -108,15 +108,15 @@ subroutine psb_dmsort(x,ix,dir,flag)
goto 9999
endif
select case(idir)
select case(dir_)
case (psb_sort_up_)
call in_msort_up(n,x,iaux,iret)
call psi_d_msort_up(n,x,iaux,iret)
case (psb_sort_down_)
call in_msort_dw(n,x,iaux,iret)
call psi_d_msort_dw(n,x,iaux,iret)
case (psb_asort_up_)
call in_amsort_up(n,x,iaux,iret)
call psi_d_amsort_up(n,x,iaux,iret)
case (psb_asort_down_)
call in_amsort_dw(n,x,iaux,iret)
call psi_d_amsort_dw(n,x,iaux,iret)
end select
!
! Do the actual reordering, since the inner routines
@ -124,7 +124,7 @@ subroutine psb_dmsort(x,ix,dir,flag)
!
if (iret == 0 ) then
if (present(ix)) then
call psb_ip_reord(n,x,indx,iaux)
call psb_ip_reord(n,x,ix,iaux)
else
call psb_ip_reord(n,x,iaux)
end if
@ -137,9 +137,10 @@ subroutine psb_dmsort(x,ix,dir,flag)
return
contains
subroutine in_msort_up(n,k,l,iret)
end subroutine psb_dmsort
subroutine psi_d_msort_up(n,k,l,iret)
use psb_const_mod
implicit none
integer(psb_ipk_) :: n, iret
@ -241,9 +242,9 @@ contains
end do outer
end do mergepass
end subroutine in_msort_up
end subroutine psi_d_msort_up
subroutine in_msort_dw(n,k,l,iret)
subroutine psi_d_msort_dw(n,k,l,iret)
use psb_const_mod
implicit none
integer(psb_ipk_) :: n, iret
@ -345,9 +346,9 @@ contains
end do outer
end do mergepass
end subroutine in_msort_dw
end subroutine psi_d_msort_dw
subroutine in_amsort_up(n,k,l,iret)
subroutine psi_d_amsort_up(n,k,l,iret)
use psb_const_mod
implicit none
integer(psb_ipk_) :: n, iret
@ -449,9 +450,9 @@ contains
end do outer
end do mergepass
end subroutine in_amsort_up
end subroutine psi_d_amsort_up
subroutine in_amsort_dw(n,k,l,iret)
subroutine psi_d_amsort_dw(n,k,l,iret)
use psb_const_mod
implicit none
integer(psb_ipk_) :: n, iret
@ -553,11 +554,9 @@ contains
end do outer
end do mergepass
end subroutine in_amsort_dw
end subroutine psi_d_amsort_dw
end subroutine psb_dmsort

194
base/serial/sort/psb_d_qsort_impl.f90
Unescape Escape View File

@ -48,7 +48,7 @@ subroutine psb_dqsort(x,ix,dir,flag)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, n, err_act
integer(psb_ipk_) :: dir_, flag_, n, err_act, i
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
@ -129,15 +129,13 @@ subroutine psb_dqsort(x,ix,dir,flag)
return
end subroutine psb_dqsort
subroutine psi_dqsrx_up(n,x,ix)
subroutine psi_dqsrx_up(n,x,idx)
use psb_d_sort_mod, psb_protect_name => psi_dqsrx_up
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
! .. Local Scalars ..
real(psb_dpk_) :: piv, xk, xt
@ -170,39 +168,39 @@ subroutine psi_dqsrx_up(n,x,ix)
piv = x(lpiv)
if (piv < x(i)) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
endif
if (piv > x(j)) then
xt = x(j)
ixt = indx(j)
ixt = idx(j)
x(j) = x(lpiv)
indx(j) = indx(lpiv)
idx(j) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
endif
if (piv < x(i)) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
endif
!
! now piv is correct; place it into first location
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
i = ilx - 1
@ -228,11 +226,11 @@ subroutine psi_dqsrx_up(n,x,ix)
if (j > i) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(j)
indx(i) = indx(j)
idx(i) = idx(j)
x(j) = xt
indx(j) = ixt
idx(j) = ixt
else
exit outer_up
end if
@ -254,14 +252,14 @@ subroutine psi_dqsrx_up(n,x,ix)
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_disrx_up(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_disrx_up(n1,x(ilx:i-1),idx(ilx:i-1))
endif
if (n2 > ithrs) then
istp = istp + 1
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_disrx_up(n2,x(i:iux),indx(i:iux))
call psi_disrx_up(n2,x(i:iux),idx(i:iux))
endif
else
if (n2 > ithrs) then
@ -269,29 +267,29 @@ subroutine psi_dqsrx_up(n,x,ix)
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_disrx_up(n2,x(i:iux),indx(i:iux))
call psi_disrx_up(n2,x(i:iux),idx(i:iux))
endif
if (n1 > ithrs) then
istp = istp + 1
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_disrx_up(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_disrx_up(n1,x(ilx:i-1),idx(ilx:i-1))
endif
endif
enddo
else
call psi_disrx_up(n,x,indx)
call psi_disrx_up(n,x,idx)
endif
end subroutine psi_dqsrx_up
subroutine psi_dqsrx_dw(n,x,ix)
subroutine psi_dqsrx_dw(n,x,idx)
use psb_d_sort_mod, psb_protect_name => psi_dqsrx_dw
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
! .. Local Scalars ..
real(psb_dpk_) :: piv, xk, xt
@ -324,39 +322,39 @@ subroutine psi_dqsrx_dw(n,x,ix)
piv = x(lpiv)
if (piv > x(i)) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
endif
if (piv < x(j)) then
xt = x(j)
ixt = indx(j)
ixt = idx(j)
x(j) = x(lpiv)
indx(j) = indx(lpiv)
idx(j) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
endif
if (piv > x(i)) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
endif
!
! now piv is correct; place it into first location
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
i = ilx - 1
@ -382,11 +380,11 @@ subroutine psi_dqsrx_dw(n,x,ix)
if (j > i) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(j)
indx(i) = indx(j)
idx(i) = idx(j)
x(j) = xt
indx(j) = ixt
idx(j) = ixt
else
exit outer_dw
end if
@ -408,14 +406,14 @@ subroutine psi_dqsrx_dw(n,x,ix)
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_disrx_dw(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_disrx_dw(n1,x(ilx:i-1),idx(ilx:i-1))
endif
if (n2 > ithrs) then
istp = istp + 1
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_disrx_dw(n2,x(i:iux),indx(i:iux))
call psi_disrx_dw(n2,x(i:iux),idx(i:iux))
endif
else
if (n2 > ithrs) then
@ -423,19 +421,19 @@ subroutine psi_dqsrx_dw(n,x,ix)
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_disrx_dw(n2,x(i:iux),indx(i:iux))
call psi_disrx_dw(n2,x(i:iux),idx(i:iux))
endif
if (n1 > ithrs) then
istp = istp + 1
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_disrx_dw(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_disrx_dw(n1,x(ilx:i-1),idx(ilx:i-1))
endif
endif
enddo
else
call psi_disrx_dw(n,x,indx)
call psi_disrx_dw(n,x,idx)
endif
end subroutine psi_dqsrx_dw
@ -590,7 +588,7 @@ subroutine psi_dqsr_dw(n,x)
integer(psb_ipk_), intent(in) :: n
! ..
! .. Local Scalars ..
real(@FKIND) :: piv, xt, xk
real(psb_dpk_) :: piv, xt, xk
integer(psb_ipk_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: n1, n2
@ -722,16 +720,17 @@ subroutine psi_dqsr_dw(n,x)
end subroutine psi_dqsr_dw
subroutine psi_daqsrx_up(n,x,ix)
subroutine psi_daqsrx_up(n,x,idx)
use psb_d_sort_mod, psb_protect_name => psi_daqsrx_up
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
! .. Local Scalars ..
real(psb_dpk_) :: piv, xk, xt
real(psb_dpk_) :: piv, xk
real(psb_dpk_) :: xt
integer(psb_ipk_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2
@ -761,39 +760,39 @@ subroutine psi_daqsrx_up(n,x,ix)
piv = abs(x(lpiv))
if (piv < abs(x(i))) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = abs(x(lpiv))
endif
if (piv > abs(x(j))) then
xt = x(j)
ixt = indx(j)
ixt = idx(j)
x(j) = x(lpiv)
indx(j) = indx(lpiv)
idx(j) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = abs(x(lpiv))
endif
if (piv < abs(x(i))) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = abs(x(lpiv))
endif
!
! now piv is correct; place it into first location
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
i = ilx - 1
j = iux + 1
@ -818,11 +817,11 @@ subroutine psi_daqsrx_up(n,x,ix)
if (j > i) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(j)
indx(i) = indx(j)
idx(i) = idx(j)
x(j) = xt
indx(j) = ixt
idx(j) = ixt
else
exit outer_up
end if
@ -844,14 +843,14 @@ subroutine psi_daqsrx_up(n,x,ix)
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_daisrx_up(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_daisrx_up(n1,x(ilx:i-1),idx(ilx:i-1))
endif
if (n2 > ithrs) then
istp = istp + 1
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_daisrx_up(n2,x(i:iux),indx(i:iux))
call psi_daisrx_up(n2,x(i:iux),idx(i:iux))
endif
else
if (n2 > ithrs) then
@ -859,34 +858,35 @@ subroutine psi_daqsrx_up(n,x,ix)
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_daisrx_up(n2,x(i:iux),indx(i:iux))
call psi_daisrx_up(n2,x(i:iux),idx(i:iux))
endif
if (n1 > ithrs) then
istp = istp + 1
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_daisrx_up(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_daisrx_up(n1,x(ilx:i-1),idx(ilx:i-1))
endif
endif
enddo
else
call psi_daisrx_up(n,x,indx)
call psi_daisrx_up(n,x,idx)
endif
end subroutine psi_daqsrx_up
subroutine psi_daqsrx_dw(n,x,ix)
subroutine psi_daqsrx_dw(n,x,idx)
use psb_d_sort_mod, psb_protect_name => psi_daqsrx_dw
use psb_error_mod
implicit none
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
! .. Local Scalars ..
real(psb_dpk_) :: piv, xk, xt
real(psb_dpk_) :: piv, xk
real(psb_dpk_) :: xt
integer(psb_ipk_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2
@ -915,39 +915,39 @@ subroutine psi_daqsrx_dw(n,x,ix)
piv = abs(x(lpiv))
if (piv > abs(x(i))) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = abs(x(lpiv))
endif
if (piv < abs(x(j))) then
xt = x(j)
ixt = indx(j)
ixt = idx(j)
x(j) = x(lpiv)
indx(j) = indx(lpiv)
idx(j) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = abs(x(lpiv))
endif
if (piv > abs(x(i))) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = abs(x(lpiv))
endif
!
! now piv is correct; place it into first location
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
i = ilx - 1
j = iux + 1
@ -972,11 +972,11 @@ subroutine psi_daqsrx_dw(n,x,ix)
if (j > i) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(j)
indx(i) = indx(j)
idx(i) = idx(j)
x(j) = xt
indx(j) = ixt
idx(j) = ixt
else
exit outer_dw
end if
@ -998,14 +998,14 @@ subroutine psi_daqsrx_dw(n,x,ix)
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_daisrx_dw(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_daisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1))
endif
if (n2 > ithrs) then
istp = istp + 1
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_daisrx_dw(n2,x(i:iux),indx(i:iux))
call psi_daisrx_dw(n2,x(i:iux),idx(i:iux))
endif
else
if (n2 > ithrs) then
@ -1013,19 +1013,19 @@ subroutine psi_daqsrx_dw(n,x,ix)
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_daisrx_dw(n2,x(i:iux),indx(i:iux))
call psi_daisrx_dw(n2,x(i:iux),idx(i:iux))
endif
if (n1 > ithrs) then
istp = istp + 1
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_daisrx_dw(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_daisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1))
endif
endif
enddo
else
call psi_daisrx_dw(n,x,indx)
call psi_daisrx_dw(n,x,idx)
endif
end subroutine psi_daqsrx_dw
@ -1038,7 +1038,8 @@ subroutine psi_daqsr_up(n,x)
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
! .. Local Scalars ..
real(psb_dpk_) :: piv, xk, xt
real(psb_dpk_) :: piv, xk
real(psb_dpk_) :: xt
integer(psb_ipk_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2
@ -1177,7 +1178,8 @@ subroutine psi_daqsr_dw(n,x)
real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
! .. Local Scalars ..
real(psb_dpk_) :: piv, xk, xt
real(psb_dpk_) :: piv, xk
real(psb_dpk_) :: xt
integer(psb_ipk_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2

2
base/serial/sort/psb_i_hsort_impl.f90
Unescape Escape View File

@ -50,7 +50,7 @@ subroutine psb_ihsort(x,ix,dir,flag)
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, n, i, l, err_act,info
real(psb_spk_) :: key
integer(psb_ipk_) :: key
integer(psb_ipk_) :: index
integer(psb_ipk_) :: ierr(5)

16
base/serial/sort/psb_i_isort_impl.f90
Unescape Escape View File

@ -129,12 +129,12 @@ subroutine psb_iisort(x,ix,dir,flag)
return
end subroutine psb_iisort
subroutine psi_iisrx_up(n,x,ix)
subroutine psi_iisrx_up(n,x,idx)
use psb_i_sort_mod, psb_protect_name => psi_iisrx_up
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: xx
@ -157,12 +157,12 @@ subroutine psi_iisrx_up(n,x,ix)
enddo
end subroutine psi_iisrx_up
subroutine psi_iisrx_dw(n,x,ix)
subroutine psi_iisrx_dw(n,x,idx)
use psb_i_sort_mod, psb_protect_name => psi_iisrx_dw
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: xx
@ -234,12 +234,12 @@ subroutine psi_iisr_dw(n,x)
enddo
end subroutine psi_iisr_dw
subroutine psi_iaisrx_up(n,x,ix)
subroutine psi_iaisrx_up(n,x,idx)
use psb_i_sort_mod, psb_protect_name => psi_iaisrx_up
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: xx
@ -262,12 +262,12 @@ subroutine psi_iaisrx_up(n,x,ix)
enddo
end subroutine psi_iaisrx_up
subroutine psi_iaisrx_dw(n,x,ix)
subroutine psi_iaisrx_dw(n,x,idx)
use psb_i_sort_mod, psb_protect_name => psi_iaisrx_dw
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: xx

35
base/serial/sort/psb_i_msort_impl.f90
Unescape Escape View File

@ -215,7 +215,7 @@ subroutine psb_imsort_u(x,nout,dir)
n = size(x)
call psb_imsort(x,dir_)
call psb_imsort(x,dir=dir_)
nout = min(1,n)
do k=2,n
if (x(k) /= x(nout)) then
@ -299,15 +299,15 @@ subroutine psb_imsort(x,ix,dir,flag)
goto 9999
endif
select case(idir)
select case(dir_)
case (psb_sort_up_)
call in_msort_up(n,x,iaux,iret)
call psi_i_msort_up(n,x,iaux,iret)
case (psb_sort_down_)
call in_msort_dw(n,x,iaux,iret)
call psi_i_msort_dw(n,x,iaux,iret)
case (psb_asort_up_)
call in_amsort_up(n,x,iaux,iret)
call psi_i_amsort_up(n,x,iaux,iret)
case (psb_asort_down_)
call in_amsort_dw(n,x,iaux,iret)
call psi_i_amsort_dw(n,x,iaux,iret)
end select
!
! Do the actual reordering, since the inner routines
@ -315,7 +315,7 @@ subroutine psb_imsort(x,ix,dir,flag)
!
if (iret == 0 ) then
if (present(ix)) then
call psb_ip_reord(n,x,indx,iaux)
call psb_ip_reord(n,x,ix,iaux)
else
call psb_ip_reord(n,x,iaux)
end if
@ -328,9 +328,10 @@ subroutine psb_imsort(x,ix,dir,flag)
return
contains
subroutine in_msort_up(n,k,l,iret)
end subroutine psb_imsort
subroutine psi_i_msort_up(n,k,l,iret)
use psb_const_mod
implicit none
integer(psb_ipk_) :: n, iret
@ -432,9 +433,9 @@ contains
end do outer
end do mergepass
end subroutine in_msort_up
end subroutine psi_i_msort_up
subroutine in_msort_dw(n,k,l,iret)
subroutine psi_i_msort_dw(n,k,l,iret)
use psb_const_mod
implicit none
integer(psb_ipk_) :: n, iret
@ -536,9 +537,9 @@ contains
end do outer
end do mergepass
end subroutine in_msort_dw
end subroutine psi_i_msort_dw
subroutine in_amsort_up(n,k,l,iret)
subroutine psi_i_amsort_up(n,k,l,iret)
use psb_const_mod
implicit none
integer(psb_ipk_) :: n, iret
@ -640,9 +641,9 @@ contains
end do outer
end do mergepass
end subroutine in_amsort_up
end subroutine psi_i_amsort_up
subroutine in_amsort_dw(n,k,l,iret)
subroutine psi_i_amsort_dw(n,k,l,iret)
use psb_const_mod
implicit none
integer(psb_ipk_) :: n, iret
@ -744,11 +745,9 @@ contains
end do outer
end do mergepass
end subroutine in_amsort_dw
end subroutine psi_i_amsort_dw
end subroutine psb_imsort

194
base/serial/sort/psb_i_qsort_impl.f90
Unescape Escape View File

@ -48,7 +48,7 @@ subroutine psb_iqsort(x,ix,dir,flag)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, n, err_act
integer(psb_ipk_) :: dir_, flag_, n, err_act, i
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
@ -129,15 +129,13 @@ subroutine psb_iqsort(x,ix,dir,flag)
return
end subroutine psb_iqsort
subroutine psi_iqsrx_up(n,x,ix)
subroutine psi_iqsrx_up(n,x,idx)
use psb_i_sort_mod, psb_protect_name => psi_iqsrx_up
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
! .. Local Scalars ..
integer(psb_ipk_) :: piv, xk, xt
@ -170,39 +168,39 @@ subroutine psi_iqsrx_up(n,x,ix)
piv = x(lpiv)
if (piv < x(i)) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
endif
if (piv > x(j)) then
xt = x(j)
ixt = indx(j)
ixt = idx(j)
x(j) = x(lpiv)
indx(j) = indx(lpiv)
idx(j) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
endif
if (piv < x(i)) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
endif
!
! now piv is correct; place it into first location
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
i = ilx - 1
@ -228,11 +226,11 @@ subroutine psi_iqsrx_up(n,x,ix)
if (j > i) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(j)
indx(i) = indx(j)
idx(i) = idx(j)
x(j) = xt
indx(j) = ixt
idx(j) = ixt
else
exit outer_up
end if
@ -254,14 +252,14 @@ subroutine psi_iqsrx_up(n,x,ix)
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_iisrx_up(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_iisrx_up(n1,x(ilx:i-1),idx(ilx:i-1))
endif
if (n2 > ithrs) then
istp = istp + 1
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_iisrx_up(n2,x(i:iux),indx(i:iux))
call psi_iisrx_up(n2,x(i:iux),idx(i:iux))
endif
else
if (n2 > ithrs) then
@ -269,29 +267,29 @@ subroutine psi_iqsrx_up(n,x,ix)
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_iisrx_up(n2,x(i:iux),indx(i:iux))
call psi_iisrx_up(n2,x(i:iux),idx(i:iux))
endif
if (n1 > ithrs) then
istp = istp + 1
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_iisrx_up(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_iisrx_up(n1,x(ilx:i-1),idx(ilx:i-1))
endif
endif
enddo
else
call psi_iisrx_up(n,x,indx)
call psi_iisrx_up(n,x,idx)
endif
end subroutine psi_iqsrx_up
subroutine psi_iqsrx_dw(n,x,ix)
subroutine psi_iqsrx_dw(n,x,idx)
use psb_i_sort_mod, psb_protect_name => psi_iqsrx_dw
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
! .. Local Scalars ..
integer(psb_ipk_) :: piv, xk, xt
@ -324,39 +322,39 @@ subroutine psi_iqsrx_dw(n,x,ix)
piv = x(lpiv)
if (piv > x(i)) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
endif
if (piv < x(j)) then
xt = x(j)
ixt = indx(j)
ixt = idx(j)
x(j) = x(lpiv)
indx(j) = indx(lpiv)
idx(j) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
endif
if (piv > x(i)) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
endif
!
! now piv is correct; place it into first location
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
i = ilx - 1
@ -382,11 +380,11 @@ subroutine psi_iqsrx_dw(n,x,ix)
if (j > i) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(j)
indx(i) = indx(j)
idx(i) = idx(j)
x(j) = xt
indx(j) = ixt
idx(j) = ixt
else
exit outer_dw
end if
@ -408,14 +406,14 @@ subroutine psi_iqsrx_dw(n,x,ix)
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_iisrx_dw(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_iisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1))
endif
if (n2 > ithrs) then
istp = istp + 1
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_iisrx_dw(n2,x(i:iux),indx(i:iux))
call psi_iisrx_dw(n2,x(i:iux),idx(i:iux))
endif
else
if (n2 > ithrs) then
@ -423,19 +421,19 @@ subroutine psi_iqsrx_dw(n,x,ix)
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_iisrx_dw(n2,x(i:iux),indx(i:iux))
call psi_iisrx_dw(n2,x(i:iux),idx(i:iux))
endif
if (n1 > ithrs) then
istp = istp + 1
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_iisrx_dw(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_iisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1))
endif
endif
enddo
else
call psi_iisrx_dw(n,x,indx)
call psi_iisrx_dw(n,x,idx)
endif
end subroutine psi_iqsrx_dw
@ -590,7 +588,7 @@ subroutine psi_iqsr_dw(n,x)
integer(psb_ipk_), intent(in) :: n
! ..
! .. Local Scalars ..
integer(@FKIND) :: piv, xt, xk
integer(psb_ipk_) :: piv, xt, xk
integer(psb_ipk_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: n1, n2
@ -722,16 +720,17 @@ subroutine psi_iqsr_dw(n,x)
end subroutine psi_iqsr_dw
subroutine psi_iaqsrx_up(n,x,ix)
subroutine psi_iaqsrx_up(n,x,idx)
use psb_i_sort_mod, psb_protect_name => psi_iaqsrx_up
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
! .. Local Scalars ..
integer(psb_ipk_) :: piv, xk, xt
integer(psb_ipk_) :: piv, xk
integer(psb_ipk_) :: xt
integer(psb_ipk_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2
@ -761,39 +760,39 @@ subroutine psi_iaqsrx_up(n,x,ix)
piv = abs(x(lpiv))
if (piv < abs(x(i))) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = abs(x(lpiv))
endif
if (piv > abs(x(j))) then
xt = x(j)
ixt = indx(j)
ixt = idx(j)
x(j) = x(lpiv)
indx(j) = indx(lpiv)
idx(j) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = abs(x(lpiv))
endif
if (piv < abs(x(i))) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = abs(x(lpiv))
endif
!
! now piv is correct; place it into first location
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
i = ilx - 1
j = iux + 1
@ -818,11 +817,11 @@ subroutine psi_iaqsrx_up(n,x,ix)
if (j > i) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(j)
indx(i) = indx(j)
idx(i) = idx(j)
x(j) = xt
indx(j) = ixt
idx(j) = ixt
else
exit outer_up
end if
@ -844,14 +843,14 @@ subroutine psi_iaqsrx_up(n,x,ix)
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_iaisrx_up(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_iaisrx_up(n1,x(ilx:i-1),idx(ilx:i-1))
endif
if (n2 > ithrs) then
istp = istp + 1
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_iaisrx_up(n2,x(i:iux),indx(i:iux))
call psi_iaisrx_up(n2,x(i:iux),idx(i:iux))
endif
else
if (n2 > ithrs) then
@ -859,34 +858,35 @@ subroutine psi_iaqsrx_up(n,x,ix)
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_iaisrx_up(n2,x(i:iux),indx(i:iux))
call psi_iaisrx_up(n2,x(i:iux),idx(i:iux))
endif
if (n1 > ithrs) then
istp = istp + 1
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_iaisrx_up(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_iaisrx_up(n1,x(ilx:i-1),idx(ilx:i-1))
endif
endif
enddo
else
call psi_iaisrx_up(n,x,indx)
call psi_iaisrx_up(n,x,idx)
endif
end subroutine psi_iaqsrx_up
subroutine psi_iaqsrx_dw(n,x,ix)
subroutine psi_iaqsrx_dw(n,x,idx)
use psb_i_sort_mod, psb_protect_name => psi_iaqsrx_dw
use psb_error_mod
implicit none
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
! .. Local Scalars ..
integer(psb_ipk_) :: piv, xk, xt
integer(psb_ipk_) :: piv, xk
integer(psb_ipk_) :: xt
integer(psb_ipk_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2
@ -915,39 +915,39 @@ subroutine psi_iaqsrx_dw(n,x,ix)
piv = abs(x(lpiv))
if (piv > abs(x(i))) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = abs(x(lpiv))
endif
if (piv < abs(x(j))) then
xt = x(j)
ixt = indx(j)
ixt = idx(j)
x(j) = x(lpiv)
indx(j) = indx(lpiv)
idx(j) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = abs(x(lpiv))
endif
if (piv > abs(x(i))) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = abs(x(lpiv))
endif
!
! now piv is correct; place it into first location
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
i = ilx - 1
j = iux + 1
@ -972,11 +972,11 @@ subroutine psi_iaqsrx_dw(n,x,ix)
if (j > i) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(j)
indx(i) = indx(j)
idx(i) = idx(j)
x(j) = xt
indx(j) = ixt
idx(j) = ixt
else
exit outer_dw
end if
@ -998,14 +998,14 @@ subroutine psi_iaqsrx_dw(n,x,ix)
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_iaisrx_dw(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_iaisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1))
endif
if (n2 > ithrs) then
istp = istp + 1
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_iaisrx_dw(n2,x(i:iux),indx(i:iux))
call psi_iaisrx_dw(n2,x(i:iux),idx(i:iux))
endif
else
if (n2 > ithrs) then
@ -1013,19 +1013,19 @@ subroutine psi_iaqsrx_dw(n,x,ix)
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_iaisrx_dw(n2,x(i:iux),indx(i:iux))
call psi_iaisrx_dw(n2,x(i:iux),idx(i:iux))
endif
if (n1 > ithrs) then
istp = istp + 1
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_iaisrx_dw(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_iaisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1))
endif
endif
enddo
else
call psi_iaisrx_dw(n,x,indx)
call psi_iaisrx_dw(n,x,idx)
endif
end subroutine psi_iaqsrx_dw
@ -1038,7 +1038,8 @@ subroutine psi_iaqsr_up(n,x)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
! .. Local Scalars ..
integer(psb_ipk_) :: piv, xk, xt
integer(psb_ipk_) :: piv, xk
integer(psb_ipk_) :: xt
integer(psb_ipk_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2
@ -1177,7 +1178,8 @@ subroutine psi_iaqsr_dw(n,x)
integer(psb_ipk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
! .. Local Scalars ..
integer(psb_ipk_) :: piv, xk, xt
integer(psb_ipk_) :: piv, xk
integer(psb_ipk_) :: xt
integer(psb_ipk_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2

16
base/serial/sort/psb_s_isort_impl.f90
Unescape Escape View File

@ -129,12 +129,12 @@ subroutine psb_sisort(x,ix,dir,flag)
return
end subroutine psb_sisort
subroutine psi_sisrx_up(n,x,ix)
subroutine psi_sisrx_up(n,x,idx)
use psb_s_sort_mod, psb_protect_name => psi_sisrx_up
use psb_error_mod
implicit none
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
real(psb_spk_) :: xx
@ -157,12 +157,12 @@ subroutine psi_sisrx_up(n,x,ix)
enddo
end subroutine psi_sisrx_up
subroutine psi_sisrx_dw(n,x,ix)
subroutine psi_sisrx_dw(n,x,idx)
use psb_s_sort_mod, psb_protect_name => psi_sisrx_dw
use psb_error_mod
implicit none
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
real(psb_spk_) :: xx
@ -234,12 +234,12 @@ subroutine psi_sisr_dw(n,x)
enddo
end subroutine psi_sisr_dw
subroutine psi_saisrx_up(n,x,ix)
subroutine psi_saisrx_up(n,x,idx)
use psb_s_sort_mod, psb_protect_name => psi_saisrx_up
use psb_error_mod
implicit none
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
real(psb_spk_) :: xx
@ -262,12 +262,12 @@ subroutine psi_saisrx_up(n,x,ix)
enddo
end subroutine psi_saisrx_up
subroutine psi_saisrx_dw(n,x,ix)
subroutine psi_saisrx_dw(n,x,idx)
use psb_s_sort_mod, psb_protect_name => psi_saisrx_dw
use psb_error_mod
implicit none
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
real(psb_spk_) :: xx

33
base/serial/sort/psb_s_msort_impl.f90
Unescape Escape View File

@ -108,15 +108,15 @@ subroutine psb_smsort(x,ix,dir,flag)
goto 9999
endif
select case(idir)
select case(dir_)
case (psb_sort_up_)
call in_msort_up(n,x,iaux,iret)
call psi_s_msort_up(n,x,iaux,iret)
case (psb_sort_down_)
call in_msort_dw(n,x,iaux,iret)
call psi_s_msort_dw(n,x,iaux,iret)
case (psb_asort_up_)
call in_amsort_up(n,x,iaux,iret)
call psi_s_amsort_up(n,x,iaux,iret)
case (psb_asort_down_)
call in_amsort_dw(n,x,iaux,iret)
call psi_s_amsort_dw(n,x,iaux,iret)
end select
!
! Do the actual reordering, since the inner routines
@ -124,7 +124,7 @@ subroutine psb_smsort(x,ix,dir,flag)
!
if (iret == 0 ) then
if (present(ix)) then
call psb_ip_reord(n,x,indx,iaux)
call psb_ip_reord(n,x,ix,iaux)
else
call psb_ip_reord(n,x,iaux)
end if
@ -137,9 +137,10 @@ subroutine psb_smsort(x,ix,dir,flag)
return
contains
subroutine in_msort_up(n,k,l,iret)
end subroutine psb_smsort
subroutine psi_s_msort_up(n,k,l,iret)
use psb_const_mod
implicit none
integer(psb_ipk_) :: n, iret
@ -241,9 +242,9 @@ contains
end do outer
end do mergepass
end subroutine in_msort_up
end subroutine psi_s_msort_up
subroutine in_msort_dw(n,k,l,iret)
subroutine psi_s_msort_dw(n,k,l,iret)
use psb_const_mod
implicit none
integer(psb_ipk_) :: n, iret
@ -345,9 +346,9 @@ contains
end do outer
end do mergepass
end subroutine in_msort_dw
end subroutine psi_s_msort_dw
subroutine in_amsort_up(n,k,l,iret)
subroutine psi_s_amsort_up(n,k,l,iret)
use psb_const_mod
implicit none
integer(psb_ipk_) :: n, iret
@ -449,9 +450,9 @@ contains
end do outer
end do mergepass
end subroutine in_amsort_up
end subroutine psi_s_amsort_up
subroutine in_amsort_dw(n,k,l,iret)
subroutine psi_s_amsort_dw(n,k,l,iret)
use psb_const_mod
implicit none
integer(psb_ipk_) :: n, iret
@ -553,11 +554,9 @@ contains
end do outer
end do mergepass
end subroutine in_amsort_dw
end subroutine psi_s_amsort_dw
end subroutine psb_smsort

194
base/serial/sort/psb_s_qsort_impl.f90
Unescape Escape View File

@ -48,7 +48,7 @@ subroutine psb_sqsort(x,ix,dir,flag)
integer(psb_ipk_), optional, intent(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, n, err_act
integer(psb_ipk_) :: dir_, flag_, n, err_act, i
integer(psb_ipk_) :: ierr(5)
character(len=20) :: name
@ -129,15 +129,13 @@ subroutine psb_sqsort(x,ix,dir,flag)
return
end subroutine psb_sqsort
subroutine psi_sqsrx_up(n,x,ix)
subroutine psi_sqsrx_up(n,x,idx)
use psb_s_sort_mod, psb_protect_name => psi_sqsrx_up
use psb_error_mod
implicit none
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
! .. Local Scalars ..
real(psb_spk_) :: piv, xk, xt
@ -170,39 +168,39 @@ subroutine psi_sqsrx_up(n,x,ix)
piv = x(lpiv)
if (piv < x(i)) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
endif
if (piv > x(j)) then
xt = x(j)
ixt = indx(j)
ixt = idx(j)
x(j) = x(lpiv)
indx(j) = indx(lpiv)
idx(j) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
endif
if (piv < x(i)) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
endif
!
! now piv is correct; place it into first location
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
i = ilx - 1
@ -228,11 +226,11 @@ subroutine psi_sqsrx_up(n,x,ix)
if (j > i) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(j)
indx(i) = indx(j)
idx(i) = idx(j)
x(j) = xt
indx(j) = ixt
idx(j) = ixt
else
exit outer_up
end if
@ -254,14 +252,14 @@ subroutine psi_sqsrx_up(n,x,ix)
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_sisrx_up(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_sisrx_up(n1,x(ilx:i-1),idx(ilx:i-1))
endif
if (n2 > ithrs) then
istp = istp + 1
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_sisrx_up(n2,x(i:iux),indx(i:iux))
call psi_sisrx_up(n2,x(i:iux),idx(i:iux))
endif
else
if (n2 > ithrs) then
@ -269,29 +267,29 @@ subroutine psi_sqsrx_up(n,x,ix)
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_sisrx_up(n2,x(i:iux),indx(i:iux))
call psi_sisrx_up(n2,x(i:iux),idx(i:iux))
endif
if (n1 > ithrs) then
istp = istp + 1
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_sisrx_up(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_sisrx_up(n1,x(ilx:i-1),idx(ilx:i-1))
endif
endif
enddo
else
call psi_sisrx_up(n,x,indx)
call psi_sisrx_up(n,x,idx)
endif
end subroutine psi_sqsrx_up
subroutine psi_sqsrx_dw(n,x,ix)
subroutine psi_sqsrx_dw(n,x,idx)
use psb_s_sort_mod, psb_protect_name => psi_sqsrx_dw
use psb_error_mod
implicit none
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
! .. Local Scalars ..
real(psb_spk_) :: piv, xk, xt
@ -324,39 +322,39 @@ subroutine psi_sqsrx_dw(n,x,ix)
piv = x(lpiv)
if (piv > x(i)) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
endif
if (piv < x(j)) then
xt = x(j)
ixt = indx(j)
ixt = idx(j)
x(j) = x(lpiv)
indx(j) = indx(lpiv)
idx(j) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
endif
if (piv > x(i)) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
endif
!
! now piv is correct; place it into first location
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = x(lpiv)
i = ilx - 1
@ -382,11 +380,11 @@ subroutine psi_sqsrx_dw(n,x,ix)
if (j > i) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(j)
indx(i) = indx(j)
idx(i) = idx(j)
x(j) = xt
indx(j) = ixt
idx(j) = ixt
else
exit outer_dw
end if
@ -408,14 +406,14 @@ subroutine psi_sqsrx_dw(n,x,ix)
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_sisrx_dw(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_sisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1))
endif
if (n2 > ithrs) then
istp = istp + 1
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_sisrx_dw(n2,x(i:iux),indx(i:iux))
call psi_sisrx_dw(n2,x(i:iux),idx(i:iux))
endif
else
if (n2 > ithrs) then
@ -423,19 +421,19 @@ subroutine psi_sqsrx_dw(n,x,ix)
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_sisrx_dw(n2,x(i:iux),indx(i:iux))
call psi_sisrx_dw(n2,x(i:iux),idx(i:iux))
endif
if (n1 > ithrs) then
istp = istp + 1
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_sisrx_dw(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_sisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1))
endif
endif
enddo
else
call psi_sisrx_dw(n,x,indx)
call psi_sisrx_dw(n,x,idx)
endif
end subroutine psi_sqsrx_dw
@ -590,7 +588,7 @@ subroutine psi_sqsr_dw(n,x)
integer(psb_ipk_), intent(in) :: n
! ..
! .. Local Scalars ..
real(@FKIND) :: piv, xt, xk
real(psb_spk_) :: piv, xt, xk
integer(psb_ipk_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: n1, n2
@ -722,16 +720,17 @@ subroutine psi_sqsr_dw(n,x)
end subroutine psi_sqsr_dw
subroutine psi_saqsrx_up(n,x,ix)
subroutine psi_saqsrx_up(n,x,idx)
use psb_s_sort_mod, psb_protect_name => psi_saqsrx_up
use psb_error_mod
implicit none
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
! .. Local Scalars ..
real(psb_spk_) :: piv, xk, xt
real(psb_spk_) :: piv, xk
real(psb_spk_) :: xt
integer(psb_ipk_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2
@ -761,39 +760,39 @@ subroutine psi_saqsrx_up(n,x,ix)
piv = abs(x(lpiv))
if (piv < abs(x(i))) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = abs(x(lpiv))
endif
if (piv > abs(x(j))) then
xt = x(j)
ixt = indx(j)
ixt = idx(j)
x(j) = x(lpiv)
indx(j) = indx(lpiv)
idx(j) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = abs(x(lpiv))
endif
if (piv < abs(x(i))) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = abs(x(lpiv))
endif
!
! now piv is correct; place it into first location
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
i = ilx - 1
j = iux + 1
@ -818,11 +817,11 @@ subroutine psi_saqsrx_up(n,x,ix)
if (j > i) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(j)
indx(i) = indx(j)
idx(i) = idx(j)
x(j) = xt
indx(j) = ixt
idx(j) = ixt
else
exit outer_up
end if
@ -844,14 +843,14 @@ subroutine psi_saqsrx_up(n,x,ix)
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_saisrx_up(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_saisrx_up(n1,x(ilx:i-1),idx(ilx:i-1))
endif
if (n2 > ithrs) then
istp = istp + 1
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_saisrx_up(n2,x(i:iux),indx(i:iux))
call psi_saisrx_up(n2,x(i:iux),idx(i:iux))
endif
else
if (n2 > ithrs) then
@ -859,34 +858,35 @@ subroutine psi_saqsrx_up(n,x,ix)
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_saisrx_up(n2,x(i:iux),indx(i:iux))
call psi_saisrx_up(n2,x(i:iux),idx(i:iux))
endif
if (n1 > ithrs) then
istp = istp + 1
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_saisrx_up(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_saisrx_up(n1,x(ilx:i-1),idx(ilx:i-1))
endif
endif
enddo
else
call psi_saisrx_up(n,x,indx)
call psi_saisrx_up(n,x,idx)
endif
end subroutine psi_saqsrx_up
subroutine psi_saqsrx_dw(n,x,ix)
subroutine psi_saqsrx_dw(n,x,idx)
use psb_s_sort_mod, psb_protect_name => psi_saqsrx_dw
use psb_error_mod
implicit none
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
! .. Local Scalars ..
real(psb_spk_) :: piv, xk, xt
real(psb_spk_) :: piv, xk
real(psb_spk_) :: xt
integer(psb_ipk_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2
@ -915,39 +915,39 @@ subroutine psi_saqsrx_dw(n,x,ix)
piv = abs(x(lpiv))
if (piv > abs(x(i))) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = abs(x(lpiv))
endif
if (piv < abs(x(j))) then
xt = x(j)
ixt = indx(j)
ixt = idx(j)
x(j) = x(lpiv)
indx(j) = indx(lpiv)
idx(j) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = abs(x(lpiv))
endif
if (piv > abs(x(i))) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
piv = abs(x(lpiv))
endif
!
! now piv is correct; place it into first location
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(lpiv)
indx(i) = indx(lpiv)
idx(i) = idx(lpiv)
x(lpiv) = xt
indx(lpiv) = ixt
idx(lpiv) = ixt
i = ilx - 1
j = iux + 1
@ -972,11 +972,11 @@ subroutine psi_saqsrx_dw(n,x,ix)
if (j > i) then
xt = x(i)
ixt = indx(i)
ixt = idx(i)
x(i) = x(j)
indx(i) = indx(j)
idx(i) = idx(j)
x(j) = xt
indx(j) = ixt
idx(j) = ixt
else
exit outer_dw
end if
@ -998,14 +998,14 @@ subroutine psi_saqsrx_dw(n,x,ix)
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_saisrx_dw(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_saisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1))
endif
if (n2 > ithrs) then
istp = istp + 1
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_saisrx_dw(n2,x(i:iux),indx(i:iux))
call psi_saisrx_dw(n2,x(i:iux),idx(i:iux))
endif
else
if (n2 > ithrs) then
@ -1013,19 +1013,19 @@ subroutine psi_saqsrx_dw(n,x,ix)
istack(1,istp) = i
istack(2,istp) = iux
else
call psi_saisrx_dw(n2,x(i:iux),indx(i:iux))
call psi_saisrx_dw(n2,x(i:iux),idx(i:iux))
endif
if (n1 > ithrs) then
istp = istp + 1
istack(1,istp) = ilx
istack(2,istp) = i-1
else
call psi_saisrx_dw(n1,x(ilx:i-1),indx(ilx:i-1))
call psi_saisrx_dw(n1,x(ilx:i-1),idx(ilx:i-1))
endif
endif
enddo
else
call psi_saisrx_dw(n,x,indx)
call psi_saisrx_dw(n,x,idx)
endif
end subroutine psi_saqsrx_dw
@ -1038,7 +1038,8 @@ subroutine psi_saqsr_up(n,x)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
! .. Local Scalars ..
real(psb_spk_) :: piv, xk, xt
real(psb_spk_) :: piv, xk
real(psb_spk_) :: xt
integer(psb_ipk_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2
@ -1177,7 +1178,8 @@ subroutine psi_saqsr_dw(n,x)
real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n
! .. Local Scalars ..
real(psb_spk_) :: piv, xk, xt
real(psb_spk_) :: piv, xk
real(psb_spk_) :: xt
integer(psb_ipk_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2

34
base/serial/sort/psb_z_hsort_impl.f90
Unescape Escape View File

@ -50,7 +50,7 @@ subroutine psb_zhsort(x,ix,dir,flag)
integer(psb_ipk_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, n, i, l, err_act,info
real(psb_spk_) :: key
complex(psb_dpk_) :: key
integer(psb_ipk_) :: index
integer(psb_ipk_) :: ierr(5)
@ -391,7 +391,7 @@ contains
end subroutine psi_z_insert_heap
subroutine psi_z_heap_get_first(key,last,heap,dir,info)
use psb_z_sort_mod, psb_protect_name => psi_z_insert_heap
use psb_z_sort_mod, psb_protect_name => psi_z_heap_get_first
implicit none
!
@ -633,7 +633,7 @@ contains
end subroutine psi_z_heap_get_first
subroutine psi_z_idx_insert_heap(key,index,last,heap,idxs,dir,info)
use psb_z_sort_mod, psb_protect_name => psi_z_idx_insert_idx_heap
use psb_z_sort_mod, psb_protect_name => psi_z_idx_insert_heap
implicit none
!
@ -869,7 +869,7 @@ end subroutine psi_z_idx_insert_heap
subroutine psi_z_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
use psb_z_sort_mod, psb_protect_name => psi_z_insert_heap
use psb_z_sort_mod, psb_protect_name => psi_z_idx_heap_get_first
implicit none
!
@ -905,22 +905,22 @@ subroutine psi_z_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
info = -4
case (psb_asort_up_)
call fix_aup(last,heap)
call fix_aup(last,heap,idxs)
case (psb_asort_down_)
call fix_adw(last,heap)
call fix_adw(last,heap,idxs)
case (psb_alsort_up_)
call fix_alup(last,heap)
call fix_alup(last,heap,idxs)
case (psb_alsort_down_)
call fix_aldw(last,heap)
call fix_aldw(last,heap,idxs)
case (psb_lsort_up_)
call fix_lup(last,heap)
call fix_lup(last,heap,idxs)
case (psb_lsort_down_)
call fix_ldw(last,heap)
call fix_ldw(last,heap,idxs)
case default
write(psb_err_unit,*) 'Invalid direction in heap ',dir
@ -933,7 +933,7 @@ contains
use psi_acx_mod
integer(psb_ipk_), intent(in) :: last
complex(psb_dpk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:)
integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp
complex(psb_dpk_) :: temp
@ -968,7 +968,7 @@ contains
use psi_acx_mod
integer(psb_ipk_), intent(in) :: last
complex(psb_dpk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:)
integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp
complex(psb_dpk_) :: temp
@ -1002,7 +1002,7 @@ contains
use psi_lcx_mod
integer(psb_ipk_), intent(in) :: last
complex(psb_dpk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:)
integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp
complex(psb_dpk_) :: temp
@ -1036,7 +1036,7 @@ contains
use psi_lcx_mod
integer(psb_ipk_), intent(in) :: last
complex(psb_dpk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:)
integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp
complex(psb_dpk_) :: temp
@ -1070,7 +1070,7 @@ contains
use psi_alcx_mod
integer(psb_ipk_), intent(in) :: last
complex(psb_dpk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:)
integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp
complex(psb_dpk_) :: temp
@ -1104,7 +1104,7 @@ contains
use psi_alcx_mod
integer(psb_ipk_), intent(in) :: last
complex(psb_dpk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:)
integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp
complex(psb_dpk_) :: temp
@ -1134,7 +1134,7 @@ contains
end subroutine fix_aldw
end subroutine psi_z_heap_get_first
end subroutine psi_z_idx_heap_get_first

24
base/serial/sort/psb_z_isort_impl.f90
Unescape Escape View File

@ -137,13 +137,13 @@ subroutine psb_zisort(x,ix,dir,flag)
return
end subroutine psb_zisort
subroutine psi_zlisrx_up(n,x,ix)
subroutine psi_zlisrx_up(n,x,idx)
use psb_z_sort_mod, psb_protect_name => psi_zlisrx_up
use psb_error_mod
use psi_lcx_mod
implicit none
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
complex(psb_dpk_) :: xx
@ -167,13 +167,13 @@ subroutine psi_zlisrx_up(n,x,ix)
end subroutine psi_zlisrx_up
subroutine psi_zlisrx_dw(n,x,ix)
subroutine psi_zlisrx_dw(n,x,idx)
use psb_z_sort_mod, psb_protect_name => psi_zlisrx_dw
use psb_error_mod
use psi_lcx_mod
implicit none
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
complex(psb_dpk_) :: xx
@ -246,13 +246,13 @@ subroutine psi_zlisr_dw(n,x)
enddo
end subroutine psi_zlisr_dw
subroutine psi_zalisrx_up(n,x,ix)
subroutine psi_zalisrx_up(n,x,idx)
use psb_z_sort_mod, psb_protect_name => psi_zalisrx_up
use psb_error_mod
use psi_alcx_mod
implicit none
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
complex(psb_dpk_) :: xx
@ -275,13 +275,13 @@ subroutine psi_zalisrx_up(n,x,ix)
enddo
end subroutine psi_zalisrx_up
subroutine psi_zalisrx_dw(n,x,ix)
subroutine psi_zalisrx_dw(n,x,idx)
use psb_z_sort_mod, psb_protect_name => psi_zalisrx_dw
use psb_error_mod
use psi_alcx_mod
implicit none
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
complex(psb_dpk_) :: xx
@ -354,12 +354,12 @@ subroutine psi_zalisr_dw(n,x)
enddo
end subroutine psi_zalisr_dw
subroutine psi_zaisrx_up(n,x,ix)
subroutine psi_zaisrx_up(n,x,idx)
use psb_z_sort_mod, psb_protect_name => psi_zaisrx_up
use psb_error_mod
implicit none
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
complex(psb_dpk_) :: xx
@ -382,12 +382,12 @@ subroutine psi_zaisrx_up(n,x,ix)
enddo
end subroutine psi_zaisrx_up
subroutine psi_zaisrx_dw(n,x,ix)
subroutine psi_zaisrx_dw(n,x,idx)
use psb_z_sort_mod, psb_protect_name => psi_zaisrx_dw
use psb_error_mod
implicit none
complex(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(inout) :: ix(:)
integer(psb_ipk_), intent(inout) :: idx(:)
integer(psb_ipk_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix
complex(psb_dpk_) :: xx

48
base/serial/sort/psb_z_msort_impl.f90
Unescape Escape View File

@ -115,19 +115,19 @@ subroutine psb_zmsort(x,ix,dir,flag)
goto 9999
endif
select case(idir)
select case(dir_)
case (psb_lsort_up_)
call in_lmsort_up(n,x,iaux,iret)
call psi_z_lmsort_up(n,x,iaux,iret)
case (psb_lsort_down_)
call in_lmsort_dw(n,x,iaux,iret)
case (psb_asort_up_)
call in_amsort_up(n,x,iaux,iret)
case (psb_asort_down_)
call in_amsort_dw(n,x,iaux,iret)
call psi_z_lmsort_dw(n,x,iaux,iret)
case (psb_alsort_up_)
call in_almsort_up(n,x,iaux,iret)
call psi_z_almsort_up(n,x,iaux,iret)
case (psb_alsort_down_)
call in_almsort_dw(n,x,iaux,iret)
call psi_z_almsort_dw(n,x,iaux,iret)
case (psb_asort_up_)
call psi_z_amsort_up(n,x,iaux,iret)
case (psb_asort_down_)
call psi_z_amsort_dw(n,x,iaux,iret)
end select
!
! Do the actual reordering, since the inner routines
@ -135,7 +135,7 @@ subroutine psb_zmsort(x,ix,dir,flag)
!
if (iret == 0 ) then
if (present(ix)) then
call psb_ip_reord(n,x,indx,iaux)
call psb_ip_reord(n,x,ix,iaux)
else
call psb_ip_reord(n,x,iaux)
end if
@ -147,9 +147,10 @@ subroutine psb_zmsort(x,ix,dir,flag)
return
contains
subroutine in_lmsort_up(n,k,l,iret)
end subroutine psb_zmsort
subroutine psi_z_lmsort_up(n,k,l,iret)
use psb_const_mod
use psi_lcx_mod
implicit none
@ -252,9 +253,9 @@ contains
end do outer
end do mergepass
end subroutine in_lmsort_up
end subroutine psi_z_lmsort_up
subroutine in_lmsort_dw(n,k,l,iret)
subroutine psi_z_lmsort_dw(n,k,l,iret)
use psb_const_mod
use psi_lcx_mod
implicit none
@ -357,9 +358,9 @@ contains
end do outer
end do mergepass
end subroutine in_lmsort_dw
end subroutine psi_z_lmsort_dw
subroutine in_amsort_up(n,k,l,iret)
subroutine psi_z_amsort_up(n,k,l,iret)
use psb_const_mod
use psi_acx_mod
implicit none
@ -462,9 +463,9 @@ contains
end do outer
end do mergepass
end subroutine in_amsort_up
end subroutine psi_z_amsort_up
subroutine in_amsort_dw(n,k,l,iret)
subroutine psi_z_amsort_dw(n,k,l,iret)
use psb_const_mod
use psi_acx_mod
implicit none
@ -567,9 +568,9 @@ contains
end do outer
end do mergepass
end subroutine in_amsort_dw
end subroutine psi_z_amsort_dw
subroutine in_almsort_up(n,k,l,iret)
subroutine psi_z_almsort_up(n,k,l,iret)
use psb_const_mod
use psi_alcx_mod
implicit none
@ -672,9 +673,9 @@ contains
end do outer
end do mergepass
end subroutine in_almsort_up
end subroutine psi_z_almsort_up
subroutine in_almsort_dw(n,k,l,iret)
subroutine psi_z_almsort_dw(n,k,l,iret)
use psb_const_mod
use psi_alcx_mod
implicit none
@ -777,6 +778,5 @@ contains
end do outer
end do mergepass
end subroutine in_almsort_dw
end subroutine psi_z_almsort_dw
end subroutine psb_zmsort

875
base/serial/sort/psb_z_qsort_impl.f90
View File

File diff suppressed because it is too large Load Diff

4
base/serial/sort/psi_alcx_mod.f90
Unescape Escape View File

@ -29,7 +29,7 @@
!!$ POSSIBILITY OF SUCH DAMAGE.
!!$
!!$
module psi_lcx_mod
module psi_alcx_mod
use psb_const_mod
interface operator(<)
module procedure psi_callt, psi_zallt
@ -126,5 +126,5 @@ contains
& (abs(aimag(a))>=abs(aimag(b))))
end function psi_zalge
end module psi_lcx_mod
end module psi_alcx_mod

Write Preview
Loading…
Cancel
Save