1 : C LIEUPT SOURCE CHAT 05/01/13 01:17:33 5004 2 : SUBROUTINE LIEUPT(EPSILO,NDIM,ITYG,XREEL,IZSH,JTEST) 3 : 4 : **************************************************************************** 5 : *** SP 'LIEUPT' : permet de determiner si pt considere est à l'interieur 6 : *** ou à l'exterieur de l'element considere à epsilon pres 7 : *** 8 : *** APPELES 1 = aucun 9 : *** APPELES 2 = 'LIEUP2' 10 : *** 11 : *** E = 'EPSILO' marge relative acceptée position pt % element 12 : *** 'NDIM' dimension de l'espace 13 : *** 'ITYG' entier caracterisant la geometrie de l'element considere 14 : *** 'XREEL' pt considere en coordonnees reelles 15 : *** 'IZSH' segment content coord reelles noeuds, fcts forme et base 16 : *** 17 : *** S = 'JTEST' vaut 1 si pt à l'interieur de l'elemt a epsilon pres, 0 sinon 18 : *** 19 : *** Auteur Cyril Nou 20 : **************************************************************************** 21 : 22 : IMPLICIT INTEGER(I-N) 23 : IMPLICIT REAL*8 (A-H,O-Z) 24 : SEGMENT IZSH 25 : REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9) 26 : ENDSEGMENT 27 : DIMENSION PT1(3),PT2(3),PT3(3),PT4(3),XREEL(3) 28 : DIMENSION ITRIAN(5),ICARRE(6),ICUBE(4,6),IPRISM(4,5),ITETRA(4,4) 29 : *** donnees ordonnées specifiquement pour chaque type d'element afin de 30 : *** parcourir les faces dans l'ordre croissant dans les diverses boucles 31 : DATA ITRIAN/1,2,3,1,2/ 32 : DATA ICARRE/1,2,3,4,1,2/ 33 : DATA ICUBE/1,2,3,5, 5,6,7,1, 1,2,6,3, 2,3,7,1, 3,4,8,1, 1,4,8,2/ 34 : DATA IPRISM/1,2,3,4, 4,5,6,1, 1,2,5,3, 2,3,6,1, 1,3,6,2/ 35 : DATA ITETRA/1,2,4,3, 1,2,3,4, 2,3,4,1, 1,3,4,2/ 36 : *** on postule initialement 'XREEL' appartient à element 37 : JTEST=1 38 : 39 : ************** 40 : *** CAS 2D *** 41 : ************** 42 : 43 : *** cas TRI3 (triangles), boucle sur les différentes faces 44 : IF (ITYG.EQ.4) THEN 45 : DO 10 I=1,3 46 : *** recuperation des pts definissant la face + l'origine 47 : DO 20 J=1,NDIM 48 : PT1(J)=XYZL(J,ITRIAN(I)) 49 : PT2(J)=XYZL(J,ITRIAN(I+1)) 50 : PT3(J)=XYZL(J,ITRIAN(I+2)) 51 : 20 CONTINUE 52 : *** teste la position de 'XREEL' par rapport à la face 52 : CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST) 53 : *** si 'XREEL' est du mauvais cote de la face 54 : IF (TEST.LT.(-EPSILO)) THEN 55 : *** 'JTEST'=0 car 'XREEL' est hors du TRI3 56 : JTEST=0 57 : RETURN 58 : ENDIF 59 : 10 CONTINUE 60 : *** cas QUA4 (quadrangles) 61 : ELSEIF (ITYG.EQ.8) THEN 62 : DO 30 I=1,4 63 : DO 40 J=1,NDIM 64 : PT1(J)=XYZL(J,ICARRE(I)) 65 : PT2(J)=XYZL(J,ICARRE(I+1)) 66 : PT3(J)=XYZL(J,ICARRE(I+2)) 67 : 40 CONTINUE 67 : CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST) 68 : IF (TEST.LT.(-EPSILO)) THEN 69 : JTEST=0 70 : RETURN 71 : ENDIF 72 : 30 CONTINUE 73 : 74 : ************** 75 : *** CAS 3D *** 76 : ************** 77 : 78 : *** cas CUB8 (cubes) 79 : ELSEIF (ITYG.EQ.14) THEN 80 : DO 50 I=1,6 81 : DO 60 J=1,NDIM 82 : PT1(J)=XYZL(J,ICUBE(1,I)) 83 : PT2(J)=XYZL(J,ICUBE(2,I)) 84 : PT3(J)=XYZL(J,ICUBE(3,I)) 85 : PT4(J)=XYZL(J,ICUBE(4,I)) 86 : 60 CONTINUE 86 : CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST) 87 : IF (TEST.LT.(-EPSILO)) THEN 88 : JTEST=0 89 : RETURN 90 : ENDIF 91 : 50 CONTINUE 92 : *** cas PRI6 (prismes) 93 : ELSEIF (ITYG.EQ.16) THEN 94 : DO 70 I=1,5 95 : DO 80 J=1,NDIM 96 : PT1(J)=XYZL(J,IPRISM(1,I)) 97 : PT2(J)=XYZL(J,IPRISM(2,I)) 98 : PT3(J)=XYZL(J,IPRISM(3,I)) 99 : PT4(J)=XYZL(J,IPRISM(4,I)) 100 : 80 CONTINUE 100 : CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST) 101 : IF (TEST.LT.(-EPSILO)) THEN 102 : JTEST=0 103 : RETURN 104 : ENDIF 105 : 70 CONTINUE 106 : *** cas TET4 (tetraedres) 107 : ELSEIF (ITYG.EQ.23) THEN 108 : DO 90 I=1,4 109 : DO 100 J=1,NDIM 110 : PT1(J)=XYZL(J,ITETRA(1,I)) 111 : PT2(J)=XYZL(J,ITETRA(2,I)) 112 : PT3(J)=XYZL(J,ITETRA(3,I)) 113 : PT4(J)=XYZL(J,ITETRA(4,I)) 114 : 100 CONTINUE 114 : CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST) 115 : IF (TEST.LT.(-EPSILO)) THEN 116 : JTEST=0 117 : RETURN 118 : ENDIF 119 : 90 CONTINUE 120 : ENDIF 121 : RETURN 122 : END 123 : 124 : 125 : 126 : 127 : 128 : 129 : 130 : 131 : 132 : 133 :
© Cast3M 2003 - All rights reserved.
Disclaimer