1 : C FUSLRE SOURCE CHAT 05/01/13 00:12:44 5004 2 : SUBROUTINE FUSLRE (MLREE1,MLREE2, MLREE3) 3 : ************************************************************************ 4 : * 5 : * F U S L R E 6 : * ----------- 7 : * 8 : * FONCTION: 9 : * --------- 10 : * 11 : * FUSION DE 2 "LISTREEL" ORDONNES STRICTEMENT CROISSANT, PAR 12 : * INSERTION, DANS LE 1ER, DES REELS N'APPARTENANT QU'AU 2IEME. 13 : * 14 : * MODULES UTILISES: 15 : * ----------------- 16 : * 17 : IMPLICIT INTEGER(I-N) 18 : -INC SMLREEL 19 : -INC SMLENTI 20 : * 21 : * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN) 22 : * ----------- 23 : * 24 : * MLREE1 (E) 1ER LISTREEL ORDONNE. 25 : * MLREE2 (E) 2EME LISTREEL ORDONNE. 26 : * MLREE3 (S) FUSION ORDONNEE STRICTEMENT CROISSANT DES 2 LISTREEL. 27 : * 28 : * CONSTANTES: 29 : * ----------- 30 : * 31 : REAL*8 EPS,EPS9 32 : PARAMETER (EPS = 1.D-3) 33 : PARAMETER (EPS9 = 1.D0-EPS) 34 : * 35 : * VARIABLES: 36 : * ---------- 37 : * 38 : * NEAR = RR TRES VOISIN D'UNE VALEUR DANS LA LISTE "MLREE1". 39 : * RR = VALEUR COURANTE DE LA LISTE "MLREE2". 40 : * 41 : REAL*8 RR,AR 42 : LOGICAL NEAR 43 : * 44 : * AUTEUR, DATE DE CREATION: 45 : * ------------------------- 46 : * 47 : * PASCAL MANIGOT 9 SEPTEMBRE 1988 48 : * 49 : * LANGAGE: 50 : * -------- 51 : * 52 : * ESOPE + FORTRAN77 53 : * 54 : ************************************************************************ 55 : * 56 : SEGACT,MLREE1,MLREE2 57 : LDIM1 = MLREE1.PROG(/1) 58 : LDIM2 = MLREE2.PROG(/1) 59 : * 60 : JG = LDIM2 61 : SEGINI,MLENTI 62 : * CETTE TABLE, ASSOCIEE A "MLREE2", VA INDIQUER LA POSITION 63 : * D'INSERTION DE CHAQUE REEL (=0 S'IL NE FAUT PAS L'INSERER). 64 : * 65 : IR = 0 66 : NBINSE = 0 67 : * 68 : DO 100 IB=1,LDIM2 69 : * 70 : RR = MLREE2.PROG(IB) 71 : IDEB = MAX(1,IR) 71 : CALL PLACE3 (MLREE1.PROG,IDEB,LDIM1,RR, IR,AR) 72 : * 73 : IF (IR .EQ. 0) THEN 74 : NEAR = AR .LT. EPS 75 : ELSE IF (IR .EQ. LDIM1) THEN 76 : NEAR = AR .LT. EPS 77 : ELSE 78 : NEAR = AR.LT.EPS .OR. AR.GT.EPS9 79 : END IF 80 : * 81 : IF (NEAR) THEN 82 : LECT(IB) = 0 83 : ELSE 84 : LECT(IB) = IR + 1 85 : NBINSE = NBINSE + 1 86 : END IF 87 : * 88 : 100 CONTINUE 89 : * END DO 90 : * 91 : JG = LDIM1 + NBINSE 92 : SEGINI,MLREE3 93 : IDEB2 = 1 94 : I3 = 0 95 : * 96 : DO 200 IB=1,LDIM1 97 : * 98 : IF (NBINSE .GT. 0) THEN 99 : I2 = IDEB2 100 : DO 210 IB2=I2,JG 101 : IF (LECT(IB2) .GT. IB) THEN 102 : IDEB2 = IB2 103 : GOTO 212 104 : * EXIT 105 : END IF 106 : IF (LECT(IB2) .EQ. IB) THEN 107 : I3 = I3 + 1 108 : MLREE3.PROG(I3) = MLREE2.PROG(IB2) 109 : NBINSE = NBINSE - 1 110 : END IF 111 : 210 CONTINUE 112 : * END DO 113 : 212 CONTINUE 114 : END IF 115 : * 116 : I3 = I3 + 1 117 : MLREE3.PROG(I3) = MLREE1.PROG(IB) 118 : * 119 : 200 CONTINUE 120 : * END DO 121 : * 122 : IF (I3.LT.JG) THEN 123 : I4 = I3 + 1 124 : DO 220 IB = I4,JG 125 : DO 222 IB2 = 1,LDIM2 126 : IF (LECT(IB2).EQ.IB) THEN 127 : I3 = I3 + 1 128 : MLREE3.PROG(I3) = MLREE2.PROG(IB2) 129 : * EXIT 130 : GOTO 220 131 : ENDIF 132 : 222 CONTINUE 133 : * END DO 134 : 220 CONTINUE 135 : * END DO 136 : END IF 137 : * 138 : SEGSUP,MLENTI 139 : SEGDES,MLREE1,MLREE2 140 : SEGDES,MLREE3 141 : * 142 : END 143 :
© Cast3M 2003 - All rights reserved.
Disclaimer