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