Sources Esope | Cast3M

trifla
C TRIFLA    SOURCE    BP208322  10/01/29    21:15:32     6623
      SUBROUTINE TRIFLA(XA,XB,YA,YB,N,IPERM)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
      DIMENSION YA(N),YB(N),XA(N),XB(N)
      INTEGER   IPERM(N),IPERMB(N)
C
C  EN ENTREE : XA TABLEAU A TRIER
C              N  SA DIMENSION
C              XB TABLEAU DE TRAVAIL
C              YA TABLEAU A PERMUTER EN MEME TEMPS QUE XA
C              YB TABLEAU DE TRAVAIL
C
C  EN SORTIE :XA TABLEAU TRIE EN ORDRE CROISSANT
C             IPERM Tableau des permutations effectuées
C
      DO I=1,N
        IPERM(I)=I
      ENDDO
 
      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(ABS(XA(J)).LT.ABS(XA(J1))) GO TO 4
*     on iverse J et J1=J+1
      ITMP=IPERM(J1)
      IPERM(J1)=IPERM(J)
      IPERM(J)=ITMP
      XAX=XA(J1)
      XA(J1)=XA(J)
      XA(J)=XAX
      yAX=yA(J1)
      yA(J1)=yA(J)
      yA(J)=yAX
   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
        IPERMB(I)=IPERM(I)
        yB(I)=yA(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(abs(XB(N1)).GT.abs(XB(N2))) GO TO 14
          IPERM(INC)=IPERMB(N1)
          XA(INC)=XB(N1)
          yA(INC)=yB(N1)
          IF(N1.GE.NF1) GO TO 17
          N1=N1+1
        GO TO 13
*  14    XA(INC)=XB(N2)
  14    IPERM(INC)=IPERMB(N2)
        XA(INC)=XB(N2)
        yA(INC)=yB(N2)
        IF(N2.GE.NF2) GO TO 18
        N2=N2+1
      GO TO 13
  17  DO 20 I=N2,NF2
        IPERM(I)=IPERMB(I)
        yA(I)=yB(I)
  20    XA(I)=XB(I)
        INC=NF2
      GO TO 30
  18  DO 21 I=N1,NF1
        INC=INC+1
        IPERM(INC)=IPERMB(I)
        yA(INC)=yB(I)
  21    XA(INC)=XB(I)
  30  CONTINUE
      IF(NI.GE.N) RETURN
      GO TO 1
      END