Download triflo.eso

Back to the list

   1 : C TRIFLO    SOURCE    CHAT      05/01/13    03:46:56     5004           
   2 :       SUBROUTINE TRIFLO(XA,XB,KA,KB,N)                                          
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
   5 :       DIMENSION KA(N),KB(N),XA(N),XB(N)                                         
   6 : C                                                                               
   7 : C  EN ENTREE : XA TABLEAU A TRIER                                               
   8 : C              N  SA DIMENSION                                                  
   9 : C              XB TABLEAU DE TRAVAIL                                            
  10 : C              IA TABLEAU A PERMUTER EN MEME TEMPS QUE XA                       
  11 : C              IB TABLEAU DE TRAVAIL                                            
  12 : C                                                                               
  13 : C  EN SORTIE :KA TABLEAU TRIE EN ORDRE CROISSANT                                
  14 : C                                                                               
  15 :       IF(N.EQ.1) RETURN                                                         
  16 : C                                                                               
  17 : C   ON FAIT UNE PREMIERE BOUCLE POUR LES ORDONNES 2 A 2 .CECI PERMET            
  18 : C   DESAUVER 3*N/2 TESTS.                                                       
  19 : C                                                                               
  20 :       NC=N/2                                                                    
  21 :       DO 4 I=1,NC                                                               
  22 :       J=2*I-1                                                                   
  23 :       J1=J+1                                                                    
  24 :       IF(XA(J).LT.XA(J1)) GO TO 4                                               
  25 :       XAX=XA(J1)                                                                
  26 :       XA(J1)=XA(J)                                                              
  27 :       XA(J)=XAX                                                                 
  28 :       KAX=KA(J1)                                                                
  29 :       KA(J1)=KA(J)                                                              
  30 :       KA(J)=KAX                                                                 
  31 :    4  CONTINUE                                                                  
  32 :       IF(N.EQ.2) RETURN                                                         
  33 : C                                                                               
  34 : C  ON CONTINUE A LES ORDONNNES NI PAR NI                                        
  35 : C                                                                               
  36 :       NI=2                                                                      
  37 :     1 ND=NI                                                                     
  38 :       NI=NI*2                                                                   
  39 :       NC=N/NI                                                                   
  40 :       NE=MOD(N,NI)                                                              
  41 :       IF(NE.GT.ND) NC=NC+1                                                      
  42 :       NF2=0                                                                     
  43 :       INC=0                                                                     
  44 :       DO 2 I=1,N                                                                
  45 :       KB(I)=KA(I)                                                               
  46 :    2  XB(I)=XA(I)                                                               
  47 : C                                                                               
  48 : C  BOUCLE SUR LES NC COUPLES DE ND VALEURS                                      
  49 : C                                                                               
  50 :       DO 30 JJ=1,NC                                                             
  51 :       N1=NF2+1                                                                  
  52 :       N2=N1+ND                                                                  
  53 :       NF1=NF2+ND                                                                
  54 :       NF2=NF1+ND                                                                
  55 :       NF2=MIN(NF2,N)                                                            
  56 :  13   INC=INC+1                                                                 
  57 :       IF(XB(N1).GT.XB(N2)) GO TO 14                                             
  58 :       XA(INC)=XB(N1)                                                            
  59 :       KA(INC)=KB(N1)                                                            
  60 :       IF(N1.GE.NF1) GO TO 17                                                    
  61 :       N1=N1+1                                                                   
  62 :       GO TO 13                                                                  
  63 :   14  XA(INC)=XB(N2)                                                            
  64 :       KA(INC)=KB(N2)                                                            
  65 :       IF(N2.GE.NF2) GO TO 18                                                    
  66 :       N2=N2+1                                                                   
  67 :       GO TO 13                                                                  
  68 :   17  DO 20 I=N2,NF2                                                            
  69 :       KA(I)=KB(I)                                                               
  70 :   20  XA(I)=XB(I)                                                               
  71 :       INC=NF2                                                                   
  72 :       GO TO 30                                                                  
  73 :   18  DO 21 I=N1,NF1                                                            
  74 :       INC=INC+1                                                                 
  75 :       KA(INC)=KB(I)                                                             
  76 :   21  XA(INC)=XB(I)                                                             
  77 :   30  CONTINUE                                                                  
  78 :       IF(NI.GE.N) RETURN                                                        
  79 :       GO TO 1                                                                   
  80 :       END                                                                       
  81 :  

© Cast3M 2003 - All rights reserved.
Disclaimer