1 : C TRISEG SOURCE PV 09/01/08 21:15:20 6254 2 : SUBROUTINE TRISEG (TS,ISEG,TN,INOR,TI,ICPR,lcpr,VN,IP1,IP2,IC) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Y) 5 : IMPLICIT LOGICAL (Z) 6 : SEGMENT TN 7 : REAL*8 TNOR (N1,3) 8 : ENDSEGMENT 9 : SEGMENT TS 10 : INTEGER TSEG (M1,M2) 11 : ENDSEGMENT 12 : SEGMENT TI 13 : INTEGER TINDIC(MI1,MI2,2) 14 : ENDSEGMENT 15 : SEGMENT ICPR(0) 16 : -INC SMELEME 17 : REAL*8 VN(3) 18 : * RECHERCHE SI NORMALE DEJA CODEE 19 : IF (INOR.NE.0) THEN 20 : IF (.NOT.( (VN(1).EQ.TNOR(INOR,1)) .AND. 21 : . (VN(2).EQ.TNOR(INOR,2)) .AND. (VN(3).EQ.TNOR(INOR,3)))) THEN 22 : INOR=INOR+1 23 : IF (INOR.GT.TNOR(/1)) THEN 24 : N1=INOR+199 25 : N2=3 26 : SEGADJ TN 27 : ENDIF 28 : TNOR(INOR,1)=VN(1) 29 : TNOR(INOR,2)=VN(2) 30 : TNOR(INOR,3)=VN(3) 31 : ENDIF 32 : ELSE 33 : INOR=INOR+1 34 : TNOR(INOR,1)=VN(1) 35 : TNOR(INOR,2)=VN(2) 36 : TNOR(INOR,3)=VN(3) 37 : ENDIF 38 : * RECHERCHE SI SEGMENT EN TABLE OU SEGMENT A AJOUTER 39 : IMIN=1 40 : IMAX=ISEG 41 : ZTROUV=.FALSE. 42 : ZFINI=.FALSE. 43 : * CLASSE LES EXTREM. 44 : JP1=MIN(IP1,IP2) 45 : JP2=MAX(IP1,IP2) 46 : * on cherche jp1 jp2 dans tindic 47 : ijp1=icpr(jp1) 48 : if (ijp1.eq.0) then 49 : lcpr=lcpr+1 50 : icpr(jp1)=lcpr 51 : ijp1=lcpr 52 : endif 53 : mi1=tindic(/1) 54 : mi2=tindic(/2) 55 : if (ijp1.gt.tindic(/1)) then 56 : mi1=ijp1+100 57 : segadj ti 58 : endif 59 : do 100 mj=1,mi2 60 : jp=tindic(ijp1,mj,1) 61 : if (jp.eq.0) goto 101 62 : if (jp.ne.jp2) goto 100 63 : it=tindic(ijp1,mj,2) 64 : ztrouv=.true. 65 : goto 101 66 : 100 continue 67 : 101 continue 68 : 69 : * AJOUT D'UNE NORMALE POUR UN SEGMENT DEJA EXISTANT 70 : IF (ZTROUV) THEN 71 : J=6 72 : 2 IF ((J.LE.TSEG(/2)).AND.(TSEG(IT,J).NE.0)) THEN 73 : J=J+1 74 : GOTO 2 75 : ENDIF 76 : IF (J.GT.TSEG(/2)) THEN 77 : M2=J 78 : M1=TSEG(/1) 79 : SEGADJ TS 80 : ENDIF 81 : TSEG(IT,J)=INOR 82 : ELSE 83 : * AJOUT D'UN SEGMENT 84 : ISEG=ISEG+1 85 : IF (ISEG.GT.TSEG(/1)) THEN 86 : M1=ISEG+199 87 : M2=TSEG(/2) 88 : SEGADJ TS 89 : ENDIF 90 : TSEG(ISEG,3)=JP1 91 : TSEG(ISEG,4)=JP2 92 : TSEG(ISEG,5)=INOR 93 : TSEG(ISEG,1)=0 94 : TSEG(ISEG,2)=IC 95 : DO 8 I=6,TSEG(/2) 96 : TSEG(ISEG,I)=0 97 : 8 CONTINUE 98 : 99 : * mise a jour de tindic 100 : do 110 mj=1,mi2 101 : if (tindic(ijp1,mj,1).eq.0) goto 111 102 : 110 continue 103 : mi2=mi2+1 104 : segadj ti 105 : 111 continue 106 : tindic(ijp1,mj,1)=jp2 107 : tindic(ijp1,mj,2)=iseg 108 : ENDIF 109 : RETURN 110 : END 111 : 112 : 113 : 114 : 115 : 116 : 117 : 118 :
© Cast3M 2003 - All rights reserved.
Disclaimer