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 :
© Cast3M 2003 - All rights reserved.
Disclaimer