LCPQ/quantum_package
10
0
Fork 0
mirror of https://github.com/LCPQ/quantum_package synced 2024-12-26 06:14:43 +01:00
Code Issues Releases Wiki Activity

Fixed quicksort openmp

Browse Source
This commit is contained in:
Anthony Scemama 2018-10-15 14:49:08 +02:00
parent b3d17a6479
commit fc01113383
1 changed files with 31 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
src/Utils/sort.irp.f
View File

@ -37,19 +37,21 @@ BEGIN_TEMPLATE
integer,intent(in) :: isize integer,intent(in) :: isize
$type,intent(inout) :: x(isize) $type,intent(inout) :: x(isize)
integer,intent(inout) :: iorder(isize) integer,intent(inout) :: iorder(isize)
integer :: tn integer, external :: omp_get_num_threads
integer, external :: omp_get_thread_num if (omp_get_num_threads() == 1) then
tn = omp_get_thread_num() !$OMP PARALLEL DEFAULT(SHARED)
!$OMP PARALLEL if (tn == 0)
!$OMP SINGLE !$OMP SINGLE
call rec_$X_quicksort(x,iorder,isize,1,isize) call rec_$X_quicksort(x,iorder,isize,1,isize,nproc)
!$OMP END SINGLE !$OMP END SINGLE
!$OMP END PARALLEL !$OMP END PARALLEL
else
call rec_$X_quicksort(x,iorder,isize,1,isize,nproc)
endif
end end
recursive subroutine rec_$X_quicksort(x, iorder, isize, first, last) recursive subroutine rec_$X_quicksort(x, iorder, isize, first, last, level)
implicit none implicit none
integer, intent(in) :: isize, first, last integer, intent(in) :: isize, first, last, level
integer,intent(inout) :: iorder(isize) integer,intent(inout) :: iorder(isize)
$type, intent(inout) :: x(isize) $type, intent(inout) :: x(isize)
$type :: c, tmp $type :: c, tmp
@ -76,17 +78,26 @@ BEGIN_TEMPLATE
i=i+1 i=i+1
j=j-1 j=j-1
enddo enddo
if ( ((i-first <= 10000).and.(last-j <= 10000)).or.(level<=0) ) then
if (first < i-1) then if (first < i-1) then
!$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(isize,first,i) if (i-first > 100000) call rec_$X_quicksort(x, iorder, isize, first, i-1,level/2)
call rec_$X_quicksort(x, iorder, isize, first, i-1) endif
if (j+1 < last) then
call rec_$X_quicksort(x, iorder, isize, j+1, last,level/2)
endif
else
if (first < i-1) then
!$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(isize,first,i,level)
call rec_$X_quicksort(x, iorder, isize, first, i-1,level/2)
!$OMP END TASK !$OMP END TASK
endif endif
if (j+1 < last) then if (j+1 < last) then
!$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(isize,last,j) if (last-j > 100000) !$OMP TASK DEFAULT(SHARED) FIRSTPRIVATE(isize,last,j,level)
call rec_$X_quicksort(x, iorder, isize, j+1, last) call rec_$X_quicksort(x, iorder, isize, j+1, last,level/2)
!$OMP END TASK !$OMP END TASK
endif endif
!$OMP TASKWAIT !$OMP TASKWAIT
endif
end end
subroutine heap_$Xsort(x,iorder,isize) subroutine heap_$Xsort(x,iorder,isize)