Commit 97a2aae5 authored by Daniel Wortmann's avatar Daniel Wortmann

Merge branch 'develop' of iffgit.fz-juelich.de:fleur/fleur into develop

parents 943e29eb c001f463
...@@ -4,91 +4,91 @@ ...@@ -4,91 +4,91 @@
! of the MIT license as expressed in the LICENSE file in more detail. ! of the MIT license as expressed in the LICENSE file in more detail.
!-------------------------------------------------------------------------------- !--------------------------------------------------------------------------------
MODULE m_sort MODULE m_sort
USE m_judft USE m_judft
CONTAINS CONTAINS
SUBROUTINE sort(ind,lv,lv1) SUBROUTINE sort(ind,lv,lv1)
!******************************************************************** !********************************************************************
! heapsort routine ! heapsort routine
! input: lv = array of objects to be sorted ! input: lv = array of objects to be sorted
! lv1 = second array to use as secondary sort key ! lv1 = second array to use as secondary sort key
! output: ind(i) = index of i'th smallest object ! output: ind(i) = index of i'th smallest object
!******************************************************************** !********************************************************************
IMPLICIT NONE IMPLICIT NONE
! !
REAL, INTENT (IN) :: lv(:) REAL, INTENT (IN) :: lv(:)
INTEGER, INTENT (OUT) :: ind(:) INTEGER, INTENT (OUT) :: ind(:)
REAL,INTENT(IN),OPTIONAL :: lv1(:) REAL,INTENT(IN),OPTIONAL :: lv1(:)
! .. ! ..
! .. Local Scalars .. ! .. Local Scalars ..
REAL eps,q,q1 REAL eps,q,q1
INTEGER i,idx,ir,j,l,n INTEGER i,idx,ir,j,l,n
REAL,ALLOCATABLE :: llv(:) REAL,ALLOCATABLE :: llv(:)
! .. ! ..
! .. Data statements .. ! .. Data statements ..
DATA eps/1.e-10/ DATA eps/1.e-10/
! .. ! ..
! !
n=SIZE(ind) n=SIZE(ind)
IF (n>SIZE(lv)) CALL judft_error("BUG: incosistent dimensions") IF (n>SIZE(lv)) CALL judft_error("BUG: incosistent dimensions")
ALLOCATE(llv(n)) ALLOCATE(llv(n))
IF (PRESENT(lv1)) THEN IF (PRESENT(lv1)) THEN
IF (n>SIZE(lv1)) CALL judft_error("BUG: incosistent dimensions") IF (n>SIZE(lv1)) CALL judft_error("BUG: incosistent dimensions")
llv=lv1 llv=lv1
ELSE ELSE
llv=(/(1.*i,i=1,n)/) llv=(/(1.*i,i=1,n)/)
END IF END IF
IF (n == 0) RETURN ! Nothing to do IF (n == 0) RETURN ! Nothing to do
IF (n == 1) THEN ! Not much to do IF (n == 1) THEN ! Not much to do
ind(1) = 1 ind(1) = 1
RETURN RETURN
END IF END IF
DO i = 1,n DO i = 1,n
ind(i) = i ind(i) = i
ENDDO ENDDO
! !
l = n/2 + 1 l = n/2 + 1
ir = n ir = n
DO DO
IF (l.GT.1) THEN IF (l.GT.1) THEN
l = l - 1 l = l - 1
idx = ind(l) idx = ind(l)
q = lv(idx) q = lv(idx)
q1= llv(idx) q1= llv(idx)
ELSE ELSE
idx = ind(ir) idx = ind(ir)
q = lv(idx) q = lv(idx)
q1= llv(idx) q1= llv(idx)
ind(ir) = ind(1) ind(ir) = ind(1)
ir = ir - 1 ir = ir - 1
IF (ir.EQ.1) THEN IF (ir.EQ.1) THEN
ind(1) = idx ind(1) = idx
RETURN RETURN
END IF END IF
END IF END IF
i = l i = l
j = l + l j = l + l
DO WHILE(j.LE.ir) DO WHILE(j.LE.ir)
IF (j.LT.ir) THEN IF (j.LT.ir) THEN
! if(lv(ind(j)).lt.lv(ind(j+1))) j=j+1 ! if(lv(ind(j)).lt.lv(ind(j+1))) j=j+1
IF (((lv(ind(j+1))-lv(ind(j))).GE.eps).OR. &!Standard comparison IF (((lv(ind(j+1))-lv(ind(j))).GE.eps).OR. &!Standard comparison
((ABS((lv(ind(j+1))-lv(ind(j))))<eps).AND.&!Same length, check second key ((ABS((lv(ind(j+1))-lv(ind(j))))<eps).AND.&!Same length, check second key
((llv(ind(j+1))-llv(ind(j))).GE.eps))) & ((llv(ind(j+1))-llv(ind(j))).GE.eps))) &
j=j+1 j=j+1
END IF END IF
! if(q.lt.lv(ind(j))) then ! if(q.lt.lv(ind(j))) then
IF ((lv(ind(j))-q).GE.eps.OR.& IF ((lv(ind(j))-q).GE.eps.OR.&
(ABS((lv(ind(j))-q))<eps.AND.(llv(ind(j))-q1).GE.eps))THEN (ABS((lv(ind(j))-q))<eps.AND.(llv(ind(j))-q1).GE.eps))THEN
ind(i) = ind(j) ind(i) = ind(j)
i = j i = j
j = j + j j = j + j
ELSE ELSE
j = ir + 1 j = ir + 1
END IF END IF
enddo enddo
ind(i) = idx ind(i) = idx
ENDDO ENDDO
END SUBROUTINE sort END SUBROUTINE sort
END MODULE m_sort END MODULE m_sort
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment