Télécharger la plaquette Cast3M


fr en

Télécharger trifu2.eso

Retour à la liste

Numérotation des lignes : 

trifu2

  1. C TRIFU2    SOURCE    CHAT      05/01/13    03:46:59     5004
  2. C****************************************************************************
  3. C****************************************************************************
  4. C*************TRIFUS....TRI par FUSion**************************************
  5. C****************************************************************************
  6. C****************************************************************************
  7.  
  8.  
  9.  
  10.       SUBROUTINE TRIFU2(IKA,NODES)
  11.       IMPLICIT INTEGER(I-N)
  12.  
  13.       SEGMENT IKA(0)
  14.       SEGMENT IKB(3*NODES)
  15.       INTEGER IAX,IAX2
  16.  
  17.  
  18. C  EN ENTREE : IKA TABLEAU A TRIER
  19. C  EN SORTIE :IKA TABLEAU TRIE EN ORDRE CROISSANT
  20.  
  21.       N=NODES
  22.  
  23.       SEGINI IKB
  24.  
  25.       IF(N.EQ.1) GOTO 999
  26. C
  27. C   ON FAIT UNE PREMIERE BOUCLE POUR LES ORDONNES 2 A 2 .CECI PERMET
  28. C   DE SAUVER 3*N/2 TESTS.
  29. C
  30.  
  31.       NC=N/2
  32.       DO 4 I=1,NC
  33.       J=2*I-1
  34.       J1=J+1
  35.       IF(IKA(J+NODES).LT.IKA(J1+NODES)) GO TO 4
  36.       IF(IKA(J+NODES).EQ.IKA(J1+NODES).AND.
  37.      >             IKA(J+2*NODES).LE.IKA(J1+2*NODES)) GO TO 4
  38.       IAX=IKA(J1)
  39.       IAX2=IKA(J1+NODES)
  40.       IAX3=IKA(J1+2*NODES)
  41.  
  42.       IKA(J1)=IKA(J)
  43.       IKA(J1+NODES)=IKA(J+NODES)
  44.       IKA(J1+2*NODES)=IKA(J+2*NODES)
  45.  
  46.       IKA(J)=IAX
  47.       IKA(J+NODES)=IAX2
  48.       IKA(J+2*NODES)=IAX3
  49.  
  50.    4  CONTINUE
  51.       IF(N.EQ.2) GOTO 999
  52. C
  53. C  ON CONTINUE A LES ORDONNNES NI PAR NI
  54. C
  55.       NI=2
  56.     1 ND=NI
  57.  
  58.       NI=NI*2
  59.       NC=N/NI
  60.       NE=MOD(N,NI)
  61.       IF(NE.GT.ND) NC=NC+1
  62.       NF2=0
  63.       INC=0
  64.       DO 2 I=1,N
  65.           IKB(I)=IKA(I)
  66.           IKB(I+NODES)=IKA(I+NODES)
  67.           IKB(I+2*NODES)=IKA(I+2*NODES)
  68. 2     CONTINUE
  69. C
  70. C  BOUCLE SUR LES NC COUPLES DE ND VALEURS
  71. C
  72.       DO 30 JJ=1,NC
  73.       N1=NF2+1
  74.       N2=N1+ND
  75.       NF1=NF2+ND
  76.       NF2=NF1+ND
  77.       NF2=MIN(NF2,N)
  78.  13   INC=INC+1
  79.       IF(IKB(N1+NODES).GT.IKB(N2+NODES)) GO TO 14
  80.       IF(IKB(N1+NODES).EQ.IKB(N2+NODES).AND.
  81.      >       IKB(N1+2*NODES).GE.IKB(N2+2*NODES)) GO TO 14
  82.  
  83.       IKA(INC)=IKB(N1)
  84.       IKA(INC+NODES)=IKB(N1+NODES)
  85.       IKA(INC+2*NODES)=IKB(N1+2*NODES)
  86.  
  87.       IF(N1.GE.NF1) GO TO 17
  88.       N1=N1+1
  89.       GO TO 13
  90.   14  IKA(INC)=IKB(N2)
  91.       IKA(INC+NODES)=IKB(N2+NODES)
  92.       IKA(INC+2*NODES)=IKB(N2+2*NODES)
  93.       IF(N2.GE.NF2) GO TO 18
  94.       N2=N2+1
  95.       GO TO 13
  96.   17  DO 20 I=N2,NF2
  97.       IKA(I)=IKB(I)
  98.       IKA(I+NODES)=IKB(I+NODES)
  99.       IKA(I+2*NODES)=IKB(I+2*NODES)
  100.   20  CONTINUE
  101.  
  102.       INC=NF2
  103.       GO TO 30
  104.   18  DO 21 I=N1,NF1
  105.       INC=INC+1
  106.       IKA(INC)=IKB(I)
  107.       IKA(INC+NODES)=IKB(I+NODES)
  108.       IKA(INC+2*NODES)=IKB(I+2*NODES)
  109.   21  CONTINUE
  110.   30  CONTINUE
  111.       IF(NI.GE.N) GOTO 999
  112.       GO TO 1
  113.  
  114. 999   SEGSUP IKB
  115.  
  116.       RETURN
  117.       END
  118.  
  119.  
  120.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales