1 : C ARTREF SOURCE CHAT 05/01/12 21:25:24 5004 2 : SUBROUTINE ARTREF(X,ITYP,IART) 3 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4 : C 5 : C RECHERCHE IART NUMERO DE L ARETE OU SE TROUVE LE POINT DE 6 : C COORDONNEES X DANS L'ELEMENT DE REFERENCE 7 : C 8 : C ITYP TYPE DE L ELEMENT (3D ) 9 : C 10 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 11 : IMPLICIT INTEGER(I-N) 12 : IMPLICIT REAL*8 (A-H,O-Z) 13 : DIMENSION X(*) 14 : EPS=1.D-15 15 : IART=0 16 : IF(ITYP.EQ.14)THEN 17 : C L ELEMENT DE REFERENCE EST UN CUBE 18 : IF(ABS(1.D0-X(3)).LT.EPS)THEN 19 : IF(ABS(1.D0-X(1)).LT.EPS)THEN 20 : IART=3 21 : X(3)=1.D0 22 : X(1)=1.D0 23 : ELSEIF(ABS(1.D0+X(1)).LT.EPS)THEN 24 : IART=4 25 : X(3)=1.D0 26 : X(1)=-1.D0 27 : ELSEIF(ABS(1.D0-X(2)).LT.EPS)THEN 28 : IART=7 29 : X(3)=1.D0 30 : X(2)=1.D0 31 : ELSEIF(ABS(1.D0+X(2)).LT.EPS)THEN 32 : IART=8 33 : X(3)=1.D0 34 : X(2)=-1.D0 35 : ELSE 36 : RETURN 37 : ENDIF 38 : ELSEIF(ABS(1.D0+X(3)).LT.EPS)THEN 39 : IF(ABS(1.D0-X(1)).LT.EPS)THEN 40 : IART=2 41 : X(3)=-1.D0 42 : X(1)=1.D0 43 : ELSEIF(ABS(1.D0+X(1)).LT.EPS)THEN 44 : IART=1 45 : X(3)=-1.D0 46 : X(1)=-1.D0 47 : ELSEIF(ABS(1.D0-X(2)).LT.EPS)THEN 48 : IART=6 49 : X(3)=-1.D0 50 : X(2)=1.D0 51 : ELSEIF(ABS(1.D0+X(2)).LT.EPS)THEN 52 : IART=5 53 : X(3)=-1.D0 54 : X(2)=-1.D0 55 : ELSE 56 : RETURN 57 : ENDIF 58 : ELSEIF(ABS(1.D0-X(1)).LT.EPS)THEN 59 : IF(ABS(1.D0-X(2)).LT.EPS)THEN 60 : IART=11 61 : X(1)=1.D0 62 : X(2)=1.D0 63 : ELSEIF(ABS(1.D0+X(2)).LT.EPS)THEN 64 : IART=10 65 : X(1)=1.D0 66 : X(2)=-1.D0 67 : ELSE 68 : RETURN 69 : ENDIF 70 : ELSEIF(ABS(1.D0+X(1)).LT.EPS)THEN 71 : IF(ABS(1.D0-X(2)).LT.EPS)THEN 72 : IART=12 73 : X(1)=-1.D0 74 : X(2)=1.D0 75 : ELSEIF(ABS(1.D0+X(2)).LT.EPS)THEN 76 : IART=9 77 : X(1)=-1.D0 78 : X(2)=-1.D0 79 : ELSE 80 : RETURN 81 : ENDIF 82 : ENDIF 83 : ELSEIF(ITYP.EQ.16)THEN 84 : C L ELEMENT DE REFERENCE EST UN PRISME 85 : IF(ABS(1.D0-X(3)).LT.EPS)THEN 86 : IF(ABS(X(1)).LT.EPS)THEN 87 : IART=2 88 : X(3)=1.D0 89 : X(1)=0.D0 90 : ELSEIF(ABS(X(2)).LT.EPS)THEN 91 : IART=4 92 : X(3)=1.D0 93 : X(2)=0.D0 94 : ELSEIF(ABS(1.D0-X(1)-X(2)).LT.EPS)THEN 95 : IART=6 96 : X(3)=1.D0 97 : X(2)=1.D0-X(1) 98 : ELSE 99 : RETURN 100 : ENDIF 101 : ELSEIF(ABS(1.D0+X(3)).LT.EPS)THEN 102 : IF(ABS(X(1)).LT.EPS)THEN 103 : IART=1 104 : X(3)=-1.D0 105 : X(1)=0.D0 106 : ELSEIF(ABS(X(2)).LT.EPS)THEN 107 : IART=3 108 : X(3)=-1.D0 109 : X(2)=0.D0 110 : ELSEIF(ABS(1.D0-X(1)-X(2)).LT.EPS)THEN 111 : IART=5 112 : X(3)=-1.D0 113 : X(2)=1.D0-X(1) 114 : ELSE 115 : RETURN 116 : ENDIF 117 : ELSEIF(ABS(X(2)).LT.EPS)THEN 118 : IF(ABS(X(1)).LT.EPS)THEN 119 : IART=7 120 : X(2)=0.D0 121 : X(1)=0.D0 122 : ELSEIF(ABS(1.D0-X(1)).LT.EPS)THEN 123 : IART=8 124 : X(1)=1.D0 125 : X(2)=0.D0 126 : ELSE 127 : RETURN 128 : ENDIF 129 : ELSEIF(ABS(1.D0-X(2)).LT.EPS)THEN 130 : IF(ABS(X(1)).LT.EPS)THEN 131 : IART=9 132 : X(2)=1.D0 133 : X(1)=0.D0 134 : ELSE 135 : RETURN 136 : ENDIF 137 : ENDIF 138 : ELSEIF(ITYP.EQ.23)THEN 139 : C L ELEMENT DE REFERENCE EST TETRAEDRE 140 : IF(ABS(X(3)).LT.EPS)THEN 141 : IF(ABS(X(1)).LT.EPS)THEN 142 : IART=2 143 : X(3)=0.D0 144 : X(1)=0.D0 145 : ELSEIF(ABS(X(2)).LT.EPS)THEN 146 : IART=1 147 : X(3)=0.D0 148 : X(2)=0.D0 149 : ELSEIF(ABS(1.D0-X(1)-X(2)).LT.EPS)THEN 150 : IART=4 151 : X(3)=0.D0 152 : X(2)=1.D0-X(1) 153 : ELSE 154 : RETURN 155 : ENDIF 156 : ELSEIF(ABS(X(2)).LT.EPS)THEN 157 : IF(ABS(X(1)).LT.EPS)THEN 158 : IART=3 159 : X(2)=0.D0 160 : X(1)=0.D0 161 : ELSEIF(ABS(1.D0-X(1)-X(3)).LT.EPS)THEN 162 : IART=6 163 : X(2)=0.D0 164 : X(3)=1.D0-X(1) 165 : ELSE 166 : RETURN 167 : ENDIF 168 : ELSEIF(ABS(X(1)).LT.EPS)THEN 169 : IF(ABS(1.D0-X(2)-X(3)).LT.EPS)THEN 170 : IART=5 171 : X(1)=0.D0 172 : X(3)=1.D0-X(2) 173 : ELSE 174 : RETURN 175 : ENDIF 176 : ENDIF 177 : ELSE 177 : CALL ERREUR(16) 178 : ENDIF 179 : RETURN 180 : END 181 : 182 :
© Cast3M 2003 - All rights reserved.
Disclaimer