9
1
mirror of https://github.com/QuantumPackage/qp2.git synced 2024-11-19 03:42:21 +01:00

Sorting compatible with old IPP

This commit is contained in:
Anthony Scemama 2021-05-31 12:16:00 +02:00
parent 3837dea58c
commit d45f6091da
3 changed files with 69 additions and 8 deletions

View File

@ -31,7 +31,7 @@ OPENMP : 1 ; Append OpenMP flags
# -ftz : Flushes denormal results to zero # -ftz : Flushes denormal results to zero
# #
[OPT] [OPT]
FC : -traceback FC : -traceback -shared-intel
FCFLAGS : -O2 -ip -g -march=core-avx2 -align array64byte -fma -ftz -fomit-frame-pointer FCFLAGS : -O2 -ip -g -march=core-avx2 -align array64byte -fma -ftz -fomit-frame-pointer
# Profiling flags # Profiling flags

View File

@ -17,15 +17,15 @@ module intel
interface interface
subroutine ippsSortAscend_64s_I(pSrc, len) bind(C, name='ippsSortAscend_64s_I') subroutine ippsSortAscend_64s_I(pSrc, len) bind(C, name='ippsSortAscend_64s_I')
use iso_c_binding use iso_c_binding
integer*8, intent(in), value :: len integer, intent(in), value :: len
integer, intent(inout) :: pSrc(len) integer*8, intent(inout) :: pSrc(len)
end end
end interface end interface
interface interface
subroutine ippsSortAscend_64f_I(pSrc, len) bind(C, name='ippsSortAscend_64f_I') subroutine ippsSortAscend_64f_I(pSrc, len) bind(C, name='ippsSortAscend_64f_I')
use iso_c_binding use iso_c_binding
double precision, intent(in), value :: len integer, intent(in), value :: len
real, intent(inout) :: pSrc(len) double precision, intent(inout) :: pSrc(len)
end end
end interface end interface

View File

@ -310,12 +310,73 @@ BEGIN_TEMPLATE
SUBST [ X, type, ityp, n, ippsz ] SUBST [ X, type, ityp, n, ippsz ]
; real ; 32f ; 4 ; 13 ;; ; real ; 32f ; 4 ; 13 ;;
d ; double precision ; 64f ; 8 ; 19;;
i ; integer ; 32s ; 4 ; 11 ;; i ; integer ; 32s ; 4 ; 11 ;;
i8 ; integer*8 ; 64s ; 8 ; 17;;
i2 ; integer*2 ; 16s ; 2 ; 7 ;; i2 ; integer*2 ; 16s ; 2 ; 7 ;;
END_TEMPLATE END_TEMPLATE
BEGIN_TEMPLATE
subroutine $Xsort(x,iorder,isize)
implicit none
BEGIN_DOC
! Sort array x(isize).
! iorder in input should be (1,2,3,...,isize), and in output
! contains the new order of the elements.
END_DOC
integer,intent(in) :: isize
$type,intent(inout) :: x(isize)
integer,intent(inout) :: iorder(isize)
integer :: n
if (isize < 2) then
return
endif
! call sorted_$Xnumber(x,isize,n)
! if (isize == n) then
! return
! endif
if ( isize < 32) then
call insertion_$Xsort(x,iorder,isize)
else
! call heap_$Xsort(x,iorder,isize)
call quick_$Xsort(x,iorder,isize)
endif
end subroutine $Xsort
SUBST [ X, type ]
d ; double precision ;;
END_TEMPLATE
BEGIN_TEMPLATE
subroutine $Xsort(x,iorder,isize)
implicit none
BEGIN_DOC
! Sort array x(isize).
! iorder in input should be (1,2,3,...,isize), and in output
! contains the new order of the elements.
END_DOC
integer,intent(in) :: isize
$type,intent(inout) :: x(isize)
integer,intent(inout) :: iorder(isize)
integer :: n
if (isize < 2) then
return
endif
call sorted_$Xnumber(x,isize,n)
if (isize == n) then
return
endif
if ( isize < 32) then
call insertion_$Xsort(x,iorder,isize)
else
call $Xradix_sort(x,iorder,isize,-1)
endif
end subroutine $Xsort
SUBST [ X, type ]
i8 ; integer*8 ;;
END_TEMPLATE
!---------------------- END INTEL !---------------------- END INTEL
IRP_ELSE IRP_ELSE
!---------------------- NON-INTEL !---------------------- NON-INTEL