1 : C PLAN SOURCE PV 07/10/05 21:16:14 5890 2 : C---------------------------------------------------------------------| 3 : C | 4 : LOGICAL FUNCTION PLAN(JF) 5 : C | 6 : C CETTE SUBROUTINE TESTE SI LA FACETTE JF EST PLANE OU NON | 7 : C | 8 : C PLAN EST VRAI SI JF EST PLANE | 9 : C PLAN EST FAUX SI JF N'EST PAS PLANE | 10 : C | 11 : C ELLE VERIFIE AUSSI QUE LES DIAGONALES NE SONT PAS DANS | 12 : C D'AUTRES ELEMENTS | 13 : C | 14 : C---------------------------------------------------------------------| 15 : C 16 : IMPLICIT INTEGER(I-N) 17 : IMPLICIT REAL*8(A-H,O-Z) 18 : -INC CCOPTIO 19 : -INC TDEMAIT 20 : DIMENSION V1(3),V2(3),V3(3),V4(3),VN1(3),VN2(3) 21 : * 22 : C SI LA FACETTE A ETE SUPPRIME ELLE EST CONSIDEREE COMME BONNE 23 : DO 10 I=1,NFACET 24 : IF (IFUT(I).EQ.JF) GOTO 20 25 : 10 CONTINUE 26 : PLAN=.TRUE. 27 : RETURN 28 : 20 CONTINUE 29 : C 30 : I1=NFC(1,JF) 31 : I2=NFC(2,JF) 32 : I3=NFC(3,JF) 33 : I4=NFC(4,JF) 34 : C VERIFICATION LES POINTS SONT DIFFERENTS ENTRE EUX 35 : IF (I1.EQ.I2.OR.I1.EQ.I3.OR.I1.EQ.I4.OR. 36 : # I2.EQ.I3.OR.I2.EQ.I4.OR. 37 : # I3.EQ.I4 ) THEN 38 : WRITE (6,*) ' PLAN FACE DEGENEREE ',I4 39 : PLAN=.FALSE. 40 : RETURN 41 : ENDIF 42 : C 43 : DO 100 I=1,3 44 : V1(I)=XYZ(I,I2)-XYZ(I,I1) 45 : V2(I)=XYZ(I,I3)-XYZ(I,I2) 46 : V3(I)=XYZ(I,I4)-XYZ(I,I3) 47 : V4(I)=XYZ(I,I1)-XYZ(I,I4) 48 : 100 CONTINUE 49 : C 50 : * VV1=SQRT(V1(1)**2+V1(2)**2+V1(3)**2) 51 : * VV2=SQRT(V2(1)**2+V2(2)**2+V2(3)**2) 52 : * VV3=SQRT(V3(1)**2+V3(2)**2+V3(3)**2) 53 : * VV4=SQRT(V4(1)**2+V4(2)**2+V4(3)**2) 54 : C 55 : * DO 110 I=1,3 56 : * V1(I)=V1(I)/VV1 57 : * V2(I)=V2(I)/VV2 58 : * V3(I)=V3(I)/VV3 59 : * V4(I)=V4(I)/VV4 60 : 110 CONTINUE 61 : C 62 : VN1(1)=V1(2)*V2(3)-V1(3)*V2(2) 63 : VN1(2)=V1(3)*V2(1)-V1(1)*V2(3) 64 : VN1(3)=V1(1)*V2(2)-V1(2)*V2(1) 65 : VVN1=SQRT(VN1(1)**2+VN1(2)**2+VN1(3)**2) 66 : C 67 : VN2(1)=V3(2)*V4(3)-V3(3)*V4(2) 68 : VN2(2)=V3(3)*V4(1)-V3(1)*V4(3) 69 : VN2(3)=V3(1)*V4(2)-V3(2)*V4(1) 70 : VVN2=SQRT(VN2(1)**2+VN2(2)**2+VN2(3)**2) 71 : C 72 : SCAL=(VN1(1)*VN2(1)+VN1(2)*VN2(2)+VN1(3)*VN2(3))/(vvn1*vvn2) 73 : * WRITE(6,1000)JF,SCAL 74 : 1000 FORMAT(' FACETTE :',I3,' PLAN:',F7.2) 75 : C 76 : PLAN=.TRUE. 77 : IF (SCAL.LT.0.85) PLAN=.FALSE. 78 : C 79 : IF (.NOT.PLAN) RETURN 80 : C VERIFICATION I1 I3 ET I2 I4 PAS DANS UN AUTRE ELEMENT 81 : DO 200 I=1,40 82 : IF=NPF(I,I1) 83 : IF (IF.EQ.JF) GOTO 200 84 : IF (IF.EQ.0) GOTO 220 85 : DO 210 J=1,40 86 : IF (NPF(J,I3).EQ.0) GOTO 200 87 : IF (IF.NE.NPF(J,I3)) GOTO 210 88 : PLAN=.FALSE. 89 : RETURN 90 : 210 CONTINUE 91 : 200 CONTINUE 92 : 220 CONTINUE 93 : DO 230 I=1,40 94 : IF=NPF(I,I2) 95 : IF (IF.EQ.JF) GOTO 230 96 : IF (IF.EQ.0) GOTO 250 97 : DO 240 J=1,40 98 : IF (NPF(J,I4).EQ.0) GOTO 230 99 : IF (IF.NE.NPF(J,I4)) GOTO 240 100 : PLAN=.FALSE. 101 : RETURN 102 : 240 CONTINUE 103 : 230 CONTINUE 104 : 250 CONTINUE 105 : C FIN DE LA SUBROUTINE FACE3 106 : END 107 : 108 :
© Cast3M 2003 - All rights reserved.
Disclaimer