Sources Esope | Cast3M

triflo
C TRIFLO    SOURCE    CHAT      05/01/13    03:46:56     5004
      SUBROUTINE TRIFLO(XA,XB,KA,KB,N)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION KA(N),KB(N),XA(N),XB(N)
C
C  EN ENTREE : XA TABLEAU A TRIER
C              N  SA DIMENSION
C              XB TABLEAU DE TRAVAIL
C              IA TABLEAU A PERMUTER EN MEME TEMPS QUE XA
C              IB TABLEAU DE TRAVAIL
C
C  EN SORTIE :KA TABLEAU TRIE EN ORDRE CROISSANT
C
      IF(N.EQ.1) RETURN
C
C   ON FAIT UNE PREMIERE BOUCLE POUR LES ORDONNES 2 A 2 .CECI PERMET
C   DESAUVER 3*N/2 TESTS.
C
      NC=N/2
      DO 4 I=1,NC
      J=2*I-1
      J1=J+1
      IF(XA(J).LT.XA(J1)) GO TO 4
      XAX=XA(J1)
      XA(J1)=XA(J)
      XA(J)=XAX
      KAX=KA(J1)
      KA(J1)=KA(J)
      KA(J)=KAX
   4  CONTINUE
      IF(N.EQ.2) RETURN
C
C  ON CONTINUE A LES ORDONNNES NI PAR NI
C
      NI=2
    1 ND=NI
      NI=NI*2
      NC=N/NI
      NE=MOD(N,NI)
      IF(NE.GT.ND) NC=NC+1
      NF2=0
      INC=0
      DO 2 I=1,N
      KB(I)=KA(I)
   2  XB(I)=XA(I)
C
C  BOUCLE SUR LES NC COUPLES DE ND VALEURS
C
      DO 30 JJ=1,NC
      N1=NF2+1
      N2=N1+ND
      NF1=NF2+ND
      NF2=NF1+ND
      NF2=MIN(NF2,N)
 13   INC=INC+1
      IF(XB(N1).GT.XB(N2)) GO TO 14
      XA(INC)=XB(N1)
      KA(INC)=KB(N1)
      IF(N1.GE.NF1) GO TO 17
      N1=N1+1
      GO TO 13
  14  XA(INC)=XB(N2)
      KA(INC)=KB(N2)
      IF(N2.GE.NF2) GO TO 18
      N2=N2+1
      GO TO 13
  17  DO 20 I=N2,NF2
      KA(I)=KB(I)
  20  XA(I)=XB(I)
      INC=NF2
      GO TO 30
  18  DO 21 I=N1,NF1
      INC=INC+1
      KA(INC)=KB(I)
  21  XA(INC)=XB(I)
  30  CONTINUE
      IF(NI.GE.N) RETURN
      GO TO 1
      END