Sources Esope | Cast3M

plan
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