C ORDON3    SOURCE    CHAT      05/01/13    02:06:04     5004           
      SUBROUTINE ORDON3 (IPEVOL,CROISS,ABSOLU)                                  
************************************************************************        
*                                                                               
*                             O R D O N 3                                       
*                             -----------                                       
*                                                                               
* FONCTION:                                                                     
* ---------                                                                     
*                                                                               
*     RANGER EN ORDRE CROISSANT OU DECROISSANT UN 'EVOLUTIO'.                   
*                                                                               
* MODE D'APPEL:                                                                 
* -------------                                                                 
*                                                                               
*     CALL ORDON3 (IPEVOL,CROISS,ABSOLU)                                        
*                                                                               
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE                                         
* -----------                                                                   
*                                                                               
*     IPEVOL  ENTIER    (E)  POINTEUR SUR L' EVOL  A ORDONNER.                  
*                       (S)  MEME POINTEUR, EVOL  REORDONNE .                   
*     CROISS  LOGIQUE   (E)  INDIQUE PAR "VRAI" OU "FAUX" SI ON ORDONNE         
*                            CROISSANT OU NON.                                  
*     ABSOLU  LOGIQUE   (E)  INDIQUE PAR "VRAI" OU "FAUX" SI ON ORDONNE         
*                            EN CONSIDERANT LES VALEURS ABSOLUES OU LES         
*                            VRAIES VALEURS.                                    
*                                                                               
* LANGAGE:                                                                      
* --------                                                                      
*                                                                               
*     ESOPE + FORTRAN77                                                         
*                                                                               
************************************************************************        
*                                                                               
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)                                                 
-INC SMLREEL                                                                    
-INC SMEVOLL
-INC CCOPTIO
-INC TMCOLAC                                                                           
*                                                                               
      CHARACTER*72 TI                                                           
      LOGICAL CROISS,ABSOLU,DECROI                                              
*                                                                               
      DECROI = .NOT.CROISS                                                      
      MEVOLL=IPEVOL                                                             
      SEGACT MEVOLL*MOD                                                         
      NCOU=IEVOLL(/1)                                                           
*                                                                               
*   BOUCLE SUR LES DIFFERENTES COURBES                                          
*                                                                               
        DO 400 NC=1,NCOU                                                        
        KEVOL1 = IEVOLL(NC)
        SEGINI,KEVOLL=KEVOL1
        IEVOLL(NC)=KEVOLL
        SEGACT KEVOLL*MOD                                                           
*                                                                               
*  TEST SUR LE TYPE DES ABSCISSES ET DES ORDONNEES                              
*                                                                               
        IF(TYPX(1:8).NE.'LISTREEL'.OR.TYPY(1:8).NE.'LISTREEL') THEN             
        CALL ERREUR(19)                                                         
        SEGDES KEVOLL,MEVOLL                                                    
        RETURN                                                                  
        ENDIF                                                                   
*                                                                               
        MLREE1=IPROGX                                                           
        SEGINI,MLREEL=MLREE1
        IPROGX=MLREEL                                                          
        NBPT=PROG(/1)                                                           
*                                                                               
*  TEST SUR LE NOMBRE DE POINTS                                                 
*                                                                               
        IF(NBPT.EQ.1) THEN                                                      
        SEGDES MLREEL                                                     
        SEGDES KEVOLL                                                     
        GO TO 400                                                               
        ENDIF                                                                   
*                                                                               
        MLREE3=IPROGY 
        SEGINI,MLREE1=MLREE3
        IPROGY=MLREE1
c  
        SEGACT MLREE1*MOD                                                           
         DO 100 IB=2,NBPT                                                       
         XL1 = PROG(IB)                                                         
         FXL1 = MLREE1.PROG(IB)                                                 
         IF(ABSOLU) THEN                                                        
         YL1 = ABS(XL1)                                                         
         ELSE                                                                   
         YL1 = XL1                                                              
         ENDIF                                                                  
         IB1 = IB - 1                                                           
         NRANG = IB                                                             
         DO 110 JB=IB1,1,-1                                                     
            XL2 = PROG(JB)                                                      
            IF(ABSOLU) THEN                                                     
            YL2 = ABS(XL2)                                                      
            ELSE                                                                
            YL2 = XL2                                                           
            ENDIF                                                               
            IF ( (CROISS .AND. YL1.LT.YL2)                                      
     &      .OR. (DECROI .AND. YL1.GT.YL2) ) THEN                               
               NRANG = NRANG - 1                                                
            ELSE                                                                
               GOTO 112                                                         
            END IF                                                              
  110       CONTINUE                                                            
  112    CONTINUE                                                               
         DO 120 JB=IB1,NRANG,-1                                                 
            PROG(JB+1) = PROG(JB)                                               
            MLREE1.PROG(JB+1) = MLREE1.PROG(JB)                                 
  120       CONTINUE                                                            
         PROG(NRANG) = XL1                                                      
         MLREE1.PROG(NRANG) = FXL1                                              
  100    CONTINUE                                                               
        SEGDES KEVOLL,kevol1,MLREEL,MLREE1,mlree3
 400    CONTINUE                                                                
*                                                                               
      SEGDES MEVOLL 
      IF(IPSAUV.NE.0) THEN
        ICOLAC = IPSAUV
        SEGACT ICOLAC
        ILISSE=ILISSG
        SEGACT ILISSE*MOD
        CALL TYPFIL('EVOLUTIO',ICO)
        ITLACC = KCOLA(ICO)
        SEGACT ITLACC*MOD
        CALL AJOUN0(ITLACC,MEVOLL,ILISSE,1) 
        SEGDES ICOLAC,ILISSE   
      ENDIF                                                                    
      RETURN                                                                    
      END