1 SUBROUTINE TRIAGE(M1,M2,M3,M4,ICPT,ICPT0,NFC,IOPT,NUM,NR,NODC) 2C 3 INCLUDE 'com_faces.f' 4C 5C Ce programme recherche une face deja apparue 6C dans l'etude des faces precedentes et "oublie" 7C ces 2 faces si tel est le cas. 8C 9C 10C Creation du premier element de la liste des faces 11C 12 IF (IOPT.EQ.0.OR.ICPT.LT.ICPT0) GOTO 110 13C 14C Boucle de recherche 15C 16 IF (IOPT.EQ.8) THEN 17 DO 100 I=ICPT,ICPT0,-1 18 IF (M1.EQ.ITAB(I)) THEN 19 IF (ICLAS(3,I).EQ.M3) THEN 20 ITAB(I) = 0 21 ICLAS(1,I) = 0 22 NFC = NFC+1 23 GOTO 120 24 ENDIF 25 ENDIF 26 100 CONTINUE 27 ELSEIF (IOPT.EQ.4) THEN 28 DO 101 I=ICPT,ICPT0,-1 29 IF (M1.EQ.ITAB(I)) THEN 30 IF (ICLAS(2,I).EQ.M3) THEN 31 IF (ICLAS(3,I).EQ.M2) THEN 32 ITAB(I) = 0 33 ICLAS(1,I) = 0 34 NFC = NFC+1 35 GOTO 120 36 ENDIF 37 ENDIF 38 ENDIF 39 101 CONTINUE 40 ELSE 41 DO 102 I=ICPT,ICPT0,-1 42 IF (M1.EQ.ITAB(I)) THEN 43 ITAB(I) = 0 44 ICLAS(1,I) = 0 45 NFC = NFC+1 46 GOTO 120 47 ENDIF 48 102 CONTINUE 49 ENDIF 50C 51C Creation d'un element de la liste 52C 53 110 ICPT = ICPT+1 54 IF (ICPT.GT.NCMAX) THEN 55 PRINT*,'ERREUR DANS TRIAGE - AUGMENTEZ NCMAX (',NCMAX,')' 56 STOP 57 ENDIF 58 ITAB(ICPT) = M1 59 ICLAS(1,ICPT) = M1 60 ICLAS(2,ICPT) = M2 61 ICLAS(3,ICPT) = M3 62 ICLAS(4,ICPT) = M4 63 ICLAS(5,ICPT) = NUM 64 ICLAS(6,ICPT) = NR 65 ICLAS(7,ICPT) = NODC 66 IF (IOPT.NE.8.AND.IOPT.NE.4) IOPT=0 67 120 END 68C====================================================================== 69 SUBROUTINE COMPAC(ICPT,ICPT0,NFC) 70C 71 INCLUDE 'com_faces.f' 72C 73 IBON = ICPT0-1 74 DO I=ICPT0,ICPT 75 IF (ITAB(I).NE.0) THEN 76 IBON = IBON+1 77 ITAB(IBON) = ITAB(I) 78 DO K=1,7 79 ICLAS(K,IBON) = ICLAS(K,I) 80 ENDDO 81 ISD2(IBON) = ISD2(I) 82 ISD3(IBON) = ISD3(I) 83 ENDIF 84 ENDDO 85 ICPT = IBON 86 NFC = 0 87 END 88