C PLAN SOURCE JC220346 16/11/29 21:15:27 9221 C---------------------------------------------------------------------| C | LOGICAL FUNCTION PLAN(JF) C | C CETTE SUBROUTINE TESTE SI LA FACETTE JF EST PLANE OU NON | C | C PLAN EST VRAI SI JF EST PLANE | C PLAN EST FAUX SI JF N'EST PAS PLANE | C | C ELLE VERIFIE AUSSI QUE LES DIAGONALES NE SONT PAS DANS | C D'AUTRES ELEMENTS | C | C---------------------------------------------------------------------| C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC TDEMAIT DIMENSION V1(3),V2(3),V3(3),V4(3),VN1(3),VN2(3) * C SI LA FACETTE A ETE SUPPRIME ELLE EST CONSIDEREE COMME BONNE DO 10 I=1,NFACET IF (IFUT(I).EQ.JF) GOTO 20 10 CONTINUE PLAN=.TRUE. RETURN 20 CONTINUE C I1=NFC(1,JF) I2=NFC(2,JF) I3=NFC(3,JF) I4=NFC(4,JF) C VERIFICATION LES POINTS SONT DIFFERENTS ENTRE EUX IF (I1.EQ.I2.OR.I1.EQ.I3.OR.I1.EQ.I4.OR. # I2.EQ.I3.OR.I2.EQ.I4.OR. # I3.EQ.I4 ) THEN IF (IVERB.EQ.1) WRITE (6,*) ' PLAN FACE DEGENEREE ',I4 PLAN=.FALSE. RETURN ENDIF C DO 100 I=1,3 V1(I)=XYZ(I,I2)-XYZ(I,I1) V2(I)=XYZ(I,I3)-XYZ(I,I2) V3(I)=XYZ(I,I4)-XYZ(I,I3) V4(I)=XYZ(I,I1)-XYZ(I,I4) 100 CONTINUE C * VV1=SQRT(V1(1)**2+V1(2)**2+V1(3)**2) * VV2=SQRT(V2(1)**2+V2(2)**2+V2(3)**2) * VV3=SQRT(V3(1)**2+V3(2)**2+V3(3)**2) * VV4=SQRT(V4(1)**2+V4(2)**2+V4(3)**2) C * DO 110 I=1,3 * V1(I)=V1(I)/VV1 * V2(I)=V2(I)/VV2 * V3(I)=V3(I)/VV3 * V4(I)=V4(I)/VV4 110 CONTINUE C VN1(1)=V1(2)*V2(3)-V1(3)*V2(2) VN1(2)=V1(3)*V2(1)-V1(1)*V2(3) VN1(3)=V1(1)*V2(2)-V1(2)*V2(1) VVN1=SQRT(VN1(1)**2+VN1(2)**2+VN1(3)**2) C VN2(1)=V3(2)*V4(3)-V3(3)*V4(2) VN2(2)=V3(3)*V4(1)-V3(1)*V4(3) VN2(3)=V3(1)*V4(2)-V3(2)*V4(1) VVN2=SQRT(VN2(1)**2+VN2(2)**2+VN2(3)**2) C SCAL=(VN1(1)*VN2(1)+VN1(2)*VN2(2)+VN1(3)*VN2(3))/(vvn1*vvn2) * WRITE(6,1000)JF,SCAL 1000 FORMAT(' FACETTE :',I3,' PLAN:',F7.2) C PLAN=.TRUE. IF (SCAL.LT.0.85) PLAN=.FALSE. C IF (.NOT.PLAN) RETURN C VERIFICATION I1 I3 ET I2 I4 PAS DANS UN AUTRE ELEMENT DO 200 I=1,40 IF=NPF(I,I1) IF (IF.EQ.JF) GOTO 200 IF (IF.EQ.0) GOTO 220 DO 210 J=1,40 IF (NPF(J,I3).EQ.0) GOTO 200 IF (IF.NE.NPF(J,I3)) GOTO 210 PLAN=.FALSE. RETURN 210 CONTINUE 200 CONTINUE 220 CONTINUE DO 230 I=1,40 IF=NPF(I,I2) IF (IF.EQ.JF) GOTO 230 IF (IF.EQ.0) GOTO 250 DO 240 J=1,40 IF (NPF(J,I4).EQ.0) GOTO 230 IF (IF.NE.NPF(J,I4)) GOTO 240 PLAN=.FALSE. RETURN 240 CONTINUE 230 CONTINUE 250 CONTINUE C FIN DE LA SUBROUTINE FACE3 END