Esope source files

   1 : C TRIFLA    SOURCE    BP208322  10/01/29    21:15:32     6623           
   2 :       SUBROUTINE TRIFLA(XA,XB,YA,YB,N,IPERM)                                          
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
   5 :       DIMENSION YA(N),YB(N),XA(N),XB(N)
   6 :       INTEGER   IPERM(N),IPERMB(N)
   7 : C                                                                               
   8 : C  EN ENTREE : XA TABLEAU A TRIER                                               
   9 : C              N  SA DIMENSION                                                  
  10 : C              XB TABLEAU DE TRAVAIL                                            
  11 : C              YA TABLEAU A PERMUTER EN MEME TEMPS QUE XA                       
  12 : C              YB TABLEAU DE TRAVAIL                                            
  13 : C                                                                               
  14 : C  EN SORTIE :XA TABLEAU TRIE EN ORDRE CROISSANT                                
  15 : C             IPERM Tableau des permutations effectuées                              
  16 : C    
  17 :       DO I=1,N
  18 :         IPERM(I)=I
  19 :       ENDDO
  20 : 
  21 :       IF(N.EQ.1) RETURN                                                         
  22 : C                                                                               
  23 : C   ON FAIT UNE PREMIERE BOUCLE POUR LES ORDONNES 2 A 2 .CECI PERMET            
  24 : C   DESAUVER 3*N/2 TESTS.                                                       
  25 : C                                                                               
  26 :       NC=N/2                                                                    
  27 :       DO 4 I=1,NC                                                               
  28 :       J=2*I-1                                                                   
  29 :       J1=J+1                                                                    
  30 :       IF(ABS(XA(J)).LT.ABS(XA(J1))) GO TO 4  
  31 : *     on iverse J et J1=J+1
  32 :       ITMP=IPERM(J1)
  33 :       IPERM(J1)=IPERM(J)
  34 :       IPERM(J)=ITMP
  35 :       XAX=XA(J1)                                                                
  36 :       XA(J1)=XA(J)                                                              
  37 :       XA(J)=XAX                                                                 
  38 :       yAX=yA(J1)                                                                
  39 :       yA(J1)=yA(J)                                                              
  40 :       yA(J)=yAX 
  41 :    4  CONTINUE                                                                  
  42 :       IF(N.EQ.2) RETURN                                                         
  43 : C                                                                               
  44 : C  ON CONTINUE A LES ORDONNNES NI PAR NI                                        
  45 : C                                                                               
  46 :       NI=2                                                                      
  47 :     1 ND=NI                                                                     
  48 :       NI=NI*2                                                                   
  49 :       NC=N/NI                                                                   
  50 :       NE=MOD(N,NI)                                                              
  51 :       IF(NE.GT.ND) NC=NC+1                                                      
  52 :       NF2=0                                                                     
  53 :       INC=0                                                                     
  54 :       DO 2 I=1,N
  55 :         IPERMB(I)=IPERM(I)
  56 :         yB(I)=yA(I)                                                               
  57 :    2    XB(I)=XA(I)                                                               
  58 : C                                                                               
  59 : C  BOUCLE SUR LES NC COUPLES DE ND VALEURS                                      
  60 : C                                                                               
  61 :       DO 30 JJ=1,NC                                                             
  62 :         N1=NF2+1                                                                  
  63 :         N2=N1+ND                                                                  
  64 :         NF1=NF2+ND                                                                
  65 :         NF2=NF1+ND                                                                
  66 :         NF2=MIN(NF2,N)                                                            
  67 :  13     INC=INC+1                                                                 
  68 :           IF(abs(XB(N1)).GT.abs(XB(N2))) GO TO 14                                             
  69 :           IPERM(INC)=IPERMB(N1)
  70 :           XA(INC)=XB(N1)                                                            
  71 :           yA(INC)=yB(N1)                                                            
  72 :           IF(N1.GE.NF1) GO TO 17                                                    
  73 :           N1=N1+1                                                                   
  74 :         GO TO 13                                                                  
  75 : *  14    XA(INC)=XB(N2)                                                            
  76 :   14    IPERM(INC)=IPERMB(N2)                                                            
  77 :         XA(INC)=XB(N2)                                                            
  78 :         yA(INC)=yB(N2)                                                            
  79 :         IF(N2.GE.NF2) GO TO 18                                                    
  80 :         N2=N2+1                                                                   
  81 :       GO TO 13                                                                  
  82 :   17  DO 20 I=N2,NF2
  83 :         IPERM(I)=IPERMB(I)
  84 :         yA(I)=yB(I)                                                               
  85 :   20    XA(I)=XB(I)                                                               
  86 :         INC=NF2                                                                   
  87 :       GO TO 30                                                                  
  88 :   18  DO 21 I=N1,NF1                                                            
  89 :         INC=INC+1                                                                 
  90 :         IPERM(INC)=IPERMB(I)
  91 :         yA(INC)=yB(I)                                                             
  92 :   21    XA(INC)=XB(I)                                                             
  93 :   30  CONTINUE                                                                  
  94 :       IF(NI.GE.N) RETURN                                                        
  95 :       GO TO 1                                                                   
  96 :       END                                                                       
  97 :  
  98 :  
  99 :