1 : C TESTAR SOURCE CHAT 05/01/13 03:36:16 5004 2 : SUBROUTINE TESTAR(EPSILO,ITYG,XREF,ITEST,INOEU1,INOEU2) 3 : ************************************************************************ 4 : *** SP 'TESTAR' : en coordonnees de reference, dans le cas 3D , teste un 5 : *** pt par rapport à un element pour savoir s'il appartient à l'une 6 : *** de ses aretes à 'EPSILO' près (erreur acceptable % à arete). 7 : *** 8 : *** APPELES 1 = aucun 9 : *** APPELES 2 = aucun 10 : *** 11 : *** E = 'EPSILO' erreur de précision de calcul (calibrage) acceptable 12 : *** 'ITYG' entier caracterisant la géométrie de l'élément 13 : *** 'XREF' coordonnées reference du pt considéré 14 : *** 15 : *** S = 'ITEST' vaut 1 si pt se trouve sur une arete, 0 sinon 16 : *** 'INOEU1' n° local premier noeud appartenant à arete, 0 sinon 17 : *** 'INOEU2' n° local deuxieme noeud appartenant à arete, 0 sinon 18 : ************************************************************************ 19 : IMPLICIT INTEGER(I-N) 20 : IMPLICIT REAL*8 (A-H,O-Z) 21 : DIMENSION XREF(3) 22 : ITEST=0 23 : INOEU1=0 24 : INOEU2=0 25 : *** element de reference est un cube CUB8 26 : IF (ITYG.EQ.14) THEN 27 : IF (ABS(1.D0-XREF(3)).LT.EPSILO) THEN 28 : IF (ABS(1.D0-XREF(1)).LT.EPSILO) THEN 29 : ITEST=1 30 : INOEU1=6 31 : INOEU2=7 32 : XREF(3)=1.D0 33 : XREF(1)=1.D0 34 : ELSEIF (ABS(1.D0+XREF(1)).LT.EPSILO) THEN 35 : ITEST=1 36 : INOEU1=5 37 : INOEU2=8 38 : XREF(3)=1.D0 39 : XREF(1)=-1.D0 40 : ELSEIF (ABS(1.D0-XREF(2)).LT.EPSILO) THEN 41 : ITEST=1 42 : INOEU1=7 43 : INOEU2=8 44 : XREF(3)=1.D0 45 : XREF(2)=1.D0 46 : ELSEIF (ABS(1.D0+XREF(2)).LT.EPSILO) THEN 47 : ITEST=1 48 : INOEU1=5 49 : INOEU2=6 50 : XREF(3)=1.D0 51 : XREF(2)=-1.D0 52 : ENDIF 53 : ELSEIF (ABS(1.D0+XREF(3)).LT.EPSILO) THEN 54 : IF (ABS(1.D0-XREF(1)).LT.EPSILO) THEN 55 : ITEST=1 56 : INOEU1=2 57 : INOEU2=3 58 : XREF(3)=-1.D0 59 : XREF(1)=1.D0 60 : ELSEIF (ABS(1.D0+XREF(1)).LT.EPSILO) THEN 61 : ITEST=1 62 : INOEU1=1 63 : INOEU2=4 64 : XREF(3)=-1.D0 65 : XREF(1)=-1.D0 66 : ELSEIF (ABS(1.D0-XREF(2)).LT.EPSILO) THEN 67 : ITEST=1 68 : INOEU1=3 69 : INOEU2=4 70 : XREF(3)=-1.D0 71 : XREF(2)=1.D0 72 : ELSEIF (ABS(1.D0+XREF(2)).LT.EPSILO) THEN 73 : ITEST=1 74 : INOEU1=1 75 : INOEU2=2 76 : XREF(3)=-1.D0 77 : XREF(2)=-1.D0 78 : ENDIF 79 : ELSEIF (ABS(1.D0-XREF(1)).LT.EPSILO) THEN 80 : IF (ABS(1.D0-XREF(2)).LT.EPSILO) THEN 81 : ITEST=1 82 : INOEU1=3 83 : INOEU2=7 84 : XREF(1)=1.D0 85 : XREF(2)=1.D0 86 : ELSEIF (ABS(1.D0+XREF(2)).LT.EPSILO) THEN 87 : ITEST=1 88 : INOEU1=2 89 : INOEU2=6 90 : XREF(1)=1.D0 91 : XREF(2)=-1.D0 92 : ENDIF 93 : ELSEIF (ABS(1.D0+XREF(1)).LT.EPSILO) THEN 94 : IF (ABS(1.D0-XREF(2)).LT.EPSILO) THEN 95 : ITEST=1 96 : INOEU1=4 97 : INOEU2=8 98 : XREF(1)=-1.D0 99 : XREF(2)=1.D0 100 : ELSEIF (ABS(1.D0+XREF(2)).LT.EPSILO) THEN 101 : ITEST=1 102 : INOEU1=1 103 : INOEU2=5 104 : XREF(1)=-1.D0 105 : XREF(2)=-1.D0 106 : ENDIF 107 : ENDIF 108 : *** element de reference est un prisme PRI6 109 : ELSEIF (ITYG.EQ.16) THEN 110 : IF (ABS(1.D0-XREF(3)).LT.EPSILO) THEN 111 : IF (ABS(XREF(1)).LT.EPSILO) THEN 112 : ITEST=1 113 : INOEU1=4 114 : INOEU2=6 115 : XREF(3)=1.D0 116 : XREF(1)=0.D0 117 : ELSEIF (ABS(XREF(2)).LT.EPSILO) THEN 118 : ITEST=1 119 : INOEU1=4 120 : INOEU2=5 121 : XREF(3)=1.D0 122 : XREF(2)=0.D0 123 : ELSEIF (ABS(1.D0-XREF(1)-XREF(2)).LT.EPSILO) THEN 124 : ITEST=1 125 : INOEU1=5 126 : INOEU2=6 127 : XREF(3)=1.D0 128 : XREF(2)=1.D0-XREF(1) 129 : ENDIF 130 : ELSEIF (ABS(1.D0+XREF(3)).LT.EPSILO) THEN 131 : IF (ABS(XREF(1)).LT.EPSILO) THEN 132 : ITEST=1 133 : INOEU1=1 134 : INOEU2=3 135 : XREF(3)=-1.D0 136 : XREF(1)=0.D0 137 : ELSEIF (ABS(XREF(2)).LT.EPSILO) THEN 138 : ITEST=1 139 : INOEU1=1 140 : INOEU2=2 141 : XREF(3)=-1.D0 142 : XREF(2)=0.D0 143 : ELSEIF (ABS(1.D0-XREF(1)-XREF(2)).LT.EPSILO) THEN 144 : ITEST=1 145 : INOEU1=2 146 : INOEU2=3 147 : XREF(3)=-1.D0 148 : XREF(2)=1.D0-XREF(1) 149 : ENDIF 150 : ELSEIF (ABS(XREF(2)).LT.EPSILO) THEN 151 : IF (ABS(XREF(1)).LT.EPSILO) THEN 152 : ITEST=1 153 : INOEU1=1 154 : INOEU2=4 155 : XREF(2)=0.D0 156 : XREF(1)=0.D0 157 : ELSEIF (ABS(1.D0-XREF(1)).LT.EPSILO) THEN 158 : ITEST=1 159 : INOEU1=2 160 : INOEU2=5 161 : XREF(1)=1.D0 162 : XREF(2)=0.D0 163 : ENDIF 164 : ELSEIF (ABS(1.D0-XREF(2)).LT.EPSILO) THEN 165 : IF (ABS(XREF(1)).LT.EPSILO) THEN 166 : ITEST=1 167 : INOEU1=3 168 : INOEU2=6 169 : XREF(2)=1.D0 170 : XREF(1)=0.D0 171 : ENDIF 172 : ENDIF 173 : *** element de reference est un tetraedre TET4 174 : ELSEIF (ITYG.EQ.23) THEN 175 : IF (ABS(XREF(3)).LT.EPSILO) THEN 176 : IF (ABS(XREF(1)).LT.EPSILO) THEN 177 : ITEST=1 178 : INOEU1=1 179 : INOEU2=3 180 : XREF(3)=0.D0 181 : XREF(1)=0.D0 182 : ELSEIF (ABS(XREF(2)).LT.EPSILO) THEN 183 : ITEST=1 184 : INOEU1=1 185 : INOEU2=2 186 : XREF(3)=0.D0 187 : XREF(2)=0.D0 188 : ELSEIF (ABS(1.D0-XREF(1)-XREF(2)).LT.EPSILO) THEN 189 : ITEST=1 190 : INOEU1=2 191 : INOEU2=3 192 : XREF(3)=0.D0 193 : XREF(2)=1.D0-XREF(1) 194 : ENDIF 195 : ELSEIF (ABS(XREF(2)).LT.EPSILO) THEN 196 : IF (ABS(XREF(1)).LT.EPSILO) THEN 197 : ITEST=1 198 : INOEU1=1 199 : INOEU2=4 200 : XREF(2)=0.D0 201 : XREF(1)=0.D0 202 : ELSEIF (ABS(1.D0-XREF(1)-XREF(3)).LT.EPSILO) THEN 203 : ITEST=1 204 : INOEU1=2 205 : INOEU2=4 206 : XREF(2)=0.D0 207 : XREF(3)=1.D0-XREF(1) 208 : ENDIF 209 : ELSEIF (ABS(XREF(1)).LT.EPSILO) THEN 210 : IF (ABS(1.D0-XREF(2)-XREF(3)).LT.EPSILO) THEN 211 : ITEST=1 212 : INOEU1=3 213 : INOEU2=4 214 : XREF(1)=0.D0 215 : XREF(3)=1.D0-XREF(2) 216 : ENDIF 217 : ENDIF 218 : ENDIF 219 : RETURN 220 : END 221 : 222 : 223 :
© Cast3M 2003 - All rights reserved.
Disclaimer