Télécharger la plaquette Cast3M


fr en

Télécharger trifus.eso

Retour à la liste

Numérotation des lignes : 

trifus

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

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