1 : C KTRS3 SOURCE MAGN 10/05/18 21:16:10 6675 2 : SUBROUTINE KTRS3(MACRO,MELEME,MTBT0,IRET,GA,EPS,EPSD,ALFA) 3 : IMPLICIT INTEGER(I-N) 4 : IMPLICIT REAL*8 (A-H,O-Z) 5 : -INC CCOPTIO 6 : -INC CCGEOME 7 : -INC SMCOORD 8 : -INC SMCHPOI 9 : -INC SIZFFB 10 : POINTEUR IZFF1.IZFFM,IZHR1.IZHR 11 : -INC SMELEME 12 : POINTEUR MACRO.MELEME,MFACEI.MELEME,MFICEL.MELEME,MELTFI.MELEME 13 : POINTEUR MCTREI.MELEME,MELSTB.MELEME 14 : DIMENSION XA(3,27) 15 : DIMENSION ITAB(5),GA(8),EPS(8),EPSD(8) 16 : PARAMETER (NBE=7) 17 : CHARACTER*8 LISTE(NBE),TYPE,LIST(NBE) 18 : DATA LISTE /'TRI6 ','QUA8 ','SEG3 ', 19 : & 'CU20 ','PR15 ','PY13 ','TE10 '/ 20 : DATA LIST /'TRI3 ','QUA4 ','SEG2 ', 21 : & 'CUB8 ','PRI6 ','PYR5 ','TET4 '/ 22 : C**** 23 : 24 : COEF=ALFA*0.01D0 25 : IAXI=0 26 : IF(IFOMOD.EQ.0)IAXI=2 27 : 28 : IRET=1 29 : IM =0 30 : 31 : NSOUPO=1 32 : NAT=1 33 : N=0 34 : NC=8 35 : KPOC=0 36 : SEGINI MCHPO1,MSOUP1,MPOVA1 37 : MCHPO1.JATTRI(1)=2 38 : MCHPO1.IFOPOI=IFOMOD 39 : MCHPO1.MTYPOI='CENTRE ' 40 : MCHPO1.MOCHDE=' ' 41 : MCHPO1.IPCHP(1)=MSOUP1 42 : MSOUP1.IPOVAL=MPOVA1 43 : MSOUP1.NOCOMP(1)='SCC1' 44 : MSOUP1.NOCOMP(2)='SCC2' 45 : MSOUP1.NOCOMP(3)='SCC3' 46 : MSOUP1.NOCOMP(4)='SCC4' 47 : MSOUP1.NOCOMP(5)='SCC5' 48 : MSOUP1.NOCOMP(6)='SCC6' 49 : MSOUP1.NOCOMP(7)='SCC7' 50 : MSOUP1.NOCOMP(8)='SCC8' 51 : 52 : NBELEM=0 53 : NBNN=1 54 : NBSOUS=0 55 : NBREF=0 56 : SEGINI MCTREI 57 : MCTREI.ITYPEL=1 58 : KCTREI=0 59 : 60 : C Connectivités de la matrice de stabilisation 61 : NBELEM=0 62 : NBNN=4 63 : NBSOUS=0 64 : NBREF=0 65 : SEGINI MELSTB 66 : MELSTB.ITYPEL=14 67 : KSTB=0 68 : 69 : SEGACT MACRO 70 : NBSOUS=MACRO.LISOUS(/1) 71 : IF(NBSOUS.EQ.0)NBSOUS=1 72 : DO 1 L=1,NBSOUS 73 : IPT1=MACRO 74 : IF(NBSOUS.NE.1)IPT1=MACRO.LISOUS(L) 75 : SEGACT IPT1 76 : TYPE=NOMS(IPT1.ITYPEL)//' ' 76 : CALL OPTLI(IP,LISTE,TYPE,NBE) 77 : IF(IP.EQ.0)THEN 78 : WRITE(6,*)' Type d''élément : ',TYPE,' non prévu ' 79 : IRET=0 80 : RETURN 81 : ENDIF 82 : GO TO (106,108,103,120,115,113,110),IP 83 : 84 : C TRI6 -> 4 TRI3 85 : 106 CONTINUE 86 : NBEL=IPT1.NUM(/2) 87 : NP=IPT1.NUM(/1) 88 : NBPC=NBEL*4 89 : KCTREI=1 90 : C write(6,*)' TRI6 -> 4 TRI3 nbel= ',nbel 91 : 92 : NBV0=XCOOR(/1)/(IDIM+1) 93 : NBPTS=NBV0+NBPC 94 : SEGADJ MCOORD 95 : 96 : C maillage de lineaires 97 : NBELEM=4*NBEL 98 : NBNN=3 99 : NBSOUS=0 100 : NBREF=0 101 : SEGINI IPT2 102 : IPT2.ITYPEL=4 103 : IM=IM+1 104 : ITAB(IM)=IPT2 105 : 106 : K1=0 107 : DO 206 K=1,NBEL 108 : N1=IPT1.NUM(1,K) 109 : N2=IPT1.NUM(2,K) 110 : N3=IPT1.NUM(3,K) 111 : N4=IPT1.NUM(4,K) 112 : N5=IPT1.NUM(5,K) 113 : N6=IPT1.NUM(6,K) 114 : 115 : DO 1061 M=1,3 116 : XA(M,1)=XCOOR((N1-1)*(IDIM+1) +M) 117 : XA(M,2)=XCOOR((N2-1)*(IDIM+1) +M) 118 : XA(M,3)=XCOOR((N3-1)*(IDIM+1) +M) 119 : XA(M,4)=XCOOR((N4-1)*(IDIM+1) +M) 120 : XA(M,5)=XCOOR((N5-1)*(IDIM+1) +M) 121 : XA(M,6)=XCOOR((N6-1)*(IDIM+1) +M) 122 : 1061 CONTINUE 123 : 124 : CT1 125 : K1=K1+1 126 : NC1=NBV0+K1 127 : 128 : IPT2.NUM(1,K1)=N1 129 : IPT2.NUM(2,K1)=N2 130 : IPT2.NUM(3,K1)=N6 131 : 132 : CT2 133 : K1=K1+1 134 : NC2=NBV0+K1 135 : 136 : IPT2.NUM(1,K1)=N3 137 : IPT2.NUM(2,K1)=N4 138 : IPT2.NUM(3,K1)=N2 139 : 140 : CT3 141 : K1=K1+1 142 : NC3=NBV0+K1 143 : 144 : IPT2.NUM(1,K1)=N5 145 : IPT2.NUM(2,K1)=N6 146 : IPT2.NUM(3,K1)=N4 147 : 148 : CT4 149 : K1=K1+1 150 : NC4=NBV0+K1 151 : 152 : IPT2.NUM(1,K1)=N2 153 : IPT2.NUM(2,K1)=N4 154 : IPT2.NUM(3,K1)=N6 155 : 156 : DO 1062 M=1,3 157 : XCOOR((NC4-1)*(IDIM+1) +M)= (XA(M,2)+XA(M,4)+XA(M,6))/3.D0 158 : XCOOR((NC1-1)*(IDIM+1) +M)= (XA(M,1)+XA(M,2)+XA(M,6))/3.D0 159 : XCOOR((NC2-1)*(IDIM+1) +M)= (XA(M,3)+XA(M,4)+XA(M,2))/3.D0 160 : XCOOR((NC3-1)*(IDIM+1) +M)= (XA(M,5)+XA(M,6)+XA(M,4))/3.D0 161 : 1062 CONTINUE 162 : 163 : 206 CONTINUE 164 : SEGDES IPT1,IPT2 165 : GO TO 1 166 : 167 : C************************************************************************** 168 : 169 : C QUA8 -> 4 QUA4 170 : 108 CONTINUE 171 : 172 : NBEL=IPT1.NUM(/2) 173 : NP=IPT1.NUM(/1) 174 : NBP9=NBEL 175 : NBPC=NBEL*4 176 : KCTREI=1 177 : C write(6,*)' QUA8 -> 4 QUA4 nbel=',nbel 178 : 179 : NBV0=XCOOR(/1)/(IDIM+1) 180 : NBPTS=NBV0+NBPC+NBP9 181 : SEGADJ MCOORD 182 : 183 : C maillage de lineaires 184 : NBELEM=4*NBEL 185 : NBNN=4 186 : NBSOUS=0 187 : NBREF=0 188 : SEGINI IPT2 189 : IPT2.ITYPEL=8 190 : IM=IM+1 191 : ITAB(IM)=IPT2 192 : 193 : K1=0 194 : DO 208 K=1,NBEL 195 : N1=IPT1.NUM(1,K) 196 : N2=IPT1.NUM(2,K) 197 : N3=IPT1.NUM(3,K) 198 : N4=IPT1.NUM(4,K) 199 : N5=IPT1.NUM(5,K) 200 : N6=IPT1.NUM(6,K) 201 : N7=IPT1.NUM(7,K) 202 : N8=IPT1.NUM(8,K) 203 : N9=NBV0+NBPC+K 204 : C write(6,*)' N1,N2,N3,N4,N5,N6,N7,N8,N9=', 205 : C &N1,N2,N3,N4,N5,N6,N7,N8,N9 206 : 207 : DO 1081 M=1,3 208 : XA(M,1)=XCOOR((N1-1)*(IDIM+1) +M) 209 : XA(M,2)=XCOOR((N2-1)*(IDIM+1) +M) 210 : XA(M,3)=XCOOR((N3-1)*(IDIM+1) +M) 211 : XA(M,4)=XCOOR((N4-1)*(IDIM+1) +M) 212 : XA(M,5)=XCOOR((N5-1)*(IDIM+1) +M) 213 : XA(M,6)=XCOOR((N6-1)*(IDIM+1) +M) 214 : XA(M,7)=XCOOR((N7-1)*(IDIM+1) +M) 215 : XA(M,8)=XCOOR((N8-1)*(IDIM+1) +M) 216 : 1081 CONTINUE 217 : 217 : CALL FFQUA8(XA) 218 : 219 : 220 : CQ1 221 : K1=K1+1 222 : NC1=NBV0+K1 223 : 224 : IPT2.NUM(1,K1)=N1 225 : IPT2.NUM(2,K1)=N2 226 : IPT2.NUM(3,K1)=N9 227 : IPT2.NUM(4,K1)=N8 228 : CQ2 229 : K1=K1+1 230 : NC2=NBV0+K1 231 : 232 : IPT2.NUM(1,K1)=N3 233 : IPT2.NUM(2,K1)=N4 234 : IPT2.NUM(3,K1)=N9 235 : IPT2.NUM(4,K1)=N2 236 : CQ3 237 : K1=K1+1 238 : NC3=NBV0+K1 239 : 240 : IPT2.NUM(1,K1)=N5 241 : IPT2.NUM(2,K1)=N6 242 : IPT2.NUM(3,K1)=N9 243 : IPT2.NUM(4,K1)=N4 244 : CQ4 245 : K1=K1+1 246 : NC4=NBV0+K1 247 : 248 : IPT2.NUM(1,K1)=N7 249 : IPT2.NUM(2,K1)=N8 250 : IPT2.NUM(3,K1)=N9 251 : IPT2.NUM(4,K1)=N6 252 : 253 : DO 1082 M=1,3 254 : XCOOR((N9-1)*(IDIM+1) +M)=XA(M,9) 255 : XCOOR((NC1-1)*(IDIM+1) +M)= (XA(M,1)+XA(M,2)+XA(M,9)+XA(M,8))/4.D0 256 : XCOOR((NC2-1)*(IDIM+1) +M)= (XA(M,3)+XA(M,4)+XA(M,9)+XA(M,2))/4.D0 257 : XCOOR((NC3-1)*(IDIM+1) +M)= (XA(M,5)+XA(M,6)+XA(M,9)+XA(M,4))/4.D0 258 : XCOOR((NC4-1)*(IDIM+1) +M)= (XA(M,7)+XA(M,8)+XA(M,9)+XA(M,6))/4.D0 259 : 260 : 1082 CONTINUE 261 : 262 : 208 CONTINUE 263 : SEGDES IPT1,IPT2 264 : GO TO 1 265 : 266 : C************************************************************************** 267 : 268 : C SEG3 -> 2 SEG2 269 : 103 CONTINUE 270 : NBEL=IPT1.NUM(/2) 271 : NP=IPT1.NUM(/1) 272 : 273 : NBELEM=2*NBEL 274 : write(6,*)' SEG3 -> 2 SEG2 nbel=',nbel 275 : NBNN=2 276 : NBSOUS=0 277 : NBREF=0 278 : SEGINI IPT2 279 : IPT2.ITYPEL=2 280 : IM=IM+1 281 : ITAB(IM)=IPT2 282 : 283 : K1=0 284 : DO 203 K=1,NBEL 285 : N1=IPT1.NUM(1,K) 286 : N2=IPT1.NUM(2,K) 287 : N3=IPT1.NUM(3,K) 288 : 289 : CS1 290 : K1=K1+1 291 : 292 : IPT2.NUM(1,K1)=N1 293 : IPT2.NUM(2,K1)=N2 294 : 295 : CS2 296 : K1=K1+1 297 : 298 : IPT2.NUM(1,K1)=N2 299 : IPT2.NUM(2,K1)=N3 300 : 203 CONTINUE 301 : SEGDES IPT1,IPT2 302 : GO TO 1 303 : C************************************************************************** 304 : C CU20 -> 8 CUB8 305 : 120 CONTINUE 306 : C write(6,*)' CU20 -> 8 CUB8 ' 307 : NBEL=IPT1.NUM(/2) 308 : NP=IPT1.NUM(/1) 309 : NBPC=NBEL*8 310 : NBP9=NBEL*7 311 : 312 : N=NBPC+MPOVA1.VPOCHA(/1) 313 : NC=8 314 : NCTV0=MPOVA1.VPOCHA(/1) 315 : SEGADJ MPOVA1 316 : 317 : NBV0=XCOOR(/1)/(IDIM+1) 318 : NBPTS=NBV0+NBPC+NBP9 319 : SEGADJ MCOORD 320 : 321 : C maillage de lineaires 322 : NBELEM=8*NBEL 323 : NBNN=8 324 : NBSOUS=0 325 : NBREF=0 326 : SEGINI IPT2 327 : IPT2.ITYPEL=14 328 : IM=IM+1 329 : ITAB(IM)=IPT2 330 : 331 : C Spg des pts centres des macro elements 332 : NCTR0=MCTREI.NUM(/2) 333 : NBELEM=NCTR0+NBPC 334 : NBNN=1 335 : NBSOUS=0 336 : NBREF=0 337 : SEGADJ MCTREI 338 : KCTREI=1 339 : 340 : C Connectivités de la matrice de stabilisation 341 : NCSTB=MELSTB.NUM(/2) 342 : NBELEM=NCSTB+NBPC 343 : NBNN=8 344 : C write(6,*)' KTRS3 : ',nbnn,nbelem 345 : NBSOUS=0 346 : NBREF=0 347 : SEGADJ MELSTB 348 : KSTB=1 349 : 349 : CALL KALPBG('QUA4 ','FONFORM0',IZFFM) 349 : IF(IZFFM.EQ.0)CALL ARRET(0) 350 : SEGACT IZFFM*MOD 351 : IZHR=KZHR(1) 352 : SEGACT IZHR*MOD 353 : NPG=GR(/3) 354 : NES=GR(/1) 355 : NPI=4 356 : 357 : K1=0 358 : DO 220 K=1,NBEL 359 : N1=IPT1.NUM(1,K) 360 : N2=IPT1.NUM(2,K) 361 : N3=IPT1.NUM(3,K) 362 : N4=IPT1.NUM(4,K) 363 : N5=IPT1.NUM(5,K) 364 : N6=IPT1.NUM(6,K) 365 : N7=IPT1.NUM(7,K) 366 : N8=IPT1.NUM(8,K) 367 : N9=IPT1.NUM(9,K) 368 : N10=IPT1.NUM(10,K) 369 : N11=IPT1.NUM(11,K) 370 : N12=IPT1.NUM(12,K) 371 : N13=IPT1.NUM(13,K) 372 : N14=IPT1.NUM(14,K) 373 : N15=IPT1.NUM(15,K) 374 : N16=IPT1.NUM(16,K) 375 : N17=IPT1.NUM(17,K) 376 : N18=IPT1.NUM(18,K) 377 : N19=IPT1.NUM(19,K) 378 : N20=IPT1.NUM(20,K) 379 : N21=NBV0+NBPC+(K-1)*7+1 380 : N22=NBV0+NBPC+(K-1)*7+2 381 : N23=NBV0+NBPC+(K-1)*7+3 382 : N24=NBV0+NBPC+(K-1)*7+4 383 : N25=NBV0+NBPC+(K-1)*7+5 384 : N26=NBV0+NBPC+(K-1)*7+6 385 : N27=NBV0+NBPC+(K-1)*7+7 386 : NC1=NBV0+(K-1)*8+1 387 : NC2=NBV0+(K-1)*8+2 388 : NC3=NBV0+(K-1)*8+3 389 : NC4=NBV0+(K-1)*8+4 390 : NC5=NBV0+(K-1)*8+5 391 : NC6=NBV0+(K-1)*8+6 392 : NC7=NBV0+(K-1)*8+7 393 : NC8=NBV0+(K-1)*8+8 394 : 395 : DO 2201 M=1,3 396 : XA(M,1)=XCOOR((N1-1)*(IDIM+1) +M) 397 : XA(M,2)=XCOOR((N2-1)*(IDIM+1) +M) 398 : XA(M,3)=XCOOR((N3-1)*(IDIM+1) +M) 399 : XA(M,4)=XCOOR((N4-1)*(IDIM+1) +M) 400 : XA(M,5)=XCOOR((N5-1)*(IDIM+1) +M) 401 : XA(M,6)=XCOOR((N6-1)*(IDIM+1) +M) 402 : XA(M,7)=XCOOR((N7-1)*(IDIM+1) +M) 403 : XA(M,8)=XCOOR((N8-1)*(IDIM+1) +M) 404 : XA(M,9)=XCOOR((N9-1)*(IDIM+1) +M) 405 : XA(M,10)=XCOOR((N10-1)*(IDIM+1) +M) 406 : XA(M,11)=XCOOR((N11-1)*(IDIM+1) +M) 407 : XA(M,12)=XCOOR((N12-1)*(IDIM+1) +M) 408 : XA(M,13)=XCOOR((N13-1)*(IDIM+1) +M) 409 : XA(M,14)=XCOOR((N14-1)*(IDIM+1) +M) 410 : XA(M,15)=XCOOR((N15-1)*(IDIM+1) +M) 411 : XA(M,16)=XCOOR((N16-1)*(IDIM+1) +M) 412 : XA(M,17)=XCOOR((N17-1)*(IDIM+1) +M) 413 : XA(M,18)=XCOOR((N18-1)*(IDIM+1) +M) 414 : XA(M,19)=XCOOR((N19-1)*(IDIM+1) +M) 415 : XA(M,20)=XCOOR((N20-1)*(IDIM+1) +M) 416 : 2201 CONTINUE 417 : 417 : CALL FFCU20(XA) 418 : 419 : 420 : DO 2202 M=1,3 421 : 422 : XCOOR((N21-1)*(IDIM+1) +M)=XA(M,21) 423 : XCOOR((N22-1)*(IDIM+1) +M)=XA(M,22) 424 : XCOOR((N23-1)*(IDIM+1) +M)=XA(M,23) 425 : XCOOR((N24-1)*(IDIM+1) +M)=XA(M,24) 426 : XCOOR((N25-1)*(IDIM+1) +M)=XA(M,25) 427 : XCOOR((N26-1)*(IDIM+1) +M)=XA(M,26) 428 : XCOOR((N27-1)*(IDIM+1) +M)=XA(M,27) 429 : 430 : XNC1 =(XA(M,1)+XA(M,2)+XA(M,21)+XA(M,8)+XA(M,9)+XA(M,23) 431 : & +XA(M,27)+XA(M,26))/8.D0 432 : XCOOR((NC1 -1)*(IDIM+1) +M)=XNC1 433 : 434 : XNC2 =(XA(M,3)+XA(M,2)+XA(M,21)+XA(M,4)+XA(M,10)+XA(M,23) 435 : & +XA(M,27)+XA(M,24))/8.D0 436 : XCOOR((NC2 -1)*(IDIM+1) +M)=XNC2 437 : 438 : XNC3 =(XA(M,5)+XA(M,6)+XA(M,21)+XA(M,4)+XA(M,25) 439 : & +XA(M,11)+XA(M,27)+XA(M,24))/8.D0 440 : XCOOR((NC3 -1)*(IDIM+1) +M)=XNC3 441 : 442 : XNC4 =(XA(M,8)+XA(M,6)+XA(M,21)+XA(M,7)+XA(M,25) 443 : & +XA(M,12)+XA(M,27)+XA(M,26))/8.D0 444 : XCOOR((NC4 -1)*(IDIM+1) +M)=XNC4 445 : 446 : XNC5 =(XA(M,26)+XA(M,9)+XA(M,23)+XA(M,27)+XA(M,20) 447 : & +XA(M,13)+XA(M,14)+XA(M,22))/8.D0 448 : XCOOR((NC5 -1)*(IDIM+1) +M)=XNC5 449 : 450 : XNC6 =(XA(M,10)+XA(M,24)+XA(M,23)+XA(M,27)+XA(M,22) 451 : & +XA(M,15)+XA(M,14)+XA(M,16))/8.D0 452 : XCOOR((NC6 -1)*(IDIM+1) +M)=XNC6 453 : 454 : XNC7 =(XA(M,11)+XA(M,24)+XA(M,25)+XA(M,27)+XA(M,22) 455 : & +XA(M,17)+XA(M,18)+XA(M,16))/8.D0 456 : XCOOR((NC7 -1)*(IDIM+1) +M)=XNC7 457 : 458 : XNC8 =(XA(M,12)+XA(M,26)+XA(M,25)+XA(M,27)+XA(M,22) 459 : & +XA(M,20)+XA(M,18)+XA(M,19))/8.D0 460 : XCOOR((NC8 -1)*(IDIM+1) +M)=XNC8 461 : 462 : 2202 CONTINUE 463 : 464 : MCTREI.NUM(1,NCTR0+K1+1)=NC1 465 : MCTREI.NUM(1,NCTR0+K1+2)=NC2 466 : MCTREI.NUM(1,NCTR0+K1+3)=NC3 467 : MCTREI.NUM(1,NCTR0+K1+4)=NC4 468 : MCTREI.NUM(1,NCTR0+K1+5)=NC5 469 : MCTREI.NUM(1,NCTR0+K1+6)=NC6 470 : MCTREI.NUM(1,NCTR0+K1+7)=NC7 471 : MCTREI.NUM(1,NCTR0+K1+8)=NC8 472 : 473 : IPT2.NUM(1,K1+1)=N1 474 : IPT2.NUM(2,K1+1)=N2 475 : IPT2.NUM(3,K1+1)=N21 476 : IPT2.NUM(4,K1+1)=N8 477 : IPT2.NUM(5,K1+1)=N9 478 : IPT2.NUM(6,K1+1)=N23 479 : IPT2.NUM(7,K1+1)=N27 480 : IPT2.NUM(8,K1+1)=N26 481 : 482 : IPT2.NUM(1,K1+2)=N2 483 : IPT2.NUM(2,K1+2)=N3 484 : IPT2.NUM(3,K1+2)=N4 485 : IPT2.NUM(4,K1+2)=N21 486 : IPT2.NUM(5,K1+2)=N23 487 : IPT2.NUM(6,K1+2)=N10 488 : IPT2.NUM(7,K1+2)=N24 489 : IPT2.NUM(8,K1+2)=N27 490 : 491 : IPT2.NUM(1,K1+3)=N4 492 : IPT2.NUM(2,K1+3)=N5 493 : IPT2.NUM(3,K1+3)=N6 494 : IPT2.NUM(4,K1+3)=N21 495 : IPT2.NUM(5,K1+3)=N24 496 : IPT2.NUM(6,K1+3)=N11 497 : IPT2.NUM(7,K1+3)=N25 498 : IPT2.NUM(8,K1+3)=N27 499 : 500 : IPT2.NUM(1,K1+4)=N8 501 : IPT2.NUM(2,K1+4)=N21 502 : IPT2.NUM(3,K1+4)=N6 503 : IPT2.NUM(4,K1+4)=N7 504 : IPT2.NUM(5,K1+4)=N26 505 : IPT2.NUM(6,K1+4)=N27 506 : IPT2.NUM(7,K1+4)=N25 507 : IPT2.NUM(8,K1+4)=N12 508 : 509 : IPT2.NUM(1,K1+5)=N9 510 : IPT2.NUM(2,K1+5)=N23 511 : IPT2.NUM(3,K1+5)=N27 512 : IPT2.NUM(4,K1+5)=N26 513 : IPT2.NUM(5,K1+5)=N13 514 : IPT2.NUM(6,K1+5)=N14 515 : IPT2.NUM(7,K1+5)=N22 516 : IPT2.NUM(8,K1+5)=N20 517 : 518 : IPT2.NUM(1,K1+6)=N23 519 : IPT2.NUM(2,K1+6)=N10 520 : IPT2.NUM(3,K1+6)=N24 521 : IPT2.NUM(4,K1+6)=N27 522 : IPT2.NUM(5,K1+6)=N14 523 : IPT2.NUM(6,K1+6)=N15 524 : IPT2.NUM(7,K1+6)=N16 525 : IPT2.NUM(8,K1+6)=N22 526 : 527 : IPT2.NUM(1,K1+7)=N25 528 : IPT2.NUM(2,K1+7)=N27 529 : IPT2.NUM(3,K1+7)=N24 530 : IPT2.NUM(4,K1+7)=N11 531 : IPT2.NUM(5,K1+7)=N18 532 : IPT2.NUM(6,K1+7)=N22 533 : IPT2.NUM(7,K1+7)=N16 534 : IPT2.NUM(8,K1+7)=N17 535 : 536 : IPT2.NUM(1,K1+8)=N26 537 : IPT2.NUM(2,K1+8)=N27 538 : IPT2.NUM(3,K1+8)=N25 539 : IPT2.NUM(4,K1+8)=N12 540 : IPT2.NUM(5,K1+8)=N20 541 : IPT2.NUM(6,K1+8)=N22 542 : IPT2.NUM(7,K1+8)=N18 543 : IPT2.NUM(8,K1+8)=N19 544 : 545 : K1=K1+8 546 : 547 : C DF1 548 : DO 22001 M=1,3 549 : XYZ(M,1)=XA(M,2) 550 : XYZ(M,2)=XA(M,21) 551 : XYZ(M,3)=XA(M,27) 552 : XYZ(M,4)=XA(M,23) 553 : 22001 CONTINUE 554 : 554 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR1) 555 : 556 : AIR1=ABS(AIR1) 557 : DF1=SQRT(AIR1) 558 : 559 : CDF2 560 : DO 22002 M=1,3 561 : XYZ(M,1)=XA(M,21) 562 : XYZ(M,2)=XA(M,4) 563 : XYZ(M,3)=XA(M,24) 564 : XYZ(M,4)=XA(M,27) 565 : 22002 CONTINUE 566 : 566 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR2) 567 : 568 : AIR2=ABS(AIR2) 569 : DF2=SQRT(AIR2) 570 : 571 : CDF3 572 : DO 22003 M=1,3 573 : XYZ(M,1)=XA(M,21) 574 : XYZ(M,2)=XA(M,6) 575 : XYZ(M,3)=XA(M,25) 576 : XYZ(M,4)=XA(M,27) 577 : 22003 CONTINUE 578 : 578 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR3) 579 : 580 : AIR3=ABS(AIR3) 581 : DF3=SQRT(AIR3) 582 : 583 : CDF4 584 : DO 22004 M=1,3 585 : XYZ(M,1)=XA(M,21) 586 : XYZ(M,2)=XA(M,8) 587 : XYZ(M,3)=XA(M,26) 588 : XYZ(M,4)=XA(M,27) 589 : 22004 CONTINUE 590 : 590 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR4) 591 : 592 : AIR4=ABS(AIR4) 593 : DF4=SQRT(AIR4) 594 : 595 : CDF5 596 : DO 22005 M=1,3 597 : XYZ(M,1)=XA(M,9 ) 598 : XYZ(M,2)=XA(M,23) 599 : XYZ(M,3)=XA(M,27) 600 : XYZ(M,4)=XA(M,26) 601 : 22005 CONTINUE 602 : 602 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR5) 603 : 604 : AIR5=ABS(AIR5) 605 : DF5=SQRT(AIR5) 606 : 607 : CDF6 608 : DO 22006 M=1,3 609 : XYZ(M,1)=XA(M,10) 610 : XYZ(M,2)=XA(M,24) 611 : XYZ(M,3)=XA(M,27) 612 : XYZ(M,4)=XA(M,23) 613 : 22006 CONTINUE 614 : 614 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR6) 615 : 616 : AIR6=ABS(AIR6) 617 : DF6=SQRT(AIR6) 618 : 619 : CDF7 620 : DO 22007 M=1,3 621 : XYZ(M,1)=XA(M,11) 622 : XYZ(M,2)=XA(M,25) 623 : XYZ(M,3)=XA(M,27) 624 : XYZ(M,4)=XA(M,24) 625 : 22007 CONTINUE 626 : 626 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR7) 627 : 628 : AIR7=ABS(AIR7) 629 : DF7=SQRT(AIR7) 630 : 631 : CDF8 632 : DO 22008 M=1,3 633 : XYZ(M,1)=XA(M,12) 634 : XYZ(M,2)=XA(M,26) 635 : XYZ(M,3)=XA(M,27) 636 : XYZ(M,4)=XA(M,25) 637 : 22008 CONTINUE 638 : 638 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR8) 639 : 640 : AIR8=ABS(AIR8) 641 : DF8=SQRT(AIR8) 642 : 643 : CDF9 644 : DO 22009 M=1,3 645 : XYZ(M,1)=XA(M,23) 646 : XYZ(M,2)=XA(M,27) 647 : XYZ(M,3)=XA(M,22) 648 : XYZ(M,4)=XA(M,14) 649 : 22009 CONTINUE 650 : 650 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR9) 651 : 652 : AIR9=ABS(AIR9) 653 : DF9=SQRT(AIR9) 654 : 655 : CDF10 656 : DO 22010 M=1,3 657 : XYZ(M,1)=XA(M,16) 658 : XYZ(M,2)=XA(M,24) 659 : XYZ(M,3)=XA(M,27) 660 : XYZ(M,4)=XA(M,22) 661 : 22010 CONTINUE 662 : 662 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR10) 663 : 664 : AIR10=ABS(AIR10) 665 : DF10=SQRT(AIR10) 666 : 667 : CDF11 668 : DO 22011 M=1,3 669 : XYZ(M,1)=XA(M,18) 670 : XYZ(M,2)=XA(M,25) 671 : XYZ(M,3)=XA(M,27) 672 : XYZ(M,4)=XA(M,22) 673 : 22011 CONTINUE 674 : 674 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR11) 675 : 676 : AIR11=ABS(AIR11) 677 : DF11=SQRT(AIR11) 678 : 679 : CDF12 680 : DO 22012 M=1,3 681 : XYZ(M,1)=XA(M,20) 682 : XYZ(M,2)=XA(M,26) 683 : XYZ(M,3)=XA(M,27) 684 : XYZ(M,4)=XA(M,22) 685 : 22012 CONTINUE 686 : 686 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR12) 687 : 688 : AIR12=ABS(AIR12) 689 : DF12=SQRT(AIR12) 690 : 691 : DFM=(DF1+DF2+DF3+DF4+DF5+DF6+DF7+DF8+DF9+DF10+DF11+DF12)/12.D0 692 : AIRM=(AIR1+AIR2+AIR3+AIR4+AIR5+AIR6 693 : & +AIR7+AIR8+AIR9+AIR10+AIR11+AIR12)/12.D0 694 : 695 : MELSTB.NUM(1,NCSTB+K)=NC1 696 : MELSTB.NUM(2,NCSTB+K)=NC2 697 : MELSTB.NUM(3,NCSTB+K)=NC3 698 : MELSTB.NUM(4,NCSTB+K)=NC4 699 : MELSTB.NUM(5,NCSTB+K)=NC5 700 : MELSTB.NUM(6,NCSTB+K)=NC6 701 : MELSTB.NUM(7,NCSTB+K)=NC7 702 : MELSTB.NUM(8,NCSTB+K)=NC8 703 : 704 : MELSTB.NUM(1,NCSTB+K+1)=NC2 705 : MELSTB.NUM(2,NCSTB+K+1)=NC3 706 : MELSTB.NUM(3,NCSTB+K+1)=NC4 707 : MELSTB.NUM(4,NCSTB+K+1)=NC5 708 : MELSTB.NUM(5,NCSTB+K+1)=NC6 709 : MELSTB.NUM(6,NCSTB+K+1)=NC7 710 : MELSTB.NUM(7,NCSTB+K+1)=NC8 711 : MELSTB.NUM(8,NCSTB+K+1)=NC1 712 : 713 : MELSTB.NUM(1,NCSTB+K+2)=NC3 714 : MELSTB.NUM(2,NCSTB+K+2)=NC4 715 : MELSTB.NUM(3,NCSTB+K+2)=NC5 716 : MELSTB.NUM(4,NCSTB+K+2)=NC6 717 : MELSTB.NUM(5,NCSTB+K+2)=NC7 718 : MELSTB.NUM(6,NCSTB+K+2)=NC8 719 : MELSTB.NUM(7,NCSTB+K+2)=NC1 720 : MELSTB.NUM(8,NCSTB+K+2)=NC2 721 : 722 : MELSTB.NUM(1,NCSTB+K+3)=NC4 723 : MELSTB.NUM(2,NCSTB+K+3)=NC5 724 : MELSTB.NUM(3,NCSTB+K+3)=NC6 725 : MELSTB.NUM(4,NCSTB+K+3)=NC7 726 : MELSTB.NUM(5,NCSTB+K+3)=NC8 727 : MELSTB.NUM(6,NCSTB+K+3)=NC1 728 : MELSTB.NUM(7,NCSTB+K+3)=NC2 729 : MELSTB.NUM(8,NCSTB+K+3)=NC3 730 : 731 : MELSTB.NUM(1,NCSTB+K+4)=NC5 732 : MELSTB.NUM(2,NCSTB+K+4)=NC6 733 : MELSTB.NUM(3,NCSTB+K+4)=NC7 734 : MELSTB.NUM(4,NCSTB+K+4)=NC8 735 : MELSTB.NUM(5,NCSTB+K+4)=NC1 736 : MELSTB.NUM(6,NCSTB+K+4)=NC2 737 : MELSTB.NUM(7,NCSTB+K+4)=NC3 738 : MELSTB.NUM(8,NCSTB+K+4)=NC4 739 : 740 : MELSTB.NUM(1,NCSTB+K+5)=NC6 741 : MELSTB.NUM(2,NCSTB+K+5)=NC7 742 : MELSTB.NUM(3,NCSTB+K+5)=NC8 743 : MELSTB.NUM(4,NCSTB+K+5)=NC1 744 : MELSTB.NUM(5,NCSTB+K+5)=NC2 745 : MELSTB.NUM(6,NCSTB+K+5)=NC3 746 : MELSTB.NUM(7,NCSTB+K+5)=NC4 747 : MELSTB.NUM(8,NCSTB+K+5)=NC5 748 : 749 : MELSTB.NUM(1,NCSTB+K+6)=NC7 750 : MELSTB.NUM(2,NCSTB+K+6)=NC8 751 : MELSTB.NUM(3,NCSTB+K+6)=NC1 752 : MELSTB.NUM(4,NCSTB+K+6)=NC2 753 : MELSTB.NUM(5,NCSTB+K+6)=NC3 754 : MELSTB.NUM(6,NCSTB+K+6)=NC4 755 : MELSTB.NUM(7,NCSTB+K+6)=NC5 756 : MELSTB.NUM(8,NCSTB+K+6)=NC6 757 : 758 : MELSTB.NUM(1,NCSTB+K+7)=NC8 759 : MELSTB.NUM(2,NCSTB+K+7)=NC1 760 : MELSTB.NUM(3,NCSTB+K+7)=NC2 761 : MELSTB.NUM(4,NCSTB+K+7)=NC3 762 : MELSTB.NUM(5,NCSTB+K+7)=NC4 763 : MELSTB.NUM(6,NCSTB+K+7)=NC5 764 : MELSTB.NUM(7,NCSTB+K+7)=NC6 765 : MELSTB.NUM(8,NCSTB+K+7)=NC7 766 : 767 : 768 : 769 : H12=AIR1*DF1*GA(4) 770 : H13=AIRM*DFM*EPS(4) 771 : H14=AIR4*DF4*GA(4) 772 : H15=AIR5*DF5*GA(4) 773 : H16=AIRM*DFM*EPS(4) 774 : H17=AIRM*DFM*EPS(4) 775 : H18=AIRM*DFM*EPS(4) 776 : 777 : H23=AIR2*DF2*GA(4) 778 : H24=AIRM*DFM*EPS(4) 779 : H25=AIRM*DFM*EPS(4) 780 : H26=AIR6*DF6*GA(4) 781 : H27=AIRM*DFM*EPS(4) 782 : H28=AIRM*DFM*EPS(4) 783 : 784 : H34=AIR3*DF3*GA(4) 785 : H35=AIRM*DFM*EPS(4) 786 : H36=AIRM*DFM*EPS(4) 787 : H37=AIR7*DF7*GA(4) 788 : H38=AIRM*DFM*EPS(4) 789 : 790 : H45=AIRM*DFM*EPS(4) 791 : H46=AIRM*DFM*EPS(4) 792 : H47=AIRM*DFM*EPS(4) 793 : H48=AIR8*DF8*GA(4) 794 : 795 : H56=AIR9*DF9*GA(4) 796 : H57=AIRM*DFM*EPS(4) 797 : H58=AIR12*DF12*GA(4) 798 : 799 : H67=AIR10*DF10*GA(4) 800 : H68=AIRM*DFM*EPS(4) 801 : 802 : H78=AIR11*DF11*GA(4) 803 : 804 : MPOVA1.VPOCHA(NCTV0+K,1)=H12+H13+H14+H15+H16+H17+H18 805 : MPOVA1.VPOCHA(NCTV0+K,2)=-H12 806 : MPOVA1.VPOCHA(NCTV0+K,3)=-H13 807 : MPOVA1.VPOCHA(NCTV0+K,4)=-H14 808 : MPOVA1.VPOCHA(NCTV0+K,5)=-H15 809 : MPOVA1.VPOCHA(NCTV0+K,6)=-H16 810 : MPOVA1.VPOCHA(NCTV0+K,7)=-H17 811 : MPOVA1.VPOCHA(NCTV0+K,8)=-H18 812 : MPOVA1.VPOCHA(NCTV0+K+1,1)=H12+H23+H24+H25+H26+H27+H28 813 : MPOVA1.VPOCHA(NCTV0+K+1,2)=-H23 814 : MPOVA1.VPOCHA(NCTV0+K+1,3)=-H24 815 : MPOVA1.VPOCHA(NCTV0+K+1,4)=-H25 816 : MPOVA1.VPOCHA(NCTV0+K+1,5)=-H26 817 : MPOVA1.VPOCHA(NCTV0+K+1,6)=-H27 818 : MPOVA1.VPOCHA(NCTV0+K+1,7)=-H28 819 : MPOVA1.VPOCHA(NCTV0+K+1,8)=-H12 820 : MPOVA1.VPOCHA(NCTV0+K+2,1)=H13+H23+H34+H35+H36+H37+H38 821 : MPOVA1.VPOCHA(NCTV0+K+2,2)=-H34 822 : MPOVA1.VPOCHA(NCTV0+K+2,3)=-H35 823 : MPOVA1.VPOCHA(NCTV0+K+2,4)=-H36 824 : MPOVA1.VPOCHA(NCTV0+K+2,5)=-H37 825 : MPOVA1.VPOCHA(NCTV0+K+2,6)=-H38 826 : MPOVA1.VPOCHA(NCTV0+K+2,7)=-H13 827 : MPOVA1.VPOCHA(NCTV0+K+2,8)=-H23 828 : MPOVA1.VPOCHA(NCTV0+K+3,1)=H14+H24+H34+H45+H46+H47+H48 829 : MPOVA1.VPOCHA(NCTV0+K+3,2)=-H45 830 : MPOVA1.VPOCHA(NCTV0+K+3,3)=-H46 831 : MPOVA1.VPOCHA(NCTV0+K+3,4)=-H47 832 : MPOVA1.VPOCHA(NCTV0+K+3,5)=-H48 833 : MPOVA1.VPOCHA(NCTV0+K+3,6)=-H14 834 : MPOVA1.VPOCHA(NCTV0+K+3,7)=-H24 835 : MPOVA1.VPOCHA(NCTV0+K+3,8)=-H34 836 : MPOVA1.VPOCHA(NCTV0+K+4,1)=H15+H25+H35+H45+H56+H57+H58 837 : MPOVA1.VPOCHA(NCTV0+K+4,2)=-H56 838 : MPOVA1.VPOCHA(NCTV0+K+4,3)=-H57 839 : MPOVA1.VPOCHA(NCTV0+K+4,4)=-H58 840 : MPOVA1.VPOCHA(NCTV0+K+4,5)=-H15 841 : MPOVA1.VPOCHA(NCTV0+K+4,6)=-H25 842 : MPOVA1.VPOCHA(NCTV0+K+4,7)=-H35 843 : MPOVA1.VPOCHA(NCTV0+K+4,8)=-H45 844 : MPOVA1.VPOCHA(NCTV0+K+5,1)=H16+H26+H36+H46+H56+H67+H68 845 : MPOVA1.VPOCHA(NCTV0+K+5,2)=-H67 846 : MPOVA1.VPOCHA(NCTV0+K+5,3)=-H68 847 : MPOVA1.VPOCHA(NCTV0+K+5,4)=-H16 848 : MPOVA1.VPOCHA(NCTV0+K+5,5)=-H26 849 : MPOVA1.VPOCHA(NCTV0+K+5,6)=-H36 850 : MPOVA1.VPOCHA(NCTV0+K+5,7)=-H46 851 : MPOVA1.VPOCHA(NCTV0+K+5,8)=-H56 852 : MPOVA1.VPOCHA(NCTV0+K+6,1)=H17+H27+H37+H47+H57+H67+H78 853 : MPOVA1.VPOCHA(NCTV0+K+6,2)=-H78 854 : MPOVA1.VPOCHA(NCTV0+K+6,3)=-H17 855 : MPOVA1.VPOCHA(NCTV0+K+6,4)=-H27 856 : MPOVA1.VPOCHA(NCTV0+K+6,5)=-H37 857 : MPOVA1.VPOCHA(NCTV0+K+6,6)=-H47 858 : MPOVA1.VPOCHA(NCTV0+K+6,7)=-H57 859 : MPOVA1.VPOCHA(NCTV0+K+6,8)=-H67 860 : MPOVA1.VPOCHA(NCTV0+K+7,1)=H18+H28+H38+H48+H58+H68+H78 861 : MPOVA1.VPOCHA(NCTV0+K+7,2)=-H18 862 : MPOVA1.VPOCHA(NCTV0+K+7,3)=-H28 863 : MPOVA1.VPOCHA(NCTV0+K+7,4)=-H38 864 : MPOVA1.VPOCHA(NCTV0+K+7,5)=-H48 865 : MPOVA1.VPOCHA(NCTV0+K+7,6)=-H58 866 : MPOVA1.VPOCHA(NCTV0+K+7,7)=-H68 867 : MPOVA1.VPOCHA(NCTV0+K+7,8)=-H78 868 : KPOC=1 869 : NCTV0=NCTV0+7 870 : NCSTB=NCSTB+7 871 : 872 : 873 : 874 : 220 CONTINUE 875 : C SEGDES IPT1,IPT2,IPT3 876 : SEGDES IPT1,IPT2 877 : GO TO 1 878 : 879 : C************************************************************************** 880 : C PR15 -> 8 PRI6 881 : 882 : 115 CONTINUE 883 : C write(6,*)' PR15 -> 8 PRI6 ' 884 : NBEL=IPT1.NUM(/2) 885 : NP=IPT1.NUM(/1) 886 : NBPC=NBEL*8 887 : NBP9=NBEL*3 888 : 889 : N=NBPC+MPOVA1.VPOCHA(/1) 890 : NC=8 891 : NCTV0=MPOVA1.VPOCHA(/1) 892 : SEGADJ MPOVA1 893 : 894 : NBV0=XCOOR(/1)/(IDIM+1) 895 : NBPTS=NBV0+NBPC+NBP9 896 : SEGADJ MCOORD 897 : 898 : C maillage de lineaires 899 : NBELEM=8*NBEL 900 : NBNN=6 901 : NBSOUS=0 902 : NBREF=0 903 : SEGINI IPT2 904 : IPT2.ITYPEL=16 905 : IM=IM+1 906 : ITAB(IM)=IPT2 907 : 908 : C Spg des pts centres des macro elements 909 : NCTR0=MCTREI.NUM(/2) 910 : NBELEM=NCTR0+NBPC 911 : NBNN=1 912 : NBSOUS=0 913 : NBREF=0 914 : SEGADJ MCTREI 915 : KCTREI=1 916 : 917 : C Connectivités de la matrice de stabilisation 918 : NCSTB=MELSTB.NUM(/2) 919 : NBELEM=NCSTB+NBPC 920 : NBNN=8 921 : C write(6,*)' KTRS3 : ',nbnn,nbelem 922 : NBSOUS=0 923 : NBREF=0 924 : SEGADJ MELSTB 925 : KSTB=1 926 : 926 : CALL KALPBG('QUA4 ','FONFORM0',IZFFM) 926 : IF(IZFFM.EQ.0)CALL ARRET(0) 927 : SEGACT IZFFM*MOD 928 : IZHR=KZHR(1) 929 : SEGACT IZHR*MOD 930 : NPG=GR(/3) 931 : NES=GR(/1) 932 : 932 : CALL KALPBG('TRI3 ','FONFORM0',IZFF1) 932 : IF(IZFF1.EQ.0)CALL ARRET(0) 933 : SEGACT IZFF1*MOD 934 : IZHR1=IZFF1.KZHR(1) 935 : SEGACT IZHR1*MOD 936 : NPG1=IZFF1.GR(/3) 937 : NES1=IZFF1.GR(/1) 938 : 939 : NPI=4 940 : NPI1=3 941 : C write(6,*)' npg1,nes1,npi1=',npg1,nes1,npi1 942 : 943 : K1=0 944 : DO 215 K=1,NBEL 945 : N1=IPT1.NUM(1,K) 946 : N2=IPT1.NUM(2,K) 947 : N3=IPT1.NUM(3,K) 948 : N4=IPT1.NUM(4,K) 949 : N5=IPT1.NUM(5,K) 950 : N6=IPT1.NUM(6,K) 951 : N7=IPT1.NUM(7,K) 952 : N8=IPT1.NUM(8,K) 953 : N9=IPT1.NUM(9,K) 954 : N10=IPT1.NUM(10,K) 955 : N11=IPT1.NUM(11,K) 956 : N12=IPT1.NUM(12,K) 957 : N13=IPT1.NUM(13,K) 958 : N14=IPT1.NUM(14,K) 959 : N15=IPT1.NUM(15,K) 960 : N16=NBV0+NBPC+(K-1)*3+1 961 : N17=NBV0+NBPC+(K-1)*3+2 962 : N18=NBV0+NBPC+(K-1)*3+3 963 : NC1=NBV0+(K-1)*8+1 964 : NC2=NBV0+(K-1)*8+2 965 : NC3=NBV0+(K-1)*8+3 966 : NC4=NBV0+(K-1)*8+4 967 : NC5=NBV0+(K-1)*8+5 968 : NC6=NBV0+(K-1)*8+6 969 : NC7=NBV0+(K-1)*8+7 970 : NC8=NBV0+(K-1)*8+8 971 : 972 : DO 2101 M=1,3 973 : XA(M,1)=XCOOR((N1-1)*(IDIM+1) +M) 974 : XA(M,2)=XCOOR((N2-1)*(IDIM+1) +M) 975 : XA(M,3)=XCOOR((N3-1)*(IDIM+1) +M) 976 : XA(M,4)=XCOOR((N4-1)*(IDIM+1) +M) 977 : XA(M,5)=XCOOR((N5-1)*(IDIM+1) +M) 978 : XA(M,6)=XCOOR((N6-1)*(IDIM+1) +M) 979 : XA(M,7)=XCOOR((N7-1)*(IDIM+1) +M) 980 : XA(M,8)=XCOOR((N8-1)*(IDIM+1) +M) 981 : XA(M,9)=XCOOR((N9-1)*(IDIM+1) +M) 982 : XA(M,10)=XCOOR((N10-1)*(IDIM+1) +M) 983 : XA(M,11)=XCOOR((N11-1)*(IDIM+1) +M) 984 : XA(M,12)=XCOOR((N12-1)*(IDIM+1) +M) 985 : XA(M,13)=XCOOR((N13-1)*(IDIM+1) +M) 986 : XA(M,14)=XCOOR((N14-1)*(IDIM+1) +M) 987 : XA(M,15)=XCOOR((N15-1)*(IDIM+1) +M) 988 : 2101 CONTINUE 989 : 989 : CALL FFPR15(XA) 990 : C write(6,*)' X' 991 : C write(6,1002)(XA(1,j),j=16,18) 992 : C write(6,*)' Y' 993 : C write(6,1002)(XA(2,j),j=16,18) 994 : C write(6,*)' Z' 995 : C write(6,1002)(XA(3,j),j=16,18) 996 : 997 : DO 2102 M=1,3 998 : 999 : XCOOR((N16-1)*(IDIM+1) +M)=XA(M,16) 1000 : XCOOR((N17-1)*(IDIM+1) +M)=XA(M,17) 1001 : XCOOR((N18-1)*(IDIM+1) +M)=XA(M,18) 1002 : 1003 : XNC1 =(XA(M,1)+XA(M,2)+XA(M,6)+XA(M,7)+XA(M,16)+XA(M,18))/6.D0 1004 : XCOOR((NC1 -1)*(IDIM+1) +M)=XNC1 1005 : 1006 : XNC2 =(XA(M,2)+XA(M,3)+XA(M,4)+XA(M,16)+XA(M,8)+XA(M,17))/6.D0 1007 : XCOOR((NC2 -1)*(IDIM+1) +M)=XNC2 1008 : 1009 : XNC3 =(XA(M,4)+XA(M,5)+XA(M,6)+XA(M,17)+XA(M,9)+XA(M,18))/6.D0 1010 : XCOOR((NC3 -1)*(IDIM+1) +M)=XNC3 1011 : 1012 : XNC4 =(XA(M,2)+XA(M,4)+XA(M,6)+XA(M,16)+XA(M,17)+XA(M,18))/6.D0 1013 : XCOOR((NC4 -1)*(IDIM+1) +M)=XNC4 1014 : 1015 : XNC5 =(XA(M,7)+XA(M,16)+XA(M,18)+XA(M,10)+XA(M,11)+XA(M,15))/6.D0 1016 : XCOOR((NC5 -1)*(IDIM+1) +M)=XNC5 1017 : 1018 : XNC6 =(XA(M,16)+XA(M,8)+XA(M,17)+XA(M,11)+XA(M,12)+XA(M,13))/6.D0 1019 : XCOOR((NC6 -1)*(IDIM+1) +M)=XNC6 1020 : 1021 : XNC7 =(XA(M,18)+XA(M,17)+XA(M,9)+XA(M,15)+XA(M,13)+XA(M,14))/6.D0 1022 : XCOOR((NC7 -1)*(IDIM+1) +M)=XNC7 1023 : 1024 : XNC8 =(XA(M,16)+XA(M,17)+XA(M,18)+XA(M,11)+XA(M,13)+XA(M,15))/6.D0 1025 : XCOOR((NC8 -1)*(IDIM+1) +M)=XNC8 1026 : 1027 : 1028 : 2102 CONTINUE 1029 : 1030 : MCTREI.NUM(1,NCTR0+K1+1)=NC1 1031 : MCTREI.NUM(1,NCTR0+K1+2)=NC2 1032 : MCTREI.NUM(1,NCTR0+K1+3)=NC3 1033 : MCTREI.NUM(1,NCTR0+K1+4)=NC4 1034 : MCTREI.NUM(1,NCTR0+K1+5)=NC5 1035 : MCTREI.NUM(1,NCTR0+K1+6)=NC6 1036 : MCTREI.NUM(1,NCTR0+K1+7)=NC7 1037 : MCTREI.NUM(1,NCTR0+K1+8)=NC8 1038 : 1039 : IPT2.NUM(1,K1+1)=N1 1040 : IPT2.NUM(2,K1+1)=N2 1041 : IPT2.NUM(3,K1+1)=N6 1042 : IPT2.NUM(4,K1+1)=N7 1043 : IPT2.NUM(5,K1+1)=N16 1044 : IPT2.NUM(6,K1+1)=N18 1045 : 1046 : IPT2.NUM(1,K1+2)=N2 1047 : IPT2.NUM(2,K1+2)=N3 1048 : IPT2.NUM(3,K1+2)=N4 1049 : IPT2.NUM(4,K1+2)=N16 1050 : IPT2.NUM(5,K1+2)=N8 1051 : IPT2.NUM(6,K1+2)=N17 1052 : 1053 : IPT2.NUM(1,K1+3)=N4 1054 : IPT2.NUM(2,K1+3)=N5 1055 : IPT2.NUM(3,K1+3)=N6 1056 : IPT2.NUM(4,K1+3)=N17 1057 : IPT2.NUM(5,K1+3)=N9 1058 : IPT2.NUM(6,K1+3)=N18 1059 : 1060 : IPT2.NUM(1,K1+4)=N2 1061 : IPT2.NUM(2,K1+4)=N4 1062 : IPT2.NUM(3,K1+4)=N6 1063 : IPT2.NUM(4,K1+4)=N16 1064 : IPT2.NUM(5,K1+4)=N17 1065 : IPT2.NUM(6,K1+4)=N18 1066 : 1067 : IPT2.NUM(1,K1+5)=N7 1068 : IPT2.NUM(2,K1+5)=N16 1069 : IPT2.NUM(3,K1+5)=N18 1070 : IPT2.NUM(4,K1+5)=N10 1071 : IPT2.NUM(5,K1+5)=N11 1072 : IPT2.NUM(6,K1+5)=N15 1073 : 1074 : IPT2.NUM(1,K1+6)=N16 1075 : IPT2.NUM(2,K1+6)=N8 1076 : IPT2.NUM(3,K1+6)=N17 1077 : IPT2.NUM(4,K1+6)=N11 1078 : IPT2.NUM(5,K1+6)=N12 1079 : IPT2.NUM(6,K1+6)=N13 1080 : 1081 : IPT2.NUM(1,K1+7)=N18 1082 : IPT2.NUM(2,K1+7)=N17 1083 : IPT2.NUM(3,K1+7)=N9 1084 : IPT2.NUM(4,K1+7)=N15 1085 : IPT2.NUM(5,K1+7)=N13 1086 : IPT2.NUM(6,K1+7)=N14 1087 : 1088 : IPT2.NUM(1,K1+8)=N16 1089 : IPT2.NUM(2,K1+8)=N17 1090 : IPT2.NUM(3,K1+8)=N18 1091 : IPT2.NUM(4,K1+8)=N11 1092 : IPT2.NUM(5,K1+8)=N13 1093 : IPT2.NUM(6,K1+8)=N15 1094 : 1095 : 1096 : K1=K1+8 1097 : 1098 : C DF1 1099 : DO 21001 M=1,3 1100 : XYZ(M,1)=XA(M,6) 1101 : XYZ(M,2)=XA(M,2 ) 1102 : XYZ(M,3)=XA(M,16) 1103 : XYZ(M,4)=XA(M,18) 1104 : 21001 CONTINUE 1105 : 1105 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR1) 1106 : 1107 : AIR1=ABS(AIR1) 1108 : DF1=SQRT(AIR1) 1109 : 1110 : C DF2 1111 : DO 21002 M=1,3 1112 : XYZ(M,1)=XA(M,2) 1113 : XYZ(M,2)=XA(M,4 ) 1114 : XYZ(M,3)=XA(M,17) 1115 : XYZ(M,4)=XA(M,16) 1116 : 21002 CONTINUE 1117 : 1117 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR2) 1118 : 1119 : AIR2=ABS(AIR2) 1120 : DF2=SQRT(AIR2) 1121 : 1122 : C DF3 1123 : DO 21003 M=1,3 1124 : XYZ(M,1)=XA(M,4) 1125 : XYZ(M,2)=XA(M,6 ) 1126 : XYZ(M,3)=XA(M,18) 1127 : XYZ(M,4)=XA(M,17) 1128 : 21003 CONTINUE 1129 : 1129 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR3) 1130 : 1131 : AIR3=ABS(AIR3) 1132 : DF3=SQRT(AIR3) 1133 : 1134 : C DF4 1135 : DO 21004 M=1,3 1136 : IZHR1.XYZ(M,1)=XA(M,7) 1137 : IZHR1.XYZ(M,2)=XA(M,16) 1138 : IZHR1.XYZ(M,3)=XA(M,18) 1139 : 21004 CONTINUE 1140 : 1140 : CALL CALJBC(IZFF1.FN,IZFF1.GR,IZFF1.PG,IZHR1.XYZ, 1141 : & IZHR1.HR,IZHR1.PGSQ,IZHR1.RPG,NES1,IDIM,NPI1,NPG1,IAXI,AIR4) 1142 : 1143 : AIR4=ABS(AIR4) 1144 : DF4=SQRT(AIR4) 1145 : 1146 : C DF5 1147 : DO 21005 M=1,3 1148 : IZHR1.XYZ(M,1)=XA(M,16) 1149 : IZHR1.XYZ(M,2)=XA(M,8 ) 1150 : IZHR1.XYZ(M,3)=XA(M,17) 1151 : 21005 CONTINUE 1152 : 1152 : CALL CALJBC(IZFF1.FN,IZFF1.GR,IZFF1.PG,IZHR1.XYZ, 1153 : & IZHR1.HR,IZHR1.PGSQ,IZHR1.RPG,NES1,IDIM,NPI1,NPG1,IAXI,AIR5) 1154 : 1155 : AIR5=ABS(AIR5) 1156 : DF5=SQRT(AIR5) 1157 : 1158 : C DF6 1159 : DO 21006 M=1,3 1160 : IZHR1.XYZ(M,1)=XA(M,18) 1161 : IZHR1.XYZ(M,2)=XA(M,17) 1162 : IZHR1.XYZ(M,3)=XA(M,9 ) 1163 : 21006 CONTINUE 1164 : 1164 : CALL CALJBC(IZFF1.FN,IZFF1.GR,IZFF1.PG,IZHR1.XYZ, 1165 : & IZHR1.HR,IZHR1.PGSQ,IZHR1.RPG,NES1,IDIM,NPI1,NPG1,IAXI,AIR6) 1166 : 1167 : AIR6=ABS(AIR6) 1168 : DF6=SQRT(AIR6) 1169 : 1170 : C DF7 1171 : DO 21007 M=1,3 1172 : IZHR1.XYZ(M,1)=XA(M,16) 1173 : IZHR1.XYZ(M,2)=XA(M,17) 1174 : IZHR1.XYZ(M,3)=XA(M,18) 1175 : 21007 CONTINUE 1176 : 1176 : CALL CALJBC(IZFF1.FN,IZFF1.GR,IZFF1.PG,IZHR1.XYZ, 1177 : & IZHR1.HR,IZHR1.PGSQ,IZHR1.RPG,NES1,IDIM,NPI1,NPG1,IAXI,AIR7) 1178 : 1179 : AIR7=ABS(AIR7) 1180 : DF7=SQRT(AIR7) 1181 : 1182 : C DF8 1183 : DO 21008 M=1,3 1184 : XYZ(M,1)=XA(M,18) 1185 : XYZ(M,2)=XA(M,16) 1186 : XYZ(M,3)=XA(M,11) 1187 : XYZ(M,4)=XA(M,15) 1188 : 21008 CONTINUE 1189 : 1189 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR8) 1190 : 1191 : AIR8=ABS(AIR8) 1192 : DF8=SQRT(AIR8) 1193 : 1194 : C DF9 1195 : DO 21009 M=1,3 1196 : XYZ(M,1)=XA(M,16) 1197 : XYZ(M,2)=XA(M,17) 1198 : XYZ(M,3)=XA(M,13) 1199 : XYZ(M,4)=XA(M,11) 1200 : 21009 CONTINUE 1201 : 1201 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR9) 1202 : 1203 : AIR9=ABS(AIR9) 1204 : DF9=SQRT(AIR9) 1205 : 1206 : C DF10 1207 : DO 21010 M=1,3 1208 : XYZ(M,1)=XA(M,18) 1209 : XYZ(M,2)=XA(M,17) 1210 : XYZ(M,3)=XA(M,13) 1211 : XYZ(M,4)=XA(M,15) 1212 : 21010 CONTINUE 1213 : 1213 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR10) 1214 : 1215 : AIR10=ABS(AIR10) 1216 : DF10=SQRT(AIR10) 1217 : 1218 : 1219 : DFM=(DF1+DF2+DF3+DF4+DF5+DF6+DF7+DF8+DF9+DF10)/10.D0 1220 : AIRM=(AIR1+AIR2+AIR3+AIR4+AIR5+AIR6 1221 : & +AIR7+AIR8+AIR9+AIR10)/10.D0 1222 : 1223 : MELSTB.NUM(1,NCSTB+K)=NC1 1224 : MELSTB.NUM(2,NCSTB+K)=NC2 1225 : MELSTB.NUM(3,NCSTB+K)=NC3 1226 : MELSTB.NUM(4,NCSTB+K)=NC4 1227 : MELSTB.NUM(5,NCSTB+K)=NC5 1228 : MELSTB.NUM(6,NCSTB+K)=NC6 1229 : MELSTB.NUM(7,NCSTB+K)=NC7 1230 : MELSTB.NUM(8,NCSTB+K)=NC8 1231 : 1232 : MELSTB.NUM(1,NCSTB+K+1)=NC2 1233 : MELSTB.NUM(2,NCSTB+K+1)=NC3 1234 : MELSTB.NUM(3,NCSTB+K+1)=NC4 1235 : MELSTB.NUM(4,NCSTB+K+1)=NC5 1236 : MELSTB.NUM(5,NCSTB+K+1)=NC6 1237 : MELSTB.NUM(6,NCSTB+K+1)=NC7 1238 : MELSTB.NUM(7,NCSTB+K+1)=NC8 1239 : MELSTB.NUM(8,NCSTB+K+1)=NC1 1240 : 1241 : MELSTB.NUM(1,NCSTB+K+2)=NC3 1242 : MELSTB.NUM(2,NCSTB+K+2)=NC4 1243 : MELSTB.NUM(3,NCSTB+K+2)=NC5 1244 : MELSTB.NUM(4,NCSTB+K+2)=NC6 1245 : MELSTB.NUM(5,NCSTB+K+2)=NC7 1246 : MELSTB.NUM(6,NCSTB+K+2)=NC8 1247 : MELSTB.NUM(7,NCSTB+K+2)=NC1 1248 : MELSTB.NUM(8,NCSTB+K+2)=NC2 1249 : 1250 : MELSTB.NUM(1,NCSTB+K+3)=NC4 1251 : MELSTB.NUM(2,NCSTB+K+3)=NC5 1252 : MELSTB.NUM(3,NCSTB+K+3)=NC6 1253 : MELSTB.NUM(4,NCSTB+K+3)=NC7 1254 : MELSTB.NUM(5,NCSTB+K+3)=NC8 1255 : MELSTB.NUM(6,NCSTB+K+3)=NC1 1256 : MELSTB.NUM(7,NCSTB+K+3)=NC2 1257 : MELSTB.NUM(8,NCSTB+K+3)=NC3 1258 : 1259 : MELSTB.NUM(1,NCSTB+K+4)=NC5 1260 : MELSTB.NUM(2,NCSTB+K+4)=NC6 1261 : MELSTB.NUM(3,NCSTB+K+4)=NC7 1262 : MELSTB.NUM(4,NCSTB+K+4)=NC8 1263 : MELSTB.NUM(5,NCSTB+K+4)=NC1 1264 : MELSTB.NUM(6,NCSTB+K+4)=NC2 1265 : MELSTB.NUM(7,NCSTB+K+4)=NC3 1266 : MELSTB.NUM(8,NCSTB+K+4)=NC4 1267 : 1268 : MELSTB.NUM(1,NCSTB+K+5)=NC6 1269 : MELSTB.NUM(2,NCSTB+K+5)=NC7 1270 : MELSTB.NUM(3,NCSTB+K+5)=NC8 1271 : MELSTB.NUM(4,NCSTB+K+5)=NC1 1272 : MELSTB.NUM(5,NCSTB+K+5)=NC2 1273 : MELSTB.NUM(6,NCSTB+K+5)=NC3 1274 : MELSTB.NUM(7,NCSTB+K+5)=NC4 1275 : MELSTB.NUM(8,NCSTB+K+5)=NC5 1276 : 1277 : MELSTB.NUM(1,NCSTB+K+6)=NC7 1278 : MELSTB.NUM(2,NCSTB+K+6)=NC8 1279 : MELSTB.NUM(3,NCSTB+K+6)=NC1 1280 : MELSTB.NUM(4,NCSTB+K+6)=NC2 1281 : MELSTB.NUM(5,NCSTB+K+6)=NC3 1282 : MELSTB.NUM(6,NCSTB+K+6)=NC4 1283 : MELSTB.NUM(7,NCSTB+K+6)=NC5 1284 : MELSTB.NUM(8,NCSTB+K+6)=NC6 1285 : 1286 : MELSTB.NUM(1,NCSTB+K+7)=NC8 1287 : MELSTB.NUM(2,NCSTB+K+7)=NC1 1288 : MELSTB.NUM(3,NCSTB+K+7)=NC2 1289 : MELSTB.NUM(4,NCSTB+K+7)=NC3 1290 : MELSTB.NUM(5,NCSTB+K+7)=NC4 1291 : MELSTB.NUM(6,NCSTB+K+7)=NC5 1292 : MELSTB.NUM(7,NCSTB+K+7)=NC6 1293 : MELSTB.NUM(8,NCSTB+K+7)=NC7 1294 : 1295 : C write(6,1002)air1,air2,air3,air4,air5,air6,air7,air8,air9, 1296 : C &air10 1297 : C write(6,1002)df3,df4,df5,df6,df7,df8,df9,df10 1298 : H12=AIRM*DFM*EPS(5) 1299 : H13=AIRM*DFM*EPS(5) 1300 : H14=AIR1*DF1*GA(5) 1301 : H15=AIR4*DF4*GA(5) 1302 : H16=AIRM*DFM*EPS(5) 1303 : H17=AIRM*DFM*EPS(5) 1304 : H18=AIRM*DFM*EPS(5) 1305 : 1306 : H23=AIRM*DFM*EPS(5) 1307 : H24=AIR2*DF2*GA(5) 1308 : H25=AIRM*DFM*EPS(5) 1309 : H26=AIR5*DF5*GA(5) 1310 : H27=AIRM*DFM*EPS(5) 1311 : H28=AIRM*DFM*EPS(5) 1312 : 1313 : H34=AIR3*DF3*GA(5) 1314 : H35=AIRM*DFM*EPS(5) 1315 : H36=AIRM*DFM*EPS(5) 1316 : H37=AIR6*DF6*GA(5) 1317 : H38=AIRM*DFM*EPS(5) 1318 : 1319 : H45=AIRM*DFM*EPS(5) 1320 : H46=AIRM*DFM*EPS(5) 1321 : H47=AIRM*DFM*EPS(5) 1322 : H48=AIR7*DF7*GA(5) 1323 : 1324 : H56=AIRM*DFM*EPS(5) 1325 : H57=AIRM*DFM*EPS(5) 1326 : H58=AIR8*DF8*GA(5) 1327 : 1328 : H67=AIRM*DFM*EPS(5) 1329 : H68=AIR9*DF9*GA(5) 1330 : 1331 : H78=AIR10*DF10*GA(5) 1332 : 1333 : MPOVA1.VPOCHA(NCTV0+K,1)=H12+H13+H14+H15+H16+H17+H18 1334 : MPOVA1.VPOCHA(NCTV0+K,2)=-H12 1335 : MPOVA1.VPOCHA(NCTV0+K,3)=-H13 1336 : MPOVA1.VPOCHA(NCTV0+K,4)=-H14 1337 : MPOVA1.VPOCHA(NCTV0+K,5)=-H15 1338 : MPOVA1.VPOCHA(NCTV0+K,6)=-H16 1339 : MPOVA1.VPOCHA(NCTV0+K,7)=-H17 1340 : MPOVA1.VPOCHA(NCTV0+K,8)=-H18 1341 : MPOVA1.VPOCHA(NCTV0+K+1,1)=H12+H23+H24+H25+H26+H27+H28 1342 : MPOVA1.VPOCHA(NCTV0+K+1,2)=-H23 1343 : MPOVA1.VPOCHA(NCTV0+K+1,3)=-H24 1344 : MPOVA1.VPOCHA(NCTV0+K+1,4)=-H25 1345 : MPOVA1.VPOCHA(NCTV0+K+1,5)=-H26 1346 : MPOVA1.VPOCHA(NCTV0+K+1,6)=-H27 1347 : MPOVA1.VPOCHA(NCTV0+K+1,7)=-H28 1348 : MPOVA1.VPOCHA(NCTV0+K+1,8)=-H12 1349 : MPOVA1.VPOCHA(NCTV0+K+2,1)=H13+H23+H34+H35+H36+H37+H38 1350 : MPOVA1.VPOCHA(NCTV0+K+2,2)=-H34 1351 : MPOVA1.VPOCHA(NCTV0+K+2,3)=-H35 1352 : MPOVA1.VPOCHA(NCTV0+K+2,4)=-H36 1353 : MPOVA1.VPOCHA(NCTV0+K+2,5)=-H37 1354 : MPOVA1.VPOCHA(NCTV0+K+2,6)=-H38 1355 : MPOVA1.VPOCHA(NCTV0+K+2,7)=-H13 1356 : MPOVA1.VPOCHA(NCTV0+K+2,8)=-H23 1357 : MPOVA1.VPOCHA(NCTV0+K+3,1)=H14+H24+H34+H45+H46+H47+H48 1358 : MPOVA1.VPOCHA(NCTV0+K+3,2)=-H45 1359 : MPOVA1.VPOCHA(NCTV0+K+3,3)=-H46 1360 : MPOVA1.VPOCHA(NCTV0+K+3,4)=-H47 1361 : MPOVA1.VPOCHA(NCTV0+K+3,5)=-H48 1362 : MPOVA1.VPOCHA(NCTV0+K+3,6)=-H14 1363 : MPOVA1.VPOCHA(NCTV0+K+3,7)=-H24 1364 : MPOVA1.VPOCHA(NCTV0+K+3,8)=-H34 1365 : MPOVA1.VPOCHA(NCTV0+K+4,1)=H15+H25+H35+H45+H56+H57+H58 1366 : MPOVA1.VPOCHA(NCTV0+K+4,2)=-H56 1367 : MPOVA1.VPOCHA(NCTV0+K+4,3)=-H57 1368 : MPOVA1.VPOCHA(NCTV0+K+4,4)=-H58 1369 : MPOVA1.VPOCHA(NCTV0+K+4,5)=-H15 1370 : MPOVA1.VPOCHA(NCTV0+K+4,6)=-H25 1371 : MPOVA1.VPOCHA(NCTV0+K+4,7)=-H35 1372 : MPOVA1.VPOCHA(NCTV0+K+4,8)=-H45 1373 : MPOVA1.VPOCHA(NCTV0+K+5,1)=H16+H26+H36+H46+H56+H67+H68 1374 : MPOVA1.VPOCHA(NCTV0+K+5,2)=-H67 1375 : MPOVA1.VPOCHA(NCTV0+K+5,3)=-H68 1376 : MPOVA1.VPOCHA(NCTV0+K+5,4)=-H16 1377 : MPOVA1.VPOCHA(NCTV0+K+5,5)=-H26 1378 : MPOVA1.VPOCHA(NCTV0+K+5,6)=-H36 1379 : MPOVA1.VPOCHA(NCTV0+K+5,7)=-H46 1380 : MPOVA1.VPOCHA(NCTV0+K+5,8)=-H56 1381 : MPOVA1.VPOCHA(NCTV0+K+6,1)=H17+H27+H37+H47+H57+H67+H78 1382 : MPOVA1.VPOCHA(NCTV0+K+6,2)=-H78 1383 : MPOVA1.VPOCHA(NCTV0+K+6,3)=-H17 1384 : MPOVA1.VPOCHA(NCTV0+K+6,4)=-H27 1385 : MPOVA1.VPOCHA(NCTV0+K+6,5)=-H37 1386 : MPOVA1.VPOCHA(NCTV0+K+6,6)=-H47 1387 : MPOVA1.VPOCHA(NCTV0+K+6,7)=-H57 1388 : MPOVA1.VPOCHA(NCTV0+K+6,8)=-H67 1389 : MPOVA1.VPOCHA(NCTV0+K+7,1)=H18+H28+H38+H48+H58+H68+H78 1390 : MPOVA1.VPOCHA(NCTV0+K+7,2)=-H18 1391 : MPOVA1.VPOCHA(NCTV0+K+7,3)=-H28 1392 : MPOVA1.VPOCHA(NCTV0+K+7,4)=-H38 1393 : MPOVA1.VPOCHA(NCTV0+K+7,5)=-H48 1394 : MPOVA1.VPOCHA(NCTV0+K+7,6)=-H58 1395 : MPOVA1.VPOCHA(NCTV0+K+7,7)=-H68 1396 : MPOVA1.VPOCHA(NCTV0+K+7,8)=-H78 1397 : KPOC=1 1398 : NCTV0=NCTV0+7 1399 : NCSTB=NCSTB+7 1400 : 1401 : 1402 : 215 CONTINUE 1403 : SEGDES IPT1,IPT2 1404 : GO TO 1 1405 : 1406 : C************************************************************************** 1407 : 1408 : 113 CONTINUE 1409 : WRITE(6,*)'Opérateur DOMA : Les éléments PY13 ne sont pas traités' 1410 : IRET=0 1411 : RETURN 1412 : 1413 : C************************************************************************** 1414 : C TE10 -> 8 TET4 1415 : 1416 : 110 CONTINUE 1417 : C write(6,*)' TE10 -> 8 TET4 ' 1418 : NBEL=IPT1.NUM(/2) 1419 : NP=IPT1.NUM(/1) 1420 : NBPC=NBEL*8 1421 : 1422 : N=NBPC+MPOVA1.VPOCHA(/1) 1423 : NC=8 1424 : NCTV0=MPOVA1.VPOCHA(/1) 1425 : SEGADJ MPOVA1 1426 : 1427 : NBV0=XCOOR(/1)/(IDIM+1) 1428 : NBPTS=NBV0+NBPC 1429 : SEGADJ MCOORD 1430 : 1431 : C maillage de lineaires 1432 : NBELEM=8*NBEL 1433 : NBNN=4 1434 : NBSOUS=0 1435 : NBREF=0 1436 : SEGINI IPT2 1437 : IPT2.ITYPEL=23 1438 : IM=IM+1 1439 : ITAB(IM)=IPT2 1440 : 1441 : C Spg des pts centres des macro elements 1442 : NCTR0=MCTREI.NUM(/2) 1443 : NBELEM=NCTR0+NBPC 1444 : NBNN=1 1445 : NBSOUS=0 1446 : NBREF=0 1447 : SEGADJ MCTREI 1448 : KCTREI=1 1449 : 1450 : C Connectivités de la matrice de stabilisation 1451 : NCSTB=MELSTB.NUM(/2) 1452 : NBELEM=NCSTB+NBPC 1453 : NBNN=8 1454 : C write(6,*)' KTRS3 : ',nbnn,nbelem 1455 : NBSOUS=0 1456 : NBREF=0 1457 : SEGADJ MELSTB 1458 : KSTB=1 1459 : 1459 : CALL KALPBG('TRI3 ','FONFORM0',IZFFM) 1459 : IF(IZFFM.EQ.0)CALL ARRET(0) 1460 : SEGACT IZFFM*MOD 1461 : IZHR=KZHR(1) 1462 : SEGACT IZHR*MOD 1463 : NPG=GR(/3) 1464 : NES=GR(/1) 1465 : NPI=3 1466 : 1467 : C write(6,*)' NBEL=',nbel 1468 : 1469 : K1=0 1470 : DO 210 K=1,NBEL 1471 : N1=IPT1.NUM(1,K) 1472 : N2=IPT1.NUM(2,K) 1473 : N3=IPT1.NUM(3,K) 1474 : N4=IPT1.NUM(4,K) 1475 : N5=IPT1.NUM(5,K) 1476 : N6=IPT1.NUM(6,K) 1477 : N7=IPT1.NUM(7,K) 1478 : N8=IPT1.NUM(8,K) 1479 : N9=IPT1.NUM(9,K) 1480 : N10=IPT1.NUM(10,K) 1481 : NC1=NBV0+(K-1)*8+1 1482 : NC2=NBV0+(K-1)*8+2 1483 : NC3=NBV0+(K-1)*8+3 1484 : NC4=NBV0+(K-1)*8+4 1485 : NC5=NBV0+(K-1)*8+5 1486 : NC6=NBV0+(K-1)*8+6 1487 : NC7=NBV0+(K-1)*8+7 1488 : NC8=NBV0+(K-1)*8+8 1489 : 1490 : DO 2111 M=1,3 1491 : XA(M,1)=XCOOR((N1-1)*(IDIM+1) +M) 1492 : XA(M,2)=XCOOR((N2-1)*(IDIM+1) +M) 1493 : XA(M,3)=XCOOR((N3-1)*(IDIM+1) +M) 1494 : XA(M,4)=XCOOR((N4-1)*(IDIM+1) +M) 1495 : XA(M,5)=XCOOR((N5-1)*(IDIM+1) +M) 1496 : XA(M,6)=XCOOR((N6-1)*(IDIM+1) +M) 1497 : XA(M,7)=XCOOR((N7-1)*(IDIM+1) +M) 1498 : XA(M,8)=XCOOR((N8-1)*(IDIM+1) +M) 1499 : XA(M,9)=XCOOR((N9-1)*(IDIM+1) +M) 1500 : XA(M,10)=XCOOR((N10-1)*(IDIM+1) +M) 1501 : 2111 CONTINUE 1502 : 1503 : DO 2112 M=1,3 1504 : 1505 : XNC1 =(XA(M,1)+XA(M,2)+XA(M,6)+XA(M,7))/4.D0 1506 : XCOOR((NC1 -1)*(IDIM+1) +M)=XNC1 1507 : 1508 : XNC2 =(XA(M,2)+XA(M,3)+XA(M,4)+XA(M,8))/4.D0 1509 : XCOOR((NC2 -1)*(IDIM+1) +M)=XNC2 1510 : 1511 : XNC3 =(XA(M,4)+XA(M,5)+XA(M,6)+XA(M,9))/4.D0 1512 : XCOOR((NC3 -1)*(IDIM+1) +M)=XNC3 1513 : 1514 : XNC4 =(XA(M,7)+XA(M,8)+XA(M,9)+XA(M,10))/4.D0 1515 : XCOOR((NC4 -1)*(IDIM+1) +M)=XNC4 1516 : 1517 : XNC5 =(XA(M,2)+XA(M,6)+XA(M,7)+XA(M,8))/4.D0 1518 : XCOOR((NC5 -1)*(IDIM+1) +M)=XNC5 1519 : 1520 : XNC6 =(XA(M,6)+XA(M,8)+XA(M,9)+XA(M,7))/4.D0 1521 : XCOOR((NC6 -1)*(IDIM+1) +M)=XNC6 1522 : 1523 : XNC7 =(XA(M,6)+XA(M,8)+XA(M,2)+XA(M,4))/4.D0 1524 : XCOOR((NC7 -1)*(IDIM+1) +M)=XNC7 1525 : 1526 : XNC8 =(XA(M,6)+XA(M,8)+XA(M,9)+XA(M,4))/4.D0 1527 : XCOOR((NC8 -1)*(IDIM+1) +M)=XNC8 1528 : 1529 : 1530 : 2112 CONTINUE 1531 : 1532 : MCTREI.NUM(1,NCTR0+K1+1)=NC1 1533 : MCTREI.NUM(1,NCTR0+K1+2)=NC2 1534 : MCTREI.NUM(1,NCTR0+K1+3)=NC3 1535 : MCTREI.NUM(1,NCTR0+K1+4)=NC4 1536 : MCTREI.NUM(1,NCTR0+K1+5)=NC5 1537 : MCTREI.NUM(1,NCTR0+K1+6)=NC6 1538 : MCTREI.NUM(1,NCTR0+K1+7)=NC7 1539 : MCTREI.NUM(1,NCTR0+K1+8)=NC8 1540 : 1541 : IPT2.NUM(1,K1+1)=N1 1542 : IPT2.NUM(2,K1+1)=N2 1543 : IPT2.NUM(3,K1+1)=N6 1544 : IPT2.NUM(4,K1+1)=N7 1545 : 1546 : IPT2.NUM(1,K1+2)=N3 1547 : IPT2.NUM(2,K1+2)=N4 1548 : IPT2.NUM(3,K1+2)=N8 1549 : IPT2.NUM(4,K1+2)=N2 1550 : 1551 : IPT2.NUM(1,K1+3)=N5 1552 : IPT2.NUM(2,K1+3)=N6 1553 : IPT2.NUM(3,K1+3)=N4 1554 : IPT2.NUM(4,K1+3)=N9 1555 : 1556 : IPT2.NUM(1,K1+4)=N7 1557 : IPT2.NUM(2,K1+4)=N8 1558 : IPT2.NUM(3,K1+4)=N9 1559 : IPT2.NUM(4,K1+4)=N10 1560 : 1561 : IPT2.NUM(1,K1+5)=N2 1562 : IPT2.NUM(2,K1+5)=N6 1563 : IPT2.NUM(3,K1+5)=N7 1564 : IPT2.NUM(4,K1+5)=N8 1565 : 1566 : IPT2.NUM(1,K1+6)=N6 1567 : IPT2.NUM(2,K1+6)=N8 1568 : IPT2.NUM(3,K1+6)=N9 1569 : IPT2.NUM(4,K1+6)=N7 1570 : 1571 : IPT2.NUM(1,K1+7)=N6 1572 : IPT2.NUM(2,K1+7)=N8 1573 : IPT2.NUM(3,K1+7)=N2 1574 : IPT2.NUM(4,K1+7)=N4 1575 : 1576 : IPT2.NUM(1,K1+8)=N6 1577 : IPT2.NUM(2,K1+8)=N8 1578 : IPT2.NUM(3,K1+8)=N9 1579 : IPT2.NUM(4,K1+8)=N4 1580 : 1581 : 1582 : K1=K1+8 1583 : 1584 : C DF1 1585 : DO 21101 M=1,3 1586 : XYZ(M,1)=XA(M,2) 1587 : XYZ(M,2)=XA(M,6) 1588 : XYZ(M,3)=XA(M,7) 1589 : 21101 CONTINUE 1590 : 1590 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR1) 1591 : 1592 : AIR1=ABS(AIR1) 1593 : DF1=SQRT(AIR1) 1594 : 1595 : C DF2 1596 : DO 21102 M=1,3 1597 : XYZ(M,1)=XA(M,2) 1598 : XYZ(M,2)=XA(M,4) 1599 : XYZ(M,3)=XA(M,6) 1600 : 21102 CONTINUE 1601 : 1601 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR2) 1602 : 1603 : AIR2=ABS(AIR2) 1604 : DF2=SQRT(AIR2) 1605 : 1606 : C DF3 1607 : DO 21103 M=1,3 1608 : XYZ(M,1)=XA(M,7) 1609 : XYZ(M,2)=XA(M,6) 1610 : XYZ(M,3)=XA(M,8) 1611 : 21103 CONTINUE 1612 : 1612 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR3) 1613 : 1614 : AIR3=ABS(AIR3) 1615 : DF3=SQRT(AIR3) 1616 : 1617 : C DF4 1618 : DO 21104 M=1,3 1619 : XYZ(M,1)=XA(M,2) 1620 : XYZ(M,2)=XA(M,8) 1621 : XYZ(M,3)=XA(M,6) 1622 : 21104 CONTINUE 1623 : 1623 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR4) 1624 : 1625 : AIR4=ABS(AIR4) 1626 : DF4=SQRT(AIR4) 1627 : 1628 : C DF5 1629 : DO 21105 M=1,3 1630 : XYZ(M,1)=XA(M,6) 1631 : XYZ(M,2)=XA(M,9) 1632 : XYZ(M,3)=XA(M,8) 1633 : 21105 CONTINUE 1634 : 1634 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR5) 1635 : 1636 : AIR5=ABS(AIR5) 1637 : DF5=SQRT(AIR5) 1638 : 1639 : C DF6 1640 : DO 21106 M=1,3 1641 : XYZ(M,1)=XA(M,6) 1642 : XYZ(M,2)=XA(M,8) 1643 : XYZ(M,3)=XA(M,4) 1644 : 21106 CONTINUE 1645 : 1645 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR6) 1646 : 1647 : AIR6=ABS(AIR6) 1648 : DF6=SQRT(AIR6) 1649 : 1650 : C DF7 1651 : DO 21107 M=1,3 1652 : XYZ(M,1)=XA(M,7) 1653 : XYZ(M,2)=XA(M,8) 1654 : XYZ(M,3)=XA(M,9) 1655 : 21107 CONTINUE 1656 : 1656 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR7) 1657 : 1658 : AIR7=ABS(AIR7) 1659 : DF7=SQRT(AIR7) 1660 : 1661 : C DF8 1662 : DO 21108 M=1,3 1663 : XYZ(M,1)=XA(M,9) 1664 : XYZ(M,2)=XA(M,6) 1665 : XYZ(M,3)=XA(M,4) 1666 : 21108 CONTINUE 1667 : 1667 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NPI,NPG,IAXI,AIR8) 1668 : 1669 : AIR8=ABS(AIR8) 1670 : DF8=SQRT(AIR8) 1671 : 1672 : 1673 : DFM=(DF1+DF2+DF3+DF4+DF5+DF6+DF7+DF8)/8.D0 1674 : AIRM=(AIR1+AIR2+AIR3+AIR4+AIR5+AIR6+AIR7+AIR8)/8.D0 1675 : 1676 : MELSTB.NUM(1,NCSTB+K)=NC1 1677 : MELSTB.NUM(2,NCSTB+K)=NC2 1678 : MELSTB.NUM(3,NCSTB+K)=NC3 1679 : MELSTB.NUM(4,NCSTB+K)=NC4 1680 : MELSTB.NUM(5,NCSTB+K)=NC5 1681 : MELSTB.NUM(6,NCSTB+K)=NC6 1682 : MELSTB.NUM(7,NCSTB+K)=NC7 1683 : MELSTB.NUM(8,NCSTB+K)=NC8 1684 : 1685 : MELSTB.NUM(1,NCSTB+K+1)=NC2 1686 : MELSTB.NUM(2,NCSTB+K+1)=NC3 1687 : MELSTB.NUM(3,NCSTB+K+1)=NC4 1688 : MELSTB.NUM(4,NCSTB+K+1)=NC5 1689 : MELSTB.NUM(5,NCSTB+K+1)=NC6 1690 : MELSTB.NUM(6,NCSTB+K+1)=NC7 1691 : MELSTB.NUM(7,NCSTB+K+1)=NC8 1692 : MELSTB.NUM(8,NCSTB+K+1)=NC1 1693 : 1694 : MELSTB.NUM(1,NCSTB+K+2)=NC3 1695 : MELSTB.NUM(2,NCSTB+K+2)=NC4 1696 : MELSTB.NUM(3,NCSTB+K+2)=NC5 1697 : MELSTB.NUM(4,NCSTB+K+2)=NC6 1698 : MELSTB.NUM(5,NCSTB+K+2)=NC7 1699 : MELSTB.NUM(6,NCSTB+K+2)=NC8 1700 : MELSTB.NUM(7,NCSTB+K+2)=NC1 1701 : MELSTB.NUM(8,NCSTB+K+2)=NC2 1702 : 1703 : MELSTB.NUM(1,NCSTB+K+3)=NC4 1704 : MELSTB.NUM(2,NCSTB+K+3)=NC5 1705 : MELSTB.NUM(3,NCSTB+K+3)=NC6 1706 : MELSTB.NUM(4,NCSTB+K+3)=NC7 1707 : MELSTB.NUM(5,NCSTB+K+3)=NC8 1708 : MELSTB.NUM(6,NCSTB+K+3)=NC1 1709 : MELSTB.NUM(7,NCSTB+K+3)=NC2 1710 : MELSTB.NUM(8,NCSTB+K+3)=NC3 1711 : 1712 : MELSTB.NUM(1,NCSTB+K+4)=NC5 1713 : MELSTB.NUM(2,NCSTB+K+4)=NC6 1714 : MELSTB.NUM(3,NCSTB+K+4)=NC7 1715 : MELSTB.NUM(4,NCSTB+K+4)=NC8 1716 : MELSTB.NUM(5,NCSTB+K+4)=NC1 1717 : MELSTB.NUM(6,NCSTB+K+4)=NC2 1718 : MELSTB.NUM(7,NCSTB+K+4)=NC3 1719 : MELSTB.NUM(8,NCSTB+K+4)=NC4 1720 : 1721 : MELSTB.NUM(1,NCSTB+K+5)=NC6 1722 : MELSTB.NUM(2,NCSTB+K+5)=NC7 1723 : MELSTB.NUM(3,NCSTB+K+5)=NC8 1724 : MELSTB.NUM(4,NCSTB+K+5)=NC1 1725 : MELSTB.NUM(5,NCSTB+K+5)=NC2 1726 : MELSTB.NUM(6,NCSTB+K+5)=NC3 1727 : MELSTB.NUM(7,NCSTB+K+5)=NC4 1728 : MELSTB.NUM(8,NCSTB+K+5)=NC5 1729 : 1730 : MELSTB.NUM(1,NCSTB+K+6)=NC7 1731 : MELSTB.NUM(2,NCSTB+K+6)=NC8 1732 : MELSTB.NUM(3,NCSTB+K+6)=NC1 1733 : MELSTB.NUM(4,NCSTB+K+6)=NC2 1734 : MELSTB.NUM(5,NCSTB+K+6)=NC3 1735 : MELSTB.NUM(6,NCSTB+K+6)=NC4 1736 : MELSTB.NUM(7,NCSTB+K+6)=NC5 1737 : MELSTB.NUM(8,NCSTB+K+6)=NC6 1738 : 1739 : MELSTB.NUM(1,NCSTB+K+7)=NC8 1740 : MELSTB.NUM(2,NCSTB+K+7)=NC1 1741 : MELSTB.NUM(3,NCSTB+K+7)=NC2 1742 : MELSTB.NUM(4,NCSTB+K+7)=NC3 1743 : MELSTB.NUM(5,NCSTB+K+7)=NC4 1744 : MELSTB.NUM(6,NCSTB+K+7)=NC5 1745 : MELSTB.NUM(7,NCSTB+K+7)=NC6 1746 : MELSTB.NUM(8,NCSTB+K+7)=NC7 1747 : 1748 : C write(6,1002)air1,air2,air3,air4,air5,air6,air7,air8,air9, 1749 : C &air10 1750 : C write(6,1002)df3,df4,df5,df6,df7,df8,df9,df10 1751 : H12=AIRM*DFM*EPS(7) 1752 : H13=AIRM*DFM*EPS(7) 1753 : H14=AIRM*DFM*EPS(7) 1754 : H15=AIR1*DF1*GA(7) 1755 : H16=AIRM*DFM*EPS(7) 1756 : H17=AIRM*DFM*EPS(7) 1757 : H18=AIRM*DFM*EPS(7) 1758 : 1759 : H23=AIRM*DFM*EPS(7) 1760 : H24=AIRM*DFM*EPS(7) 1761 : H25=AIRM*DFM*EPS(7) 1762 : H26=AIRM*DFM*EPS(7) 1763 : H27=AIR2*DF2*GA(7) 1764 : H28=AIRM*DFM*EPS(7) 1765 : 1766 : H34=AIRM*DFM*EPS(7) 1767 : H35=AIRM*DFM*EPS(7) 1768 : H36=AIRM*DFM*EPS(7) 1769 : H37=AIRM*DFM*EPS(7) 1770 : H38=AIR8*DF8*GA(7) 1771 : 1772 : H45=AIRM*DFM*EPS(7) 1773 : H46=AIR7*DF7*GA(7) 1774 : H47=AIRM*DFM*EPS(7) 1775 : H48=AIRM*DFM*EPS(7) 1776 : 1777 : H56=AIR3*DF3*GA(7) 1778 : H57=AIR4*DF4*GA(7) 1779 : H58=AIRM*DFM*EPS(7) 1780 : 1781 : H67=AIRM*DFM*EPS(7) 1782 : H68=AIR5*DF5*GA(7) 1783 : 1784 : H78=AIR6*DF6*GA(7) 1785 : 1786 : MPOVA1.VPOCHA(NCTV0+K,1)=H12+H13+H14+H15+H16+H17+H18 1787 : MPOVA1.VPOCHA(NCTV0+K,2)=-H12 1788 : MPOVA1.VPOCHA(NCTV0+K,3)=-H13 1789 : MPOVA1.VPOCHA(NCTV0+K,4)=-H14 1790 : MPOVA1.VPOCHA(NCTV0+K,5)=-H15 1791 : MPOVA1.VPOCHA(NCTV0+K,6)=-H16 1792 : MPOVA1.VPOCHA(NCTV0+K,7)=-H17 1793 : MPOVA1.VPOCHA(NCTV0+K,8)=-H18 1794 : MPOVA1.VPOCHA(NCTV0+K+1,1)=H12+H23+H24+H25+H26+H27+H28 1795 : MPOVA1.VPOCHA(NCTV0+K+1,2)=-H23 1796 : MPOVA1.VPOCHA(NCTV0+K+1,3)=-H24 1797 : MPOVA1.VPOCHA(NCTV0+K+1,4)=-H25 1798 : MPOVA1.VPOCHA(NCTV0+K+1,5)=-H26 1799 : MPOVA1.VPOCHA(NCTV0+K+1,6)=-H27 1800 : MPOVA1.VPOCHA(NCTV0+K+1,7)=-H28 1801 : MPOVA1.VPOCHA(NCTV0+K+1,8)=-H12 1802 : MPOVA1.VPOCHA(NCTV0+K+2,1)=H13+H23+H34+H35+H36+H37+H38 1803 : MPOVA1.VPOCHA(NCTV0+K+2,2)=-H34 1804 : MPOVA1.VPOCHA(NCTV0+K+2,3)=-H35 1805 : MPOVA1.VPOCHA(NCTV0+K+2,4)=-H36 1806 : MPOVA1.VPOCHA(NCTV0+K+2,5)=-H37 1807 : MPOVA1.VPOCHA(NCTV0+K+2,6)=-H38 1808 : MPOVA1.VPOCHA(NCTV0+K+2,7)=-H13 1809 : MPOVA1.VPOCHA(NCTV0+K+2,8)=-H23 1810 : MPOVA1.VPOCHA(NCTV0+K+3,1)=H14+H24+H34+H45+H46+H47+H48 1811 : MPOVA1.VPOCHA(NCTV0+K+3,2)=-H45 1812 : MPOVA1.VPOCHA(NCTV0+K+3,3)=-H46 1813 : MPOVA1.VPOCHA(NCTV0+K+3,4)=-H47 1814 : MPOVA1.VPOCHA(NCTV0+K+3,5)=-H48 1815 : MPOVA1.VPOCHA(NCTV0+K+3,6)=-H14 1816 : MPOVA1.VPOCHA(NCTV0+K+3,7)=-H24 1817 : MPOVA1.VPOCHA(NCTV0+K+3,8)=-H34 1818 : MPOVA1.VPOCHA(NCTV0+K+4,1)=H15+H25+H35+H45+H56+H57+H58 1819 : MPOVA1.VPOCHA(NCTV0+K+4,2)=-H56 1820 : MPOVA1.VPOCHA(NCTV0+K+4,3)=-H57 1821 : MPOVA1.VPOCHA(NCTV0+K+4,4)=-H58 1822 : MPOVA1.VPOCHA(NCTV0+K+4,5)=-H15 1823 : MPOVA1.VPOCHA(NCTV0+K+4,6)=-H25 1824 : MPOVA1.VPOCHA(NCTV0+K+4,7)=-H35 1825 : MPOVA1.VPOCHA(NCTV0+K+4,8)=-H45 1826 : MPOVA1.VPOCHA(NCTV0+K+5,1)=H16+H26+H36+H46+H56+H67+H68 1827 : MPOVA1.VPOCHA(NCTV0+K+5,2)=-H67 1828 : MPOVA1.VPOCHA(NCTV0+K+5,3)=-H68 1829 : MPOVA1.VPOCHA(NCTV0+K+5,4)=-H16 1830 : MPOVA1.VPOCHA(NCTV0+K+5,5)=-H26 1831 : MPOVA1.VPOCHA(NCTV0+K+5,6)=-H36 1832 : MPOVA1.VPOCHA(NCTV0+K+5,7)=-H46 1833 : MPOVA1.VPOCHA(NCTV0+K+5,8)=-H56 1834 : MPOVA1.VPOCHA(NCTV0+K+6,1)=H17+H27+H37+H47+H57+H67+H78 1835 : MPOVA1.VPOCHA(NCTV0+K+6,2)=-H78 1836 : MPOVA1.VPOCHA(NCTV0+K+6,3)=-H17 1837 : MPOVA1.VPOCHA(NCTV0+K+6,4)=-H27 1838 : MPOVA1.VPOCHA(NCTV0+K+6,5)=-H37 1839 : MPOVA1.VPOCHA(NCTV0+K+6,6)=-H47 1840 : MPOVA1.VPOCHA(NCTV0+K+6,7)=-H57 1841 : MPOVA1.VPOCHA(NCTV0+K+6,8)=-H67 1842 : MPOVA1.VPOCHA(NCTV0+K+7,1)=H18+H28+H38+H48+H58+H68+H78 1843 : MPOVA1.VPOCHA(NCTV0+K+7,2)=-H18 1844 : MPOVA1.VPOCHA(NCTV0+K+7,3)=-H28 1845 : MPOVA1.VPOCHA(NCTV0+K+7,4)=-H38 1846 : MPOVA1.VPOCHA(NCTV0+K+7,5)=-H48 1847 : MPOVA1.VPOCHA(NCTV0+K+7,6)=-H58 1848 : MPOVA1.VPOCHA(NCTV0+K+7,7)=-H68 1849 : MPOVA1.VPOCHA(NCTV0+K+7,8)=-H78 1850 : KPOC=1 1851 : NCTV0=NCTV0+7 1852 : NCSTB=NCSTB+7 1853 : 1854 : 1855 : 210 CONTINUE 1856 : SEGDES IPT1,IPT2 1857 : C write(6,*)' Sortie boucle',K 1858 : GO TO 1 1859 : C************************************************************************** 1860 : 1861 : 1862 : 1 CONTINUE 1863 : C IF(MELTFI.LISOUS(/1).EQ.1)THEN 1864 : C MEL=MELTFI.LISOUS(1) 1865 : C SEGSUP MELTFI 1866 : C MELTFI=MEL 1867 : C ENDIF 1868 : 1869 : IF(IM.EQ.1)THEN 1870 : MELEME=ITAB(1) 1871 : ELSE 1872 : IF(IM.GT.5)THEN 1873 : WRITE(6,*)' Problemes dans DOMA option MACRO ' 1874 : RETURN 1875 : ENDIF 1876 : NBELEM=0 1877 : NBNN=0 1878 : NBSOUS=IM 1879 : NBREF=0 1880 : SEGINI MELEME 1881 : DO 2 L=1,NBSOUS 1882 : LISOUS(L)=ITAB(L) 1883 : 2 CONTINUE 1884 : ENDIF 1884 : CALL ECMO(MTBT0,'MELEME','MAILLAGE',MELEME) 1885 : 1886 : C Connectivités de la matrice de stabilisation 1887 : segact melstb 1888 : 1889 : IF(KSTB.NE.0)THEN 1889 : CALL ECMO(MTBT0,'MELSTB','MAILLAGE',MELSTB) 1890 : ELSE 1891 : SEGSUP MELSTB 1892 : MELSTB=0 1893 : ENDIF 1894 : 1895 : IF(KCTREI.NE.0)THEN 1895 : CALL ECMO(MTBT0,'MCTREI','MAILLAGE',MCTREI) 1896 : IF(KPOC.NE.0)THEN 1897 : MSOUP1.IGEOC=MCTREI 1897 : CALL ECMO(MTBT0,'MCHPOC','CHPOINT',MCHPO1) 1898 : ELSE 1899 : SEGSUP MCHPO1,MSOUP1,MPOVA1 1900 : ENDIF 1901 : ELSE 1902 : SEGSUP MCTREI 1903 : MCTREI=0 1904 : ENDIF 1905 : 1906 : 1907 : SEGDES MELEME,MACRO 1908 : 1002 FORMAT(10(1X,1PE11.4)) 1909 : RETURN 1910 : END 1911 : 1912 : 1913 : 1914 : 1915 : 1916 : 1917 : 1918 : 1919 : 1920 : 1921 : 1922 : 1923 : 1924 : 1925 : 1926 :
© Cast3M 2003 - All rights reserved.
Disclaimer