Sources Esope | Cast3M

ordo03
C ORDO03    SOURCE    JC220346  14/12/16    21:15:08     8324
      SUBROUTINE ORDO03 (XLIST,LLIST,CROISS,IORDR)
************************************************************************
*
*                             O R D O 0 3
*                             -----------
*
* FONCTION:
* ---------
*
*     ORDONNER LE CONTENU D'UN TABLEAU UNICOLONNE DE REELS
*     ET RETOURNER UNE LISTE CONTENANT LE NOUVEL ORDRE DES ELEMENTS
*
* MODE D'APPEL:
* -------------
*
*     CALL ORDO03 (XLIST,LLIST,CROISS)
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE
* -----------
*
*     XLIST   REEL DP   (E)  TABLEAU UNICOLONNE A REORDONNER.
*                       (S)  MEME TABLEAU, AVEC LES ELEMENTS REORDONNES.
*     LLIST   ENTIER    (E)  DIMENSION DE "XLIST".
*     CROISS  LOGIQUE   (E)  INDIQUE PAR "VRAI" OU "FAUX" SI LE TABLEAU
*                            DOIT ETRE REORDONNE EN ORDRE CROISSANT.
*                            SINON, CE SERA FAIT EN ORDRE DECROISSANT.
*     IORDR             (E)  TABLEAU D'ENTIERS ALLANT DE 1 A AU MOINS
*                            LLIST.
*                       (S)  MEME TABLEAU, CONTENANT LE NOUVEL ORDRE
*                            DES ELEMENTS DE XLIST.
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     JCARDO     10 DEC 2014
*
* LANGAGE:
* --------
*
*     FORTRAN77
*
************************************************************************
*
      IMPLICIT INTEGER(I-N)
      REAL*8 XLIST(*)
      INTEGER IORDR(*)
      REAL*8 XL100,XL110
*
      LOGICAL CROISS,DECROI
*
      DECROI = .NOT.CROISS
*
      DO 100 IB100=2,LLIST
*
         XL100 = XLIST(IB100)
         IO100 = IORDR(IB100)
         IB101 = IB100 - 1
*
         NRANG = IB100
         DO 110 IB110=IB101,1,-1
            XL110 = XLIST(IB110)
            IF ( (CROISS .AND. XL100.LT.XL110)
     &      .OR. (DECROI .AND. XL100.GT.XL110) ) THEN
               NRANG = NRANG - 1
            ELSE
*              --> SORTIE DE BOUCLE N.110
               GOTO 112
            END IF
  110       CONTINUE
*        END DO
  112    CONTINUE
*
         DO 120 IB120=IB101,NRANG,-1
            XLIST(IB120+1) = XLIST(IB120)
            IORDR(IB120+1) = IORDR(IB120)
  120       CONTINUE
*        END DO
         XLIST(NRANG) = XL100
         IORDR(NRANG) = IO100
*
  100    CONTINUE
*     END DO
*
      END