1 : C SYM2D3 SOURCE LEPOTIER 10/03/24 21:15:03 6649 2 : C NOR2D3 SOURCE PV 09/03/12 21:29:27 6325 3 : SUBROUTINE SYM2D3(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR, 4 : & MPOSUR,MELTFA,MLEFA,MLEFA2,MPOTEN,MPOCHP,MLENCL, 5 : & MLENNE,MLENMI,MPOVCL, 6 : & MPOVNE,MPOVMI,ICHTE,ICHCL,ICHNE,IPO2, 7 : & SCMB,INDLI, 8 : & TAB,VAL1,VAL2,IND22,IND2,IND,NBFAC,NBCOT, 9 : & NSOMM,NBMAX) 10 : 11 : 12 : 13 : C 14 : C************************************************************************ 15 : C 16 : C PROJET : CASTEM 2000 17 : C 18 : C NOM : NORV2 19 : C 20 : C DESCRIPTION : Appelle par NORV1 21 : C 22 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) 23 : C 24 : C AUTEUR : C. LE POTIER, DM2S/SFME/MTMS 25 : C 26 : C************************************************************************ 27 : C 28 : IMPLICIT INTEGER(I-N) 29 : IMPLICIT REAL*8 (a-h,o-z) 30 : -INC SMLENTI 31 : -INC SMELEME 32 : -INC SMCHPOI 33 : -INC CCOPTIO 34 : -INC SMCOORD 35 : -INC SMLREEL 36 : 37 : POINTEUR MELEFL.MELEME, MELEFP.MELEME, MELEFA.MELEME, 38 : & MELTFA.MELEME, MELEP2.MELEME 39 : POINTEUR MPOSUR.MPOVAL, MPONOR.MPOVAL, 40 : & MPOCHP.MPOVAL, MPOVCL.MPOVAL, MPGSOM.MPOVAL, MPVOSO.MPOVAL, 41 : & MPOGRA.MPOVAL,MPOTEN.MPOVAL,MPOVNE.MPOVAL,MPOVMI.MPOVAL 42 : POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLESOM.MLENTI, 43 : & MLEFA.MLENTI,MLENNE.MLENTI,MLENMI.MLENTI,MLEFA2.MLENTI 44 : -INC SMCHAML 45 : INTEGER NBNN,NBREF 46 : 47 : 48 : 49 : C 50 : C**** Variables de COOPTIO 51 : C 52 : C 53 : C**** Variables de COOPTIO 54 : C 55 : c INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 56 : c & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 57 : c & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 58 : c & ,IECHO, IIMPI, IOSPI 59 : c & ,IDIM 60 : C & ,MCOORD 61 : c & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 62 : c & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 63 : c & ,NORINC,NORVAL,NORIND,NORVAD 64 : c & ,NUCROU, IPSAUV 65 : 66 : C**** Variable de SMLENTI, SMCHPOI 67 : C 68 : INTEGER JG, N, NC, NSOUPO, NAT, NBSOUS, NBNO,NBELEM 69 : C 70 : C**** Les includes 71 : C 72 : INTEGER I1,ICOMP,ICOMGR,IGEOM 73 : & ,IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,INORM 74 : & ,ISURF,IMAIL,ICHPO,ICHCL,ICHGRA,ICOEFF 75 : & ,NTOT,NSOMM,NCOMP,NFAC,NCEN 76 : & ,NLCF,NGCF,NGCF1,NGCF2,NGCG,NGCD,NLCG,NLCD,NGS1,NGS2 77 : & ,NLS1,NLS2,NLFCL 78 : & ,ISOUS,IELEM,INOEUD,ICELL 79 : INTEGER ICEN2 80 : REAL*8 SCNX,SCNY,SCNZ,SURF,VOL,VAL,VALX,VALY,VALZ,XG,XD,XF,XS1,XS2 81 : & ,YG,YD,YF,YS1,YS2,ZG,ZD,ZF,ZS1,ZS2, 82 : & PSCA,XNORM,VECX,VECY,VECZ,PSCAGX,PSCAGY,PSCAGZ, 83 : & PSCADX,PSCADY,PSCADZ,K11G,K22G,K21G,K31G,K32G,K33G, 84 : & K11D,K22D,K21D,K31D,K32D,K33D,VXG1,VXG2, 85 : & VXAU,VYAU,VZAU,VXD1,VXD2,VYG1,VYG2,VYD1,VYD2,VZG1, 86 : & VZG2,VZD1,VZD2,TRG1,TRG2, 87 : & TRD1,TRD2,TRG,TRD 88 : REAL*8 XLONG,AG1,AG2,AD1,AD2,PSCAG1,PSCAG2,PSCAD1,PSCAD2, 89 : & COEF1,COEF2,COEF3,COEF4,SCN1X,SCN1Y,SCN1Z,VX,VY,VZ, 90 : & COEF1X,COEF2X,COEF1Y,COEF2Y,COEF1Z,COEF2Z, 91 : & CX,CY,CZ,ANCX,ANCY,ANCZ,DIFFX,DIFFY,DIFFZ,XLONGG,XLONGD, 92 : & VALD,VALG,COEF,GX,GY,GZ,XMINK11,XMAXK11,XMINK22,XMAXK22, 93 : & QIMPX,QIMPY,QIMPZ,QIMPS,XLAMBDA1,XLAMBDA2 94 : 95 : c REAL*8 VECXG1(3),VECYG1(3) 96 : c REAL*8 VECXG2(3),VECYG2(3) 97 : c REAL*8 VECXD1(3),VECYD1(3) 98 : c REAL*8 VECXD2(3),VECYD2(3) 99 : c REAL*8 EPS 100 : c INTEGER ICRIT 101 : c CHARACTER*(4) NOMCOM(18) 102 : c CHARACTER*8 TYPE 103 : 104 : REAL*8 VECXG(4,4),VECYG(4,4),VECZG(4,4) 105 : REAL*8 VECXD(4,4),VECYD(4,4),VECZD(4,4) 106 : REAL*8 VOLUG(4),SURFAGX(4),SURFAGY(4),SURFAGZ(4),COEFG(4,4) 107 : REAL*8 VOLUD(4),SURFADX(4),SURFADY(4),SURFADZ(4),COEFD(4,4) 108 : REAL*8 XARG(4,4),YARG(4,4),ZARG(4,4),XCOUR,YCOUR,ZCOUR 109 : REAL*8 XFACG(4,4),YFACG(4,4),ZFACG(4,4),XCO,YCO,ZCO 110 : REAL*8 XARD(4,4),YARD(4,4),ZARD(4,4) 111 : REAL*8 XFACD(4,4),YFACD(4,4),ZFACD(4,4) 112 : REAL*8 XA,YA,ZA,DIST1,DIST2 113 : REAL*8 VAUX(3),VAUY(3),VAUZ(3) 114 : REAL*8 PVECX,PVECY,PVECZ 115 : INTEGER NGS(4),NLS(4),XS(4),YS(4),ZS(4) 116 : INTEGER NLOCFG(4,4),NLOCFD(4,4) 117 : REAL*8 EPS,ALPHA 118 : INTEGER ICRIT 119 : CHARACTER*(4) NOMCOM(18) 120 : CHARACTER*8 TYPE 121 : C 122 : DATA NOMCOM /'P1DX','P1DY', 123 : & 'P2DX','P2DY', 124 : & 'P3DX','P3DY', 125 : & 'P4DX','P4DY', 126 : & 'P5DX','P5DY', 127 : & 'P6DX','P6DY', 128 : & 'P7DX','P7DY', 129 : & 'P8DX','P8DY', 130 : & 'P9DX','P9DY'/ 131 : 132 : INTEGER NDIM 133 : SEGMENT MMAT1 134 : REAL*8 PM(NDIM,NDIM),PM1(NDIM,NDIM),XSOL(NDIM) 135 : INTEGER IC(NDIM) 136 : ENDSEGMENT 137 : 138 : INTEGER K1,K2 139 : SEGMENT INDICE 140 : INTEGER NUME(K1,K2) 141 : ENDSEGMENT 142 : POINTEUR IND.INDICE,IND2.INDICE,IND22.INDICE 143 : 144 : SEGMENT MATRICE 145 : REAL*8 MAT(K1,K2) 146 : ENDSEGMENT 147 : POINTEUR VAL1.MATRICE,VAL2.MATRICE,SCMB.MATRICE 148 : 149 : INTEGER K3 150 : SEGMENT POINT2 151 : INTEGER POINT(K3) 152 : ENDSEGMENT 153 : POINTEUR IPO2.POINT2 154 : 155 : SEGMENT MATRICE2 156 : REAL*8 MAT2(K1,K2) 157 : ENDSEGMENT 158 : POINTEUR MATR1.MATRICE2,MATR2.MATRICE2 159 : 160 : 161 : SEGMENT REP 162 : INTEGER ID(K3) 163 : ENDSEGMENT 164 : POINTEUR TAB.REP,INDLI.REP 165 : 166 : INTEGER K5 167 : SEGMENT NBFAC 168 : INTEGER NBFACEL(K5) 169 : INTEGER IMELEM(K5) 170 : ENDSEGMENT 171 : 172 : INTEGER K6 173 : SEGMENT NBCOT 174 : INTEGER NBCOTE(K6) 175 : INTEGER IMECOTE(K6) 176 : ENDSEGMENT 177 : 178 : 179 : 180 : c CALCUL DES DIFFERENTS POINTEURS A ACTIVER DANS POUR PLUSIIEURS 181 : c SOUS DOMAINE 182 : ALPHA = 2.0/3.0 183 : 184 : 185 : MAUX = MELTFA 186 : MAUX2 = MELEFP 187 : NMAI1 = 0 188 : NMAI2 = 0 189 : NMAI3 = 0 190 : NMAI4 = 0 191 : NBSO = MAX(1,MELTFA.LISOUS(/1)) 192 : c WRITE(6,*) 'NBSO MAILLE= ',NBSO 193 : c WRITE(6,*) 'MELTFA= ',MELTFA 194 : IELTFA = MELTFA 195 : IF (NBSO.EQ.1) THEN 196 : K5 = MELTFA.NUM(/2) 197 : ELSEIF (NBSO.EQ.2) THEN 198 : IPT1 = MELTFA.LISOUS(1) 199 : SEGACT IPT1 200 : N1 = IPT1.NUM(/2) 201 : NMAI1 = N1 202 : SEGDES IPT1 203 : IPT2 = MELTFA.LISOUS(2) 204 : SEGACT IPT2 205 : N2 = IPT2.NUM(/2) 206 : NMAI2 = N2 207 : SEGDES IPT2 208 : K5 = N1 + N2 209 : ELSEIF (NBSO.EQ.3) THEN 210 : IPT1 = MELTFA.LISOUS(1) 211 : SEGACT IPT1 212 : N1 = IPT1.NUM(/2) 213 : NMAI1 = N1 214 : SEGDES IPT1 215 : IPT2 = MELTFA.LISOUS(2) 216 : SEGACT IPT2 217 : N2 = IPT2.NUM(/2) 218 : NMAI2 = N2 219 : SEGDES IPT2 220 : IPT3 = MELTFA.LISOUS(3) 221 : SEGACT IPT3 222 : N3 = IPT3.NUM(/2) 223 : NMAI3 = N3 224 : SEGDES IPT3 225 : K5 = N1 + N2 + N3 226 : ELSEIF (NBSO.EQ.4) THEN 227 : IPT1 = MELTFA.LISOUS(1) 228 : SEGACT IPT1 229 : N1 = IPT1.NUM(/2) 230 : NMAI1 = N1 231 : SEGDES IPT1 232 : IPT2 = MELTFA.LISOUS(2) 233 : SEGACT IPT2 234 : N2 = IPT2.NUM(/2) 235 : NMAI2 = N2 236 : SEGDES IPT2 237 : IPT3 = MELTFA.LISOUS(3) 238 : SEGACT IPT3 239 : N3 = IPT3.NUM(/2) 240 : NMAI3 = N3 241 : SEGDES IPT3 242 : IPT4 = MELTFA.LISOUS(4) 243 : SEGACT IPT4 244 : N4 = IPT4.NUM(/2) 245 : NMAI4 = N4 246 : SEGDES IPT4 247 : K5 = N1 + N2 + N3 + N4 248 : ENDIF 249 : c WRITE(6,*) 'K5= ',K5 250 : 251 : 252 : 253 : IF (NBSO.EQ.1) THEN 254 : DO I = 1,K5 255 : NTYPE = MELTFA.ITYPEL 256 : c WRITE(6,*) 'NTYPE= ',NTYPE 257 : IF (NTYPE .EQ. 16) THEN 258 : NBFACEL(I) = 6 259 : IMELEM(I) = MELTFA 260 : ELSEIF (NTYPE .EQ. 25) THEN 261 : NBFACEL(I) = 5 262 : IMELEM(I) = MELTFA 263 : ELSEIF (NTYPE .EQ. 23) THEN 264 : NBFACEL(I) = 4 265 : IMELEM(I) = MELTFA 266 : ELSEIF (NTYPE .EQ. 9) THEN 267 : NBFACEL(I) = 5 268 : IMELEM(I) = MELTFA 269 : ENDIF 270 : c SEGDES MELTFA 271 : ENDDO 272 : ELSEIF (NBSO.EQ.2) THEN 273 : IPT1 = MELTFA.LISOUS(1) 274 : SEGACT IPT1 275 : IPT2 = MELTFA.LISOUS(2) 276 : SEGACT IPT2 277 : DO I = 1,K5 278 : N1 = IPT1.NUM(/2) 279 : IF (I.LE.N1) THEN 280 : NTYPE = IPT1.ITYPEL 281 : IF (NTYPE .EQ. 16) THEN 282 : NBFACEL(I) = 6 283 : IMELEM(I) = IPT1 284 : ELSEIF (NTYPE .EQ. 25) THEN 285 : NBFACEL(I) = 5 286 : IMELEM(I) = IPT1 287 : ELSEIF (NTYPE .EQ. 23) THEN 288 : NBFACEL(I) = 4 289 : IMELEM(I) = IPT1 290 : ELSEIF (NTYPE .EQ. 9) THEN 291 : NBFACEL(I) = 5 292 : IMELEM(I) = IPT1 293 : ENDIF 294 : ELSE 295 : NTYPE = IPT2.ITYPEL 296 : IF (NTYPE .EQ. 16) THEN 297 : NBFACEL(I) = 6 298 : IMELEM(I) = IPT2 299 : ELSEIF (NTYPE .EQ. 25) THEN 300 : NBFACEL(I) = 5 301 : IMELEM(I) = IPT2 302 : ELSEIF (NTYPE .EQ. 23) THEN 303 : NBFACEL(I) = 4 304 : IMELEM(I) = IPT2 305 : ELSEIF (NTYPE .EQ. 9) THEN 306 : NBFACEL(I) = 5 307 : IMELEM(I) = IPT2 308 : ENDIF 309 : ENDIF 310 : ENDDO 311 : ELSEIF (NBSO.EQ.3) THEN 312 : IPT1 = MELTFA.LISOUS(1) 313 : SEGACT IPT1 314 : NTYPE = IPT1.ITYPEL 315 : c WRITE(6,*) 'NTYPE= ',IPT1.ITYPEL 316 : IPT2 = MELTFA.LISOUS(2) 317 : SEGACT IPT2 318 : NTYPE = IPT2.ITYPEL 319 : c WRITE(6,*) 'NTYPE= ',IPT2.ITYPEL 320 : IPT3 = MELTFA.LISOUS(3) 321 : SEGACT IPT3 322 : NTYPE = IPT3.ITYPEL 323 : c WRITE(6,*) 'NTYPE= ',IPT3.ITYPEL 324 : N1 = IPT1.NUM(/2) 325 : N2 = IPT2.NUM(/2) 326 : N3 = IPT3.NUM(/2) 327 : DO I = 1,K5 328 : IF (I.LE.N1) THEN 329 : NTYPE = IPT1.ITYPEL 330 : IF (NTYPE .EQ. 16) THEN 331 : NBFACEL(I) = 6 332 : IMELEM(I) = IPT1 333 : ELSEIF (NTYPE .EQ. 25) THEN 334 : NBFACEL(I) = 5 335 : IMELEM(I) = IPT1 336 : ELSEIF (NTYPE .EQ. 23) THEN 337 : NBFACEL(I) = 4 338 : IMELEM(I) = IPT1 339 : ELSEIF (NTYPE .EQ. 9) THEN 340 : NBFACEL(I) = 5 341 : IMELEM(I) = IPT1 342 : ENDIF 343 : ELSEIF (I.LE.(N1+N2)) THEN 344 : NTYPE = IPT2.ITYPEL 345 : IF (NTYPE .EQ. 16) THEN 346 : NBFACEL(I) = 6 347 : IMELEM(I) = IPT2 348 : ELSEIF (NTYPE .EQ. 25) THEN 349 : NBFACEL(I) = 5 350 : IMELEM(I) = IPT2 351 : ELSEIF (NTYPE .EQ. 23) THEN 352 : NBFACEL(I) = 4 353 : IMELEM(I) = IPT2 354 : ELSEIF (NTYPE .EQ. 9) THEN 355 : NBFACEL(I) = 5 356 : IMELEM(I) = IPT2 357 : ENDIF 358 : ELSE 359 : NTYPE = IPT3.ITYPEL 360 : IF (NTYPE .EQ. 16) THEN 361 : NBFACEL(I) = 6 362 : IMELEM(I) = IPT3 363 : ELSEIF (NTYPE .EQ. 25) THEN 364 : NBFACEL(I) = 5 365 : IMELEM(I) = IPT3 366 : ELSEIF (NTYPE .EQ. 23) THEN 367 : NBFACEL(I) = 4 368 : IMELEM(I) = IPT3 369 : ELSEIF (NTYPE .EQ. 9) THEN 370 : NBFACEL(I) = 5 371 : IMELEM(I) = IPT3 372 : ENDIF 373 : ENDIF 374 : ENDDO 375 : ELSEIF (NBSO.EQ.4) THEN 376 : IPT1 = MELTFA.LISOUS(1) 377 : SEGACT IPT1 378 : NTYPE = IPT1.ITYPEL 379 : c WRITE(6,*) 'NTYPE= ',IPT1.ITYPEL 380 : IPT2 = MELTFA.LISOUS(2) 381 : SEGACT IPT2 382 : NTYPE = IPT2.ITYPEL 383 : c WRITE(6,*) 'NTYPE= ',IPT2.ITYPEL 384 : IPT3 = MELTFA.LISOUS(3) 385 : SEGACT IPT3 386 : NTYPE = IPT3.ITYPEL 387 : WRITE(6,*) 'NTYPE= ',IPT3.ITYPEL 388 : IPT4 = MELTFA.LISOUS(4) 389 : SEGACT IPT4 390 : NTYPE = IPT4.ITYPEL 391 : WRITE(6,*) 'NTYPE= ',IPT4.ITYPEL 392 : N1 = IPT1.NUM(/2) 393 : N2 = IPT2.NUM(/2) 394 : N3 = IPT3.NUM(/2) 395 : N4 = IPT4.NUM(/2) 396 : DO I = 1,K5 397 : IF (I.LE.N1) THEN 398 : NTYPE = IPT1.ITYPEL 399 : IF (NTYPE .EQ. 16) THEN 400 : NBFACEL(I) = 6 401 : IMELEM(I) = IPT1 402 : ELSEIF (NTYPE .EQ. 25) THEN 403 : NBFACEL(I) = 5 404 : IMELEM(I) = IPT1 405 : ELSEIF (NTYPE .EQ. 23) THEN 406 : NBFACEL(I) = 4 407 : IMELEM(I) = IPT1 408 : ELSEIF (NTYPE .EQ. 9) THEN 409 : NBFACEL(I) = 5 410 : IMELEM(I) = IPT1 411 : ENDIF 412 : ELSEIF (I.LE.(N1+N2)) THEN 413 : NTYPE = IPT2.ITYPEL 414 : IF (NTYPE .EQ. 16) THEN 415 : NBFACEL(I) = 6 416 : IMELEM(I) = IPT2 417 : ELSEIF (NTYPE .EQ. 25) THEN 418 : NBFACEL(I) = 5 419 : IMELEM(I) = IPT2 420 : ELSEIF (NTYPE .EQ. 23) THEN 421 : NBFACEL(I) = 4 422 : IMELEM(I) = IPT2 423 : ELSEIF (NTYPE .EQ. 9) THEN 424 : NBFACEL(I) = 5 425 : IMELEM(I) = IPT2 426 : ENDIF 427 : ELSEIF (I.LE.(N1+N2+N3)) THEN 428 : NTYPE = IPT3.ITYPEL 429 : IF (NTYPE .EQ. 16) THEN 430 : NBFACEL(I) = 6 431 : IMELEM(I) = IPT3 432 : ELSEIF (NTYPE .EQ. 25) THEN 433 : NBFACEL(I) = 5 434 : IMELEM(I) = IPT3 435 : ELSEIF (NTYPE .EQ. 23) THEN 436 : NBFACEL(I) = 4 437 : IMELEM(I) = IPT3 438 : ELSEIF (NTYPE .EQ. 9) THEN 439 : NBFACEL(I) = 5 440 : IMELEM(I) = IPT3 441 : ENDIF 442 : ELSE 443 : NTYPE = IPT4.ITYPEL 444 : IF (NTYPE .EQ. 16) THEN 445 : NBFACEL(I) = 6 446 : IMELEM(I) = IPT4 447 : ELSEIF (NTYPE .EQ. 25) THEN 448 : NBFACEL(I) = 5 449 : IMELEM(I) = IPT4 450 : ELSEIF (NTYPE .EQ. 23) THEN 451 : NBFACEL(I) = 4 452 : IMELEM(I) = IPT4 453 : ELSEIF (NTYPE .EQ. 9) THEN 454 : NBFACEL(I) = 5 455 : IMELEM(I) = IPT4 456 : ENDIF 457 : ENDIF 458 : ENDDO 459 : ENDIF 460 : 461 : C ON EST ICI CORRIGER K5 462 : 463 : MLEFA2 = MLEFA 463 : CALL KRIPAD(MELEFA,MLEFA2) 464 : c CAS OU LES FACES SONT DES TRIANGLES OU DES FACES 465 : NFAI1 = 0 466 : NBSOF = MAX(1,MELEFP.LISOUS(/1)) 467 : c WRITE(6,*) 'NBSO FACE= ',NBSOF 468 : IELTFA = MELTFA 469 : IF (NBSOF.EQ.1) THEN 470 : K6 = MELEFP.NUM(/2) 471 : ELSEIF (NBSOF.EQ.2) THEN 472 : IPT5 = MELEFP.LISOUS(1) 473 : SEGACT IPT5 474 : N1 = IPT5.NUM(/2) 475 : NFAI1 = N1 476 : SEGDES IPT5 477 : IPT6 = MELEFP.LISOUS(2) 478 : SEGACT IPT6 479 : N2 = IPT6.NUM(/2) 480 : NFAI2 = N2 481 : SEGDES IPT6 482 : K6 = N1 + N2 483 : ENDIF 484 : c WRITE(6,*) 'K6= ',K6 485 : 486 : SEGINI NBCOT 487 : c WRITE(6,*) 'POINT1' 488 : C ON EST ICI 489 : IF (NBSOF.EQ.1) THEN 490 : DO I = 1,K6 491 : NTYPE = MELEFP.ITYPEL 492 : c WRITE(6,*) 'NTYPE= ',NTYPE 493 : IF (NTYPE .EQ. 5) THEN 494 : NBCOTE(I) = 3 495 : IMECOTE(I) = MELEFP 496 : ELSE 497 : NBCOTE(I) = 4 498 : IMECOTE(I) = MELEFP 499 : ENDIF 500 : c SEGDES MELTFA 501 : ENDDO 502 : ELSEIF (NBSOF.EQ.2) THEN 503 : c WRITE(6,*) 'POINT2' 504 : IPT5 = MELEFP.LISOUS(1) 505 : SEGACT IPT5 506 : IPT6 = MELEFP.LISOUS(2) 507 : SEGACT IPT6 508 : c WRITE(6,*) 'IPT5= ',IPT5.ITYPEL 509 : c WRITE(6,*) 'IPT6= ',IPT6.ITYPEL 510 : DO I = 1,K6 511 : N1 = IPT5.NUM(/2) 512 : C MISE A JOUR DE MLEFA.LECT 513 : IF (I.LE.N1) THEN 514 : N0 = IPT5.NUM(/1) 515 : NGFAUX = IPT5.NUM(N0,I) 516 : MLEFA2.LECT(NGFAUX) = I 517 : c WRITE(6,*) 'NGFAUX = ',NGFAUX, 518 : c & 'MLEFA2=',MLEFA2.LECT(NGFAUX) 519 : IF (IPT5.ITYPEL .EQ. 5) THEN 520 : NBCOTE(I) = 3 521 : IMECOTE(I) = IPT5 522 : ELSE 523 : NBCOTE(I) = 4 524 : IMECOTE(I) = IPT5 525 : ENDIF 526 : c SEGDES IPT5 527 : ELSE 528 : N0 = IPT6.NUM(/1) 529 : NGFAUX = IPT6.NUM(N0,I-NFAI1) 530 : MLEFA2.LECT(NGFAUX) = I 531 : c WRITE(6,*) 'NGFAUX = ',NGFAUX, 532 : c & 'MLEFA2=',MLEFA2.LECT(NGFAUX) 533 : IF (IPT6.ITYPEL .EQ. 5) THEN 534 : NBCOTE(I) = 3 535 : IMECOTE(I) = IPT6 536 : ELSE 537 : NBCOTE(I) = 4 538 : IMECOTE(I) = IPT6 539 : ENDIF 540 : c SEGDES IPT6 541 : ENDIF 542 : c WRITE(6,*) 'I= ',I 543 : c WRITE(6,*) 'NBCOTE= ',NBCOTE(I) 544 : c WRITE(6,*) 'IMECOTE= ',IMECOTE(I) 545 : 546 : ENDDO 547 : ENDIF 548 : C IL FAUDRA EGALEMENT CREER DES POINTEUR POUR LES FACES DE CHAQUE ELEMENT 549 : C EXEMPLE LES PRISMES 550 : 551 : C SEGMENT SERVANT A UN PRECALCUL DE NBMAX 552 : c WRITE(6,*) 'NSOMM= ',NSOMM 553 : K3 = NSOMM 554 : SEGINI INDLI 555 : SEGINI TAB 556 : DO I = 1,K3 557 : INDLI.ID(I) = 0 558 : TAB.ID(I) = 0 559 : ENDDO 560 : 561 : NFAC=MELEFL.NUM(/2) 562 : NBMAX = 0 563 : 564 : C PRECALCUL DE NBMAX 565 : DO NLCF= 1, NFAC, 1 566 : c WRITE(6,*) 'NLCF= ',NLCF 567 : NGCF=MELEFL.NUM(2,NLCF) 568 : NGCG=MELEFL.NUM(1,NLCF) 569 : NGCD=MELEFL.NUM(3,NLCF) 570 : NLCG=MLECEN.LECT(NGCG) 571 : NLCD=MLECEN.LECT(NGCD) 572 : c NFAUX = MELEFA.NUM(NLCF,1) 573 : c WRITE(6,*) 'NFAUX= ',NFAUX 574 : c 575 : c NGFAUX = MELEFA.NUM(NLCF,1) 576 : c WRITE(6,*) 'NGFAUX = ',NGFAUX, 577 : c & 'MLEFA2=',MLEFA2.LECT(NGFAUX) 578 : c NBNO = MELEFP.NUM(/1) - 1 579 : NBNO = NBCOTE(NLCF) 580 : c WRITE(6,*) 'NLCF= ',NLCF 581 : c WRITE(6,*) 'NBNO= ',NBNO 582 : MELEFP = IMECOTE(NLCF) 583 : IF (NLCF.GT.NFAI1) THEN 584 : NLCFAUX = NLCF - NFAI1 585 : ELSE 586 : NLCFAUX = NLCF 587 : ENDIF 588 : DO IA = 1,NBNO 589 : NGS1=MELEFP.NUM(IA,NLCFAUX) 590 : NLS1=MLESOM.LECT(NGS1) 591 : NLS1=MLESOM.LECT(NGS1) 592 : INDLI.ID(NLS1) = INDLI.ID(NLS1) + 1 593 : NBMAX = MAX(NBMAX,INDLI.ID(NLS1)) 594 : ENDDO 595 : 596 : 597 : ENDDO 598 : 599 : 600 : 601 : SEGSUP INDLI 602 : SEGSUP TAB 603 : 604 : c NBMAX = 6 605 : NBMAX = NBMAX +1 606 : c WRITE(6,*) 'DANS NORV1 NBMAX= ',NBMAX 607 : c WRITE(6,*) 'NBSOM= ',NSOMM 608 : 609 : 610 : 611 : 612 : C ON CONNAIT NBMAX, ON PEUT INITIALISER LES SEGMENTS DE TRAVAIL 613 : c INITIALISATION DES MATRICES 614 : c NBMAX = 10 615 : K3 = NSOMM 616 : SEGINI INDLI 617 : SEGINI TAB 618 : DO I = 1,K3 619 : INDLI.ID(I) = 0 620 : TAB.ID(I) = 0 621 : ENDDO 622 : 623 : K1 = NBMAX 624 : K2 = NSOMM 625 : SEGINI IND2 626 : SEGINI IND 627 : SEGINI IND22 628 : SEGINI VAL1 629 : SEGINI VAL2 630 : SEGINI SCMB 631 : 632 : * K1 = NBMAX 633 : * K2 = (NBMAX+1) 634 : 635 : C INITIALISATION DU POINTEUR MATRICE2 636 : K3 = NSOMM 637 : SEGINI IPO2 638 : DO I = 1,K3 639 : K1 = NBMAX 640 : K2 = NBMAX + 1 641 : SEGINI MATR1 642 : IPO2.POINT(I) = MATR1 643 : SEGDES MATR1 644 : ENDDO 645 : 646 : 647 : 648 : 649 : c DO I = 1,K3 650 : c MATR1 = IPO2.POINT(I) 651 : c SEGACT MATR1 *MOD 652 : c MATR1.MAT2(1,1) = 4.D0 653 : c MATR1.MAT2(2,2) = 3.D0 654 : c WRITE(6,*) 'MATR1=', MATR1.MAT2(1,1) 655 : c WRITE(6,*) 'MATR1=', MATR1.MAT2(2,2) 656 : c SEGDES MATR1 657 : c ENDDO 658 : 659 : 660 : 661 : 662 : NFAC=MELEFL.NUM(/2) 663 : 664 : c WRITE(6,*) 'NFAC= ',NFAC 665 : NAUX1 = 0 666 : DO NLCF= 1, NFAC, 1 667 : INDICE = 0 668 : 669 : c ON TIENT COMPTE DU CHANGEMENT DE NUMEROTATION 670 : NGCF=MELEFL.NUM(2,NLCF) 671 : 672 : NGCG=MELEFL.NUM(1,NLCF) 673 : NGCD=MELEFL.NUM(3,NLCF) 674 : NLCG=MLECEN.LECT(NGCG) 675 : NLCD=MLECEN.LECT(NGCD) 676 : 677 : 678 : 679 : 680 : SCNX=MPONOR.VPOCHA(NLCF,1) 681 : SCNY=MPONOR.VPOCHA(NLCF,2) 682 : SCNZ=MPONOR.VPOCHA(NLCF,3) 683 : SCN1X = SCNX 684 : SCN1Y = SCNY 685 : SCN1Z = SCNZ 686 : 687 : 688 : C 4=IDIM+1 689 : ICELL=(4*(NGCG -1))+1 690 : XG=MCOORD.XCOOR(ICELL) 691 : YG=MCOORD.XCOOR(ICELL+1) 692 : ZG=MCOORD.XCOOR(ICELL+2) 693 : ICELL=(4*(NGCD -1))+1 694 : XD=MCOORD.XCOOR(ICELL) 695 : YD=MCOORD.XCOOR(ICELL+1) 696 : ZD=MCOORD.XCOOR(ICELL+2) 697 : ICELL=(4*(NGCF -1))+1 698 : XF=MCOORD.XCOOR(ICELL) 699 : YF=MCOORD.XCOOR(ICELL+1) 700 : ZF=MCOORD.XCOOR(ICELL+2) 701 : 702 : C MISE A ZERO DE NLOC 703 : DO JA=1,4 704 : DO IA=1,3 705 : NLOCFG(IA,JA) = 0 706 : NLOCFD(IA,JA) = 0 707 : ENDDO 708 : ENDDO 709 : 710 : MELTFA = IMELEM(NLCG) 711 : NBF = NBFACEL(NLCG) 712 : IF (NLCG.LE.NMAI1) THEN 713 : NGAUX = NLCG 714 : ELSEIF ((NLCG.GT.NMAI1).AND.(NLCG.LE.(NMAI1+NMAI2))) THEN 715 : NGAUX = NLCG - NMAI1 716 : ELSEIF ((NLCG.GT.(NMAI1+NMAI2)).AND. 717 : & (NLCG.LE.(NMAI1+NMAI2+NMAI3))) THEN 718 : NGAUX = NLCG - (NMAI1+NMAI2) 719 : ELSEIF (NLCG.GT.(NMAI1+NMAI2+NMAI3)) THEN 720 : NGAUX = NLCG - (NMAI1+NMAI2+NMAI3) 721 : ENDIF 722 : 723 : c SEGACT MELTFA 724 : 725 : C ON REPERE LES VECTEURS PRINCIPAUX DE LA BASE 726 : NLCF1 = MLEFA2.LECT(NGCF) 727 : NBNO = NBCOTE(NLCF1) 728 : MELEFP = IMECOTE(NLCF1) 729 : IF (NLCF1.GT.NFAI1) THEN 730 : NLCF1AUX = NLCF1 - NFAI1 731 : ELSE 732 : NLCF1AUX = NLCF1 733 : ENDIF 734 : 735 : DO JA = 1,NBNO 736 : NGS(JA) = MELEFP.NUM(JA,NLCF1AUX) 737 : ICELL=(4*(NGS(JA) -1))+1 738 : XA = MCOORD.XCOOR(ICELL) 739 : YA = MCOORD.XCOOR(ICELL+1) 740 : ZA = MCOORD.XCOOR(ICELL+2) 741 : c WRITE(6,*) 'NLCF= ',NLCF,'JA= ',JA, 742 : c & 'XA= ',XA,'YA= ',YA,'ZA= ',ZA 743 : 744 : 745 : C ON CALCULE P2 ET P3, VOIR RAPPORT PAGE 17 746 : DIST2 = -100000000000. 747 : Con CALCULE LE PLUS GRAND 748 : DO I1 =1,NBNO 749 : NSOM1 = MELEFP.NUM(I1,NLCF1AUX) 750 : ICELL=(4*(NSOM1 -1))+1 751 : XCOUR=MCOORD.XCOOR(ICELL) 752 : YCOUR=MCOORD.XCOOR(ICELL+1) 753 : ZCOUR=MCOORD.XCOOR(ICELL+2) 754 : DIST1 = ((XCOUR-XA)**2) + ((YCOUR-YA)**2) + ((ZCOUR-ZA)**2) 755 : DIST1 = SQRT( DIST1) 756 : IF ((DIST1.GT.DIST2)) THEN 757 : DIST2 = DIST1 758 : ICOURANT = I1 759 : ENDIF 760 : ENDDO 761 : 762 : IF (JA.EQ.1) ICOURANT = 3 763 : IF (JA.EQ.2) ICOURANT = 4 764 : IF (JA.EQ.3) ICOURANT = 1 765 : IF (JA.EQ.4) ICOURANT = 2 766 : 767 : c SI LA FACE EST TRIANGULAIRE ICOURANT NE SERT A RIEN 768 : IF (NBNO.EQ.3) THEN 769 : ICOURANT = 0 770 : ENDIF 771 : 772 : 773 : INDFAC=2 774 : c WRITE(6,*) 'ICOURANT= ',ICOURANT 775 : c WRITE(6,*) 'JA= ',JA 776 : DO I1 =1,NBNO 777 : NSOM1 = MELEFP.NUM(I1,NLCF1AUX) 778 : ICELL=(4*(NSOM1 -1))+1 779 : XCOUR=MCOORD.XCOOR(ICELL) 780 : YCOUR=MCOORD.XCOOR(ICELL+1) 781 : ZCOUR=MCOORD.XCOOR(ICELL+2) 782 : 783 : IF ((I1.NE.ICOURANT).AND.(I1.NE.JA)) THEN 784 : XARG(INDFAC,JA) = 0.5D0*(XA+XCOUR) 785 : YARG(INDFAC,JA) = 0.5D0*(YA+YCOUR) 786 : ZARG(INDFAC,JA) = 0.5D0*(ZA+ZCOUR) 787 : c WRITE(6,*) 'X= ',XARG(INDFAC,JA), 788 : c & 'Y= ',YARG(INDFAC,JA),'Z= ',ZARG(INDFAC,JA) 789 : c WRITE(6,*) 'XA= ',XA, 790 : c & 'YA= ',YA,'ZA= ',ZA 791 : c WRITE(6,*) 'XCOUR= ',XCOUR, 792 : c & 'YCOUR= ',YCOUR,'ZCOUR= ',ZCOUR 793 : INDFAC= INDFAC+1 794 : ENDIF 795 : ENDDO 796 : 797 : c WRITE(6,*) 'XA= ',XA,'YA= ',YA,'ZA= ',ZA 798 : c WRITE(6,*) 'P2', 'X= ',XARG(2,JA),'Y= ',YARG(2,JA),'Z= ', 799 : c & ZARG(2,JA) 800 : c WRITE(6,*) 'P3', 'X= ',XARG(3,JA),'Y= ',YARG(3,JA),'Z= ', 801 : c & ZARG(3,JA) 802 : c WRITE(6,*) 'D', 'X= ',XF,'Y= ',YF,'Z= ',ZF 803 : 804 : 805 : c IF (NLCF.EQ.14) then 806 : c WRITE(6,*) 'NGAUX= ',NGAUX,'JA= ',JA,'NGS= ',NGS(JA) 807 : c WRITE(6,*) 'NGCF= ',NGCF,'NLCF= ',NLCF 808 : c ENDIF 809 : 810 : ICOUR = 1 811 : DO J = 1,NBF 812 : N1 = MELTFA.NUM(J,NGAUX) 813 : NL1 = MLEFA2.LECT(N1) 814 : NBNO2 = NBCOTE(NL1) 815 : MELEP2 = IMECOTE(NL1) 816 : IF (NL1.GT.NFAI1) THEN 817 : NL1AUX = NL1 - NFAI1 818 : ELSE 819 : NL1AUX = NL1 820 : ENDIF 821 : c IF (NLCF.EQ.14) then 822 : c WRITE(6,*) 'N1= ',N1,'NL1= ',NL1,'NL1AUX= ',NL1AUX 823 : c ENDIF 824 : 825 : 826 : 827 : 828 : 829 : DO IA =1,NBNO2 830 : NSOM1 = MELEP2.NUM(IA,NL1AUX) 831 : 832 : 833 : 834 : c IF (NLCF.EQ.14) then 835 : c WRITE(6,*) 'NBNO2= ',NBNO2,'IA= ',IA,'NSOM1= ',NSOM1 836 : c ENDIF 837 : IF (NSOM1.EQ.NGS(JA)) THEN 838 : 839 : ICELL=(4*(N1 -1))+1 840 : XF=MCOORD.XCOOR(ICELL) 841 : YF=MCOORD.XCOOR(ICELL+1) 842 : ZF=MCOORD.XCOOR(ICELL+2) 843 : 844 : 845 : 846 : C ON CALCULE P1 VOIR RAPPORT p 17 847 : IF (N1.NE.NGCF) THEN 848 : ICOUR = ICOUR + 1 849 : VECXG(ICOUR,JA) = (XF - XG) 850 : VECYG(ICOUR,JA) = (YF - YG) 851 : VECZG(ICOUR,JA) = (ZF - ZG) 852 : NLOCFG(ICOUR,JA) = N1 853 : XFACG(ICOUR,JA) = XF 854 : YFACG(ICOUR,JA) = YF 855 : ZFACG(ICOUR,JA) = ZF 856 : 857 : DIST2 = -1.e+15 858 : DO I1 =1,NBNO2 859 : NSOM1 = MELEP2.NUM(I1,NL1AUX) 860 : ICELL=(4*(NSOM1 -1))+1 861 : XCOUR=MCOORD.XCOOR(ICELL) 862 : YCOUR=MCOORD.XCOOR(ICELL+1) 863 : ZCOUR=MCOORD.XCOOR(ICELL+2) 864 : DIST1 = ((XCOUR-XA)**2) + ((YCOUR-YA)**2) + ((ZCOUR-ZA)**2) 865 : DIST1 = SQRT( DIST1) 866 : IF ((DIST1.GT.DIST2)) THEN 867 : DIST2 = DIST1 868 : ICOURANT = I1 869 : ENDIF 870 : ENDDO 871 : IF (IA.EQ.1) ICOURANT = 3 872 : IF (IA.EQ.2) ICOURANT = 4 873 : IF (IA.EQ.3) ICOURANT = 1 874 : IF (IA.EQ.4) ICOURANT = 2 875 : IF (NBNO2.EQ.3) THEN 876 : ICOURANT = 0 877 : ENDIF 878 : 879 : 880 : NCON = 0 881 : DO I1 =1,NBNO2 882 : NSOM1 = MELEP2.NUM(I1,NL1AUX) 883 : ICELL=(4*(NSOM1 -1))+1 884 : XCOUR=MCOORD.XCOOR(ICELL) 885 : YCOUR=MCOORD.XCOOR(ICELL+1) 886 : ZCOUR=MCOORD.XCOOR(ICELL+2) 887 : XCO = 0.5D0*(XCOUR + XA) 888 : YCO = 0.5D0*(YCOUR + YA) 889 : ZCO = 0.5D0*(ZCOUR + ZA) 890 : DIST1 = ((XCO-XARG(2,JA))**2) + 891 : & ((YCO-YARG(2,JA))**2) + 892 : & ((ZCO-ZARG(2,JA))**2) 893 : DIST1 = SQRT(DIST1) 894 : 895 : IF (DIST1.LT.1e-5) THEN 896 : VAX = XARG(ICOUR,JA) 897 : VAY = YARG(ICOUR,JA) 898 : VAZ = ZARG(ICOUR,JA) 899 : C CHANGEMENT INDICE 900 : XARG(ICOUR,JA) = XCO 901 : YARG(ICOUR,JA) = YCO 902 : ZARG(ICOUR,JA) = ZCO 903 : XARG(2,JA) = VAX 904 : YARG(2,JA) = VAY 905 : ZARG(2,JA) = VAZ 906 : c WRITE(6,*) 'I1= ',I1,' ICI ON AFFECTE P1' 907 : ENDIF 908 : 909 : 910 : DIST2 = ((XCO-XARG(3,JA))**2) + 911 : & ((YCO-YARG(3,JA))**2) + 912 : & ((ZCO-ZARG(3,JA))**2) 913 : DIST2 = SQRT(DIST2) 914 : IF (DIST2.LT.1e-5) THEN 915 : VAX = XARG(ICOUR,JA) 916 : VAY = YARG(ICOUR,JA) 917 : VAZ = ZARG(ICOUR,JA) 918 : C CHANGEMENT INDICE 919 : XARG(ICOUR,JA) = XCO 920 : YARG(ICOUR,JA) = YCO 921 : ZARG(ICOUR,JA) = ZCO 922 : XARG(3,JA) = VAX 923 : YARG(3,JA) = VAY 924 : ZARG(3,JA) = VAZ 925 : c WRITE(6,*) 'I1= ',I1,' ICI ON AFFECTE P2' 926 : ENDIF 927 : 928 : INDFAC=1 929 : c ON VERIFIE QUE LE POINT TROUVE EST BIEN DIFFERENT DE P2 ET P3 930 : IF ((I1.NE.ICOURANT).AND.(I1.NE.IA).AND. 931 : & (DIST1.GT.1e-5).AND.(DIST2.GT.1e-5)) THEN 932 : XARG(INDFAC,JA) = XCO 933 : YARG(INDFAC,JA) = YCO 934 : ZARG(INDFAC,JA) = ZCO 935 : NCON = NCON + 1 936 : c WRITE(6,*) 'JA = ',JA 937 : c WRITE(6,*) 'XA= ',XA,'YA= ',YA,'ZA= ',ZA 938 : c WRITE(6,*) 'P1', 'X= ',XARG(1,JA),'Y= ',YARG(1,JA),'Z= ', 939 : c & ZARG(1,JA) 940 : ENDIF 941 : ENDDO 942 : IF (NCON.NE.1) THEN 943 : WRITE(6,*) 'NLCF= ',NLCF,'NCON=',NCON 944 : WRITE(6,*) 'P2', 'X= ',XARG(2,JA),'Y= ',YARG(2,JA),'Z= ', 945 : & ZARG(2,JA) 946 : WRITE(6,*) 'P3', 'X= ',XARG(3,JA),'Y= ',YARG(3,JA),'Z= ', 947 : & ZARG(3,JA) 948 : DO I1 =1,NBNO2 949 : NSOM1 = MELEP2.NUM(I1,NL1AUX) 950 : ICELL=(4*(NSOM1 -1))+1 951 : XCOUR=MCOORD.XCOOR(ICELL) 952 : YCOUR=MCOORD.XCOOR(ICELL+1) 953 : ZCOUR=MCOORD.XCOOR(ICELL+2) 954 : XCO = 0.5D0*(XCOUR + XA) 955 : YCO = 0.5D0*(YCOUR + YA) 956 : ZCO = 0.5D0*(ZCOUR + ZA) 957 : DIST1 = ((XCO-XARG(2,JA))**2) + 958 : & ((YCO-YARG(2,JA))**2) + 959 : & ((ZCO-ZARG(2,JA))**2) 960 : DIST1 = SQRT(DIST1) 961 : DIST2 = ((XCO-XARG(3,JA))**2) + 962 : & ((YCO-YARG(3,JA))**2) + 963 : & ((ZCO-ZARG(3,JA))**2) 964 : DIST2 = SQRT(DIST2) 965 : WRITE(6,*) 'TEST', 'XCO= ',XCO,'YCO ',YCO,'ZCO= ', 966 : & ZCO 967 : WRITE(6,*) 'DIST1= ',DIST1,'DIST2= ',DIST2 968 : WRITE(6,*) 'I1= ',I1,'XCOUR= ',XCOUR, 969 : & 'YCOUR= ',YCOUR,'ZCOUR= ',ZCOUR 970 : ENDDO 971 : DIST2 = -100000000000. 972 : DO I1 =1,NBNO 973 : NSOM1 = MELEFP.NUM(I1,NLCF1AUX) 974 : ICELL=(4*(NSOM1 -1))+1 975 : XCOUR=MCOORD.XCOOR(ICELL) 976 : YCOUR=MCOORD.XCOOR(ICELL+1) 977 : ZCOUR=MCOORD.XCOOR(ICELL+2) 978 : WRITE(6,*) 'I1= ',I1,'XCOUR2= ',XCOUR, 979 : & 'YCOUR2= ',YCOUR,'ZCOUR2= ',ZCOUR 980 : DIST1 = ((XCOUR-XA)**2) + ((YCOUR-YA)**2) + ((ZCOUR-ZA)**2) 981 : DIST1 = SQRT( DIST1) 982 : IF ((DIST1.GT.DIST2)) THEN 983 : DIST2 = DIST1 984 : ICOURANT = I1 985 : ENDIF 986 : ENDDO 987 : WRITE(6,*) 'ICOURANT= ',ICOURANT 988 : WRITE(6,*) 'JA= ',JA 989 : 990 : ENDIF 991 : ENDIF 992 : C ON PERMUTE 993 : C ICI 994 : 995 : IF (N1.EQ.NGCF) THEN 996 : VECXG(1,JA) = (XF - XG) 997 : VECYG(1,JA) = (YF - YG) 998 : VECZG(1,JA) = (ZF - ZG) 999 : XFACG(1,JA) = XF 1000 : YFACG(1,JA) = YF 1001 : ZFACG(1,JA) = ZF 1002 : NLOCFG(1,JA) = N1 1003 : ENDIF 1004 : ENDIF 1005 : ENDDO 1006 : ENDDO 1007 : c IF (NLCF.EQ.14) THEN 1008 : c WRITE(6,*) 'JA= ',JA 1009 : c WRITE(6,*) 'ICOUR= ',ICOUR 1010 : c ENDIF 1011 : ENDDO 1012 : 1013 : 1014 : MELTFA = IMELEM(NLCD) 1015 : NBF = NBFACEL(NLCD) 1016 : c WRITE(6,*) 'NLCD= ',NLCD 1017 : c WRITE(6,*) 'NBF= ',NBF 1018 : c WRITE(6,*) 'NTYPE= ',MELTFA.ITYPEL 1019 : 1020 : IF (NLCD.LE.NMAI1) THEN 1021 : NDAUX = NLCD 1022 : ELSEIF ((NLCD.GT.NMAI1).AND.(NLCD.LE.(NMAI1+NMAI2))) THEN 1023 : NDAUX = NLCD - NMAI1 1024 : ELSEIF ((NLCD.GT.(NMAI1+NMAI2)).AND. 1025 : & (NLCD.LE.(NMAI1+NMAI2+NMAI3))) THEN 1026 : NDAUX = NLCD - (NMAI1+NMAI2) 1027 : ELSEIF (NLCD.GT.(NMAI1+NMAI2+NMAI3)) THEN 1028 : NDAUX = NLCD - (NMAI1+NMAI2+NMAI3) 1029 : ENDIF 1030 : 1031 : C ON REPERE LES VECTEURS PRINCIPAUX DE LA BASE 1032 : DO JA = 1,NBNO 1033 : NGS(JA) = MELEFP.NUM(JA,NLCF1AUX) 1034 : ICELL=(4*(NGS(JA) -1))+1 1035 : XA = MCOORD.XCOOR(ICELL) 1036 : YA = MCOORD.XCOOR(ICELL+1) 1037 : ZA = MCOORD.XCOOR(ICELL+2) 1038 : 1039 : 1040 : C ON CALCULE P2 ET P3, VOIR RAPPORT PAGE 17 1041 : DIST2 = -1.e+15 1042 : Con CALCULE LE PLUS GRAND 1043 : DO I1 =1,NBNO 1044 : NSOM1 = MELEFP.NUM(I1,NLCF1AUX) 1045 : ICELL=(4*(NSOM1 -1))+1 1046 : XCOUR=MCOORD.XCOOR(ICELL) 1047 : YCOUR=MCOORD.XCOOR(ICELL+1) 1048 : ZCOUR=MCOORD.XCOOR(ICELL+2) 1049 : DIST1 = ((XCOUR-XA)**2) + ((YCOUR-YA)**2) + ((ZCOUR-ZA)**2) 1050 : DIST1 = SQRT( DIST1) 1051 : IF ((DIST1.GT.DIST2)) THEN 1052 : DIST2 = DIST1 1053 : ICOURANT = I1 1054 : ENDIF 1055 : ENDDO 1056 : IF (JA.EQ.1) ICOURANT = 3 1057 : IF (JA.EQ.2) ICOURANT = 4 1058 : IF (JA.EQ.3) ICOURANT = 1 1059 : IF (JA.EQ.4) ICOURANT = 2 1060 : IF (NBNO.EQ.3) THEN 1061 : ICOURANT = 0 1062 : ENDIF 1063 : 1064 : 1065 : INDFAC=2 1066 : DO I1 =1,NBNO 1067 : NSOM1 = MELEFP.NUM(I1,NLCF1AUX) 1068 : ICELL=(4*(NSOM1 -1))+1 1069 : XCOUR=MCOORD.XCOOR(ICELL) 1070 : YCOUR=MCOORD.XCOOR(ICELL+1) 1071 : ZCOUR=MCOORD.XCOOR(ICELL+2) 1072 : 1073 : IF ((I1.NE.ICOURANT).AND.(I1.NE.JA)) THEN 1074 : XARD(INDFAC,JA) = 0.5D0*(XA+XCOUR) 1075 : YARD(INDFAC,JA) = 0.5D0*(YA+YCOUR) 1076 : ZARD(INDFAC,JA) = 0.5D0*(ZA+ZCOUR) 1077 : INDFAC= INDFAC+1 1078 : ENDIF 1079 : ENDDO 1080 : 1081 : c WRITE(6,*) 'NDAUX= ',NDAUX,'JA= ',JA,'NGS= ',NGS(JA) 1082 : c WRITE(6,*) 'NGCF= ',NGCF,'NLCF= ',NLCF 1083 : ICOUR = 1 1084 : DO J = 1,NBF 1085 : N1 = MELTFA.NUM(J,NDAUX) 1086 : NL1 = MLEFA2.LECT(N1) 1087 : c WRITE(6,*) 'N1= ',N1,'NL1= ',NL1 1088 : 1089 : NBNO2 = NBCOTE(NL1) 1090 : MELEP2 = IMECOTE(NL1) 1091 : IF (NL1.GT.NFAI1) THEN 1092 : NL1AUX = NL1 - NFAI1 1093 : ELSE 1094 : NL1AUX = NL1 1095 : ENDIF 1096 : 1097 : 1098 : DO IA =1,NBNO2 1099 : NSOM1 = MELEP2.NUM(IA,NL1AUX) 1100 : c WRITE(6,*) 'NBNO2= ',NBNO2,'IA= ',IA,'NSOM1= ',NSOM1 1101 : IF (NSOM1.EQ.NGS(JA)) THEN 1102 : 1103 : ICELL=(4*(N1 -1))+1 1104 : XF=MCOORD.XCOOR(ICELL) 1105 : YF=MCOORD.XCOOR(ICELL+1) 1106 : ZF=MCOORD.XCOOR(ICELL+2) 1107 : 1108 : 1109 : C ON CALCULE P1 VOIR RAPPORT p 17 1110 : IF (N1.NE.NGCF) THEN 1111 : ICOUR = ICOUR + 1 1112 : VECXD(ICOUR,JA) = (XF - XD) 1113 : VECYD(ICOUR,JA) = (YF - YD) 1114 : VECZD(ICOUR,JA) = (ZF - ZD) 1115 : NLOCFD(ICOUR,JA) = N1 1116 : XFACD(ICOUR,JA) = XF 1117 : YFACD(ICOUR,JA) = YF 1118 : ZFACD(ICOUR,JA) = ZF 1119 : 1120 : DIST2 = -1.e+15 1121 : DO I1 =1,NBNO2 1122 : NSOM1 = MELEP2.NUM(I1,NL1AUX) 1123 : ICELL=(4*(NSOM1 -1))+1 1124 : XCOUR=MCOORD.XCOOR(ICELL) 1125 : YCOUR=MCOORD.XCOOR(ICELL+1) 1126 : ZCOUR=MCOORD.XCOOR(ICELL+2) 1127 : DIST1 = ((XCOUR-XA)**2) + ((YCOUR-YA)**2) + ((ZCOUR-ZA)**2) 1128 : DIST1 = SQRT( DIST1) 1129 : IF ((DIST1.GT.DIST2)) THEN 1130 : DIST2 = DIST1 1131 : ICOURANT = I1 1132 : ENDIF 1133 : ENDDO 1134 : IF (IA.EQ.1) ICOURANT = 3 1135 : IF (IA.EQ.2) ICOURANT = 4 1136 : IF (IA.EQ.3) ICOURANT = 1 1137 : IF (IA.EQ.4) ICOURANT = 2 1138 : c BUG CORRIGE 15/06 1139 : IF (NBNO.EQ.3) THEN 1140 : ICOURANT = 0 1141 : ENDIF 1142 : 1143 : 1144 : INDFAC=3 1145 : DO I1 =1,NBNO2 1146 : NSOM1 = MELEP2.NUM(I1,NL1AUX) 1147 : ICELL=(4*(NSOM1 -1))+1 1148 : XCOUR=MCOORD.XCOOR(ICELL) 1149 : YCOUR=MCOORD.XCOOR(ICELL+1) 1150 : ZCOUR=MCOORD.XCOOR(ICELL+2) 1151 : XCO = 0.5D0*(XCOUR + XA) 1152 : YCO = 0.5D0*(YCOUR + YA) 1153 : ZCO = 0.5D0*(ZCOUR + ZA) 1154 : DIST1 = ((XCO-XARD(2,JA))**2) + 1155 : & ((YCO-YARD(2,JA))**2) + 1156 : & ((ZCO-ZARD(2,JA))**2) 1157 : 1158 : DIST1 = SQRT( DIST1) 1159 : IF (DIST1.LT.1e-5) THEN 1160 : VAX = XARD(ICOUR,JA) 1161 : VAY = YARD(ICOUR,JA) 1162 : VAZ = ZARD(ICOUR,JA) 1163 : C CHANGEMENT INDICE 1164 : XARD(ICOUR,JA) = XCO 1165 : YARD(ICOUR,JA) = YCO 1166 : ZARD(ICOUR,JA) = ZCO 1167 : XARD(2,JA) = VAX 1168 : YARD(2,JA) = VAY 1169 : ZARD(2,JA) = VAZ 1170 : ENDIF 1171 : 1172 : 1173 : DIST2 = ((XCO-XARD(3,JA))**2) + 1174 : & ((YCO-YARD(3,JA))**2) + 1175 : & ((ZCO-ZARD(3,JA))**2) 1176 : DIST2 = SQRT( DIST2) 1177 : IF (DIST2.LT.1e-5) THEN 1178 : VAX = XARD(ICOUR,JA) 1179 : VAY = YARD(ICOUR,JA) 1180 : VAZ = ZARD(ICOUR,JA) 1181 : C CHANGEMENT INDICE 1182 : XARD(ICOUR,JA) = XCO 1183 : YARD(ICOUR,JA) = YCO 1184 : ZARD(ICOUR,JA) = ZCO 1185 : XARD(3,JA) = VAX 1186 : YARD(3,JA) = VAY 1187 : ZARD(3,JA) = VAZ 1188 : ENDIF 1189 : 1190 : INDFAC=1 1191 : c ON VERIFIE QUE LE POINT TROUVE EST BIEN DIFFERENT DE P2 ET P3 1192 : IF ((I1.NE.ICOURANT).AND.(I1.NE.IA).AND. 1193 : & (DIST1.GT.1e-5).AND.(DIST2.GT.1e-5)) THEN 1194 : c WRITE(6,*) 'ON AFFECTE INDICE 1 ARD' 1195 : c WRITE(6,*) 'JA= ',JA 1196 : XARD(INDFAC,JA) = XCO 1197 : YARD(INDFAC,JA) = YCO 1198 : ZARD(INDFAC,JA) = ZCO 1199 : ENDIF 1200 : ENDDO 1201 : ENDIF 1202 : 1203 : C ON PERMUTE 1204 : IF (N1.EQ.NGCF) THEN 1205 : VECXD(1,JA) = (XF - XD) 1206 : VECYD(1,JA) = (YF - YD) 1207 : VECZD(1,JA) = (ZF - ZD) 1208 : NLOCFD(1,JA) = N1 1209 : XFACD(1,JA) = XF 1210 : YFACD(1,JA) = YF 1211 : ZFACD(1,JA) = ZF 1212 : ENDIF 1213 : ENDIF 1214 : ENDDO 1215 : ENDDO 1216 : c WRITE(6,*) 'JA= ',JA 1217 : c WRITE(6,*) 'ICOUR= ',ICOUR 1218 : ENDDO 1219 : 1220 : CALCUL DES VOLUMES 1221 : c DO JA = 1,NBNO 1222 : c DO KA=1,ICOUR 1223 : c WRITE(6,*)'JA= ',JA,'KA= ',KA 1224 : c WRITE(6,*) 'VECG = ',VECXG(KA,JA),VECYG(KA,JA),VECZG(KA,JA) 1225 : c WRITE(6,*)'VECD = ',VECXD(KA,JA),VECYD(KA,JA),VECZD(KA,JA) 1226 : c ENDDO 1227 : c ENDDO 1228 : 1229 : DO JA = 1,NBNO 1230 : c CALCUL DU VOLUME : ON SOMME LE VOLUME DES 6 TETRAEDRES 1231 : ICELL=(4*(NGS(JA) -1))+1 1232 : XA = MCOORD.XCOOR(ICELL) 1233 : YA = MCOORD.XCOOR(ICELL+1) 1234 : ZA = MCOORD.XCOOR(ICELL+2) 1235 : 1236 : c WRITE(6,*) 'JA = ',JA 1237 : c WRITE(6,*) 'XA= ',XA,'YA= ',YA,'ZA= ',ZA 1238 : c WRITE(6,*) 'P2', 'X= ',XARG(2,JA),'Y= ',YARG(2,JA),'Z= ', 1239 : c & ZARG(2,JA) 1240 : c WRITE(6,*) 'P3', 'X= ',XARG(3,JA),'Y= ',YARG(3,JA),'Z= ', 1241 : c & ZARG(3,JA) 1242 : c WRITE(6,*) 'D', 'X= ',XFACG(1,JA),'Y= ',YFACG(1,JA),'Z= ', 1243 : c & ZFACG(1,JA) 1244 : c WRITE(6,*) 'B', 'X= ',XFACG(2,JA),'Y= ',YFACG(2,JA),'Z= ', 1245 : c & ZFACG(2,JA) 1246 : c WRITE(6,*) 'C', 'X= ',XFACG(3,JA),'Y= ',YFACG(3,JA),'Z= ', 1247 : c & ZFACG(3,JA) 1248 : c WRITE(6,*) 'P1', 'X= ',XARG(1,JA),'Y= ',YARG(1,JA),'Z= ', 1249 : c & ZARG(1,JA) 1250 : c WRITE(6,*) 'A', 'X= ',XD,'Y= ',YD,'Z= ',ZD 1251 : 1252 : VAUX(1) = XA - XARG(1,JA) 1253 : VAUY(1) = YA - YARG(1,JA) 1254 : VAUZ(1) = ZA - ZARG(1,JA) 1255 : 1256 : VAUX(2) = XA - XARG(2,JA) 1257 : VAUY(2) = YA - YARG(2,JA) 1258 : VAUZ(2) = ZA - ZARG(2,JA) 1259 : 1260 : VAUX(3) = XA - XARG(3,JA) 1261 : VAUY(3) = YA - YARG(3,JA) 1262 : VAUZ(3) = ZA - ZARG(3,JA) 1263 : 1264 : PVECX = VAUY(2)*VAUZ(3) - VAUZ(2)*VAUY(3) 1265 : PVECY = VAUZ(2)*VAUX(3) - VAUX(2)*VAUZ(3) 1266 : PVECZ = VAUX(2)*VAUY(3) - VAUY(2)*VAUX(3) 1267 : 1268 : VOL = 1269 : & 1.D0/6.D0*ABS((VAUX(1)*PVECX) + (VAUY(1)*PVECY) + 1270 : & (VAUZ(1)*PVECZ)) 1271 : 1272 : VOLUG(JA) = VOL 1273 : 1274 : 1275 : DO KA = 1,ICOUR 1276 : C COMPLETER ICI 1277 : C PRODUIT MIXTES 1278 : C PRODUIT VECTORIEL 1279 : IF (KA.EQ.1) THEN 1280 : 1281 : VAUX(2) = XA - XARG(2,JA) 1282 : VAUY(2) = YA - YARG(2,JA) 1283 : VAUZ(2) = ZA - ZARG(2,JA) 1284 : 1285 : VAUX(3) = XA - XARG(3,JA) 1286 : VAUY(3) = YA - YARG(3,JA) 1287 : VAUZ(3) = ZA - ZARG(3,JA) 1288 : c WRITE(6,*) 'ZA= ',ZA,'ZARG(3)= ',ZARG(3,JA), 1289 : c & 'DIFF',ZA - ZARG(3,JA),'VAUXZ3',VAUZ(3) 1290 : 1291 : 1292 : c WRITE(6,*) 'XA= ',XA,'YA= ',YA,'ZA= ',ZA 1293 : c WRITE(6,*) 'P2', 'X= ',XARG(2,JA),'Y= ',YARG(2,JA),'Z= ', 1294 : c & ZARG(2,JA) 1295 : c WRITE(6,*) 'P3', 'X= ',XARG(3,JA),'Y= ',YARG(3,JA),'Z= ', 1296 : c & ZARG(3,JA) 1297 : c WRITE(6,*) 'D', 'X= ',XFACG(1,JA),'Y= ',YFACG(1,JA),'Z= ', 1298 : c & ZFACG(1,JA) 1299 : c WRITE(6,*) 'JA = ',JA,'KA=',KA,'VAUX2',VAUX(2), 1300 : c & 'VAUY2',VAUY(2),'VAUZ2',VAUZ(2) 1301 : c WRITE(6,*) 'ZA= ',ZA,'ZARG(3)= ',ZARG(3,JA), 1302 : c & 'DIFF',ZA - ZARG(3,JA),'VAUXZ3',VAUZ(3) 1303 : c WRITE(6,*) 'JA = ',JA,'KA=',KA,'VAUX3',VAUX(3), 1304 : c & 'VAUY3',VAUY(3),'VAUZ3',VAUZ(3) 1305 : PSCAGX = (VAUY(2)*VAUZ(3)) - 1306 : & (VAUZ(2)*VAUY(3)) 1307 : PSCAGY = (VAUZ(2)*VAUX(3)) - 1308 : & (VAUX(2)*VAUZ(3)) 1309 : PSCAGZ = (VAUX(2)*VAUY(3)) - 1310 : & (VAUY(2)*VAUX(3)) 1311 : PSCA = (VECXG(1,JA)* PSCAGX) + (VECYG(1,JA)* PSCAGY) + 1312 : & (VECZG(1,JA)* PSCAGZ) 1313 : IF (PSCA.LT.0) THEN 1314 : PSCAGX = - PSCAGX 1315 : PSCAGY = - PSCAGY 1316 : PSCAGZ = - PSCAGZ 1317 : ENDIF 1318 : SURFAGX(KA) = 0.5D0* PSCAGX 1319 : SURFAGY(KA) = 0.5D0* PSCAGY 1320 : SURFAGZ(KA) = 0.5D0* PSCAGZ 1321 : c WRITE(6,*)'SURFAG = ',SURFAGX(1),SURFAGY(1),SURFAGZ(1) 1322 : ENDIF 1323 : 1324 : 1325 : IF (KA.EQ.2) THEN 1326 : VAUX(2) = XA - XARG(2,JA) 1327 : VAUY(2) = YA - YARG(2,JA) 1328 : VAUZ(2) = ZA - ZARG(2,JA) 1329 : 1330 : VAUX(3) = XA - XARG(1,JA) 1331 : VAUY(3) = YA - YARG(1,JA) 1332 : VAUZ(3) = ZA - ZARG(1,JA) 1333 : 1334 : PSCAGX = (VAUY(2)*VAUZ(3)) - 1335 : & (VAUZ(2)*VAUY(3)) 1336 : PSCAGY = (VAUZ(2)*VAUX(3)) - 1337 : & (VAUX(2)*VAUZ(3)) 1338 : PSCAGZ = (VAUX(2)*VAUY(3)) - 1339 : & (VAUY(2)*VAUX(3)) 1340 : 1341 : PSCA = (VECXG(2,JA)* PSCAGX) + (VECYG(2,JA)* PSCAGY) + 1342 : & (VECZG(2,JA)* PSCAGZ) 1343 : IF (PSCA.LT.0) THEN 1344 : PSCAGX = - PSCAGX 1345 : PSCAGY = - PSCAGY 1346 : PSCAGZ = - PSCAGZ 1347 : ENDIF 1348 : SURFAGX(KA) = 0.5D0* PSCAGX 1349 : SURFAGY(KA) = 0.5D0* PSCAGY 1350 : SURFAGZ(KA) = 0.5D0* PSCAGZ 1351 : 1352 : ENDIF 1353 : 1354 : 1355 : IF (KA.EQ.3) THEN 1356 : VAUX(2) = XA - XARG(3,JA) 1357 : VAUY(2) = YA - YARG(3,JA) 1358 : VAUZ(2) = ZA - ZARG(3,JA) 1359 : 1360 : VAUX(3) = XA - XARG(1,JA) 1361 : VAUY(3) = YA - YARG(1,JA) 1362 : VAUZ(3) = ZA - ZARG(1,JA) 1363 : 1364 : PSCAGX = (VAUY(2)*VAUZ(3)) - 1365 : & (VAUZ(2)*VAUY(3)) 1366 : PSCAGY = (VAUZ(2)*VAUX(3)) - 1367 : & (VAUX(2)*VAUZ(3)) 1368 : PSCAGZ = (VAUX(2)*VAUY(3)) - 1369 : & (VAUY(2)*VAUX(3)) 1370 : 1371 : PSCA = (VECXG(3,JA)* PSCAGX) + (VECYG(3,JA)* PSCAGY) + 1372 : & (VECZG(3,JA)* PSCAGZ) 1373 : IF (PSCA.LT.0) THEN 1374 : PSCAGX = - PSCAGX 1375 : PSCAGY = - PSCAGY 1376 : PSCAGZ = - PSCAGZ 1377 : ENDIF 1378 : SURFAGX(KA) = 0.5D0* PSCAGX 1379 : SURFAGY(KA) = 0.5D0* PSCAGY 1380 : SURFAGZ(KA) = 0.5D0* PSCAGZ 1381 : ENDIF 1382 : 1383 : c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS1 1384 : IF (ICHTE.EQ.0) THEN 1385 : COEFG(KA,JA) = ( (SURFAGX(KA)*SCN1X) + (SURFAGY(KA)*SCN1Y) + 1386 : & (SURFAGZ(KA)*SCN1Z)) 1387 : & / (VOLUG(JA)) 1388 : 1389 : ELSE 1390 : C TENSEUR 1391 : IF (MPOTEN.VPOCHA(/2) .EQ.6) THEN 1392 : K11G = MPOTEN.VPOCHA(NLCG,1) 1393 : K22G = MPOTEN.VPOCHA(NLCG,2) 1394 : K33G = MPOTEN.VPOCHA(NLCG,3) 1395 : K21G = MPOTEN.VPOCHA(NLCG,4) 1396 : K31G = MPOTEN.VPOCHA(NLCG,5) 1397 : K32G = MPOTEN.VPOCHA(NLCG,6) 1398 : ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN 1399 : K11G = MPOTEN.VPOCHA(NLCG,1) 1400 : K22G = K11G 1401 : K33G = K11G 1402 : K21G = 0.0D0 1403 : K31G = 0.0D0 1404 : K32G = 0.0D0 1405 : ELSE 1406 : WRITE(6,*) 'TENSEUR NON PREVU' 1407 : STOP 1408 : ENDIF 1409 : 1410 : PSCAGX = (K11G*SURFAGX(KA)) + (K21G*SURFAGY(KA)) + 1411 : & (K31G*SURFAGZ(KA)) 1412 : PSCAGY = (K21G*SURFAGX(KA)) + (K22G*SURFAGY(KA)) + 1413 : & (K32G*SURFAGZ(KA)) 1414 : PSCAGZ = (K31G*SURFAGX(KA)) + (K32G*SURFAGY(KA)) + 1415 : & (K33G*SURFAGZ(KA)) 1416 : COEFG(KA,JA) = (PSCAGX*SCN1X) + (PSCAGY*SCN1Y) + 1417 : & (PSCAGZ*SCN1Z) 1418 : COEFG(KA,JA) = COEFG(KA,JA) / (VOLUG(JA)) 1419 : ENDIF 1420 : c WRITE(6,*)'JA = ',JA, 'KA= ',KA,'VOLUG(JA) = ',VOLUG(JA) 1421 : c WRITE(6,*)'SURFAG = ',SURFAGX(KA),SURFAGY(KA),SURFAGZ(KA) 1422 : c WRITE(6,*)'VEXG = ',VECXG(KA,JA),VECYG(KA,JA),VECZG(KA,JA) 1423 : c WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z 1424 : ENDDO 1425 : c WRITE(6,*) 'JA = ',JA,'VOLUG(JA) = ',VOLUG(JA) 1426 : c WRITE(6,*) 'VECG1 = ',VECXG(1,JA),VECYG(1,JA),VECZG(1,JA) 1427 : c WRITE(6,*) 'VECG2 = ',VECXG(2,JA),VECYG(2,JA),VECZG(2,JA) 1428 : c WRITE(6,*) 'VECG3 = ',VECXG(3,JA),VECYG(3,JA),VECZG(3,JA) 1429 : c WRITE(6,*)'NLCF= ',NLCF,'COEFG = ', 1430 : c & COEFG(1,JA),COEFG(2,JA),COEFG(3,JA) 1431 : c WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z 1432 : c WRITE(6,*)'SURFAG = ',SURFAGX(1),SURFAGY(1),SURFAGZ(1) 1433 : c WRITE(6,*)'SURFAG = ',SURFAGX(2),SURFAGY(2),SURFAGZ(2) 1434 : c WRITE(6,*)'SURFAG = ',SURFAGX(3),SURFAGY(3),SURFAGZ(3) 1435 : 1436 : c WRITE(6,*) 'JA = ',JA,'VOLUG(JA) = ',VOLUG(JA) 1437 : c WRITE(6,*) 'VECG1 = ',VECXG(1,JA),VECYG(1,JA),VECZG(1,JA) 1438 : c WRITE(6,*) 'VECG2 = ',VECXG(2,JA),VECYG(2,JA),VECZG(2,JA) 1439 : c WRITE(6,*) 'VECG3 = ',VECXG(3,JA),VECYG(3,JA),VECZG(3,JA) 1440 : c WRITE(6,*)'NLCF= ',NLCF,'COEFG = ', 1441 : c & COEFG(1,JA),COEFG(2,JA),COEFG(3,JA) 1442 : c WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z 1443 : c WRITE(6,*)'SURFAG = ',SURFAGX(1),SURFAGY(1),SURFAGZ(1) 1444 : c WRITE(6,*)'SURFAG = ',SURFAGX(2),SURFAGY(2),SURFAGZ(2) 1445 : c WRITE(6,*)'SURFAG = ',SURFAGX(3),SURFAGY(3),SURFAGZ(3) 1446 : ENDDO 1447 : CALCUL DES VOLUMES 1448 : 1449 : DO JA = 1,NBNO 1450 : NGS(JA) = MELEFP.NUM(JA,NLCF1AUX) 1451 : NLS(JA)=MLESOM.LECT(NGS(JA)) 1452 : 1453 : ICELL=(4*(NGS(JA) -1))+1 1454 : XA = MCOORD.XCOOR(ICELL) 1455 : YA = MCOORD.XCOOR(ICELL+1) 1456 : ZA = MCOORD.XCOOR(ICELL+2) 1457 : 1458 : VAUX(1) = XA - XARD(1,JA) 1459 : VAUY(1) = YA - YARD(1,JA) 1460 : VAUZ(1) = ZA - ZARD(1,JA) 1461 : 1462 : VAUX(2) = XA - XARD(2,JA) 1463 : VAUY(2) = YA - YARD(2,JA) 1464 : VAUZ(2) = ZA - ZARD(2,JA) 1465 : 1466 : VAUX(3) = XA - XARD(3,JA) 1467 : VAUY(3) = YA - YARD(3,JA) 1468 : VAUZ(3) = ZA - ZARD(3,JA) 1469 : 1470 : PVECX = VAUY(2)*VAUZ(3) - VAUZ(2)*VAUY(3) 1471 : PVECY = VAUZ(2)*VAUX(3) - VAUX(2)*VAUZ(3) 1472 : PVECZ = VAUX(2)*VAUY(3) - VAUY(2)*VAUX(3) 1473 : 1474 : VOL = 1475 : & 1.D0/6.D0*ABS((VAUX(1)*PVECX) + (VAUY(1)*PVECY) + 1476 : & (VAUZ(1)*PVECZ)) 1477 : 1478 : c WRITE(6,*) 'XA= ',XA,'XARD(1)= ',XARD(1,JA) 1479 : c WRITE(6,*) 'YA= ',YA,'YARD(1)= ',YARD(1,JA) 1480 : c WRITE(6,*) 'ZA= ',ZA,'ZARD(1)= ',ZARD(1,JA) 1481 : 1482 : c WRITE(6,*) 'XA= ',XA,'XARD(2)= ',XARD(2,JA) 1483 : c WRITE(6,*) 'YA= ',YA,'YARD(2)= ',YARD(2,JA) 1484 : c WRITE(6,*) 'ZA= ',ZA,'ZARD(2)= ',ZARD(2,JA) 1485 : 1486 : c WRITE(6,*) 'XA= ',XA,'XARD(3)= ',XARD(3,JA) 1487 : c WRITE(6,*) 'YA= ',YA,'YARD(3)= ',YARD(3,JA) 1488 : c WRITE(6,*) 'ZA= ',ZA,'ZARD(3)= ',ZARD(3,JA) 1489 : 1490 : c WRITE(6,*) 'VAUX(1)= ',VAUX(1) 1491 : c WRITE(6,*) 'VAUY(1)= ',VAUY(1) 1492 : c WRITE(6,*) 'VAUZ(1)= ',VAUZ(1) 1493 : 1494 : c WRITE(6,*) 'VAUX(2)= ',VAUX(2) 1495 : c WRITE(6,*) 'VAUY(2)= ',VAUY(2) 1496 : c WRITE(6,*) 'VAUZ(2)= ',VAUZ(2) 1497 : 1498 : c WRITE(6,*) 'VAUX(3)= ',VAUX(3) 1499 : c WRITE(6,*) 'VAUY(3)= ',VAUY(3) 1500 : c WRITE(6,*) 'VAUZ(3)= ',VAUZ(3) 1501 : 1502 : c CALCUL DU PREMIER VOLUME 1503 : VOLUD(JA) = VOL 1504 : 1505 : 1506 : DO KA = 1,ICOUR 1507 : C COMPLETER ICI 1508 : C PRODUIT MIXTES 1509 : C PRODUIT VECTORIEL 1510 : IF (KA.EQ.1) THEN 1511 : 1512 : VAUX(2) = XA - XARD(2,JA) 1513 : VAUY(2) = YA - YARD(2,JA) 1514 : VAUZ(2) = ZA - ZARD(2,JA) 1515 : 1516 : VAUX(3) = XA - XARD(3,JA) 1517 : VAUY(3) = YA - YARD(3,JA) 1518 : VAUZ(3) = ZA - ZARD(3,JA) 1519 : 1520 : PSCADX = (VAUY(2)*VAUZ(3)) - 1521 : & (VAUZ(2)*VAUY(3)) 1522 : PSCADY = (VAUZ(2)*VAUX(3)) - 1523 : & (VAUX(2)*VAUZ(3)) 1524 : PSCADZ = (VAUX(2)*VAUY(3)) - 1525 : & (VAUY(2)*VAUX(3)) 1526 : PSCA = (VECXD(1,JA)* PSCADX) + (VECYD(1,JA)* PSCADY) + 1527 : & (VECZD(1,JA)* PSCADZ) 1528 : IF (PSCA.LT.0) THEN 1529 : PSCADX = - PSCADX 1530 : PSCADY = - PSCADY 1531 : PSCADZ = - PSCADZ 1532 : ENDIF 1533 : SURFADX(KA) = 0.5D0* PSCADX 1534 : SURFADY(KA) = 0.5D0* PSCADY 1535 : SURFADZ(KA) = 0.5D0* PSCADZ 1536 : 1537 : 1538 : ENDIF 1539 : 1540 : IF (KA.EQ.2) THEN 1541 : VAUX(2) = XA - XARD(2,JA) 1542 : VAUY(2) = YA - YARD(2,JA) 1543 : VAUZ(2) = ZA - ZARD(2,JA) 1544 : 1545 : VAUX(3) = XA - XARD(1,JA) 1546 : VAUY(3) = YA - YARD(1,JA) 1547 : VAUZ(3) = ZA - ZARD(1,JA) 1548 : 1549 : PSCADX = (VAUY(2)*VAUZ(3)) - 1550 : & (VAUZ(2)*VAUY(3)) 1551 : PSCADY = (VAUZ(2)*VAUX(3)) - 1552 : & (VAUX(2)*VAUZ(3)) 1553 : PSCADZ = (VAUX(2)*VAUY(3)) - 1554 : & (VAUY(2)*VAUX(3)) 1555 : 1556 : PSCA = (VECXD(2,JA)* PSCADX) + (VECYD(2,JA)* PSCADY) + 1557 : & (VECZD(2,JA)* PSCADZ) 1558 : IF (PSCA.LT.0) THEN 1559 : PSCADX = - PSCADX 1560 : PSCADY = - PSCADY 1561 : PSCADZ = - PSCADZ 1562 : ENDIF 1563 : SURFADX(KA) = 0.5D0* PSCADX 1564 : SURFADY(KA) = 0.5D0* PSCADY 1565 : SURFADZ(KA) = 0.5D0* PSCADZ 1566 : 1567 : ENDIF 1568 : 1569 : 1570 : IF (KA.EQ.3) THEN 1571 : VAUX(2) = XA - XARD(3,JA) 1572 : VAUY(2) = YA - YARD(3,JA) 1573 : VAUZ(2) = ZA - ZARD(3,JA) 1574 : 1575 : VAUX(3) = XA - XARD(1,JA) 1576 : VAUY(3) = YA - YARD(1,JA) 1577 : VAUZ(3) = ZA - ZARD(1,JA) 1578 : 1579 : PSCADX = (VAUY(2)*VAUZ(3)) - 1580 : & (VAUZ(2)*VAUY(3)) 1581 : PSCADY = (VAUZ(2)*VAUX(3)) - 1582 : & (VAUX(2)*VAUZ(3)) 1583 : PSCADZ = (VAUX(2)*VAUY(3)) - 1584 : & (VAUY(2)*VAUX(3)) 1585 : 1586 : PSCA = (VECXD(3,JA)* PSCADX) + (VECYD(3,JA)* PSCADY) + 1587 : & (VECZD(3,JA)* PSCADZ) 1588 : IF (PSCA.LT.0) THEN 1589 : PSCADX = - PSCADX 1590 : PSCADY = - PSCADY 1591 : PSCADZ = - PSCADZ 1592 : ENDIF 1593 : SURFADX(KA) = 0.5D0* PSCADX 1594 : SURFADY(KA) = 0.5D0* PSCADY 1595 : SURFADZ(KA) = 0.5D0* PSCADZ 1596 : 1597 : ENDIF 1598 : c WRITE(6,*) 'NLCF=',NLCF 1599 : c WRITE(6,*) 'NLCD=',NLCD 1600 : c WRITE(6,*) 'NLCD=',NLCG 1601 : c WRite(6,*) 'AG1=',AG1 1602 : c WRite(6,*) 'AG2=',AG2 1603 : c WRite(6,*) 'AD1=',AD1 1604 : c WRite(6,*) 'AD2=',AD2 1605 : c WRite(6,*) 'PSCAG1=',PSCAG1 1606 : c WRite(6,*) 'PSCAG2=',PSCAG2 1607 : c WRite(6,*) 'PSCAD1=',PSCAD1 1608 : c WRite(6,*) 'PSCAD2=',PSCAD2 1609 : c WRite(6,*) 'COEF1D=',COEF1D 1610 : c WRite(6,*) 'COEF2D=',COEF2D 1611 : c WRite(6,*) 'BETA1GD=',BETA1GD 1612 : c WRite(6,*) 'BETA2GD=',BETA2GD 1613 : c WRite(6,*) 'INDD2=',INDD2 1614 : 1615 : c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS1 1616 : IF (ICHTE.EQ.0) THEN 1617 : COEFD(KA,JA) = ( (SURFADX(KA)*SCN1X) + (SURFADY(KA)*SCN1Y) + 1618 : & (SURFADZ(KA)*SCN1Z)) 1619 : & / (VOLUD(JA)) 1620 : 1621 : ELSE 1622 : C TENSEUR 1623 : IF (MPOTEN.VPOCHA(/2) .EQ.6) THEN 1624 : K11D = MPOTEN.VPOCHA(NLCD,1) 1625 : K22D = MPOTEN.VPOCHA(NLCD,2) 1626 : K33D = MPOTEN.VPOCHA(NLCD,3) 1627 : K21D = MPOTEN.VPOCHA(NLCD,4) 1628 : K31D = MPOTEN.VPOCHA(NLCD,5) 1629 : K32D = MPOTEN.VPOCHA(NLCD,6) 1630 : ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN 1631 : K11D = MPOTEN.VPOCHA(NLCD,1) 1632 : K22D = K11D 1633 : K33D = K11D 1634 : K21D = 0.0D0 1635 : K31D = 0.0D0 1636 : K32D = 0.0D0 1637 : ELSE 1638 : WRITE(6,*) 'TENSEUR NON PREVU' 1639 : STOP 1640 : ENDIF 1641 : 1642 : PSCADX = (K11D*SURFADX(KA)) + (K21D*SURFADY(KA)) + 1643 : & (K31D*SURFADZ(KA)) 1644 : PSCADY = (K21D*SURFADX(KA)) + (K22D*SURFADY(KA)) + 1645 : & (K32D*SURFADZ(KA)) 1646 : PSCADZ = (K31D*SURFADX(KA)) + (K32D*SURFADY(KA)) + 1647 : & (K33D*SURFADZ(KA)) 1648 : COEFD(KA,JA) = (PSCADX*SCN1X) + (PSCADY*SCN1Y) 1649 : & + (PSCADZ*SCN1Z) 1650 : COEFD(KA,JA) = COEFD(KA,JA) / (VOLUD(JA)) 1651 : ENDIF 1652 : c WRITE(6,*) 'JA = ',JA,'KA= ',KA,'VOLUD(JA) = ',VOLUD(JA) 1653 : c WRITE(6,*)'SURFAD = ',SURFADX(KA),SURFADY(KA),SURFADZ(KA) 1654 : c WRITE(6,*)'VECD = ',VECXD(KA,JA),VECYD(KA,JA),VECZD(KA,JA) 1655 : ENDDO 1656 : 1657 : c WRITE(6,*) 'JA = ',JA,'VOLUD(JA) = ',VOLUD(JA) 1658 : c WRITE(6,*)'VECD1 = ',VECXD(1,JA),VECYD(1,JA),VECZD(1,JA) 1659 : c WRITE(6,*)'VECD3 = ',VECXD(2,JA),VECYD(2,JA),VECZD(2,JA) 1660 : c WRITE(6,*)'VECD3 = ',VECXD(3,JA),VECYD(3,JA),VECZD(3,JA) 1661 : c WRITE(6,*)'NLCF= ',NLCF,'COEFD = ', 1662 : c & COEFD(1,JA),COEFD(2,JA),COEFD(3,JA) 1663 : c WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z 1664 : c WRITE(6,*)'SURFAD = ',SURFADX(1),SURFADY(1),SURFADZ(1) 1665 : c WRITE(6,*)'SURFAD = ',SURFADX(2),SURFADY(2),SURFADZ(2) 1666 : c WRITE(6,*)'SURFAD = ',SURFADX(3),SURFADY(3),SURFADZ(3) 1667 : 1668 : ENDDO 1669 : CALCUL DES VOLUMES 1670 : 1671 : c WRITE(6,*) 'NLCF= ',NLCF 1672 : c WRITE(6,*) 'NGCF= ',NGCF 1673 : c WRITE(6,*) 'KG=', K11G,K22G,K33G,K21G,K31G,K32G 1674 : c WRITE(6,*) 'KD=', K11D,K22D,K33D,K21D,K31D,K32D 1675 : DO JA = 1,NBNO 1676 : 1677 : XX1 = ABS(COEFG(1,JA)) 1678 : XX2 = ABS(COEFD(1,JA)) 1679 : IF ((XX1.LT.1e-8) .OR.(XX2.LT.1E-8)) THEN 1680 : INDICE = 1 1681 : ENDIF 1682 : 1683 : MARQ = 0 1684 : DO I5 = 1,INDLI.ID(NLS(JA)) 1685 : INDAUX = IND2.NUME(I5,NLS(JA)) 1686 : IF (INDAUX.EQ.NGCF) THEN 1687 : MARQ = 1 1688 : IAFF = I5 1689 : GOTO 4 1690 : ENDIF 1691 : ENDDO 1692 : 4 CONTINUE 1693 : 1694 : 1695 : IF (MARQ.EQ.0) THEN 1696 : INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1 1697 : ICOU = INDLI.ID(NLS(JA)) 1698 : IND2.NUME(ICOU,NLS(JA)) = NGCF 1699 : ELSE 1700 : ICOU = IAFF 1701 : ENDIF 1702 : 1703 : 1704 : COEF = COEFG(1,JA)-COEFD(1,JA) 1705 : MATR1 = IPO2.POINT(NLS(JA)) 1706 : c SEGINI MATR1 1707 : SEGACT MATR1 *MOD 1708 : MATR1.MAT2(ICOU,ICOU) = COEF 1709 : 1710 : MARQ = 0 1711 : DO I5 = 1,INDLI.ID(NLS(JA)) 1712 : INDAUX = IND2.NUME(I5,NLS(JA)) 1713 : IF (INDAUX.EQ.NLOCFG(2,JA)) THEN 1714 : MARQ = 1 1715 : IAFF = I5 1716 : GOTO 5 1717 : ENDIF 1718 : ENDDO 1719 : 5 CONTINUE 1720 : 1721 : 1722 : IF (MARQ.EQ.0) THEN 1723 : INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1 1724 : ICOUCO = INDLI.ID(NLS(JA)) 1725 : IND2.NUME(ICOUCO,NLS(JA)) = NLOCFG(2,JA) 1726 : ELSE 1727 : ICOUCO = IAFF 1728 : ENDIF 1729 : ICOUG2 = ICOUCO 1730 : 1731 : 1732 : MATR1.MAT2(ICOU,ICOUCO) = COEFG(2,JA) 1733 : 1734 : MARQ = 0 1735 : DO I5 = 1,INDLI.ID(NLS(JA)) 1736 : INDAUX = IND2.NUME(I5,NLS(JA)) 1737 : IF (INDAUX.EQ.NLOCFG(3,JA)) THEN 1738 : MARQ = 1 1739 : IAFF = I5 1740 : GOTO 6 1741 : ENDIF 1742 : ENDDO 1743 : 6 CONTINUE 1744 : 1745 : 1746 : IF (MARQ.EQ.0) THEN 1747 : INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1 1748 : ICOUCO = INDLI.ID(NLS(JA)) 1749 : IND2.NUME(ICOUCO,NLS(JA)) = NLOCFG(3,JA) 1750 : ELSE 1751 : ICOUCO = IAFF 1752 : ENDIF 1753 : ICOUG3 = ICOUCO 1754 : MATR1.MAT2(ICOU,ICOUCO) = COEFG(3,JA) 1755 : 1756 : 1757 : MARQ = 0 1758 : DO I5 = 1,INDLI.ID(NLS(JA)) 1759 : INDAUX = IND2.NUME(I5,NLS(JA)) 1760 : IF (INDAUX.EQ.NLOCFD(2,JA)) THEN 1761 : MARQ = 1 1762 : IAFF = I5 1763 : GOTO 59 1764 : ENDIF 1765 : ENDDO 1766 : 59 CONTINUE 1767 : 1768 : 1769 : IF (MARQ.EQ.0) THEN 1770 : INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1 1771 : ICOUCO = INDLI.ID(NLS(JA)) 1772 : IND2.NUME(ICOUCO,NLS(JA)) = NLOCFD(2,JA) 1773 : ELSE 1774 : ICOUCO = IAFF 1775 : ENDIF 1776 : ICOUD2 = ICOUCO 1777 : 1778 : 1779 : MATR1.MAT2(ICOU,ICOUCO) = - COEFD(2,JA) 1780 : 1781 : MARQ = 0 1782 : DO I5 = 1,INDLI.ID(NLS(JA)) 1783 : INDAUX = IND2.NUME(I5,NLS(JA)) 1784 : IF (INDAUX.EQ.NLOCFD(3,JA)) THEN 1785 : MARQ = 1 1786 : IAFF = I5 1787 : GOTO 69 1788 : ENDIF 1789 : ENDDO 1790 : 69 CONTINUE 1791 : 1792 : 1793 : IF (MARQ.EQ.0) THEN 1794 : INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1 1795 : ICOUCO = INDLI.ID(NLS(JA)) 1796 : IND2.NUME(ICOUCO,NLS(JA)) = NLOCFD(3,JA) 1797 : ELSE 1798 : ICOUCO = IAFF 1799 : ENDIF 1800 : ICOUD3 = ICOUCO 1801 : MATR1.MAT2(ICOU,ICOUCO) = - COEFD(3,JA) 1802 : 1803 : c ON EST ICI 1804 : 1805 : SCMB.MAT(ICOU,NLS(JA)) = 1806 : & ((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA)) 1807 : & *ALPHA*MPOCHP.VPOCHA(NLCG,1)) - 1808 : & ((COEFD(1,JA)+COEFD(2,JA)+COEFD(3,JA))* 1809 : & ALPHA*MPOCHP.VPOCHA(NLCD,1)) 1810 : c SCMB.MAT(ICOU,NLS(JA)) = COEF* SCMB.MAT(ICOU,NLS(JA)) 1811 : 1812 : 1813 : c NLS1 = NLS(JA) 1814 : c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU, 1815 : c & 'SCMB', SCMB.MAT(ICOU,NLS1), 1816 : c & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU),'COEF= ',COEF, 1817 : c & 'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2), 1818 : c & 'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3), 1819 : c & 'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2), 1820 : c & 'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3) 1821 : * ON EST ICI 1822 : * IL FAUT VERIFIER CE QUI EST AVANT 1823 : 1824 : 1825 : * COEF POUR INVERSER LA MATRICE 1826 : 1827 : * ON CORRIGE ICI 1828 : VAL1.MAT(ICOU,NLS(JA)) = 1829 : & ALPHA*(COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA)) 1830 : c VAL1.MAT(ICOU,NLS(JA)) = COEF*VAL1.MAT(ICOU,NLS(JA)) 1831 : VAL2.MAT(ICOU,NLS(JA)) = 1832 : & - (ALPHA*(COEFD(1,JA) + COEFD(2,JA) + COEFD(3,JA))) 1833 : c VAL2.MAT(ICOU,NLS(JA)) = COEF*VAL2.MAT(ICOU,NLS(JA)) 1834 : IND.NUME(ICOU,NLS(JA)) = NGCG 1835 : IND22.NUME(ICOU,NLS(JA)) = NGCD 1836 : 1837 : * CONDITION AUX LIMITE DE DIRICICHLET 1838 : IF (NGCG.EQ.NGCD) THEN 1839 : NLFCL=MLENCL.LECT(NGCF) 1840 : IF (NLFCL.GT.0) THEN 1841 : c WRITE(6,*) 'NLCF= ',NLCF 1842 : c WRITE(6,*) 'NGCF= ',NGCF 1843 : c WRITE(6,*) 'VAL=',MPOVCL.VPOCHA(NLFCL,1) 1844 : COEF = MAX(ABS(COEFG(1,JA)),ABS(COEFG(2,JA))) 1845 : COEF = MAX(COEF,ABS(COEFG(3,JA))) 1846 : MATR1.MAT2(ICOU,ICOU) = COEF 1847 : MATR1.MAT2(ICOU,ICOUG2) = 0.0D0 1848 : MATR1.MAT2(ICOU,ICOUG3) = 0.0D0 1849 : MATR1.MAT2(ICOU,ICOUD2) = 0.0D0 1850 : MATR1.MAT2(ICOU,ICOUD3) = 0.0D0 1851 : c ICI 1852 : SCMB.MAT(ICOU,NLS(JA)) = (COEF*ALPHA*MPOVCL.VPOCHA(NLFCL,1)) 1853 : VAL1.MAT(ICOU,NLS(JA)) = 0.D0 1854 : VAL2.MAT(ICOU,NLS(JA)) = ALPHA*COEF 1855 : c ON AJOUTE ICI UN POINT FACE POUR COMPATIBILITE AVEC LAPN 1856 : IND.NUME(ICOU,NLS(JA)) = NGCG 1857 : IND22.NUME(ICOU,NLS(JA)) = NGCF 1858 : ELSE 1859 : NLFNE=MLENNE.LECT(NGCF) 1860 : 1861 : c CONDITION DE FLUX 1862 : IF (NLFNE.GT.0) THEN 1863 : QIMPX = MPOVNE.VPOCHA(NLFNE,1) 1864 : C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE 1865 : QIMPS = (QIMPX) 1866 : QIMPS = -QIMPS 1867 : c WRITE(6,*) 'NGCF= ',NGCF 1868 : c WRITE(6,*) 'QIMPS= ',QIMPS 1869 : 1870 : COEF = COEFG(1,JA) 1871 : MATR1.MAT2(ICOU,ICOUD2) = 0.0D0 1872 : MATR1.MAT2(ICOU,ICOUD3) = 0.0D0 1873 : MATR1.MAT2(ICOU,ICOU) = COEF 1874 : MATR1.MAT2(ICOU,ICOUG2) = COEFG(2,JA) 1875 : MATR1.MAT2(ICOU,ICOUG3) = COEFG(3,JA) 1876 : 1877 : SCMB.MAT(ICOU,NLS(JA)) = 1878 : & ((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))*MPOCHP.VPOCHA(NLCG,1)) 1879 : & + (QIMPS) 1880 : VAL1.MAT(ICOU,NLS(JA)) = 1881 : & (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA)) 1882 : VAL2.MAT(ICOU,NLS(JA)) = 1.D0 1883 : IND.NUME(ICOU,NLS(JA)) = NGCG 1884 : IND22.NUME(ICOU,NLS(JA)) = NGCF 1885 : NLS1 = NLS(JA) 1886 : c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU, 1887 : c & 'SCMB', SCMB.MAT(ICOU,NLS1) 1888 : c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU, 1889 : c & 'IND= ',IND.NUME(ICOU,NLS1), 1890 : c & 'IND22= ',IND22.NUME(ICOU,NLS1), 1891 : c & 'SCMB', SCMB.MAT(ICOU,NLS1), 1892 : c & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU,NLS1), 1893 : c & 'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2,NLS1), 1894 : c & 'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3,NLS1), 1895 : c & 'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2,NLS1), 1896 : c & 'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3,NLS1) 1897 : 1898 : ELSE 1899 : c CONDITION MIXTE 1900 : NLFMI=MLENMI.LECT(NGCF) 1901 : IF (NLFMI.GT.0) THEN 1902 : XLAMBDA1 = MPOVMI.VPOCHA(NLFMI,1) 1903 : XLAMBDA2 = MPOVMI.VPOCHA(NLFMI,2) 1904 : QIMPX = MPOVMI.VPOCHA(NLFMI,3) 1905 : 1906 : C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE 1907 : QIMPS = (QIMPX) 1908 : QIMPS= - QIMPS 1909 : 1910 : c WRITE(6,*) 'NLCF= ',NLCF 1911 : c WRITE(6,*) 'NGCF= ',NGCF 1912 : c WRITE(6,*) 'XLAMBDA1= ',XLAMBDA1,'XLAMBDA2= ',XLAMBDA2 1913 : COEF = COEFG(1,JA) 1914 : c WRITE(6,*) 'COEF= ',COEF 1915 : c WRITE(6,*) 'COEF= ',COEF,'QIMPS= ',QIMPS 1916 : MATR1.MAT2(ICOU,ICOUD2) = 0.0D0 1917 : MATR1.MAT2(ICOU,ICOUD3) = 0.0D0 1918 : MATR1.MAT2(ICOU,ICOU) = (XLAMBDA1*COEF) + 1919 : & (1.D0*XLAMBDA2) 1920 : MATR1.MAT2(ICOU,ICOUG2) = (XLAMBDA1*COEFG(2,JA)) 1921 : MATR1.MAT2(ICOU,ICOUG3) = (XLAMBDA1*COEFG(3,JA)) 1922 : c ON EST ICI 1923 : SCMB.MAT(ICOU,NLS(JA)) = 1924 : & (XLAMBDA1*((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))* 1925 : & MPOCHP.VPOCHA(NLCG,1))) 1926 : & + (1.D0*QIMPS) 1927 : VAL1.MAT(ICOU,NLS(JA)) = XLAMBDA1* 1928 : & (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA)) 1929 : VAL2.MAT(ICOU,NLS(JA)) = 1.D0 1930 : IND.NUME(ICOU,NLS(JA)) = NGCG 1931 : IND22.NUME(ICOU,NLS(JA)) = NGCF 1932 : NLS1 = NLS(JA) 1933 : c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU, 1934 : c & 'IND= ',IND.NUME(ICOU,NLS1), 1935 : c & 'IND22= ',IND22.NUME(ICOU,NLS1), 1936 : c & 'SCMB', SCMB.MAT(ICOU,NLS1), 1937 : c & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU,NLS1), 1938 : c & 'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2,NLS1), 1939 : c & 'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3,NLS1), 1940 : c & 'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2,NLS1), 1941 : c & 'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3,NLS1) 1942 : ELSE 1943 : C PAR DEFAUT FLUX NUL 1944 : QIMPS = 0 1945 : COEF = COEFG(1,JA) 1946 : MATR1.MAT2(ICOU,ICOU) = COEF 1947 : MATR1.MAT2(ICOU,ICOUG2) = COEFG(2,JA) 1948 : MATR1.MAT2(ICOU,ICOUG3) = COEFG(3,JA) 1949 : SCMB.MAT(ICOU,NLS(JA)) = 1950 : & ((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))*MPOCHP.VPOCHA(NLCG,1)) 1951 : VAL1.MAT(ICOU,NLS(JA)) = 1952 : & (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA)) 1953 : VAL2.MAT(ICOU,NLS(JA)) = 0.D0 1954 : IND.NUME(ICOU,NLS(JA)) = NGCG 1955 : IND22.NUME(ICOU,NLS(JA)) = NGCD 1956 : ENDIF 1957 : 1958 : ENDIF 1959 : 1960 : ENDIF 1961 : ENDIF 1962 : 1963 : c WRITE(6,*) 'COEF1 = ',COEFGG,'COEF2= ',COEF2,'COEF3= ', 1964 : c & COEF3,'COEF4=',COEF4,'HG=',MPOCHP.VPOCHA(NLCG,1), 1965 : c & 'HD= ',MPOCHP.VPOCHA(NLCD,1) 1966 : 1967 : NAUX1 = MAX(NAUX1,INDLI.ID(NLS(JA))) 1968 : c WRITE(6,*) 'NLCF= ',NLCF,'NAUX1 = ',NAUX1 1969 : c WRITE(6,*) 'NLS= ',NLS(JA),'NGS= ',NGS(JA), 1970 : c & 'INDLI.ID',INDLI.ID(NLS(JA)) 1971 : c WRITE(6,*) 'JA= ',JA 1972 : c WRITE(6,*) 'NLOCFG= ',NLOCFG(1,JA),NLOCFG(2,JA),NLOCFG(3,JA) 1973 : c WRITE(6,*) 'NLOCFD= ',NLOCFD(1,JA),NLOCFD(2,JA),NLOCFD(3,JA) 1974 : c DO I5 = 1,INDLI.ID(NLS(JA)) 1975 : c INDAUX = IND2.NUME(I5,NLS(JA)) 1976 : c WRITE(6,*) 'I5= ','JA= ','NLS= ',NLS(JA), 1977 : c & 'IND2= ',IND2.NUME(I5,NLS(JA)) 1978 : c ENDDO 1979 : 1980 : C ON DESACTIVE (FIN DE LA BOUCLE SUR LES POINTS) 1981 : c SEGDES MATRICE2 1982 : c SEGACT MATRICE2 1983 : NLS1 = NLS(JA) 1984 : IF (ABS(COEF).LT. (-1.D0)) THEN 1985 : NLFCL=MLENCL.LECT(NGCF) 1986 : WRITE(6,*) 'CLIMD = ',NLFCL 1987 : NLFNE=MLENNE.LECT(NGCF) 1988 : WRITE(6,*) 'CLIMN = ',NLFNE 1989 : WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU, 1990 : & 'SCMB', SCMB.MAT(ICOU,NLS1), 1991 : & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU),'COEF= ',COEF, 1992 : & 'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2), 1993 : & 'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3), 1994 : & 'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2), 1995 : & 'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3), 1996 : & 'COEFG1JA', COEFG(1,JA),'COEFD1JA',COEFD(1,JA) 1997 : 1998 : c WRITE(6,*)'JA = ',JA, 'KA= ',KA,'VOLUG(JA) = ',VOLUG(JA) 1999 : c WRITE(6,*)'SURFAG = ',SURFAGX(KA),SURFAGY(KA),SURFAGZ(KA) 2000 : c WRITE(6,*)'VEXG = ',VECXG(KA,JA),VECYG(KA,JA),VECZG(KA,JA) 2001 : WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z 2002 : WRITE(6,*) 'JA = ',JA,'VOLUG(JA) = ',VOLUG(JA) 2003 : WRITE(6,*) 'VECG1 = ',VECXG(1,JA),VECYG(1,JA),VECZG(1,JA) 2004 : WRITE(6,*) 'VECG2 = ',VECXG(2,JA),VECYG(2,JA),VECZG(2,JA) 2005 : WRITE(6,*) 'VECG3 = ',VECXG(3,JA),VECYG(3,JA),VECZG(3,JA) 2006 : WRITE(6,*)'NLCF= ',NLCF,'COEFG = ', 2007 : & COEFG(1,JA),COEFG(2,JA),COEFG(3,JA) 2008 : WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z 2009 : WRITE(6,*)'SURFAG = ',SURFAGX(1),SURFAGY(1),SURFAGZ(1) 2010 : WRITE(6,*)'SURFAG = ',SURFAGX(2),SURFAGY(2),SURFAGZ(2) 2011 : WRITE(6,*)'SURFAG = ',SURFAGX(3),SURFAGY(3),SURFAGZ(3) 2012 : 2013 : WRITE(6,*) 'JA = ',JA,'VOLUD(JA) = ',VOLUD(JA) 2014 : WRITE(6,*)'VECD1 = ',VECXD(1,JA),VECYD(1,JA),VECZD(1,JA) 2015 : WRITE(6,*)'VECD3 = ',VECXD(2,JA),VECYD(2,JA),VECZD(2,JA) 2016 : WRITE(6,*)'VECD3 = ',VECXD(3,JA),VECYD(3,JA),VECZD(3,JA) 2017 : WRITE(6,*)'NLCF= ',NLCF,'COEFD = ', 2018 : & COEFD(1,JA),COEFD(2,JA),COEFD(3,JA) 2019 : WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z 2020 : WRITE(6,*)'SURFAD = ',SURFADX(1),SURFADY(1),SURFADZ(1) 2021 : WRITE(6,*)'SURFAD = ',SURFADX(2),SURFADY(2),SURFADZ(2) 2022 : WRITE(6,*)'SURFAD = ',SURFADX(3),SURFADY(3),SURFADZ(3) 2023 : WRITE(6,*) 'KG=', K11G,K22G,K33G,K21G,K31G,K32G 2024 : WRITE(6,*) 'KD=', K11D,K22D,K33D,K21D,K31D,K32D 2025 : 2026 : ENDIF 2027 : 2028 : SEGDES MATR1 * MOD 2029 : 2030 : ENDDO 2031 : 2032 : 2033 : 2034 : c IF (INDICE.EQ.1) THEN 2035 : c WRITE(6,*)'NLCF= ',NLCF,'COEFG(1) OU COEFD(1) TRES PETIT' 2036 : c ENDIF 2037 : ENDDO 2038 : 2039 : 2040 : IF (NAUX1.GT.NBMAX) THEN 2041 : WRITE(6,*) 'ERREUR DANS LES PARAMETRES' 2042 : c STOP 2043 : ENDIF 2044 : c DO J= 1,INDLI.ID(NLS1) 2045 : c WRITE(6,*) 'MELVA1=',MELVA1.VELCHE(J,NLCF) 2046 : c WRITE(6,*) 'MELVA2=',MELVA1.VELCHE(J,NLCF) 2047 : c WRITE(6,*) 'MELEME=',MELEME.NUM(J,NLCF) 2048 : c ENDDO 2049 : 2050 : MELTFA = MAUX 2051 : MELEFP = MAUX2 2052 : IF (NBSO.EQ.2) THEN 2053 : SEGDES IPT1 2054 : SEGDES IPT2 2055 : ELSEIF (NBSO.EQ.3) THEN 2056 : SEGDES IPT1 2057 : SEGDES IPT2 2058 : SEGDES IPT3 2059 : ELSEIF (NBSO.EQ.4) THEN 2060 : SEGDES IPT1 2061 : SEGDES IPT2 2062 : SEGDES IPT3 2063 : SEGDES IPT4 2064 : ENDIF 2065 : IF (NBSOF.EQ.2) THEN 2066 : SEGDES IPT5 2067 : SEGDES IPT6 2068 : ENDIF 2069 : 2070 : c MAUX = MELEFP 2071 : c MELEFP = IMECOTE(1) 2072 : c NGCF=MELEFP.NUM(4,1) 2073 : c WRITE(6,*) 'NGCF= ',NGCF 2074 : c MELEFP = MAUX 2075 : 2076 : c DO NLS1=1,NSOMM,1 2077 : c MATR1 = IPO2.POINT(NLS1) 2078 : c SEGACT MATR1 2079 : c 2080 : c DO I=1,INDLI.ID(NLS1) 2081 : c DO J = 1,INDLI.ID(NLS1) 2082 : c WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,MATR1.MAT2(I,J) 2083 : c ENDDO 2084 : c ENDDO 2085 : c ENDDO 2086 : c SEGDES MATR1 2087 : 2088 : 9999 CONTINUE 2089 : RETURN 2090 : END 2091 : 2092 : 2093 : 2094 : 2095 : 2096 : 2097 : 2098 : 2099 : 2100 : 2101 :
© Cast3M 2003 - All rights reserved.
Disclaimer