LCOV - code coverage report
Current view: top level - global - sort.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 45 45 100.0 %
Date: 2019-09-08 04:53:50 Functions: 1 1 100.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : MODULE m_sort
       7             :    USE m_judft
       8             : CONTAINS
       9             : 
      10        3555 :    SUBROUTINE sort(ind,lv,lv1)
      11             :       !********************************************************************
      12             :       !     heapsort routine
      13             :       !     input:   lv    = array of objects to be sorted
      14             :       !              lv1   = second array to use as secondary sort key
      15             :       !     output:  ind(i) = index of i'th smallest object
      16             :       !********************************************************************
      17             :       IMPLICIT NONE
      18             :       !
      19             :       REAL,    INTENT (IN) :: lv(:)
      20             :       INTEGER, INTENT (OUT) :: ind(:)
      21             :       REAL,INTENT(IN),OPTIONAL :: lv1(:)
      22             :       !     ..
      23             :       !     .. Local Scalars ..
      24             :       REAL eps,q,q1
      25             :       INTEGER i,idx,ir,j,l,n
      26        3555 :       REAL,ALLOCATABLE :: llv(:)
      27             :       !     ..
      28             :       !     .. Data statements ..
      29             :       DATA eps/1.e-10/
      30             :       !     ..
      31             :       !
      32        3555 :       n=SIZE(ind)
      33        3555 :       IF (n>SIZE(lv)) CALL judft_error("BUG: incosistent dimensions")
      34        3555 :       ALLOCATE(llv(n))
      35        3555 :       IF (PRESENT(lv1)) THEN
      36        3239 :          IF (n>SIZE(lv1)) CALL judft_error("BUG: incosistent dimensions")
      37        3239 :          llv=lv1
      38             :       ELSE
      39         316 :          llv=(/(1.*i,i=1,n)/)
      40             :       END IF
      41        7110 :       IF (n == 0) RETURN ! Nothing to do
      42        3528 :       IF (n == 1) THEN   ! Not much to do
      43          13 :          ind(1) = 1
      44          13 :          RETURN
      45             :       END IF
      46             : 
      47     1376043 :       DO i = 1,n
      48      689779 :          ind(i) = i
      49             :       ENDDO
      50             :       !
      51        3515 :       l = n/2 + 1
      52        3515 :       ir = n
      53     1021750 :       DO
      54     1025265 :          IF (l.GT.1) THEN
      55      342516 :             l = l - 1
      56      342516 :             idx = ind(l)
      57      342516 :             q = lv(idx)
      58      342516 :             q1= llv(idx)
      59             :          ELSE
      60      682749 :             idx = ind(ir)
      61      682749 :             q = lv(idx)
      62      682749 :             q1= llv(idx)
      63      682749 :             ind(ir) = ind(1)
      64      682749 :             ir = ir - 1
      65      682749 :             IF (ir.EQ.1) THEN
      66        3515 :                ind(1) = idx
      67        3515 :                RETURN
      68             :             END IF
      69             :          END IF
      70     1021750 :          i = l
      71     1021750 :          j = l + l
      72     6010679 :          DO WHILE(j.LE.ir)
      73     4988929 :             IF (j.LT.ir) THEN
      74             :                !           if(lv(ind(j)).lt.lv(ind(j+1))) j=j+1
      75     4962427 :                IF (((lv(ind(j+1))-lv(ind(j))).GE.eps).OR. &!Standard comparison
      76             :                    ((ABS((lv(ind(j+1))-lv(ind(j))))<eps).AND.&!Same length, check second key
      77             :                     ((llv(ind(j+1))-llv(ind(j))).GE.eps))) &
      78     2354346 :                   j=j+1
      79             :             END IF
      80             :             !        if(q.lt.lv(ind(j))) then
      81     4988929 :             IF ((lv(ind(j))-q).GE.eps.OR.&
      82     1021750 :                 (ABS((lv(ind(j))-q))<eps.AND.(llv(ind(j))-q1).GE.eps))THEN
      83     4724496 :                ind(i) = ind(j)
      84     4724496 :                i = j
      85     4724496 :                j = j + j
      86             :             ELSE
      87      264433 :                j = ir + 1
      88             :             END IF
      89             :          enddo
      90     1021750 :          ind(i) = idx
      91             :       ENDDO
      92        7110 :    END SUBROUTINE sort
      93             : 
      94             : END MODULE m_sort

Generated by: LCOV version 1.13