1 : C TESTFA SOURCE CHAT 05/01/13 03:36:24 5004 2 : SUBROUTINE TESTFA(EPSILO,NDIM,ITYG 3 : $ ,XREEL,IZSH,JFACE,PT1,PT2,PT3,PT4) 4 : 5 : ************************************************************************* 6 : *** SP 'TESTFA' : permet de tester % element considéré appartenance pt à 7 : *** l'une des faces associées, renvoie alors n° local face ou se trouve pt. 8 : *** 9 : *** APPELES 1 = aucun 10 : *** APPELES 2 = 'LIEUP2' 11 : *** 12 : *** E = 'EPSILO' marge relative acceptée position pt % element 13 : *** 'NDIM' dimension de l'espace 14 : *** 'ITYG' entier caracterisant la geometrie de l'element 15 : *** 'XREEL' coordonnees reelles du pt considéré 16 : *** 'IZSH' segment content coords reelles des noeuds de l'elemt considere 17 : *** 18 : *** S = 'JFACE' n° local face ou se trouve particule, -1 sinon 19 : *** 'PT1', 'PT2', 'PT3', 'PT4' noeuds appartenant à la face 20 : *** 21 : *** Rq : developpee seulement pour ITYPEL = 4,8,14,16 et 23 22 : *** 23 : *** 24 : *** Auteur Cyril Nou 25 : ************************************************************************* 26 : 27 : IMPLICIT INTEGER(I-N) 28 : IMPLICIT REAL*8 (A-H,O-Z) 29 : SEGMENT IZSH 30 : REAL*8 SHP(6,MNO9),SHY(12,MNO9),XYZL(3,MNO9) 31 : ENDSEGMENT 32 : DIMENSION XREEL(3) 33 : DIMENSION PT1(3),PT2(3),PT3(3),PT4(3) 34 : DIMENSION ITRIAN(5),ICARRE(6),ICUBE(4,6),IPRISM(4,5),ITETRA(4,4) 35 : *** donnees ordonnées specifiquement pour chaque type d'element afin de 36 : *** parcourir les faces dans l'ordre croissant dans les diverses boucles 37 : DATA ITRIAN/1,2,3,1,2/ 38 : DATA ICARRE/1,2,3,4,1,2/ 39 : 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/ 40 : DATA IPRISM/1,2,3,4, 4,5,6,1, 1,2,5,3, 2,3,6,1, 1,3,6,2/ 41 : DATA ITETRA/1,2,4,3, 1,2,3,4, 2,3,4,1, 1,3,4,2/ 42 : *** on postule initialement non appartenance à face 43 : JFACE=-1 44 : 45 : *** cas TRI3 (triangles), boucle sur les différentes faces 46 : IF (ITYG.EQ.4) THEN 47 : DO 10 I=1,3 48 : *** recuperation des pts definissant la face 49 : DO 20 J=1,NDIM 50 : PT1(J)=XYZL(J,ITRIAN(I)) 51 : PT2(J)=XYZL(J,ITRIAN(I+1)) 52 : PT3(J)=XYZL(J,ITRIAN(I+2)) 53 : 20 CONTINUE 53 : CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST) 54 : *** 'TEST'=0. si appartenance à face considérée 55 : IF (ABS(TEST).LE.EPSILO) THEN 56 : JFACE=I 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 (ABS(TEST).LE.EPSILO) THEN 69 : JFACE=I 70 : RETURN 71 : ENDIF 72 : 30 CONTINUE 73 : *** cas CUB8 (cubes) 74 : ELSEIF (ITYG.EQ.14) THEN 75 : DO 50 I=1,6 76 : DO 60 J=1,NDIM 77 : PT1(J)=XYZL(J,ICUBE(1,I)) 78 : PT2(J)=XYZL(J,ICUBE(2,I)) 79 : PT3(J)=XYZL(J,ICUBE(3,I)) 80 : PT4(J)=XYZL(J,ICUBE(4,I)) 81 : 60 CONTINUE 81 : CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST) 82 : IF (ABS(TEST).LE.EPSILO) THEN 83 : JFACE=I 84 : RETURN 85 : ENDIF 86 : 50 CONTINUE 87 : *** cas PRI6 (prismes) 88 : ELSEIF (ITYG.EQ.16) THEN 89 : DO 70 I=1,5 90 : DO 80 J=1,NDIM 91 : PT1(J)=XYZL(J,IPRISM(1,I)) 92 : PT2(J)=XYZL(J,IPRISM(2,I)) 93 : PT3(J)=XYZL(J,IPRISM(3,I)) 94 : PT4(J)=XYZL(J,IPRISM(4,I)) 95 : 80 CONTINUE 95 : CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST) 96 : IF (ABS(TEST).LE.EPSILO) THEN 97 : JFACE=I 98 : RETURN 99 : ENDIF 100 : 70 CONTINUE 101 : *** cas TET4 (tetraedres) 102 : ELSEIF (ITYG.EQ.23) THEN 103 : DO 90 I=1,4 104 : DO 100 J=1,NDIM 105 : PT1(J)=XYZL(J,ITETRA(1,I)) 106 : PT2(J)=XYZL(J,ITETRA(2,I)) 107 : PT3(J)=XYZL(J,ITETRA(3,I)) 108 : PT4(J)=XYZL(J,ITETRA(4,I)) 109 : 100 CONTINUE 109 : CALL LIEUP2(NDIM,PT1,PT2,PT3,PT4,XREEL,TEST) 110 : IF (ABS(TEST).LE.EPSILO) THEN 111 : JFACE=I 112 : RETURN 113 : ENDIF 114 : 90 CONTINUE 115 : ENDIF 116 : 117 : RETURN 118 : END 119 : 120 : 121 :
© Cast3M 2003 - All rights reserved.
Disclaimer