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_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_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_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) 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 subroutine psb_cmsort
end interface psb_msort 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 interface psb_qsort
subroutine psb_cqsort(x,ix,dir,flag) subroutine psb_cqsort(x,ix,dir,flag)
import 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 subroutine psb_dmsort
end interface psb_msort 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 interface psb_qsort
subroutine psb_dqsort(x,ix,dir,flag) subroutine psb_dqsort(x,ix,dir,flag)
import 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 subroutine psb_imsort
end interface psb_msort 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 interface psb_qsort
subroutine psb_iqsort(x,ix,dir,flag) subroutine psb_iqsort(x,ix,dir,flag)
import 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 subroutine psb_smsort
end interface psb_msort 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 interface psb_qsort
subroutine psb_sqsort(x,ix,dir,flag) subroutine psb_sqsort(x,ix,dir,flag)
import 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 subroutine psb_zmsort
end interface psb_msort 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 interface psb_qsort
subroutine psb_zqsort(x,ix,dir,flag) subroutine psb_zqsort(x,ix,dir,flag)
import import

9
base/serial/Makefile
Unescape Escape View File

@ -1,7 +1,7 @@
include ../../Make.inc 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_srwextd.o psb_drwextd.o psb_crwextd.o psb_zrwextd.o \
psb_sspspmm.o psb_dspspmm.o psb_cspspmm.o psb_zspspmm.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 \ 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_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_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_sasum_s.o psb_dasum_s.o psb_casum_s.o psb_zasum_s.o
# psb_sort_impl.o
LIBDIR=.. LIBDIR=..
INCDIR=.. INCDIR=..
MODDIR=../modules MODDIR=../modules
FINCLUDES=$(FMFLAG). $(FMFLAG)$(MODDIR) $(FMFLAG)$(INCDIR) FINCLUDES=$(FMFLAG). $(FMFLAG)$(MODDIR) $(FMFLAG)$(INCDIR)
lib: auxd f77d impld lib1 $(FOBJS) lib: auxd f77d impld sortd lib1 $(FOBJS)
$(AR) $(LIBDIR)/$(LIBNAME) $(FOBJS) $(AR) $(LIBDIR)/$(LIBNAME) $(FOBJS)
$(RANLIB) $(LIBDIR)/$(LIBNAME) $(RANLIB) $(LIBDIR)/$(LIBNAME)
@ -34,10 +35,14 @@ f77d:
impld: impld:
cd impl && $(MAKE) lib cd impl && $(MAKE) lib
sortd:
cd sort && $(MAKE) lib
clean: clean:
/bin/rm -f $(FOBJS) *$(.mod) /bin/rm -f $(FOBJS) *$(.mod)
(cd aux; $(MAKE) clean) (cd aux; $(MAKE) clean)
(cd f77; $(MAKE) clean) (cd f77; $(MAKE) clean)
(cd impl; $(MAKE) clean) (cd impl; $(MAKE) clean)
(cd sort; $(MAKE) clean)
veryclean: clean veryclean: clean

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

@ -3,18 +3,19 @@ include ../../../Make.inc
# The object files # The object files
# #
FOBJS = isr.o isrx.o iasr.o iasrx.o msort_up.o msort_dw.o\ FOBJS = idot.o inrm2.o
imsr.o imsrx.o imsru.o iamsort_up.o iamsort_dw.o idot.o inrm2.o\ # FOBJS = isr.o isrx.o iasr.o iasrx.o msort_up.o msort_dw.o\
dsr.o dsrx.o dasr.o dasrx.o dmsr.o dmsrx.o \ # imsr.o imsrx.o imsru.o iamsort_up.o iamsort_dw.o idot.o inrm2.o\
dmsort_up.o dmsort_dw.o damsort_up.o damsort_dw.o \ # dsr.o dsrx.o dasr.o dasrx.o dmsr.o dmsrx.o \
ssr.o ssrx.o sasr.o sasrx.o smsr.o smsrx.o \ # dmsort_up.o dmsort_dw.o damsort_up.o damsort_dw.o \
smsort_up.o smsort_dw.o samsort_up.o samsort_dw.o \ # ssr.o ssrx.o sasr.o sasrx.o smsr.o smsrx.o \
clcmp_mod.o clsr.o clsrx.o \ # smsort_up.o smsort_dw.o samsort_up.o samsort_dw.o \
calcmp_mod.o calsr.o calsrx.o \ # clcmp_mod.o clsr.o clsrx.o \
cacmp_mod.o casr.o casrx.o camsr.o camsrx.o camsort_up.o camsort_dw.o\ # calcmp_mod.o calsr.o calsrx.o \
zlcmp_mod.o zlsr.o zlsrx.o \ # cacmp_mod.o casr.o casrx.o camsr.o camsrx.o camsort_up.o camsort_dw.o\
zalcmp_mod.o zalsr.o zalsrx.o \ # zlcmp_mod.o zlsr.o zlsrx.o \
zacmp_mod.o zasr.o zasrx.o zamsr.o zamsrx.o zamsort_up.o zamsort_dw.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) 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 imx = i+nzl-1
if (nzl > 0) then 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) & if (iret == 0) &
& call psb_ip_reord(nzl,val(i:imx),& & call psb_ip_reord(nzl,val(i:imx),&
& ia(i:imx),ja(i:imx),ix2) & 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 imx = i+nzl-1
if (nzl > 0) then 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) & if (iret == 0) &
& call psb_ip_reord(nzl,vs(i:imx),& & call psb_ip_reord(nzl,vs(i:imx),&
& ias(i:imx),jas(i:imx),ix2) & 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, ! If we did not have enough memory for buffers,
! let's try in place. ! 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) & if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux) & call psb_ip_reord(nzin,val,ia,ja,iaux)
i = 1 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 if (j > nzin) exit
enddo enddo
nzl = j - i 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) & if (iret == 0) &
& call psb_ip_reord(nzl,val(i:i+nzl-1),& & call psb_ip_reord(nzl,val(i:i+nzl-1),&
& ia(i:i+nzl-1),ja(i:i+nzl-1),iaux) & 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 imx = i+nzl-1
if (nzl > 0) then 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) & if (iret == 0) &
& call psb_ip_reord(nzl,val(i:imx),& & call psb_ip_reord(nzl,val(i:imx),&
& ia(i:imx),ja(i:imx),ix2) & 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 imx = i+nzl-1
if (nzl > 0) then 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) & if (iret == 0) &
& call psb_ip_reord(nzl,vs(i:imx),& & call psb_ip_reord(nzl,vs(i:imx),&
& ias(i:imx),jas(i:imx),ix2) & 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 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) & if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux) & call psb_ip_reord(nzin,val,ia,ja,iaux)
i = 1 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 if (j > nzin) exit
enddo enddo
nzl = j - i 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) & if (iret == 0) &
& call psb_ip_reord(nzl,val(i:i+nzl-1),& & call psb_ip_reord(nzl,val(i:i+nzl-1),&
& ia(i:i+nzl-1),ja(i:i+nzl-1),iaux) & 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_) :: ma,na,mb,nb
integer(psb_ipk_), allocatable :: icol(:), idxs(:), iaux(:) integer(psb_ipk_), allocatable :: icol(:), idxs(:), iaux(:)
complex(psb_spk_), allocatable :: col(:) complex(psb_spk_), allocatable :: col(:)
type(psb_int_heap) :: heap
integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, & integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, &
& nzc,nnzre, isz, ipb, irwsz, nrc, nze & nzc,nnzre, isz, ipb, irwsz, nrc, nze
complex(psb_spk_) :: cfb 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_) :: ma,na,mb,nb
integer(psb_ipk_), allocatable :: irow(:), idxs(:) integer(psb_ipk_), allocatable :: irow(:), idxs(:)
complex(psb_spk_), allocatable :: row(:) complex(psb_spk_), allocatable :: row(:)
type(psb_int_heap) :: heap
integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, & integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, &
& nzc,nnzre, isz, ipb, irwsz, nrc, nze & nzc,nnzre, isz, ipb, irwsz, nrc, nze
complex(psb_spk_) :: cfb 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 imx = i+nzl-1
if (nzl > 0) then 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) & if (iret == 0) &
& call psb_ip_reord(nzl,val(i:imx),& & call psb_ip_reord(nzl,val(i:imx),&
& ia(i:imx),ja(i:imx),ix2) & 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 imx = i+nzl-1
if (nzl > 0) then 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) & if (iret == 0) &
& call psb_ip_reord(nzl,vs(i:imx),& & call psb_ip_reord(nzl,vs(i:imx),&
& ias(i:imx),jas(i:imx),ix2) & 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, ! If we did not have enough memory for buffers,
! let's try in place. ! 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) & if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux) & call psb_ip_reord(nzin,val,ia,ja,iaux)
i = 1 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 if (j > nzin) exit
enddo enddo
nzl = j - i 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) & if (iret == 0) &
& call psb_ip_reord(nzl,val(i:i+nzl-1),& & call psb_ip_reord(nzl,val(i:i+nzl-1),&
& ia(i:i+nzl-1),ja(i:i+nzl-1),iaux) & 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 imx = i+nzl-1
if (nzl > 0) then 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) & if (iret == 0) &
& call psb_ip_reord(nzl,val(i:imx),& & call psb_ip_reord(nzl,val(i:imx),&
& ia(i:imx),ja(i:imx),ix2) & 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 imx = i+nzl-1
if (nzl > 0) then 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) & if (iret == 0) &
& call psb_ip_reord(nzl,vs(i:imx),& & call psb_ip_reord(nzl,vs(i:imx),&
& ias(i:imx),jas(i:imx),ix2) & 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 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) & if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux) & call psb_ip_reord(nzin,val,ia,ja,iaux)
i = 1 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 if (j > nzin) exit
enddo enddo
nzl = j - i 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) & if (iret == 0) &
& call psb_ip_reord(nzl,val(i:i+nzl-1),& & call psb_ip_reord(nzl,val(i:i+nzl-1),&
& ia(i:i+nzl-1),ja(i:i+nzl-1),iaux) & 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_) :: ma,na,mb,nb
integer(psb_ipk_), allocatable :: icol(:), idxs(:), iaux(:) integer(psb_ipk_), allocatable :: icol(:), idxs(:), iaux(:)
real(psb_dpk_), allocatable :: col(:) real(psb_dpk_), allocatable :: col(:)
type(psb_int_heap) :: heap
integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, & integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, &
& nzc,nnzre, isz, ipb, irwsz, nrc, nze & nzc,nnzre, isz, ipb, irwsz, nrc, nze
real(psb_dpk_) :: cfb 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_) :: ma,na,mb,nb
integer(psb_ipk_), allocatable :: irow(:), idxs(:) integer(psb_ipk_), allocatable :: irow(:), idxs(:)
real(psb_dpk_), allocatable :: row(:) real(psb_dpk_), allocatable :: row(:)
type(psb_int_heap) :: heap
integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, & integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, &
& nzc,nnzre, isz, ipb, irwsz, nrc, nze & nzc,nnzre, isz, ipb, irwsz, nrc, nze
real(psb_dpk_) :: cfb 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 imx = i+nzl-1
if (nzl > 0) then 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) & if (iret == 0) &
& call psb_ip_reord(nzl,val(i:imx),& & call psb_ip_reord(nzl,val(i:imx),&
& ia(i:imx),ja(i:imx),ix2) & 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 imx = i+nzl-1
if (nzl > 0) then 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) & if (iret == 0) &
& call psb_ip_reord(nzl,vs(i:imx),& & call psb_ip_reord(nzl,vs(i:imx),&
& ias(i:imx),jas(i:imx),ix2) & 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, ! If we did not have enough memory for buffers,
! let's try in place. ! 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) & if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux) & call psb_ip_reord(nzin,val,ia,ja,iaux)
i = 1 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 if (j > nzin) exit
enddo enddo
nzl = j - i 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) & if (iret == 0) &
& call psb_ip_reord(nzl,val(i:i+nzl-1),& & call psb_ip_reord(nzl,val(i:i+nzl-1),&
& ia(i:i+nzl-1),ja(i:i+nzl-1),iaux) & 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 imx = i+nzl-1
if (nzl > 0) then 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) & if (iret == 0) &
& call psb_ip_reord(nzl,val(i:imx),& & call psb_ip_reord(nzl,val(i:imx),&
& ia(i:imx),ja(i:imx),ix2) & 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 imx = i+nzl-1
if (nzl > 0) then 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) & if (iret == 0) &
& call psb_ip_reord(nzl,vs(i:imx),& & call psb_ip_reord(nzl,vs(i:imx),&
& ias(i:imx),jas(i:imx),ix2) & 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 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) & if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux) & call psb_ip_reord(nzin,val,ia,ja,iaux)
i = 1 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 if (j > nzin) exit
enddo enddo
nzl = j - i 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) & if (iret == 0) &
& call psb_ip_reord(nzl,val(i:i+nzl-1),& & call psb_ip_reord(nzl,val(i:i+nzl-1),&
& ia(i:i+nzl-1),ja(i:i+nzl-1),iaux) & 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_) :: ma,na,mb,nb
integer(psb_ipk_), allocatable :: icol(:), idxs(:), iaux(:) integer(psb_ipk_), allocatable :: icol(:), idxs(:), iaux(:)
real(psb_spk_), allocatable :: col(:) real(psb_spk_), allocatable :: col(:)
type(psb_int_heap) :: heap
integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, & integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, &
& nzc,nnzre, isz, ipb, irwsz, nrc, nze & nzc,nnzre, isz, ipb, irwsz, nrc, nze
real(psb_spk_) :: cfb 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_) :: ma,na,mb,nb
integer(psb_ipk_), allocatable :: irow(:), idxs(:) integer(psb_ipk_), allocatable :: irow(:), idxs(:)
real(psb_spk_), allocatable :: row(:) real(psb_spk_), allocatable :: row(:)
type(psb_int_heap) :: heap
integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, & integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, &
& nzc,nnzre, isz, ipb, irwsz, nrc, nze & nzc,nnzre, isz, ipb, irwsz, nrc, nze
real(psb_spk_) :: cfb 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 imx = i+nzl-1
if (nzl > 0) then 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) & if (iret == 0) &
& call psb_ip_reord(nzl,val(i:imx),& & call psb_ip_reord(nzl,val(i:imx),&
& ia(i:imx),ja(i:imx),ix2) & 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 imx = i+nzl-1
if (nzl > 0) then 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) & if (iret == 0) &
& call psb_ip_reord(nzl,vs(i:imx),& & call psb_ip_reord(nzl,vs(i:imx),&
& ias(i:imx),jas(i:imx),ix2) & 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, ! If we did not have enough memory for buffers,
! let's try in place. ! 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) & if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux) & call psb_ip_reord(nzin,val,ia,ja,iaux)
i = 1 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 if (j > nzin) exit
enddo enddo
nzl = j - i 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) & if (iret == 0) &
& call psb_ip_reord(nzl,val(i:i+nzl-1),& & call psb_ip_reord(nzl,val(i:i+nzl-1),&
& ia(i:i+nzl-1),ja(i:i+nzl-1),iaux) & 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 imx = i+nzl-1
if (nzl > 0) then 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) & if (iret == 0) &
& call psb_ip_reord(nzl,val(i:imx),& & call psb_ip_reord(nzl,val(i:imx),&
& ia(i:imx),ja(i:imx),ix2) & 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 imx = i+nzl-1
if (nzl > 0) then 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) & if (iret == 0) &
& call psb_ip_reord(nzl,vs(i:imx),& & call psb_ip_reord(nzl,vs(i:imx),&
& ias(i:imx),jas(i:imx),ix2) & 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 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) & if (iret == 0) &
& call psb_ip_reord(nzin,val,ia,ja,iaux) & call psb_ip_reord(nzin,val,ia,ja,iaux)
i = 1 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 if (j > nzin) exit
enddo enddo
nzl = j - i 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) & if (iret == 0) &
& call psb_ip_reord(nzl,val(i:i+nzl-1),& & call psb_ip_reord(nzl,val(i:i+nzl-1),&
& ia(i:i+nzl-1),ja(i:i+nzl-1),iaux) & 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_) :: ma,na,mb,nb
integer(psb_ipk_), allocatable :: icol(:), idxs(:), iaux(:) integer(psb_ipk_), allocatable :: icol(:), idxs(:), iaux(:)
complex(psb_dpk_), allocatable :: col(:) complex(psb_dpk_), allocatable :: col(:)
type(psb_int_heap) :: heap
integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, & integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, &
& nzc,nnzre, isz, ipb, irwsz, nrc, nze & nzc,nnzre, isz, ipb, irwsz, nrc, nze
complex(psb_dpk_) :: cfb 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_) :: ma,na,mb,nb
integer(psb_ipk_), allocatable :: irow(:), idxs(:) integer(psb_ipk_), allocatable :: irow(:), idxs(:)
complex(psb_dpk_), allocatable :: row(:) complex(psb_dpk_), allocatable :: row(:)
type(psb_int_heap) :: heap
integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, & integer(psb_ipk_) :: i,j,k,irw,icl,icf, iret, &
& nzc,nnzre, isz, ipb, irwsz, nrc, nze & nzc,nnzre, isz, ipb, irwsz, nrc, nze
complex(psb_dpk_) :: cfb complex(psb_dpk_) :: cfb

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

@ -4,12 +4,13 @@ include ../../../Make.inc
# The object files # The object files
# #
BOBJS=psi_lcx_mod.o psi_alcx_mod.o psi_acx_mod.o 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 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 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 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 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. # 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_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, n, i, l, err_act,info 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_) :: index
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
@ -391,7 +391,7 @@ contains
end subroutine psi_c_insert_heap end subroutine psi_c_insert_heap
subroutine psi_c_heap_get_first(key,last,heap,dir,info) 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 implicit none
! !
@ -633,7 +633,7 @@ contains
end subroutine psi_c_heap_get_first end subroutine psi_c_heap_get_first
subroutine psi_c_idx_insert_heap(key,index,last,heap,idxs,dir,info) 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 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) 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 implicit none
! !
@ -905,22 +905,22 @@ subroutine psi_c_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
info = -4 info = -4
case (psb_asort_up_) case (psb_asort_up_)
call fix_aup(last,heap) call fix_aup(last,heap,idxs)
case (psb_asort_down_) case (psb_asort_down_)
call fix_adw(last,heap) call fix_adw(last,heap,idxs)
case (psb_alsort_up_) case (psb_alsort_up_)
call fix_alup(last,heap) call fix_alup(last,heap,idxs)
case (psb_alsort_down_) case (psb_alsort_down_)
call fix_aldw(last,heap) call fix_aldw(last,heap,idxs)
case (psb_lsort_up_) case (psb_lsort_up_)
call fix_lup(last,heap) call fix_lup(last,heap,idxs)
case (psb_lsort_down_) case (psb_lsort_down_)
call fix_ldw(last,heap) call fix_ldw(last,heap,idxs)
case default case default
write(psb_err_unit,*) 'Invalid direction in heap ',dir write(psb_err_unit,*) 'Invalid direction in heap ',dir
@ -933,7 +933,7 @@ contains
use psi_acx_mod use psi_acx_mod
integer(psb_ipk_), intent(in) :: last integer(psb_ipk_), intent(in) :: last
complex(psb_spk_), intent(inout) :: heap(:) complex(psb_spk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:) integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp integer(psb_ipk_) :: i,j, itemp
complex(psb_spk_) :: temp complex(psb_spk_) :: temp
@ -968,7 +968,7 @@ contains
use psi_acx_mod use psi_acx_mod
integer(psb_ipk_), intent(in) :: last integer(psb_ipk_), intent(in) :: last
complex(psb_spk_), intent(inout) :: heap(:) complex(psb_spk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:) integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp integer(psb_ipk_) :: i,j, itemp
complex(psb_spk_) :: temp complex(psb_spk_) :: temp
@ -1002,7 +1002,7 @@ contains
use psi_lcx_mod use psi_lcx_mod
integer(psb_ipk_), intent(in) :: last integer(psb_ipk_), intent(in) :: last
complex(psb_spk_), intent(inout) :: heap(:) complex(psb_spk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:) integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp integer(psb_ipk_) :: i,j, itemp
complex(psb_spk_) :: temp complex(psb_spk_) :: temp
@ -1036,7 +1036,7 @@ contains
use psi_lcx_mod use psi_lcx_mod
integer(psb_ipk_), intent(in) :: last integer(psb_ipk_), intent(in) :: last
complex(psb_spk_), intent(inout) :: heap(:) complex(psb_spk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:) integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp integer(psb_ipk_) :: i,j, itemp
complex(psb_spk_) :: temp complex(psb_spk_) :: temp
@ -1070,7 +1070,7 @@ contains
use psi_alcx_mod use psi_alcx_mod
integer(psb_ipk_), intent(in) :: last integer(psb_ipk_), intent(in) :: last
complex(psb_spk_), intent(inout) :: heap(:) complex(psb_spk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:) integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp integer(psb_ipk_) :: i,j, itemp
complex(psb_spk_) :: temp complex(psb_spk_) :: temp
@ -1104,7 +1104,7 @@ contains
use psi_alcx_mod use psi_alcx_mod
integer(psb_ipk_), intent(in) :: last integer(psb_ipk_), intent(in) :: last
complex(psb_spk_), intent(inout) :: heap(:) complex(psb_spk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:) integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp integer(psb_ipk_) :: i,j, itemp
complex(psb_spk_) :: temp complex(psb_spk_) :: temp
@ -1134,7 +1134,7 @@ contains
end subroutine fix_aldw 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 return
end subroutine psb_cisort 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_c_sort_mod, psb_protect_name => psi_clisrx_up
use psb_error_mod use psb_error_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
complex(psb_spk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
complex(psb_spk_) :: xx complex(psb_spk_) :: xx
@ -167,13 +167,13 @@ subroutine psi_clisrx_up(n,x,ix)
end subroutine psi_clisrx_up 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_c_sort_mod, psb_protect_name => psi_clisrx_dw
use psb_error_mod use psb_error_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
complex(psb_spk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
complex(psb_spk_) :: xx complex(psb_spk_) :: xx
@ -246,13 +246,13 @@ subroutine psi_clisr_dw(n,x)
enddo enddo
end subroutine psi_clisr_dw 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_c_sort_mod, psb_protect_name => psi_calisrx_up
use psb_error_mod use psb_error_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
complex(psb_spk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
complex(psb_spk_) :: xx complex(psb_spk_) :: xx
@ -275,13 +275,13 @@ subroutine psi_calisrx_up(n,x,ix)
enddo enddo
end subroutine psi_calisrx_up 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_c_sort_mod, psb_protect_name => psi_calisrx_dw
use psb_error_mod use psb_error_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
complex(psb_spk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
complex(psb_spk_) :: xx complex(psb_spk_) :: xx
@ -354,12 +354,12 @@ subroutine psi_calisr_dw(n,x)
enddo enddo
end subroutine psi_calisr_dw 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_c_sort_mod, psb_protect_name => psi_caisrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_spk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
complex(psb_spk_) :: xx complex(psb_spk_) :: xx
@ -382,12 +382,12 @@ subroutine psi_caisrx_up(n,x,ix)
enddo enddo
end subroutine psi_caisrx_up 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_c_sort_mod, psb_protect_name => psi_caisrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_spk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
complex(psb_spk_) :: xx 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 goto 9999
endif endif
select case(idir) select case(dir_)
case (psb_lsort_up_) 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_) case (psb_lsort_down_)
call in_lmsort_dw(n,x,iaux,iret) call psi_c_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)
case (psb_alsort_up_) 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_) 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 end select
! !
! Do the actual reordering, since the inner routines ! Do the actual reordering, since the inner routines
@ -135,7 +135,7 @@ subroutine psb_cmsort(x,ix,dir,flag)
! !
if (iret == 0 ) then if (iret == 0 ) then
if (present(ix)) then if (present(ix)) then
call psb_ip_reord(n,x,indx,iaux) call psb_ip_reord(n,x,ix,iaux)
else else
call psb_ip_reord(n,x,iaux) call psb_ip_reord(n,x,iaux)
end if end if
@ -147,9 +147,10 @@ subroutine psb_cmsort(x,ix,dir,flag)
return 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 psb_const_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
@ -252,9 +253,9 @@ contains
end do outer end do outer
end do mergepass 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 psb_const_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
@ -357,9 +358,9 @@ contains
end do outer end do outer
end do mergepass 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 psb_const_mod
use psi_acx_mod use psi_acx_mod
implicit none implicit none
@ -462,9 +463,9 @@ contains
end do outer end do outer
end do mergepass 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 psb_const_mod
use psi_acx_mod use psi_acx_mod
implicit none implicit none
@ -567,9 +568,9 @@ contains
end do outer end do outer
end do mergepass 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 psb_const_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
@ -672,9 +673,9 @@ contains
end do outer end do outer
end do mergepass 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 psb_const_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
@ -777,6 +778,5 @@ contains
end do outer end do outer
end do mergepass 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_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, n, i, l, err_act,info 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_) :: index
integer(psb_ipk_) :: ierr(5) 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 return
end subroutine psb_disort 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_d_sort_mod, psb_protect_name => psi_disrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_dpk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
real(psb_dpk_) :: xx real(psb_dpk_) :: xx
@ -157,12 +157,12 @@ subroutine psi_disrx_up(n,x,ix)
enddo enddo
end subroutine psi_disrx_up 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_d_sort_mod, psb_protect_name => psi_disrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_dpk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
real(psb_dpk_) :: xx real(psb_dpk_) :: xx
@ -234,12 +234,12 @@ subroutine psi_disr_dw(n,x)
enddo enddo
end subroutine psi_disr_dw 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_d_sort_mod, psb_protect_name => psi_daisrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_dpk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
real(psb_dpk_) :: xx real(psb_dpk_) :: xx
@ -262,12 +262,12 @@ subroutine psi_daisrx_up(n,x,ix)
enddo enddo
end subroutine psi_daisrx_up 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_d_sort_mod, psb_protect_name => psi_daisrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_dpk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
real(psb_dpk_) :: xx 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 goto 9999
endif endif
select case(idir) select case(dir_)
case (psb_sort_up_) 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_) 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_) 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_) case (psb_asort_down_)
call in_amsort_dw(n,x,iaux,iret) call psi_d_amsort_dw(n,x,iaux,iret)
end select end select
! !
! Do the actual reordering, since the inner routines ! Do the actual reordering, since the inner routines
@ -124,7 +124,7 @@ subroutine psb_dmsort(x,ix,dir,flag)
! !
if (iret == 0 ) then if (iret == 0 ) then
if (present(ix)) then if (present(ix)) then
call psb_ip_reord(n,x,indx,iaux) call psb_ip_reord(n,x,ix,iaux)
else else
call psb_ip_reord(n,x,iaux) call psb_ip_reord(n,x,iaux)
end if end if
@ -137,9 +137,10 @@ subroutine psb_dmsort(x,ix,dir,flag)
return 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 use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
@ -241,9 +242,9 @@ contains
end do outer end do outer
end do mergepass 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 use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
@ -345,9 +346,9 @@ contains
end do outer end do outer
end do mergepass 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 use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
@ -449,9 +450,9 @@ contains
end do outer end do outer
end do mergepass 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 use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
@ -553,11 +554,9 @@ contains
end do outer end do outer
end do mergepass 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(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:) 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) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
@ -129,15 +129,13 @@ subroutine psb_dqsort(x,ix,dir,flag)
return return
end subroutine psb_dqsort end subroutine psb_dqsort
subroutine psi_dqsrx_up(n,x,idx)
subroutine psi_dqsrx_up(n,x,ix)
use psb_d_sort_mod, psb_protect_name => psi_dqsrx_up use psb_d_sort_mod, psb_protect_name => psi_dqsrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_dpk_), intent(inout) :: x(:) 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_), intent(in) :: n
! .. Local Scalars .. ! .. Local Scalars ..
real(psb_dpk_) :: piv, xk, xt real(psb_dpk_) :: piv, xk, xt
@ -170,39 +168,39 @@ subroutine psi_dqsrx_up(n,x,ix)
piv = x(lpiv) piv = x(lpiv)
if (piv < x(i)) then if (piv < x(i)) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
if (piv > x(j)) then if (piv > x(j)) then
xt = x(j) xt = x(j)
ixt = indx(j) ixt = idx(j)
x(j) = x(lpiv) x(j) = x(lpiv)
indx(j) = indx(lpiv) idx(j) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
if (piv < x(i)) then if (piv < x(i)) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
! !
! now piv is correct; place it into first location ! now piv is correct; place it into first location
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
i = ilx - 1 i = ilx - 1
@ -228,11 +226,11 @@ subroutine psi_dqsrx_up(n,x,ix)
if (j > i) then if (j > i) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(j) x(i) = x(j)
indx(i) = indx(j) idx(i) = idx(j)
x(j) = xt x(j) = xt
indx(j) = ixt idx(j) = ixt
else else
exit outer_up exit outer_up
end if end if
@ -254,14 +252,14 @@ subroutine psi_dqsrx_up(n,x,ix)
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
if (n2 > ithrs) then if (n2 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_disrx_up(n2,x(i:iux),indx(i:iux)) call psi_disrx_up(n2,x(i:iux),idx(i:iux))
endif endif
else else
if (n2 > ithrs) then if (n2 > ithrs) then
@ -269,29 +267,29 @@ subroutine psi_dqsrx_up(n,x,ix)
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_disrx_up(n2,x(i:iux),indx(i:iux)) call psi_disrx_up(n2,x(i:iux),idx(i:iux))
endif endif
if (n1 > ithrs) then if (n1 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
endif endif
enddo enddo
else else
call psi_disrx_up(n,x,indx) call psi_disrx_up(n,x,idx)
endif endif
end subroutine psi_dqsrx_up 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_d_sort_mod, psb_protect_name => psi_dqsrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_dpk_), intent(inout) :: x(:) 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_), intent(in) :: n
! .. Local Scalars .. ! .. Local Scalars ..
real(psb_dpk_) :: piv, xk, xt real(psb_dpk_) :: piv, xk, xt
@ -324,39 +322,39 @@ subroutine psi_dqsrx_dw(n,x,ix)
piv = x(lpiv) piv = x(lpiv)
if (piv > x(i)) then if (piv > x(i)) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
if (piv < x(j)) then if (piv < x(j)) then
xt = x(j) xt = x(j)
ixt = indx(j) ixt = idx(j)
x(j) = x(lpiv) x(j) = x(lpiv)
indx(j) = indx(lpiv) idx(j) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
if (piv > x(i)) then if (piv > x(i)) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
! !
! now piv is correct; place it into first location ! now piv is correct; place it into first location
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
i = ilx - 1 i = ilx - 1
@ -382,11 +380,11 @@ subroutine psi_dqsrx_dw(n,x,ix)
if (j > i) then if (j > i) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(j) x(i) = x(j)
indx(i) = indx(j) idx(i) = idx(j)
x(j) = xt x(j) = xt
indx(j) = ixt idx(j) = ixt
else else
exit outer_dw exit outer_dw
end if end if
@ -408,14 +406,14 @@ subroutine psi_dqsrx_dw(n,x,ix)
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
if (n2 > ithrs) then if (n2 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_disrx_dw(n2,x(i:iux),indx(i:iux)) call psi_disrx_dw(n2,x(i:iux),idx(i:iux))
endif endif
else else
if (n2 > ithrs) then if (n2 > ithrs) then
@ -423,19 +421,19 @@ subroutine psi_dqsrx_dw(n,x,ix)
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_disrx_dw(n2,x(i:iux),indx(i:iux)) call psi_disrx_dw(n2,x(i:iux),idx(i:iux))
endif endif
if (n1 > ithrs) then if (n1 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
endif endif
enddo enddo
else else
call psi_disrx_dw(n,x,indx) call psi_disrx_dw(n,x,idx)
endif endif
end subroutine psi_dqsrx_dw end subroutine psi_dqsrx_dw
@ -590,7 +588,7 @@ subroutine psi_dqsr_dw(n,x)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
! .. ! ..
! .. Local Scalars .. ! .. 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_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: n1, n2 integer(psb_ipk_) :: n1, n2
@ -722,16 +720,17 @@ subroutine psi_dqsr_dw(n,x)
end subroutine psi_dqsr_dw 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_d_sort_mod, psb_protect_name => psi_daqsrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_dpk_), intent(inout) :: x(:) 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_), intent(in) :: n
! .. Local Scalars .. ! .. 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_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2 integer(psb_ipk_) :: ixt, n1, n2
@ -761,39 +760,39 @@ subroutine psi_daqsrx_up(n,x,ix)
piv = abs(x(lpiv)) piv = abs(x(lpiv))
if (piv < abs(x(i))) then if (piv < abs(x(i))) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
if (piv > abs(x(j))) then if (piv > abs(x(j))) then
xt = x(j) xt = x(j)
ixt = indx(j) ixt = idx(j)
x(j) = x(lpiv) x(j) = x(lpiv)
indx(j) = indx(lpiv) idx(j) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
if (piv < abs(x(i))) then if (piv < abs(x(i))) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
! !
! now piv is correct; place it into first location ! now piv is correct; place it into first location
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
i = ilx - 1 i = ilx - 1
j = iux + 1 j = iux + 1
@ -818,11 +817,11 @@ subroutine psi_daqsrx_up(n,x,ix)
if (j > i) then if (j > i) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(j) x(i) = x(j)
indx(i) = indx(j) idx(i) = idx(j)
x(j) = xt x(j) = xt
indx(j) = ixt idx(j) = ixt
else else
exit outer_up exit outer_up
end if end if
@ -844,14 +843,14 @@ subroutine psi_daqsrx_up(n,x,ix)
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
if (n2 > ithrs) then if (n2 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_daisrx_up(n2,x(i:iux),indx(i:iux)) call psi_daisrx_up(n2,x(i:iux),idx(i:iux))
endif endif
else else
if (n2 > ithrs) then if (n2 > ithrs) then
@ -859,34 +858,35 @@ subroutine psi_daqsrx_up(n,x,ix)
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_daisrx_up(n2,x(i:iux),indx(i:iux)) call psi_daisrx_up(n2,x(i:iux),idx(i:iux))
endif endif
if (n1 > ithrs) then if (n1 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
endif endif
enddo enddo
else else
call psi_daisrx_up(n,x,indx) call psi_daisrx_up(n,x,idx)
endif endif
end subroutine psi_daqsrx_up 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_d_sort_mod, psb_protect_name => psi_daqsrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_dpk_), intent(inout) :: x(:) 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_), intent(in) :: n
! .. Local Scalars .. ! .. 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_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2 integer(psb_ipk_) :: ixt, n1, n2
@ -915,39 +915,39 @@ subroutine psi_daqsrx_dw(n,x,ix)
piv = abs(x(lpiv)) piv = abs(x(lpiv))
if (piv > abs(x(i))) then if (piv > abs(x(i))) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
if (piv < abs(x(j))) then if (piv < abs(x(j))) then
xt = x(j) xt = x(j)
ixt = indx(j) ixt = idx(j)
x(j) = x(lpiv) x(j) = x(lpiv)
indx(j) = indx(lpiv) idx(j) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
if (piv > abs(x(i))) then if (piv > abs(x(i))) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
! !
! now piv is correct; place it into first location ! now piv is correct; place it into first location
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
i = ilx - 1 i = ilx - 1
j = iux + 1 j = iux + 1
@ -972,11 +972,11 @@ subroutine psi_daqsrx_dw(n,x,ix)
if (j > i) then if (j > i) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(j) x(i) = x(j)
indx(i) = indx(j) idx(i) = idx(j)
x(j) = xt x(j) = xt
indx(j) = ixt idx(j) = ixt
else else
exit outer_dw exit outer_dw
end if end if
@ -998,14 +998,14 @@ subroutine psi_daqsrx_dw(n,x,ix)
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
if (n2 > ithrs) then if (n2 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_daisrx_dw(n2,x(i:iux),indx(i:iux)) call psi_daisrx_dw(n2,x(i:iux),idx(i:iux))
endif endif
else else
if (n2 > ithrs) then if (n2 > ithrs) then
@ -1013,19 +1013,19 @@ subroutine psi_daqsrx_dw(n,x,ix)
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_daisrx_dw(n2,x(i:iux),indx(i:iux)) call psi_daisrx_dw(n2,x(i:iux),idx(i:iux))
endif endif
if (n1 > ithrs) then if (n1 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
endif endif
enddo enddo
else else
call psi_daisrx_dw(n,x,indx) call psi_daisrx_dw(n,x,idx)
endif endif
end subroutine psi_daqsrx_dw end subroutine psi_daqsrx_dw
@ -1038,7 +1038,8 @@ subroutine psi_daqsr_up(n,x)
real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
! .. Local Scalars .. ! .. 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_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2 integer(psb_ipk_) :: ixt, n1, n2
@ -1177,7 +1178,8 @@ subroutine psi_daqsr_dw(n,x)
real(psb_dpk_), intent(inout) :: x(:) real(psb_dpk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
! .. Local Scalars .. ! .. 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_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2 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_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, n, i, l, err_act,info 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_) :: index
integer(psb_ipk_) :: ierr(5) 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 return
end subroutine psb_iisort 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_i_sort_mod, psb_protect_name => psi_iisrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_ipk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: xx integer(psb_ipk_) :: xx
@ -157,12 +157,12 @@ subroutine psi_iisrx_up(n,x,ix)
enddo enddo
end subroutine psi_iisrx_up 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_i_sort_mod, psb_protect_name => psi_iisrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_ipk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: xx integer(psb_ipk_) :: xx
@ -234,12 +234,12 @@ subroutine psi_iisr_dw(n,x)
enddo enddo
end subroutine psi_iisr_dw 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_i_sort_mod, psb_protect_name => psi_iaisrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_ipk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: xx integer(psb_ipk_) :: xx
@ -262,12 +262,12 @@ subroutine psi_iaisrx_up(n,x,ix)
enddo enddo
end subroutine psi_iaisrx_up 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_i_sort_mod, psb_protect_name => psi_iaisrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_ipk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
integer(psb_ipk_) :: xx 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) n = size(x)
call psb_imsort(x,dir_) call psb_imsort(x,dir=dir_)
nout = min(1,n) nout = min(1,n)
do k=2,n do k=2,n
if (x(k) /= x(nout)) then if (x(k) /= x(nout)) then
@ -299,15 +299,15 @@ subroutine psb_imsort(x,ix,dir,flag)
goto 9999 goto 9999
endif endif
select case(idir) select case(dir_)
case (psb_sort_up_) 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_) 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_) 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_) case (psb_asort_down_)
call in_amsort_dw(n,x,iaux,iret) call psi_i_amsort_dw(n,x,iaux,iret)
end select end select
! !
! Do the actual reordering, since the inner routines ! Do the actual reordering, since the inner routines
@ -315,7 +315,7 @@ subroutine psb_imsort(x,ix,dir,flag)
! !
if (iret == 0 ) then if (iret == 0 ) then
if (present(ix)) then if (present(ix)) then
call psb_ip_reord(n,x,indx,iaux) call psb_ip_reord(n,x,ix,iaux)
else else
call psb_ip_reord(n,x,iaux) call psb_ip_reord(n,x,iaux)
end if end if
@ -328,9 +328,10 @@ subroutine psb_imsort(x,ix,dir,flag)
return 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 use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
@ -432,9 +433,9 @@ contains
end do outer end do outer
end do mergepass 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 use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
@ -536,9 +537,9 @@ contains
end do outer end do outer
end do mergepass 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 use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
@ -640,9 +641,9 @@ contains
end do outer end do outer
end do mergepass 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 use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
@ -744,11 +745,9 @@ contains
end do outer end do outer
end do mergepass 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(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:) 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) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
@ -129,15 +129,13 @@ subroutine psb_iqsort(x,ix,dir,flag)
return return
end subroutine psb_iqsort end subroutine psb_iqsort
subroutine psi_iqsrx_up(n,x,idx)
subroutine psi_iqsrx_up(n,x,ix)
use psb_i_sort_mod, psb_protect_name => psi_iqsrx_up use psb_i_sort_mod, psb_protect_name => psi_iqsrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_ipk_), intent(inout) :: x(:) 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_), intent(in) :: n
! .. Local Scalars .. ! .. Local Scalars ..
integer(psb_ipk_) :: piv, xk, xt integer(psb_ipk_) :: piv, xk, xt
@ -170,39 +168,39 @@ subroutine psi_iqsrx_up(n,x,ix)
piv = x(lpiv) piv = x(lpiv)
if (piv < x(i)) then if (piv < x(i)) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
if (piv > x(j)) then if (piv > x(j)) then
xt = x(j) xt = x(j)
ixt = indx(j) ixt = idx(j)
x(j) = x(lpiv) x(j) = x(lpiv)
indx(j) = indx(lpiv) idx(j) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
if (piv < x(i)) then if (piv < x(i)) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
! !
! now piv is correct; place it into first location ! now piv is correct; place it into first location
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
i = ilx - 1 i = ilx - 1
@ -228,11 +226,11 @@ subroutine psi_iqsrx_up(n,x,ix)
if (j > i) then if (j > i) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(j) x(i) = x(j)
indx(i) = indx(j) idx(i) = idx(j)
x(j) = xt x(j) = xt
indx(j) = ixt idx(j) = ixt
else else
exit outer_up exit outer_up
end if end if
@ -254,14 +252,14 @@ subroutine psi_iqsrx_up(n,x,ix)
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
if (n2 > ithrs) then if (n2 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_iisrx_up(n2,x(i:iux),indx(i:iux)) call psi_iisrx_up(n2,x(i:iux),idx(i:iux))
endif endif
else else
if (n2 > ithrs) then if (n2 > ithrs) then
@ -269,29 +267,29 @@ subroutine psi_iqsrx_up(n,x,ix)
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_iisrx_up(n2,x(i:iux),indx(i:iux)) call psi_iisrx_up(n2,x(i:iux),idx(i:iux))
endif endif
if (n1 > ithrs) then if (n1 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
endif endif
enddo enddo
else else
call psi_iisrx_up(n,x,indx) call psi_iisrx_up(n,x,idx)
endif endif
end subroutine psi_iqsrx_up 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_i_sort_mod, psb_protect_name => psi_iqsrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_ipk_), intent(inout) :: x(:) 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_), intent(in) :: n
! .. Local Scalars .. ! .. Local Scalars ..
integer(psb_ipk_) :: piv, xk, xt integer(psb_ipk_) :: piv, xk, xt
@ -324,39 +322,39 @@ subroutine psi_iqsrx_dw(n,x,ix)
piv = x(lpiv) piv = x(lpiv)
if (piv > x(i)) then if (piv > x(i)) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
if (piv < x(j)) then if (piv < x(j)) then
xt = x(j) xt = x(j)
ixt = indx(j) ixt = idx(j)
x(j) = x(lpiv) x(j) = x(lpiv)
indx(j) = indx(lpiv) idx(j) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
if (piv > x(i)) then if (piv > x(i)) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
! !
! now piv is correct; place it into first location ! now piv is correct; place it into first location
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
i = ilx - 1 i = ilx - 1
@ -382,11 +380,11 @@ subroutine psi_iqsrx_dw(n,x,ix)
if (j > i) then if (j > i) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(j) x(i) = x(j)
indx(i) = indx(j) idx(i) = idx(j)
x(j) = xt x(j) = xt
indx(j) = ixt idx(j) = ixt
else else
exit outer_dw exit outer_dw
end if end if
@ -408,14 +406,14 @@ subroutine psi_iqsrx_dw(n,x,ix)
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
if (n2 > ithrs) then if (n2 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_iisrx_dw(n2,x(i:iux),indx(i:iux)) call psi_iisrx_dw(n2,x(i:iux),idx(i:iux))
endif endif
else else
if (n2 > ithrs) then if (n2 > ithrs) then
@ -423,19 +421,19 @@ subroutine psi_iqsrx_dw(n,x,ix)
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_iisrx_dw(n2,x(i:iux),indx(i:iux)) call psi_iisrx_dw(n2,x(i:iux),idx(i:iux))
endif endif
if (n1 > ithrs) then if (n1 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
endif endif
enddo enddo
else else
call psi_iisrx_dw(n,x,indx) call psi_iisrx_dw(n,x,idx)
endif endif
end subroutine psi_iqsrx_dw end subroutine psi_iqsrx_dw
@ -590,7 +588,7 @@ subroutine psi_iqsr_dw(n,x)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
! .. ! ..
! .. Local Scalars .. ! .. 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_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: n1, n2 integer(psb_ipk_) :: n1, n2
@ -722,16 +720,17 @@ subroutine psi_iqsr_dw(n,x)
end subroutine psi_iqsr_dw 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_i_sort_mod, psb_protect_name => psi_iaqsrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_ipk_), intent(inout) :: x(:) 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_), intent(in) :: n
! .. Local Scalars .. ! .. 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_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2 integer(psb_ipk_) :: ixt, n1, n2
@ -761,39 +760,39 @@ subroutine psi_iaqsrx_up(n,x,ix)
piv = abs(x(lpiv)) piv = abs(x(lpiv))
if (piv < abs(x(i))) then if (piv < abs(x(i))) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
if (piv > abs(x(j))) then if (piv > abs(x(j))) then
xt = x(j) xt = x(j)
ixt = indx(j) ixt = idx(j)
x(j) = x(lpiv) x(j) = x(lpiv)
indx(j) = indx(lpiv) idx(j) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
if (piv < abs(x(i))) then if (piv < abs(x(i))) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
! !
! now piv is correct; place it into first location ! now piv is correct; place it into first location
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
i = ilx - 1 i = ilx - 1
j = iux + 1 j = iux + 1
@ -818,11 +817,11 @@ subroutine psi_iaqsrx_up(n,x,ix)
if (j > i) then if (j > i) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(j) x(i) = x(j)
indx(i) = indx(j) idx(i) = idx(j)
x(j) = xt x(j) = xt
indx(j) = ixt idx(j) = ixt
else else
exit outer_up exit outer_up
end if end if
@ -844,14 +843,14 @@ subroutine psi_iaqsrx_up(n,x,ix)
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
if (n2 > ithrs) then if (n2 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_iaisrx_up(n2,x(i:iux),indx(i:iux)) call psi_iaisrx_up(n2,x(i:iux),idx(i:iux))
endif endif
else else
if (n2 > ithrs) then if (n2 > ithrs) then
@ -859,34 +858,35 @@ subroutine psi_iaqsrx_up(n,x,ix)
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_iaisrx_up(n2,x(i:iux),indx(i:iux)) call psi_iaisrx_up(n2,x(i:iux),idx(i:iux))
endif endif
if (n1 > ithrs) then if (n1 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
endif endif
enddo enddo
else else
call psi_iaisrx_up(n,x,indx) call psi_iaisrx_up(n,x,idx)
endif endif
end subroutine psi_iaqsrx_up 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_i_sort_mod, psb_protect_name => psi_iaqsrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
integer(psb_ipk_), intent(inout) :: x(:) 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_), intent(in) :: n
! .. Local Scalars .. ! .. 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_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2 integer(psb_ipk_) :: ixt, n1, n2
@ -915,39 +915,39 @@ subroutine psi_iaqsrx_dw(n,x,ix)
piv = abs(x(lpiv)) piv = abs(x(lpiv))
if (piv > abs(x(i))) then if (piv > abs(x(i))) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
if (piv < abs(x(j))) then if (piv < abs(x(j))) then
xt = x(j) xt = x(j)
ixt = indx(j) ixt = idx(j)
x(j) = x(lpiv) x(j) = x(lpiv)
indx(j) = indx(lpiv) idx(j) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
if (piv > abs(x(i))) then if (piv > abs(x(i))) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
! !
! now piv is correct; place it into first location ! now piv is correct; place it into first location
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
i = ilx - 1 i = ilx - 1
j = iux + 1 j = iux + 1
@ -972,11 +972,11 @@ subroutine psi_iaqsrx_dw(n,x,ix)
if (j > i) then if (j > i) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(j) x(i) = x(j)
indx(i) = indx(j) idx(i) = idx(j)
x(j) = xt x(j) = xt
indx(j) = ixt idx(j) = ixt
else else
exit outer_dw exit outer_dw
end if end if
@ -998,14 +998,14 @@ subroutine psi_iaqsrx_dw(n,x,ix)
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
if (n2 > ithrs) then if (n2 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_iaisrx_dw(n2,x(i:iux),indx(i:iux)) call psi_iaisrx_dw(n2,x(i:iux),idx(i:iux))
endif endif
else else
if (n2 > ithrs) then if (n2 > ithrs) then
@ -1013,19 +1013,19 @@ subroutine psi_iaqsrx_dw(n,x,ix)
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_iaisrx_dw(n2,x(i:iux),indx(i:iux)) call psi_iaisrx_dw(n2,x(i:iux),idx(i:iux))
endif endif
if (n1 > ithrs) then if (n1 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
endif endif
enddo enddo
else else
call psi_iaisrx_dw(n,x,indx) call psi_iaisrx_dw(n,x,idx)
endif endif
end subroutine psi_iaqsrx_dw 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(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
! .. Local Scalars .. ! .. 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_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2 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(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
! .. Local Scalars .. ! .. 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_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2 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 return
end subroutine psb_sisort 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_s_sort_mod, psb_protect_name => psi_sisrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_spk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
real(psb_spk_) :: xx real(psb_spk_) :: xx
@ -157,12 +157,12 @@ subroutine psi_sisrx_up(n,x,ix)
enddo enddo
end subroutine psi_sisrx_up 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_s_sort_mod, psb_protect_name => psi_sisrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_spk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
real(psb_spk_) :: xx real(psb_spk_) :: xx
@ -234,12 +234,12 @@ subroutine psi_sisr_dw(n,x)
enddo enddo
end subroutine psi_sisr_dw 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_s_sort_mod, psb_protect_name => psi_saisrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_spk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
real(psb_spk_) :: xx real(psb_spk_) :: xx
@ -262,12 +262,12 @@ subroutine psi_saisrx_up(n,x,ix)
enddo enddo
end subroutine psi_saisrx_up 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_s_sort_mod, psb_protect_name => psi_saisrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_spk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
real(psb_spk_) :: xx 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 goto 9999
endif endif
select case(idir) select case(dir_)
case (psb_sort_up_) 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_) 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_) 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_) case (psb_asort_down_)
call in_amsort_dw(n,x,iaux,iret) call psi_s_amsort_dw(n,x,iaux,iret)
end select end select
! !
! Do the actual reordering, since the inner routines ! Do the actual reordering, since the inner routines
@ -124,7 +124,7 @@ subroutine psb_smsort(x,ix,dir,flag)
! !
if (iret == 0 ) then if (iret == 0 ) then
if (present(ix)) then if (present(ix)) then
call psb_ip_reord(n,x,indx,iaux) call psb_ip_reord(n,x,ix,iaux)
else else
call psb_ip_reord(n,x,iaux) call psb_ip_reord(n,x,iaux)
end if end if
@ -137,9 +137,10 @@ subroutine psb_smsort(x,ix,dir,flag)
return 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 use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
@ -241,9 +242,9 @@ contains
end do outer end do outer
end do mergepass 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 use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
@ -345,9 +346,9 @@ contains
end do outer end do outer
end do mergepass 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 use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
@ -449,9 +450,9 @@ contains
end do outer end do outer
end do mergepass 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 use psb_const_mod
implicit none implicit none
integer(psb_ipk_) :: n, iret integer(psb_ipk_) :: n, iret
@ -553,11 +554,9 @@ contains
end do outer end do outer
end do mergepass 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(in) :: dir, flag
integer(psb_ipk_), optional, intent(inout) :: ix(:) 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) integer(psb_ipk_) :: ierr(5)
character(len=20) :: name character(len=20) :: name
@ -129,15 +129,13 @@ subroutine psb_sqsort(x,ix,dir,flag)
return return
end subroutine psb_sqsort end subroutine psb_sqsort
subroutine psi_sqsrx_up(n,x,idx)
subroutine psi_sqsrx_up(n,x,ix)
use psb_s_sort_mod, psb_protect_name => psi_sqsrx_up use psb_s_sort_mod, psb_protect_name => psi_sqsrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_spk_), intent(inout) :: x(:) 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_), intent(in) :: n
! .. Local Scalars .. ! .. Local Scalars ..
real(psb_spk_) :: piv, xk, xt real(psb_spk_) :: piv, xk, xt
@ -170,39 +168,39 @@ subroutine psi_sqsrx_up(n,x,ix)
piv = x(lpiv) piv = x(lpiv)
if (piv < x(i)) then if (piv < x(i)) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
if (piv > x(j)) then if (piv > x(j)) then
xt = x(j) xt = x(j)
ixt = indx(j) ixt = idx(j)
x(j) = x(lpiv) x(j) = x(lpiv)
indx(j) = indx(lpiv) idx(j) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
if (piv < x(i)) then if (piv < x(i)) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
! !
! now piv is correct; place it into first location ! now piv is correct; place it into first location
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
i = ilx - 1 i = ilx - 1
@ -228,11 +226,11 @@ subroutine psi_sqsrx_up(n,x,ix)
if (j > i) then if (j > i) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(j) x(i) = x(j)
indx(i) = indx(j) idx(i) = idx(j)
x(j) = xt x(j) = xt
indx(j) = ixt idx(j) = ixt
else else
exit outer_up exit outer_up
end if end if
@ -254,14 +252,14 @@ subroutine psi_sqsrx_up(n,x,ix)
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
if (n2 > ithrs) then if (n2 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_sisrx_up(n2,x(i:iux),indx(i:iux)) call psi_sisrx_up(n2,x(i:iux),idx(i:iux))
endif endif
else else
if (n2 > ithrs) then if (n2 > ithrs) then
@ -269,29 +267,29 @@ subroutine psi_sqsrx_up(n,x,ix)
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_sisrx_up(n2,x(i:iux),indx(i:iux)) call psi_sisrx_up(n2,x(i:iux),idx(i:iux))
endif endif
if (n1 > ithrs) then if (n1 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
endif endif
enddo enddo
else else
call psi_sisrx_up(n,x,indx) call psi_sisrx_up(n,x,idx)
endif endif
end subroutine psi_sqsrx_up 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_s_sort_mod, psb_protect_name => psi_sqsrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_spk_), intent(inout) :: x(:) 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_), intent(in) :: n
! .. Local Scalars .. ! .. Local Scalars ..
real(psb_spk_) :: piv, xk, xt real(psb_spk_) :: piv, xk, xt
@ -324,39 +322,39 @@ subroutine psi_sqsrx_dw(n,x,ix)
piv = x(lpiv) piv = x(lpiv)
if (piv > x(i)) then if (piv > x(i)) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
if (piv < x(j)) then if (piv < x(j)) then
xt = x(j) xt = x(j)
ixt = indx(j) ixt = idx(j)
x(j) = x(lpiv) x(j) = x(lpiv)
indx(j) = indx(lpiv) idx(j) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
if (piv > x(i)) then if (piv > x(i)) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
endif endif
! !
! now piv is correct; place it into first location ! now piv is correct; place it into first location
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = x(lpiv) piv = x(lpiv)
i = ilx - 1 i = ilx - 1
@ -382,11 +380,11 @@ subroutine psi_sqsrx_dw(n,x,ix)
if (j > i) then if (j > i) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(j) x(i) = x(j)
indx(i) = indx(j) idx(i) = idx(j)
x(j) = xt x(j) = xt
indx(j) = ixt idx(j) = ixt
else else
exit outer_dw exit outer_dw
end if end if
@ -408,14 +406,14 @@ subroutine psi_sqsrx_dw(n,x,ix)
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
if (n2 > ithrs) then if (n2 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_sisrx_dw(n2,x(i:iux),indx(i:iux)) call psi_sisrx_dw(n2,x(i:iux),idx(i:iux))
endif endif
else else
if (n2 > ithrs) then if (n2 > ithrs) then
@ -423,19 +421,19 @@ subroutine psi_sqsrx_dw(n,x,ix)
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_sisrx_dw(n2,x(i:iux),indx(i:iux)) call psi_sisrx_dw(n2,x(i:iux),idx(i:iux))
endif endif
if (n1 > ithrs) then if (n1 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
endif endif
enddo enddo
else else
call psi_sisrx_dw(n,x,indx) call psi_sisrx_dw(n,x,idx)
endif endif
end subroutine psi_sqsrx_dw end subroutine psi_sqsrx_dw
@ -590,7 +588,7 @@ subroutine psi_sqsr_dw(n,x)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
! .. ! ..
! .. Local Scalars .. ! .. 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_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: n1, n2 integer(psb_ipk_) :: n1, n2
@ -722,16 +720,17 @@ subroutine psi_sqsr_dw(n,x)
end subroutine psi_sqsr_dw 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_s_sort_mod, psb_protect_name => psi_saqsrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_spk_), intent(inout) :: x(:) 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_), intent(in) :: n
! .. Local Scalars .. ! .. 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_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2 integer(psb_ipk_) :: ixt, n1, n2
@ -761,39 +760,39 @@ subroutine psi_saqsrx_up(n,x,ix)
piv = abs(x(lpiv)) piv = abs(x(lpiv))
if (piv < abs(x(i))) then if (piv < abs(x(i))) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
if (piv > abs(x(j))) then if (piv > abs(x(j))) then
xt = x(j) xt = x(j)
ixt = indx(j) ixt = idx(j)
x(j) = x(lpiv) x(j) = x(lpiv)
indx(j) = indx(lpiv) idx(j) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
if (piv < abs(x(i))) then if (piv < abs(x(i))) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
! !
! now piv is correct; place it into first location ! now piv is correct; place it into first location
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
i = ilx - 1 i = ilx - 1
j = iux + 1 j = iux + 1
@ -818,11 +817,11 @@ subroutine psi_saqsrx_up(n,x,ix)
if (j > i) then if (j > i) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(j) x(i) = x(j)
indx(i) = indx(j) idx(i) = idx(j)
x(j) = xt x(j) = xt
indx(j) = ixt idx(j) = ixt
else else
exit outer_up exit outer_up
end if end if
@ -844,14 +843,14 @@ subroutine psi_saqsrx_up(n,x,ix)
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
if (n2 > ithrs) then if (n2 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_saisrx_up(n2,x(i:iux),indx(i:iux)) call psi_saisrx_up(n2,x(i:iux),idx(i:iux))
endif endif
else else
if (n2 > ithrs) then if (n2 > ithrs) then
@ -859,34 +858,35 @@ subroutine psi_saqsrx_up(n,x,ix)
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_saisrx_up(n2,x(i:iux),indx(i:iux)) call psi_saisrx_up(n2,x(i:iux),idx(i:iux))
endif endif
if (n1 > ithrs) then if (n1 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
endif endif
enddo enddo
else else
call psi_saisrx_up(n,x,indx) call psi_saisrx_up(n,x,idx)
endif endif
end subroutine psi_saqsrx_up 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_s_sort_mod, psb_protect_name => psi_saqsrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
real(psb_spk_), intent(inout) :: x(:) 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_), intent(in) :: n
! .. Local Scalars .. ! .. 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_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2 integer(psb_ipk_) :: ixt, n1, n2
@ -915,39 +915,39 @@ subroutine psi_saqsrx_dw(n,x,ix)
piv = abs(x(lpiv)) piv = abs(x(lpiv))
if (piv > abs(x(i))) then if (piv > abs(x(i))) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
if (piv < abs(x(j))) then if (piv < abs(x(j))) then
xt = x(j) xt = x(j)
ixt = indx(j) ixt = idx(j)
x(j) = x(lpiv) x(j) = x(lpiv)
indx(j) = indx(lpiv) idx(j) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
if (piv > abs(x(i))) then if (piv > abs(x(i))) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
piv = abs(x(lpiv)) piv = abs(x(lpiv))
endif endif
! !
! now piv is correct; place it into first location ! now piv is correct; place it into first location
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(lpiv) x(i) = x(lpiv)
indx(i) = indx(lpiv) idx(i) = idx(lpiv)
x(lpiv) = xt x(lpiv) = xt
indx(lpiv) = ixt idx(lpiv) = ixt
i = ilx - 1 i = ilx - 1
j = iux + 1 j = iux + 1
@ -972,11 +972,11 @@ subroutine psi_saqsrx_dw(n,x,ix)
if (j > i) then if (j > i) then
xt = x(i) xt = x(i)
ixt = indx(i) ixt = idx(i)
x(i) = x(j) x(i) = x(j)
indx(i) = indx(j) idx(i) = idx(j)
x(j) = xt x(j) = xt
indx(j) = ixt idx(j) = ixt
else else
exit outer_dw exit outer_dw
end if end if
@ -998,14 +998,14 @@ subroutine psi_saqsrx_dw(n,x,ix)
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
if (n2 > ithrs) then if (n2 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_saisrx_dw(n2,x(i:iux),indx(i:iux)) call psi_saisrx_dw(n2,x(i:iux),idx(i:iux))
endif endif
else else
if (n2 > ithrs) then if (n2 > ithrs) then
@ -1013,19 +1013,19 @@ subroutine psi_saqsrx_dw(n,x,ix)
istack(1,istp) = i istack(1,istp) = i
istack(2,istp) = iux istack(2,istp) = iux
else else
call psi_saisrx_dw(n2,x(i:iux),indx(i:iux)) call psi_saisrx_dw(n2,x(i:iux),idx(i:iux))
endif endif
if (n1 > ithrs) then if (n1 > ithrs) then
istp = istp + 1 istp = istp + 1
istack(1,istp) = ilx istack(1,istp) = ilx
istack(2,istp) = i-1 istack(2,istp) = i-1
else 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
endif endif
enddo enddo
else else
call psi_saisrx_dw(n,x,indx) call psi_saisrx_dw(n,x,idx)
endif endif
end subroutine psi_saqsrx_dw end subroutine psi_saqsrx_dw
@ -1038,7 +1038,8 @@ subroutine psi_saqsr_up(n,x)
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
! .. Local Scalars .. ! .. 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_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2 integer(psb_ipk_) :: ixt, n1, n2
@ -1177,7 +1178,8 @@ subroutine psi_saqsr_dw(n,x)
real(psb_spk_), intent(inout) :: x(:) real(psb_spk_), intent(inout) :: x(:)
integer(psb_ipk_), intent(in) :: n integer(psb_ipk_), intent(in) :: n
! .. Local Scalars .. ! .. 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_) :: i, j, ilx, iux, istp, lpiv
integer(psb_ipk_) :: ixt, n1, n2 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_), optional, intent(inout) :: ix(:)
integer(psb_ipk_) :: dir_, flag_, n, i, l, err_act,info 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_) :: index
integer(psb_ipk_) :: ierr(5) integer(psb_ipk_) :: ierr(5)
@ -391,7 +391,7 @@ contains
end subroutine psi_z_insert_heap end subroutine psi_z_insert_heap
subroutine psi_z_heap_get_first(key,last,heap,dir,info) 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 implicit none
! !
@ -633,7 +633,7 @@ contains
end subroutine psi_z_heap_get_first end subroutine psi_z_heap_get_first
subroutine psi_z_idx_insert_heap(key,index,last,heap,idxs,dir,info) 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 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) 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 implicit none
! !
@ -905,22 +905,22 @@ subroutine psi_z_idx_heap_get_first(key,index,last,heap,idxs,dir,info)
info = -4 info = -4
case (psb_asort_up_) case (psb_asort_up_)
call fix_aup(last,heap) call fix_aup(last,heap,idxs)
case (psb_asort_down_) case (psb_asort_down_)
call fix_adw(last,heap) call fix_adw(last,heap,idxs)
case (psb_alsort_up_) case (psb_alsort_up_)
call fix_alup(last,heap) call fix_alup(last,heap,idxs)
case (psb_alsort_down_) case (psb_alsort_down_)
call fix_aldw(last,heap) call fix_aldw(last,heap,idxs)
case (psb_lsort_up_) case (psb_lsort_up_)
call fix_lup(last,heap) call fix_lup(last,heap,idxs)
case (psb_lsort_down_) case (psb_lsort_down_)
call fix_ldw(last,heap) call fix_ldw(last,heap,idxs)
case default case default
write(psb_err_unit,*) 'Invalid direction in heap ',dir write(psb_err_unit,*) 'Invalid direction in heap ',dir
@ -933,7 +933,7 @@ contains
use psi_acx_mod use psi_acx_mod
integer(psb_ipk_), intent(in) :: last integer(psb_ipk_), intent(in) :: last
complex(psb_dpk_), intent(inout) :: heap(:) complex(psb_dpk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:) integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp integer(psb_ipk_) :: i,j, itemp
complex(psb_dpk_) :: temp complex(psb_dpk_) :: temp
@ -968,7 +968,7 @@ contains
use psi_acx_mod use psi_acx_mod
integer(psb_ipk_), intent(in) :: last integer(psb_ipk_), intent(in) :: last
complex(psb_dpk_), intent(inout) :: heap(:) complex(psb_dpk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:) integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp integer(psb_ipk_) :: i,j, itemp
complex(psb_dpk_) :: temp complex(psb_dpk_) :: temp
@ -1002,7 +1002,7 @@ contains
use psi_lcx_mod use psi_lcx_mod
integer(psb_ipk_), intent(in) :: last integer(psb_ipk_), intent(in) :: last
complex(psb_dpk_), intent(inout) :: heap(:) complex(psb_dpk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:) integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp integer(psb_ipk_) :: i,j, itemp
complex(psb_dpk_) :: temp complex(psb_dpk_) :: temp
@ -1036,7 +1036,7 @@ contains
use psi_lcx_mod use psi_lcx_mod
integer(psb_ipk_), intent(in) :: last integer(psb_ipk_), intent(in) :: last
complex(psb_dpk_), intent(inout) :: heap(:) complex(psb_dpk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:) integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp integer(psb_ipk_) :: i,j, itemp
complex(psb_dpk_) :: temp complex(psb_dpk_) :: temp
@ -1070,7 +1070,7 @@ contains
use psi_alcx_mod use psi_alcx_mod
integer(psb_ipk_), intent(in) :: last integer(psb_ipk_), intent(in) :: last
complex(psb_dpk_), intent(inout) :: heap(:) complex(psb_dpk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:) integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp integer(psb_ipk_) :: i,j, itemp
complex(psb_dpk_) :: temp complex(psb_dpk_) :: temp
@ -1104,7 +1104,7 @@ contains
use psi_alcx_mod use psi_alcx_mod
integer(psb_ipk_), intent(in) :: last integer(psb_ipk_), intent(in) :: last
complex(psb_dpk_), intent(inout) :: heap(:) complex(psb_dpk_), intent(inout) :: heap(:)
integer(psb_ipk) :: idxs(:) integer(psb_ipk_) :: idxs(:)
integer(psb_ipk_) :: i,j, itemp integer(psb_ipk_) :: i,j, itemp
complex(psb_dpk_) :: temp complex(psb_dpk_) :: temp
@ -1134,7 +1134,7 @@ contains
end subroutine fix_aldw 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 return
end subroutine psb_zisort 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_z_sort_mod, psb_protect_name => psi_zlisrx_up
use psb_error_mod use psb_error_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
complex(psb_dpk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
complex(psb_dpk_) :: xx complex(psb_dpk_) :: xx
@ -167,13 +167,13 @@ subroutine psi_zlisrx_up(n,x,ix)
end subroutine psi_zlisrx_up 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_z_sort_mod, psb_protect_name => psi_zlisrx_dw
use psb_error_mod use psb_error_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
complex(psb_dpk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
complex(psb_dpk_) :: xx complex(psb_dpk_) :: xx
@ -246,13 +246,13 @@ subroutine psi_zlisr_dw(n,x)
enddo enddo
end subroutine psi_zlisr_dw 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_z_sort_mod, psb_protect_name => psi_zalisrx_up
use psb_error_mod use psb_error_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
complex(psb_dpk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
complex(psb_dpk_) :: xx complex(psb_dpk_) :: xx
@ -275,13 +275,13 @@ subroutine psi_zalisrx_up(n,x,ix)
enddo enddo
end subroutine psi_zalisrx_up 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_z_sort_mod, psb_protect_name => psi_zalisrx_dw
use psb_error_mod use psb_error_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
complex(psb_dpk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
complex(psb_dpk_) :: xx complex(psb_dpk_) :: xx
@ -354,12 +354,12 @@ subroutine psi_zalisr_dw(n,x)
enddo enddo
end subroutine psi_zalisr_dw 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_z_sort_mod, psb_protect_name => psi_zaisrx_up
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_dpk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
complex(psb_dpk_) :: xx complex(psb_dpk_) :: xx
@ -382,12 +382,12 @@ subroutine psi_zaisrx_up(n,x,ix)
enddo enddo
end subroutine psi_zaisrx_up 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_z_sort_mod, psb_protect_name => psi_zaisrx_dw
use psb_error_mod use psb_error_mod
implicit none implicit none
complex(psb_dpk_), intent(inout) :: x(:) 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_), intent(in) :: n
integer(psb_ipk_) :: i,j,ix integer(psb_ipk_) :: i,j,ix
complex(psb_dpk_) :: xx 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 goto 9999
endif endif
select case(idir) select case(dir_)
case (psb_lsort_up_) 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_) case (psb_lsort_down_)
call in_lmsort_dw(n,x,iaux,iret) call psi_z_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)
case (psb_alsort_up_) 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_) 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 end select
! !
! Do the actual reordering, since the inner routines ! Do the actual reordering, since the inner routines
@ -135,7 +135,7 @@ subroutine psb_zmsort(x,ix,dir,flag)
! !
if (iret == 0 ) then if (iret == 0 ) then
if (present(ix)) then if (present(ix)) then
call psb_ip_reord(n,x,indx,iaux) call psb_ip_reord(n,x,ix,iaux)
else else
call psb_ip_reord(n,x,iaux) call psb_ip_reord(n,x,iaux)
end if end if
@ -147,9 +147,10 @@ subroutine psb_zmsort(x,ix,dir,flag)
return 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 psb_const_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
@ -252,9 +253,9 @@ contains
end do outer end do outer
end do mergepass 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 psb_const_mod
use psi_lcx_mod use psi_lcx_mod
implicit none implicit none
@ -357,9 +358,9 @@ contains
end do outer end do outer
end do mergepass 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 psb_const_mod
use psi_acx_mod use psi_acx_mod
implicit none implicit none
@ -462,9 +463,9 @@ contains
end do outer end do outer
end do mergepass 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 psb_const_mod
use psi_acx_mod use psi_acx_mod
implicit none implicit none
@ -567,9 +568,9 @@ contains
end do outer end do outer
end do mergepass 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 psb_const_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
@ -672,9 +673,9 @@ contains
end do outer end do outer
end do mergepass 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 psb_const_mod
use psi_alcx_mod use psi_alcx_mod
implicit none implicit none
@ -777,6 +778,5 @@ contains
end do outer end do outer
end do mergepass 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. !!$ POSSIBILITY OF SUCH DAMAGE.
!!$ !!$
!!$ !!$
module psi_lcx_mod module psi_alcx_mod
use psb_const_mod use psb_const_mod
interface operator(<) interface operator(<)
module procedure psi_callt, psi_zallt module procedure psi_callt, psi_zallt
@ -126,5 +126,5 @@ contains
& (abs(aimag(a))>=abs(aimag(b)))) & (abs(aimag(a))>=abs(aimag(b))))
end function psi_zalge end function psi_zalge
end module psi_lcx_mod end module psi_alcx_mod

Write Preview
Loading…
Cancel
Save