Sources Esope | Cast3M

in2
C IN2       SOURCE    JC220346  16/11/29    21:15:21     9221           
C---------------------------------------------------------------------|
C                                                                     |
       LOGICAL FUNCTION IN2(IP1,IP2,NFCINI)
C                                                                     |
C      CETTE FONCTION LOGIQUE VERIFIE QUE LE POINT IP2 (QUI VIENT     |
C      D'ETRE CREE ), EST BIEN A L'INTERIEUR DU MAILLAGE DE SUR-      |
C      FACE.                                                          |
C                                                                     |
C      IP1 appartenant au maillage de surface, on va juste verifier   |
C      que ip1 ip2 ne coupe aucun element.                            |
C                                                                     |
C      IN EST VRAI SI LE POINT IP EST INTERNE AU MAILLAGE DE SUR-     |
C      FACE OU EST UN POINT DU MAILLAGE  DE SURFACE                   |
C      IN EST FAUX SI LE POINT IP EST EXTERNE AU MAILLAGE DE SUR-     |
C      FACE.                                                          |
C                                                                     |
C---------------------------------------------------------------------|
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
        logical in2dan
 
-INC PPARAM
-INC CCOPTIO
-INC TDEMAIT
C
*       WRITE(6,5000) nfcini,nfacet
*5000   FORMAT(' IN2 nfcini,nfacet ',i8,i8)
C      ------------------------
*      write (6,*) ' in2 ip1 ',xyz(1,ip1),xyz(2,ip1),xyz(3,ip1)
*      write (6,*) ' in2 ip2 ',xyz(1,ip2),xyz(2,ip2),xyz(3,ip2)
       DO 100 I=1,NFACET
          IF=IFUT(I)
          if (if.gt.nfcini) goto 100
          I1=NFC(1,IF)
          IF (IP1.EQ.I1) GOTO 100
          IF (IP2.EQ.I1) GOTO 100
          I2=NFC(2,IF)
          IF (IP1.EQ.I2) GOTO 100
          IF (IP2.EQ.I2) GOTO 100
          I3=NFC(3,IF)
          IF (IP1.EQ.I3) GOTO 100
          IF (IP2.EQ.I3) GOTO 100
          I4=NFC(4,IF)
          IF (IP1.EQ.I4) GOTO 100
          IF (IP2.EQ.I4) GOTO 100
*  ip1 et ip2 sont ils de part et d'autre du plan de la facette
          v1x=xyz(1,i1)-xyz(1,i2)
          v1y=xyz(2,i1)-xyz(2,i2)
          v1z=xyz(3,i1)-xyz(3,i2)
          v2x=xyz(1,i1)-xyz(1,i3)
          v2y=xyz(2,i1)-xyz(2,i3)
          v2z=xyz(3,i1)-xyz(3,i3)
          vnx=v1y*v2z-v1z*v2y
          vny=v1z*v2x-v1x*v2z
          vnz=v1x*v2y-v1y*v2x
          v1x=xyz(1,i1)-xyz(1,ip1)
          v1y=xyz(2,i1)-xyz(2,ip1)
          v1z=xyz(3,i1)-xyz(3,ip1)
          pm1=v1x*vnx+v1y*vny+v1z*vnz
          v2x=xyz(1,i1)-xyz(1,ip2)
          v2y=xyz(2,i1)-xyz(2,ip2)
          v2z=xyz(3,i1)-xyz(3,ip2)
          pm2=v2x*vnx+v2y*vny+v2z*vnz
          if (pm1*pm2.gt.0.) goto 100
*  ok touche t on le segment ?
*         write (6,*) ' in2 de part et d'' autre du plan ',pm1,pm2
          if (in2dan(ip1,ip2,i1,i2,i3,pm1,pm2)) goto 200
          if (i4.eq.0) goto 100
          v1x=xyz(1,i1)-xyz(1,i4)
          v1y=xyz(2,i1)-xyz(2,i4)
          v1z=xyz(3,i1)-xyz(3,i4)
          v2x=xyz(1,i1)-xyz(1,i3)
          v2y=xyz(2,i1)-xyz(2,i3)
          v2z=xyz(3,i1)-xyz(3,i3)
          vnx=v1y*v2z-v1z*v2y
          vny=v1z*v2x-v1x*v2z
          vnz=v1x*v2y-v1y*v2x
          v1x=xyz(1,i1)-xyz(1,ip1)
          v1y=xyz(2,i1)-xyz(2,ip1)
          v1z=xyz(3,i1)-xyz(3,ip1)
          pm1=v1x*vnx+v1y*vny+v1z*vnz
          v2x=xyz(1,i1)-xyz(1,ip2)
          v2y=xyz(2,i1)-xyz(2,ip2)
          v2z=xyz(3,i1)-xyz(3,ip2)
          pm2=v2x*vnx+v2y*vny+v2z*vnz
          if (pm1*pm2.gt.0.) goto 100
*  ok on touche touche t on le segment ?
*         write (6,*) ' in2 de part et d'' autre du plan '
          if (in2dan(ip1,ip2,i1,i3,i4,pm1,pm2)) goto 200
100    CONTINUE
       in2=.TRUE.
       return
 200   continue
 1000  FORMAT (' IN2 intersection facette segment')
C
       in2=.false.
       RETURN
       END