Sources Esope | Cast3M

ordo04
C ORDO04    SOURCE    JC220346  14/12/16    21:15:08     8324
      SUBROUTINE ORDO04 (MLIST,LLIST,CROISS,IORDR)
************************************************************************
*
*                             O R D O 0 4
*                             -----------
*
* FONCTION:
* ---------
*
*     ORDONNER LE CONTENU D'UN TABLEAU UNICOLONNE D'ENTIERS
*     ET RETOURNER UNE LISTE CONTENANT LE NOUVEL ORDRE DES ELEMENTS
*
* MODE D'APPEL:
* -------------
*
*     CALL ORDO04 (MLIST,LLIST,CROISS)
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE
* -----------
*
*     MLIST   ENTIER    (E)  TABLEAU UNICOLONNE A REORDONNER.
*                       (S)  MEME TABLEAU, AVEC LES ELEMENTS REORDONNES.
*     LLIST   ENTIER    (E)  DIMENSION DE "MLIST".
*     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 MLIST.
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     JCARDO     10 DEC 2014
*
* LANGAGE:
* --------
*
*     FORTRAN77
*
************************************************************************
*
      IMPLICIT INTEGER(I-N)
      INTEGER MLIST(*)
      INTEGER IORDR(*)
*
      LOGICAL CROISS,DECROI
*
      DECROI = .NOT.CROISS
*
      DO 100 IB100=2,LLIST
*
         ML100 = MLIST(IB100)
         IO100 = IORDR(IB100)
         IB101 = IB100 - 1
*
         NRANG = IB100
         DO 110 IB110=IB101,1,-1
            ML110 = MLIST(IB110)
            IF ( (CROISS .AND. ML100.LT.ML110)
     &      .OR. (DECROI .AND. ML100.GT.ML110) ) 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
            MLIST(IB120+1) = MLIST(IB120)
            IORDR(IB120+1) = IORDR(IB120)
  120       CONTINUE
*        END DO
         MLIST(NRANG) = ML100
         IORDR(NRANG) = IO100
*
  100    CONTINUE
*     END DO
*
      END