Sources Esope | Cast3M

ordo01
C ORDO01    SOURCE    CHAT      05/01/13    02:05:42     5004
      SUBROUTINE ORDO01 (XLIST,LLIST,CROISS)
************************************************************************
*
*                             O R D O 0 1
*                             -----------
*
* FONCTION:
* ---------
*
*     ORDONNER LE CONTENU D'UN TABLEAU UNICOLONNE DE REELS.
*
* MODE D'APPEL:
* -------------
*
*     CALL ORDO01 (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.
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL MANIGOT     19 MARS 1985
*
*     NOUVEL ALGORITHME PLUS PERFORMANT LE 14 MAI 1985 (P. MANIGOT)
*
* LANGAGE:
* --------
*
*     FORTRAN77
*
************************************************************************
*
      IMPLICIT INTEGER(I-N)
      REAL*8 XLIST(*)
      REAL*8 XL100,XL110
*
      LOGICAL CROISS,DECROI
*
      DECROI = .NOT.CROISS
*
      DO 100 IB100=2,LLIST
*
         XL100 = XLIST(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)
  120       CONTINUE
*        END DO
         XLIST(NRANG) = XL100
*
  100    CONTINUE
*     END DO
*
      END