1 : C IN2 SOURCE PV 07/10/05 21:16:03 5890 2 : C---------------------------------------------------------------------| 3 : C | 4 : LOGICAL FUNCTION IN2(IP1,IP2,NFCINI) 5 : C | 6 : C CETTE FONCTION LOGIQUE VERIFIE QUE LE POINT IP2 (QUI VIENT | 7 : C D'ETRE CREE ), EST BIEN A L'INTERIEUR DU MAILLAGE DE SUR- | 8 : C FACE. | 9 : C | 10 : C IP1 appartenant au maillage de surface, on va juste verifier | 11 : C que ip1 ip2 ne coupe aucun element. | 12 : C | 13 : C IN EST VRAI SI LE POINT IP EST INTERNE AU MAILLAGE DE SUR- | 14 : C FACE OU EST UN POINT DU MAILLAGE DE SURFACE | 15 : C IN EST FAUX SI LE POINT IP EST EXTERNE AU MAILLAGE DE SUR- | 16 : C FACE. | 17 : C | 18 : C---------------------------------------------------------------------| 19 : C 20 : IMPLICIT INTEGER(I-N) 21 : IMPLICIT REAL*8(A-H,O-Z) 22 : logical in2dan 23 : -INC CCOPTIO 24 : -INC TDEMAIT 25 : C 26 : * WRITE(6,5000) nfcini,nfacet 27 : *5000 FORMAT(' IN2 nfcini,nfacet ',i8,i8) 28 : C ------------------------ 29 : * write (6,*) ' in2 ip1 ',xyz(1,ip1),xyz(2,ip1),xyz(3,ip1) 30 : * write (6,*) ' in2 ip2 ',xyz(1,ip2),xyz(2,ip2),xyz(3,ip2) 31 : DO 100 I=1,NFACET 32 : IF=IFUT(I) 33 : if (if.gt.nfcini) goto 100 34 : I1=NFC(1,IF) 35 : IF (IP1.EQ.I1) GOTO 100 36 : IF (IP2.EQ.I1) GOTO 100 37 : I2=NFC(2,IF) 38 : IF (IP1.EQ.I2) GOTO 100 39 : IF (IP2.EQ.I2) GOTO 100 40 : I3=NFC(3,IF) 41 : IF (IP1.EQ.I3) GOTO 100 42 : IF (IP2.EQ.I3) GOTO 100 43 : I4=NFC(4,IF) 44 : IF (IP1.EQ.I4) GOTO 100 45 : IF (IP2.EQ.I4) GOTO 100 46 : * ip1 et ip2 sont ils de part et d'autre du plan de la facette 47 : v1x=xyz(1,i1)-xyz(1,i2) 48 : v1y=xyz(2,i1)-xyz(2,i2) 49 : v1z=xyz(3,i1)-xyz(3,i2) 50 : v2x=xyz(1,i1)-xyz(1,i3) 51 : v2y=xyz(2,i1)-xyz(2,i3) 52 : v2z=xyz(3,i1)-xyz(3,i3) 53 : vnx=v1y*v2z-v1z*v2y 54 : vny=v1z*v2x-v1x*v2z 55 : vnz=v1x*v2y-v1y*v2x 56 : v1x=xyz(1,i1)-xyz(1,ip1) 57 : v1y=xyz(2,i1)-xyz(2,ip1) 58 : v1z=xyz(3,i1)-xyz(3,ip1) 59 : pm1=v1x*vnx+v1y*vny+v1z*vnz 60 : v2x=xyz(1,i1)-xyz(1,ip2) 61 : v2y=xyz(2,i1)-xyz(2,ip2) 62 : v2z=xyz(3,i1)-xyz(3,ip2) 63 : pm2=v2x*vnx+v2y*vny+v2z*vnz 64 : if (pm1*pm2.gt.0.) goto 100 65 : * ok touche t on le segment ? 66 : * write (6,*) ' in2 de part et d'' autre du plan ',pm1,pm2 67 : if (in2dan(ip1,ip2,i1,i2,i3,pm1,pm2)) goto 200 68 : if (i4.eq.0) goto 100 69 : v1x=xyz(1,i1)-xyz(1,i4) 70 : v1y=xyz(2,i1)-xyz(2,i4) 71 : v1z=xyz(3,i1)-xyz(3,i4) 72 : v2x=xyz(1,i1)-xyz(1,i3) 73 : v2y=xyz(2,i1)-xyz(2,i3) 74 : v2z=xyz(3,i1)-xyz(3,i3) 75 : vnx=v1y*v2z-v1z*v2y 76 : vny=v1z*v2x-v1x*v2z 77 : vnz=v1x*v2y-v1y*v2x 78 : v1x=xyz(1,i1)-xyz(1,ip1) 79 : v1y=xyz(2,i1)-xyz(2,ip1) 80 : v1z=xyz(3,i1)-xyz(3,ip1) 81 : pm1=v1x*vnx+v1y*vny+v1z*vnz 82 : v2x=xyz(1,i1)-xyz(1,ip2) 83 : v2y=xyz(2,i1)-xyz(2,ip2) 84 : v2z=xyz(3,i1)-xyz(3,ip2) 85 : pm2=v2x*vnx+v2y*vny+v2z*vnz 86 : if (pm1*pm2.gt.0.) goto 100 87 : * ok on touche touche t on le segment ? 88 : * write (6,*) ' in2 de part et d'' autre du plan ' 89 : if (in2dan(ip1,ip2,i1,i3,i4,pm1,pm2)) goto 200 90 : 100 CONTINUE 91 : in2=.TRUE. 92 : return 93 : 200 continue 94 : 1000 FORMAT (' IN2 intersection facette segment') 95 : C 96 : in2=.false. 97 : RETURN 98 : END 99 : 100 :
© Cast3M 2003 - All rights reserved.
Disclaimer