1 : C TRJTRJ SOURCE CHAT 05/01/13 03:51:36 5004 2 : SUBROUTINE TRJTRJ(Y,X,ITYP,JTYP,JFA,IFA,IOR) 3 : C 4 : C 5 : C ISSU DE TRATRA DANS TRIOEF 6 : C UTILISE DANS LE CALCUL DES TRAJECTOIRES AU CHANGEMENT D ELEMENT 7 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 8 : C 9 : C S Y COORDONNEES DE REFERENCES DANS L ELEMENT D ARRIVEE 10 : C E X " " " " " " DE DEPART 11 : C 12 : C E ITYP TYPE DE L ELEMENT DE DEPART 13 : C E JTYP " " " D ARRIVEE 14 : C 15 : C E IFA NUMERO DE LA FACE DE DEPART 16 : C E JFA " " " " D ARRIVEE 17 : C 18 : C E IOR ORIENTATION DES DEUX FACES EN VIS A VIS 19 : C 20 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 21 : C 22 : C METHODE: ON UTILISE LES RELATIONS ENTRE COORDONNEES BARYCENTRIQUES 23 : C ET COORDONNEES DE REFERENCES. 24 : C ON EXPRIME LES COORDONNEES BARYCENTRIQUE DU POINT 25 : C PAR RAPPORT AU SOMMETS DE LA FACE DANS CHACUN DES ELEMENTS 26 : C CONCERNES. ON EN DEDUIT LES COORDONNEES DE REFERENCE DANS 27 : C L ELEMENT D'ARRIVEE 28 : C 29 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 30 : C 31 : C 32 : C 33 : IMPLICIT INTEGER(I-N) 34 : IMPLICIT REAL*8 (A-H,O-Z) 35 : C 36 : DIMENSION Y(3),X(3),X1(4),Z(4) 37 : DIMENSION IATRI(3,3),IJKTRI(3,3) 38 : DIMENSION IAQUA(4,4),IJKQUA(2,2),SQUA(2,4),ISQUA(4,4) 39 : DIMENSION IATQ(3,4),IJKTQ(2,4),ITQ(3,4) 40 : DIMENSION IAQT(4,3),IJKQT(2,4),IQT(4,3) 41 : DIMENSION IAPRI(4,5,5),IJKPRI(3,21),SPRI(3,8),DPRI(3,4) 42 : DIMENSION IDPRI(4,5,5),IPRI(4,5,5) 43 : DIMENSION IACUB(4,6,6),IJKCUB(3,24),SCUB(3,24),CPM(3) 44 : DIMENSION CPD(3),JPC(4,5,6),BCP(3,3),ACP(3,3),IBCP(4,5,6) 45 : DIMENSION IACP(3,12),IJKCP(4,6,5),SCP(3,8),ICP(4,6,5) 46 : DIMENSION IAPC(3,12),JAPC(4,5,6) 47 : DIMENSION ICTET4(4,24),ITTET4(3,4,4),ITET4P(3,4),IPTET4(3,4,2) 48 : C 49 : C 50 : C 51 : DATA IATRI/3,1,2, 1,2,3, 2,3,1/ 52 : DATA IJKTRI/1,3,2, 2,1,3, 3,2,1/ 53 : C 54 : DATA IAQUA / 1,2,1,2, 2,1,2,1, 1,2,1,2, 2,1,2,1/ 55 : DATA ISQUA / 2,4,1,3, 4,1,3,2, 1,3,2,4, 3,2,4,1/ 56 : DATA IJKQUA/1,2, 2,1/ 57 : DATA SQUA/1.,-1., -1.,1., 1.,1., -1.,-1./ 58 : C 59 : DATA IAQT / 1,2,1,2, 4,3,4,3, 2,1,2,1/ 60 : DATA IJKQT/1,2, 2,1, 2,2, 1,1/ 61 : DATA IQT / 2,4,1,3, 1,1,2,2, 3,2,4,1/ 62 : C 63 : DATA IATQ / 1,4,2, 2,3,1, 1,4,2, 2,3,1 / 64 : DATA IJKTQ/1,2, 2,1, 3,2, 2,3/ 65 : DATA ITQ / 2,2,3, 4,4,2, 1,1,4, 3,3,1 / 66 : C 67 : DATA IJKPRI/1,4,2, 1,2,4, 1,4,3, 1,3,4, 68 : * 2,1,4, 2,3,4, 2,4,3, 2,4,1, 69 : * 3,2,4, 3,4,1, 3,1,4, 3,4,2, 70 : * 4,1,2, 4,3,1, 4,1,3, 4,2,3, 4,3,2, 4,2,1, 71 : * 4,4,2, 4,4,1, 4,4,3/ 72 : DATA SPRI/1.,1.,1., 1.,1.,-1., 1.,0.5,2., 1.,-0.5,2., 73 : * -0.5,1.,2., 0.5,1.,2., 0.5,-0.5,2., -0.5,0.5,2./ 74 : DATA DPRI /0.,0.,0., 0.,0.5,-1., 0.5,0.,-1., 0.5,0.5,-1./ 75 : DATA IAPRI /5,4,9,1, 2,11, 6, 1, 1, 1, 1, 1, 1, 1, 1, 1, 76 : * 1, 1, 1, 1, 2, 6,11, 1, 5, 9, 4, 1, 1, 1, 1, 1, 77 : * 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 78 : * 18, 2,16, 9, 20,11,21, 4, 5, 8, 6, 7, 1, 1, 1, 1, 79 : * 1, 1, 1, 1, 17, 6,14, 4, 19, 2,20, 5, 9,12,11,10, 80 : * 1, 1, 1, 1, 1, 1, 1, 1, 5,15,11,13, 9,21, 6,19, 81 : * 1, 4, 3, 2 / 82 : DATA IPRI/ 1,1,1,1, 2,2,2,1, 1,1,1,1, 1,1,1,1, 1,1,1,1, 83 : * 2,2,2,1, 1,1,1,1, 1,1,1,1, 1,1,1,1, 1,1,1,1, 84 : * 1,1,1,1, 1,1,1,1, 6,2,5,1, 8,2,7,1, 1,4,2,3, 85 : * 1,1,1,1, 1,1,1,1, 6,2,5,1, 8,2,7,1, 1,4,2,3, 86 : * 1,1,1,1, 1,1,1,1, 1,6,2,5, 1,8,2,7, 3,1,4,2 / 87 : DATA IDPRI / 20*1, 20*1, 88 : * 1,1,1,1, 1,1,1,1, 3,1,3,1, 4,1,4,1, 1,2,1,2, 89 : * 1,1,1,1, 1,1,1,1, 3,1,3,1, 4,1,4,1, 1,2,1,2, 90 : * 1,1,1,1, 1,1,1,1, 1,3,1,3, 1,4,1,4, 2,1,2,1 / 91 : C 92 : DATA IJKCUB/1,3,2, 1,2,3, 1,3,2, 1,2,3, 93 : * 1,2,3, 1,3,2, 1,2,3, 1,3,2, 94 : * 2,1,3, 2,3,1, 2,1,3, 2,3,1, 95 : * 2,3,1, 2,1,3, 2,3,1, 2,1,3, 96 : * 3,2,1, 3,1,2, 3,2,1, 3,1,2, 97 : * 3,1,2, 3,2,1, 3,1,2, 3,2,1/ 98 : DATA SCUB/1.,1.,1., 1.,-1.,1., 1.,-1.,-1., 1.,1.,-1., 99 : * -1.,1.,1., -1.,1.,-1., -1.,-1.,-1., -1.,-1.,1., 100 : * 1.,1.,1., 1.,-1.,1., 1.,-1.,-1., 1.,1.,-1., 101 : * -1.,1.,1., -1.,1.,-1., -1.,-1.,-1., -1.,-1.,1., 102 : * 1.,1.,1., 1.,-1.,1., 1.,-1.,-1., 1.,1.,-1., 103 : * -1.,1.,1., -1.,1.,-1., -1.,-1.,-1., -1.,-1.,1./ 104 : DATA IACUB/ 9, 5,16, 2, 4,14, 7,11, 1,21, 8,18, 12,22,15,19, 105 : * 20, 6,23, 3, 17,13,24,10, 4,11, 7,14, 9, 2,16, 5, 106 : * 20, 3,23, 6, 17,10,24,13, 1,18, 8,21, 12,19,15,22, 107 : * 1,12, 6,13, 10, 3,15, 8, 17, 4,22, 5, 18,11,23,16, 108 : * 2,19, 7,24, 9,20,14,21, 21,22,23,24, 17,20,19,18, 109 : * 13,14,15,16, 1, 4, 3, 2, 9,12,11,10, 5, 6, 7, 8, 110 : * 10, 8,15, 3, 1,13, 6,12, 2,24, 7,19, 9,21,14,20, 111 : * 17, 5,22, 4, 18,16,23,24, 17,18,19,20, 21,24,23,22, 112 : * 9,10,11,12, 5, 8, 7, 6, 13,16,15,14, 1, 2, 3, 4 / 113 : C 114 : C 115 : DATA IACP/1,2,3, 1,3,2, 1,1,3, 1,1,2, 116 : * 2,1,3, 2,3,1, 2,2,3, 2,2,1, 117 : * 3,1,2, 3,2,1, 3,3,2, 3,3,1/ 118 : DATA JAPC / 8*0, 2, 6, 2, 6, 12, 8,12, 8, 6, 4, 6, 4, 119 : * 8*0, 6, 2, 6, 2, 8,12, 8,12, 4, 6, 4, 6, 120 : * 8*0, 6, 1, 6, 1, 9, 5, 9, 5, 3, 7, 3, 7, 121 : * 8*0, 4, 3, 4, 3, 11,10,11,10, 1, 2, 1, 2, 122 : * 8*0, 1, 6, 1, 6, 5, 9, 5, 9, 7, 3, 7, 3, 123 : * 8*0, 3, 4, 3, 4, 10,11,10,11, 2, 1, 2, 1 / 124 : DATA IAPC/1,2,3, 1,3,2, 2,1,3, 2,3,1, 2,4,3, 3,2,1, 125 : * 3,1,2, 3,2,4, 3,4,2, 4,2,3, 4,3,2, 2,3,4/ 126 : DATA IJKCP / 48*0, 127 : * 2, 6, 2, 6, 6, 2, 6, 2, 10, 1,10, 1, 9, 5, 9, 5, 128 : * 1,10, 1,10, 5, 9, 5, 9, 4, 8, 4, 8, 8, 4, 8, 4, 129 : * 12, 3,12, 3, 11, 7,11, 7, 3,12, 3,12, 7,11, 7,11, 130 : * 10, 9,10, 9, 9,10, 9,10, 5, 6, 5, 6, 1, 2, 1, 2, 131 : * 6, 5, 6, 5, 2, 1, 2, 1 / 132 : DATA SCP/1.,1.,1., 1.,-1.,1., 1.,1.,-1., 1.,-1.,-1., 133 : * -1.,1.,1., -1.,-1.,1., -1.,1.,-1., -1.,-1.,-1./ 134 : DATA ICP / 48*0 , 135 : * 1,3,7,5, 2,4,3,6, 1,3,7,5, 2,4,8,6, 2,4,8,6, 1,3,7,5, 136 : * 5,7,4,2, 5,7,4,2, 5,7,4,2, 5,7,4,2, 5,7,4,2, 5,7,4,2, 137 : * 1,2,4,3, 5,6,8,7, 1,2,4,3, 5,6,8,7, 5,6,8,7, 1,2,4,3 / 138 : DATA JPC / 0,0,0,0, 0,0,0,0, 1,5,6,2, 1,5,6,2, 1,5,6,2, 139 : * 0,0,0,0, 0,0,0,0, 3,4,8,7, 3,4,8,7, 3,4,8,7, 140 : * 0,0,0,0, 0,0,0,0, 1,3,7,5, 1,3,7,5, 1,3,7,5, 141 : * 0,0,0,0, 0,0,0,0, 5,7,8,6, 5,7,8,6, 5,7,8,6, 142 : * 0,0,0,0, 0,0,0,0, 2,6,8,4, 2,6,8,4, 2,6,8,4, 143 : * 0,0,0,0, 0,0,0,0, 1,2,4,3, 1,2,4,3, 1,2,4,3/ 144 : DATA BCP/2.,2.,1., 2.,1.,2., 1.,2.,2./ 145 : DATA ACP/1.,1.,0., 1.,0.,1., 0.,1.,1./ 146 : DATA IBCP/ 0,0,0,0, 0,0,0,0, 2,3,2,3, 2,3,2,3, 3,2,3,2, 147 : * 0,0,0,0, 0,0,0,0, 3,2,3,2, 3,2,3,2, 2,3,2,3, 148 : * 0,0,0,0, 0,0,0,0, 3,1,3,1, 3,1,3,1, 1,3,1,3, 149 : * 0,0,0,0, 0,0,0,0, 2,1,2,1, 2,1,2,1, 1,2,1,2, 150 : * 0,0,0,0, 0,0,0,0, 1,3,1,3, 1,3,1,3, 3,1,3,1, 151 : * 0,0,0,0, 0,0,0,0, 1,2,1,2, 1,2,1,2, 2,1,2,1/ 152 : DATA CPD/0.5,0.5,1.0/ 153 : DATA CPM/0.5,0.5,0.0/ 154 : C ICTET4 TOUTES LES PERMUTATIONS DES COORDONNEES BARYCENTRIQUES 155 : C DU TETRAEDRE QUI VONT ETRE UTILISEES 156 : C ITTET4 IPTET4 ITET4P POINTEURS DANS CE TABLEAU 157 : DATA ICTET4/ 1,2,3,4, 1,3,4,2, 1,4,2,3, 158 : * 2,1,4,3, 2,3,1,4, 2,4,3,1, 159 : * 3,2,4,1, 3,1,2,4, 3,4,1,2, 160 : * 4,2,1,3, 4,3,2,1, 4,1,3,2, 161 : * 1,2,4,3, 1,3,2,4, 1,4,3,2, 162 : * 2,1,3,4, 2,3,4,1, 2,4,1,3, 163 : * 3,2,1,4, 3,1,4,2, 3,4,2,1, 164 : * 4,2,3,1, 4,3,1,2, 4,1,2,3/ 165 : DATA IPTET4/ 6,9,3, 7,2,4, 1,5,8, 11,12,10, 166 : * 21,15,18, 17,20,13, 14,16,19, 22,23,24/ 167 : DATA ITTET4/ 11,5,2, 6,1,12, 3,10,4, 7,8,9, 168 : * 6,9,3, 7,2,4, 1,5,8, 11,12,10, 169 : * 12,8,4, 9,5,10, 6,11,7, 2,1,3, 170 : * 7,10,1, 11,3,8 , 2,9,12, 6,4,5/ 171 : DATA ITET4P /6,1,12, 7,2,4, 9,5,10, 11,3,8/ 172 : C 173 : C 174 : C 175 : IF(ITYP.EQ.4) GO TO 30 176 : IF(ITYP.EQ.8) GO TO 40 177 : IF(ITYP.EQ.6) GO TO 30 178 : IF(ITYP.EQ.7) GO TO 30 179 : IF(ITYP.EQ.11) GO TO 40 180 : IF(ITYP.EQ.16) GO TO 60 181 : IF(ITYP.EQ.14) GO TO 80 182 : IF(ITYP.EQ.23) GO TO 90 183 : C 184 : C 185 : 30 CONTINUE 186 : X1(1)=X(1) 187 : X1(2)=X(2) 188 : X1(3)=1.D0-X(1)-X(2) 189 : C 190 : IF(JTYP.EQ.8)GO TO 35 191 : IF(JTYP.EQ.11)GO TO 35 192 : C 193 : C*** TRIANGLE-TRIANGLE 194 : C 195 : DO 31 I=1,2 196 : Y(I)=X1(IJKTRI(I,IATRI(IFA,JFA))) 197 : 31 CONTINUE 198 : RETURN 199 : C 200 : C*** TRIANGLE-QUADRANGLE 201 : C 202 : 35 CONTINUE 203 : DO 36 I=1,2 204 : Y(I)=(2.D0*X1(IJKTQ(I,IATQ(IFA,JFA)))-1.D0)*SQUA(I,ITQ(IFA,JFA)) 205 : 36 CONTINUE 206 : RETURN 207 : C 208 : 40 CONTINUE 209 : IF(JTYP.EQ.4)GO TO 45 210 : IF(JTYP.EQ.6)GO TO 45 211 : IF(JTYP.EQ.7)GO TO 45 212 : C 213 : C*** QUADRANGLE-QUADRANGLE 214 : C 215 : C WRITE(6,*) 216 : C WRITE(6,*)' IFA ',IFA,' JFA ',JFA 217 : DO 41 I=1,2 218 : IA=IAQUA(IFA,JFA) 219 : IS=ISQUA(IFA,JFA) 220 : C WRITE(6,*)' IA ',IA,' IS ',IS 221 : Y(I)=X(IJKQUA(I,IA))*SQUA(I,IS) 222 : 41 CONTINUE 223 : C WRITE(6,*) 224 : RETURN 225 : C 226 : C*** QUADRANGLE-TRIANGLE 227 : C 228 : 45 CONTINUE 229 : DO 46 I=1,2 230 : Y(I)=0.5D0*(1.D0+X(IJKQT(I,IAQT(IFA,JFA))) 231 : * *SQUA(I,IQT(IFA,JFA))) 232 : 46 CONTINUE 233 : RETURN 234 : C 235 : 60 CONTINUE 236 : X1(1)=X(1) 237 : X1(2)=X(2) 238 : X1(3)=1.D0-X(1)-X(2) 239 : X1(4)=X(3) 240 : IF(JTYP.EQ.14)GO TO 65 241 : IF(JTYP.EQ.23)GO TO 68 242 : C 243 : C*** PRISME-PRISME 244 : C 245 : DO 61 I=1,3 246 : Y(I)=DPRI(I,IDPRI(IOR,IFA,JFA))+ 247 : * SPRI(I,IPRI(IOR,IFA,JFA))*X1(IJKPRI(I,IAPRI(IOR,IFA,JFA))) 248 : 61 CONTINUE 249 : RETURN 250 : C 251 : C*** PRISME-CUBE 252 : C 253 : 65 CONTINUE 254 : Z(1)=X(1) 255 : Z(2)=X(2) 256 : Z(3)=X(3) 257 : Z(4)=1.D0-X(1)-X(2) 258 : DO 66 I=1,3 259 : Y(I)=SCP(I,JPC(IOR,IFA,JFA))*(BCP(I,IBCP(IOR,IFA,JFA))* 260 : * Z(IAPC(I,JAPC(IOR,IFA,JFA)))-ACP(I,IBCP(IOR,IFA,JFA))) 261 : 66 CONTINUE 262 : C write(6,*)' prisme cube',ior,ifa,jfa,(y(i),i=1,3) 263 : RETURN 264 : C 265 : C*** PRISME-TETRAEDRE 266 : C 267 : 68 CONTINUE 268 : X1(1)=1.D0-X(1)-X(2) 269 : X1(2)=X(1) 270 : X1(3)=X(2) 271 : X1(4)=0.D0 272 : IA=IPTET4(IOR,JFA,IFA) 273 : DO 69 I=1,3 274 : Y(I)=X1(ICTET4(I,IA)) 275 : 69 CONTINUE 276 : RETURN 277 : C 278 : 80 CONTINUE 279 : IF(JTYP.EQ.16)GO TO 85 280 : C 281 : C*** CUBE-CUBE 282 : C 283 : DO 81 I=1,3 284 : Y(I)=X(IJKCUB(I,IACUB(IOR,IFA,JFA)))* 285 : * SCUB(I,IACUB(IOR,IFA,JFA)) 286 : 81 CONTINUE 287 : RETURN 288 : C 289 : C*** CUBE-PRISME 290 : C 291 : 85 CONTINUE 292 : DO 86 I=1,3 293 : Y(I)=CPM(I)+CPD(I)*SCP(I,ICP(IOR,IFA,JFA))* 294 : * X(IACP(I,IJKCP(IOR,IFA,JFA))) 295 : 86 CONTINUE 296 : RETURN 297 : C TETRAEDRE 298 : 90 CONTINUE 299 : X1(1)=1.D0-X(1)-X(2)-X(3) 300 : X1(2)=X(1) 301 : X1(3)=X(2) 302 : X1(4)=X(3) 303 : IF(JTYP.EQ.16)GO TO 95 304 : C 305 : C*** TETRAEDRE-TETRAEDRE 306 : C 307 : IA= ITTET4(IOR,JFA,IFA) 308 : DO 92 I=1,3 309 : Y(I)=X1(ICTET4(I,IA)) 310 : 92 CONTINUE 311 : RETURN 312 : 95 CONTINUE 313 : C 314 : C*** TETRAEDRE-PRISME 315 : C 316 : IA= ITET4P(IOR,IFA) 317 : DO 98 I=1,2 318 : Y(I)=X1(ICTET4(I,IA)) 319 : 98 CONTINUE 320 : Y(3)=1.D0 321 : IF(JFA.EQ.1)Y(3)=-1.D0 322 : RETURN 323 : C 324 : C 325 : C 326 : END 327 : 328 : 329 :
© Cast3M 2003 - All rights reserved.
Disclaimer