Line data    Source code

       1             :       MODULE m_trisrt
       2             : !
       3             : !     orders (k1,x1), (k2,x2), (k3,x3) such that x1 < x2 < x3
       4             : !
       5             :       CONTAINS
       6           0 :       SUBROUTINE trisrt(x1,x2,x3,k1,k2,k3)
       7             : 
       8             :       IMPLICIT NONE
       9             :       INTEGER, INTENT (INOUT) :: k1,k2,k3
      10             :       REAL,    INTENT (INOUT) :: x1,x2,x3
      11             :       INTEGER k
      12             :       REAL    x
      13             : 
      14           0 :       IF (x2 < x1) THEN             ! interchange x1 and x2
      15           0 :         x = x1 ; x1 = x2 ; x2 = x
      16           0 :         k = k1 ; k1 = k2 ; k2 = k
      17             :       ENDIF
      18           0 :       IF (x3 < x1) THEN             ! interchange x1 and x3
      19           0 :         x = x1 ; x1 = x3 ; x3 = x
      20           0 :         k = k1 ; k1 = k3 ; k3 = k
      21             :       ENDIF
      22           0 :       IF (x3 < x2) THEN             ! interchange x2 and x3
      23           0 :         x = x2 ; x2 = x3 ; x3 = x
      24           0 :         k = k2 ; k2 = k3 ; k3 = k
      25             :       ENDIF
      26             : 
      27           0 :       END SUBROUTINE trisrt
      28             :       END MODULE m_trisrt