Sources Esope | Cast3M

ords01
C ORDS01    SOURCE    GOUNAND   26/01/09    21:15:45     12442          
      SUBROUTINE ORDS01 (XLIST,LLIST,ISTRID)
************************************************************************
*
*                             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(*)
      PARAMETER(ISTMAX=5)
      REAL*8 XL100(ISTMAX),XL110
*
      IF (ISTRID.LT.1.OR.ISTRID.GT.ISTMAX) THEN
         write(6,*) 'Incorrect ISTRID=',ISTRID
         CALL ERREUR(5)
         RETURN
      ENDIF
*      write(6,188) 'Deb ords',(XLIST(II),II=1,ISTRID*LLIST)
 
      DO 100 IB100=2,LLIST
*
         JB100=(IB100-1)*ISTRID
         DO K=1,ISTRID
            XL100(K) = XLIST(JB100+K)
         ENDDO
         IB101 = IB100 - 1
*
         NRANG = IB100
         DO 110 IB110=IB101,1,-1
            JB110=(IB110-1)*ISTRID
            DO K=1,ISTRID
*!            DO K=1,1
               XL110 = XLIST(JB110+K)
               IF (XL100(K).LT.XL110) THEN
                  NRANG = NRANG - 1
                  GOTO 111
*              --> SORTIE DE BOUCLE K
               ELSEIF (XL100(K).GT.XL110) THEN
*              --> SORTIE DE BOUCLE N.110
                  GOTO 112
               END IF
            ENDDO
 111        CONTINUE
 110     CONTINUE
*        END DO
 112     CONTINUE
*
         DO 120 IB120=IB101,NRANG,-1
            JB120=(IB120-1)*ISTRID
            DO K=1,ISTRID
               XLIST(JB120+ISTRID+K) = XLIST(JB120+K)
            ENDDO
 120     CONTINUE
*     END DO
         JRANG=(NRANG-1)*ISTRID
         DO K=1,ISTRID
            XLIST(JRANG+K) = XL100(K)
         ENDDO
*
 100  CONTINUE
*     END DO
  188  FORMAT (A12,2X,12(1PG12.5,2X))
*
      END