Sources Esope | Cast3M

ordo14
C ORDO14    SOURCE    JC220346  14/12/16    21:15:09     8324
      SUBROUTINE ORDO14 (MLIST,LLIST,CROISS,IORDR)
************************************************************************
*
*                             O R D O 1 4
*                             -----------
*
* FONCTION:
* ---------
*
*     ORDONNER LE CONTENU D'UN TABLEAU UNICOLONNE D'ENTIERS EN NE TENANT
*     COMPTE QUE DES VALEURS ABSOLUES ET RETOURNER UNE LISTE CONTENANT
*     LE NOUVEL ORDRE DES ELEMENTS
*
* MODE D'APPEL:
* -------------
*
*     CALL ORDO14 (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)
         ML100A = ABS(ML100)
         IO100 = IORDR(IB100)
         IB101 = IB100 - 1
*
         NRANG = IB100
         DO 110 IB110=IB101,1,-1
            ML110A = ABS(MLIST(IB110))
            IF ( (CROISS .AND. ML100A.LT.ML110A)
     &      .OR. (DECROI .AND. ML100A.GT.ML110A) ) 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