Download ordo02.eso

Back to the list

   1 : C ORDO02    SOURCE    CHAT      05/01/13    02:05:45     5004           
   2 :       SUBROUTINE ORDO02 (MLIST,LLIST,CROISS)                                    
   3 : ************************************************************************        
   4 : *                                                                               
   5 : *                             O R D O 0 2                                       
   6 : *                             -----------                                       
   7 : *                                                                               
   8 : * FONCTION:                                                                     
   9 : * ---------                                                                     
  10 : *                                                                               
  11 : *     ORDONNER LE CONTENU D'UN TABLEAU UNICOLONNE D'ENTIERS.                    
  12 : *                                                                               
  13 : * MODE D'APPEL:                                                                 
  14 : * -------------                                                                 
  15 : *                                                                               
  15 : *     CALL ORDO02 (MLIST,LLIST,CROISS)                                          
  16 : *                                                                               
  17 : * PARAMETRES:   (E)=ENTREE   (S)=SORTIE                                         
  18 : * -----------                                                                   
  19 : *                                                                               
  20 : *     MLIST   ENTIER    (E)  TABLEAU UNICOLONNE A REORDONNER.                   
  21 : *                       (S)  MEME TABLEAU, AVEC LES ELEMENTS REORDONNES.        
  22 : *     LLIST   ENTIER    (E)  DIMENSION DE "MLIST".                              
  23 : *     CROISS  LOGIQUE   (E)  INDIQUE PAR "VRAI" OU "FAUX" SI LE TABLEAU         
  24 : *                            DOIT ETRE REORDONNE EN ORDRE CROISSANT.            
  25 : *                            SINON, CE SERA FAIT EN ORDRE DECROISSANT.          
  26 : *                                                                               
  27 : * AUTEUR, DATE DE CREATION:                                                     
  28 : * -------------------------                                                     
  29 : *                                                                               
  30 : *     PASCAL MANIGOT     19 MARS 1985                                           
  31 : *                                                                               
  32 : *     NOUVEL ALGORITHME PLUS PERFORMANT LE 14 MAI 1985 (P. MANIGOT)             
  33 : *                                                                               
  34 : * LANGAGE:                                                                      
  35 : * --------                                                                      
  36 : *                                                                               
  37 : *     FORTRAN77                                                                 
  38 : *                                                                               
  39 : ************************************************************************        
  40 : *                                                                               
  41 :       IMPLICIT INTEGER(I-N)
  42 :       INTEGER MLIST(*)                                                          
  43 : *                                                                               
  44 :       LOGICAL CROISS,DECROI                                                     
  45 : *                                                                               
  46 :       DECROI = .NOT.CROISS                                                      
  47 : *                                                                               
  48 :       DO 100 IB100=2,LLIST                                                      
  49 : *                                                                               
  50 :          ML100 = MLIST(IB100)                                                   
  51 :          IB101 = IB100 - 1                                                      
  52 : *                                                                               
  53 :          NRANG = IB100                                                          
  54 :          DO 110 IB110=IB101,1,-1                                                
  55 :             ML110 = MLIST(IB110)                                                
  56 :             IF ( (CROISS .AND. ML100.LT.ML110)                                  
  57 :      &      .OR. (DECROI .AND. ML100.GT.ML110) ) THEN                           
  58 :                NRANG = NRANG - 1                                                
  59 :             ELSE                                                                
  60 : *              --> SORTIE DE BOUCLE N.110                                       
  61 :                GOTO 112                                                         
  62 :             END IF                                                              
  63 :   110       CONTINUE                                                            
  64 : *        END DO                                                                 
  65 :   112    CONTINUE                                                               
  66 : *                                                                               
  67 :          DO 120 IB120=IB101,NRANG,-1                                            
  68 :             MLIST(IB120+1) = MLIST(IB120)                                       
  69 :   120       CONTINUE                                                            
  70 : *        END DO                                                                 
  71 :          MLIST(NRANG) = ML100                                                   
  72 : *                                                                               
  73 :   100    CONTINUE                                                               
  74 : *     END DO                                                                    
  75 : *                                                                               
  76 :       END                                                                       
  77 :  

© Cast3M 2003 - All rights reserved.
Disclaimer