1 : C NOR2D3 SOURCE PV 09/03/12 21:29:27 6325 2 : SUBROUTINE NOR2D3(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR, 3 : & MPOSUR,MELTFA,MLEFA,MLEFA2,MPOTEN,MPOCHP,MLENCL, 4 : & MLENNE,MLENMI,MPOVCL, 5 : & MPOVNE,MPOVMI,ICHTE,ICHCL,ICHNE,IPO2, 6 : & SCMB,INDLI, 7 : & TAB,VAL1,VAL2,IND22,IND2,IND,NBFAC,NBCOT, 8 : & NSOMM,NBMAX) 9 : 10 : 11 : 12 : C 13 : C************************************************************************ 14 : C 15 : C PROJET : CASTEM 2000 16 : C 17 : C NOM : NORV2 18 : C 19 : C DESCRIPTION : Appelle par NORV1 20 : C 21 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) 22 : C 23 : C AUTEUR : C. LE POTIER, DM2S/SFME/MTMS 24 : C 25 : C************************************************************************ 26 : C 27 : IMPLICIT INTEGER(I-N) 28 : IMPLICIT REAL*8 (a-h,o-z) 29 : -INC SMLENTI 30 : -INC SMELEME 31 : -INC SMCHPOI 32 : -INC CCOPTIO 33 : -INC SMCOORD 34 : -INC SMLREEL 35 : POINTEUR MELEFL.MELEME, MELEFP.MELEME, MELEFA.MELEME, 36 : & MELTFA.MELEME, MELEP2.MELEME 37 : POINTEUR MPOSUR.MPOVAL, MPONOR.MPOVAL, 38 : & MPOCHP.MPOVAL, MPOVCL.MPOVAL, MPGSOM.MPOVAL, MPVOSO.MPOVAL, 39 : & MPOGRA.MPOVAL,MPOTEN.MPOVAL,MPOVNE.MPOVAL,MPOVMI.MPOVAL 40 : POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLESOM.MLENTI, 41 : & MLEFA.MLENTI,MLENNE.MLENTI,MLENMI.MLENTI,MLEFA2.MLENTI 42 : -INC SMCHAML 43 : INTEGER NBNN,NBREF 44 : 45 : 46 : 47 : C 48 : C**** Variables de COOPTIO 49 : C 50 : C 51 : C**** Variables de COOPTIO 52 : C 53 : c INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 54 : c & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 55 : c & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 56 : c & ,IECHO, IIMPI, IOSPI 57 : c & ,IDIM 58 : C & ,MCOORD 59 : c & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 60 : c & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 61 : c & ,NORINC,NORVAL,NORIND,NORVAD 62 : c & ,NUCROU, IPSAUV 63 : 64 : C**** Variable de SMLENTI, SMCHPOI 65 : C 66 : INTEGER JG, N, NC, NSOUPO, NAT, NBSOUS, NBNO,NBELEM 67 : C 68 : C**** Les includes 69 : C 70 : INTEGER I1,ICOMP,ICOMGR,IGEOM 71 : & ,IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,INORM 72 : & ,ISURF,IMAIL,ICHPO,ICHCL,ICHGRA,ICOEFF 73 : & ,NTOT,NSOMM,NCOMP,NFAC,NCEN 74 : & ,NLCF,NGCF,NGCF1,NGCF2,NGCG,NGCD,NLCG,NLCD,NGS1,NGS2 75 : & ,NLS1,NLS2,NLFCL 76 : & ,ISOUS,IELEM,INOEUD,ICELL 77 : INTEGER ICEN2 78 : REAL*8 SCNX,SCNY,SCNZ,SURF,VOL,VAL,VALX,VALY,VALZ,XG,XD,XF,XS1,XS2 79 : & ,YG,YD,YF,YS1,YS2,ZG,ZD,ZF,ZS1,ZS2, 80 : & PSCA,XNORM,VECX,VECY,VECZ,PSCAGX,PSCAGY,PSCAGZ, 81 : & PSCADX,PSCADY,PSCADZ,K11G,K22G,K21G,K31G,K32G,K33G, 82 : & K11D,K22D,K21D,K31D,K32D,K33D,VXG1,VXG2, 83 : & VXAU,VYAU,VZAU,VXD1,VXD2,VYG1,VYG2,VYD1,VYD2,VZG1, 84 : & VZG2,VZD1,VZD2,TRG1,TRG2, 85 : & TRD1,TRD2,TRG,TRD 86 : REAL*8 XLONG,AG1,AG2,AD1,AD2,PSCAG1,PSCAG2,PSCAD1,PSCAD2, 87 : & COEF1,COEF2,COEF3,COEF4,SCN1X,SCN1Y,SCN1Z,VX,VY,VZ, 88 : & COEF1X,COEF2X,COEF1Y,COEF2Y,COEF1Z,COEF2Z, 89 : & CX,CY,CZ,ANCX,ANCY,ANCZ,DIFFX,DIFFY,DIFFZ,XLONGG,XLONGD, 90 : & VALD,VALG,COEF,GX,GY,GZ,XMINK11,XMAXK11,XMINK22,XMAXK22, 91 : & QIMPX,QIMPY,QIMPZ,QIMPS,XLAMBDA1,XLAMBDA2 92 : 93 : c REAL*8 VECXG1(3),VECYG1(3) 94 : c REAL*8 VECXG2(3),VECYG2(3) 95 : c REAL*8 VECXD1(3),VECYD1(3) 96 : c REAL*8 VECXD2(3),VECYD2(3) 97 : c REAL*8 EPS 98 : c INTEGER ICRIT 99 : c CHARACTER*(4) NOMCOM(18) 100 : c CHARACTER*8 TYPE 101 : 102 : REAL*8 VECXG(4,4),VECYG(4,4),VECZG(4,4) 103 : REAL*8 VECXD(4,4),VECYD(4,4),VECZD(4,4) 104 : REAL*8 VOLUG(4),SURFAGX(4),SURFAGY(4),SURFAGZ(4),COEFG(4,4) 105 : REAL*8 VOLUD(4),SURFADX(4),SURFADY(4),SURFADZ(4),COEFD(4,4) 106 : INTEGER NGS(4),NLS(4),XS(4),YS(4),ZS(4) 107 : INTEGER NLOCFG(4,4),NLOCFD(4,4) 108 : REAL*8 EPS 109 : INTEGER ICRIT 110 : CHARACTER*(4) NOMCOM(18) 111 : CHARACTER*8 TYPE 112 : C 113 : DATA NOMCOM /'P1DX','P1DY', 114 : & 'P2DX','P2DY', 115 : & 'P3DX','P3DY', 116 : & 'P4DX','P4DY', 117 : & 'P5DX','P5DY', 118 : & 'P6DX','P6DY', 119 : & 'P7DX','P7DY', 120 : & 'P8DX','P8DY', 121 : & 'P9DX','P9DY'/ 122 : 123 : INTEGER NDIM 124 : SEGMENT MMAT1 125 : REAL*8 PM(NDIM,NDIM),PM1(NDIM,NDIM),XSOL(NDIM) 126 : INTEGER IC(NDIM) 127 : ENDSEGMENT 128 : 129 : INTEGER K1,K2 130 : SEGMENT INDICE 131 : INTEGER NUME(K1,K2) 132 : ENDSEGMENT 133 : POINTEUR IND.INDICE,IND2.INDICE,IND22.INDICE 134 : 135 : SEGMENT MATRICE 136 : REAL*8 MAT(K1,K2) 137 : ENDSEGMENT 138 : POINTEUR VAL1.MATRICE,VAL2.MATRICE,SCMB.MATRICE 139 : 140 : INTEGER K3 141 : SEGMENT POINT2 142 : INTEGER POINT(K3) 143 : ENDSEGMENT 144 : POINTEUR IPO2.POINT2 145 : 146 : SEGMENT MATRICE2 147 : REAL*8 MAT2(K1,K2) 148 : ENDSEGMENT 149 : POINTEUR MATR1.MATRICE2,MATR2.MATRICE2 150 : 151 : 152 : SEGMENT REP 153 : INTEGER ID(K3) 154 : ENDSEGMENT 155 : POINTEUR TAB.REP,INDLI.REP 156 : 157 : INTEGER K5 158 : SEGMENT NBFAC 159 : INTEGER NBFACEL(K5) 160 : INTEGER IMELEM(K5) 161 : ENDSEGMENT 162 : 163 : INTEGER K6 164 : SEGMENT NBCOT 165 : INTEGER NBCOTE(K6) 166 : INTEGER IMECOTE(K6) 167 : ENDSEGMENT 168 : 169 : 170 : 171 : c CALCUL DES DIFFERENTS POINTEURS A ACTIVER DANS POUR PLUSIIEURS 172 : c SOUS DOMAINE 173 : 174 : MAUX = MELTFA 175 : MAUX2 = MELEFP 176 : NMAI1 = 0 177 : NMAI2 = 0 178 : NMAI3 = 0 179 : NMAI4 = 0 180 : NBSO = MAX(1,MELTFA.LISOUS(/1)) 181 : c WRITE(6,*) 'NBSO MAILLE= ',NBSO 182 : c WRITE(6,*) 'MELTFA= ',MELTFA 183 : IELTFA = MELTFA 184 : IF (NBSO.EQ.1) THEN 185 : K5 = MELTFA.NUM(/2) 186 : ELSEIF (NBSO.EQ.2) THEN 187 : IPT1 = MELTFA.LISOUS(1) 188 : SEGACT IPT1 189 : N1 = IPT1.NUM(/2) 190 : NMAI1 = N1 191 : SEGDES IPT1 192 : IPT2 = MELTFA.LISOUS(2) 193 : SEGACT IPT2 194 : N2 = IPT2.NUM(/2) 195 : NMAI2 = N2 196 : SEGDES IPT2 197 : K5 = N1 + N2 198 : ELSEIF (NBSO.EQ.3) THEN 199 : IPT1 = MELTFA.LISOUS(1) 200 : SEGACT IPT1 201 : N1 = IPT1.NUM(/2) 202 : NMAI1 = N1 203 : SEGDES IPT1 204 : IPT2 = MELTFA.LISOUS(2) 205 : SEGACT IPT2 206 : N2 = IPT2.NUM(/2) 207 : NMAI2 = N2 208 : SEGDES IPT2 209 : IPT3 = MELTFA.LISOUS(3) 210 : SEGACT IPT3 211 : N3 = IPT3.NUM(/2) 212 : NMAI3 = N3 213 : SEGDES IPT3 214 : K5 = N1 + N2 + N3 215 : ELSEIF (NBSO.EQ.4) THEN 216 : IPT1 = MELTFA.LISOUS(1) 217 : SEGACT IPT1 218 : N1 = IPT1.NUM(/2) 219 : NMAI1 = N1 220 : SEGDES IPT1 221 : IPT2 = MELTFA.LISOUS(2) 222 : SEGACT IPT2 223 : N2 = IPT2.NUM(/2) 224 : NMAI2 = N2 225 : SEGDES IPT2 226 : IPT3 = MELTFA.LISOUS(3) 227 : SEGACT IPT3 228 : N3 = IPT3.NUM(/2) 229 : NMAI3 = N3 230 : SEGDES IPT3 231 : IPT4 = MELTFA.LISOUS(4) 232 : SEGACT IPT4 233 : N4 = IPT4.NUM(/2) 234 : NMAI4 = N4 235 : SEGDES IPT4 236 : K5 = N1 + N2 + N3 + N4 237 : ENDIF 238 : c WRITE(6,*) 'K5= ',K5 239 : 240 : 241 : 242 : IF (NBSO.EQ.1) THEN 243 : DO I = 1,K5 244 : NTYPE = MELTFA.ITYPEL 245 : c WRITE(6,*) 'NTYPE= ',NTYPE 246 : IF (NTYPE .EQ. 16) THEN 247 : NBFACEL(I) = 6 248 : IMELEM(I) = MELTFA 249 : ELSEIF (NTYPE .EQ. 25) THEN 250 : NBFACEL(I) = 5 251 : IMELEM(I) = MELTFA 252 : ELSEIF (NTYPE .EQ. 23) THEN 253 : NBFACEL(I) = 4 254 : IMELEM(I) = MELTFA 255 : ELSEIF (NTYPE .EQ. 9) THEN 256 : NBFACEL(I) = 5 257 : IMELEM(I) = MELTFA 258 : ENDIF 259 : c SEGDES MELTFA 260 : ENDDO 261 : ELSEIF (NBSO.EQ.2) THEN 262 : IPT1 = MELTFA.LISOUS(1) 263 : SEGACT IPT1 264 : IPT2 = MELTFA.LISOUS(2) 265 : SEGACT IPT2 266 : DO I = 1,K5 267 : N1 = IPT1.NUM(/2) 268 : IF (I.LE.N1) THEN 269 : NTYPE = IPT1.ITYPEL 270 : IF (NTYPE .EQ. 16) THEN 271 : NBFACEL(I) = 6 272 : IMELEM(I) = IPT1 273 : ELSEIF (NTYPE .EQ. 25) THEN 274 : NBFACEL(I) = 5 275 : IMELEM(I) = IPT1 276 : ELSEIF (NTYPE .EQ. 23) THEN 277 : NBFACEL(I) = 4 278 : IMELEM(I) = IPT1 279 : ELSEIF (NTYPE .EQ. 9) THEN 280 : NBFACEL(I) = 5 281 : IMELEM(I) = IPT1 282 : ENDIF 283 : ELSE 284 : NTYPE = IPT2.ITYPEL 285 : IF (NTYPE .EQ. 16) THEN 286 : NBFACEL(I) = 6 287 : IMELEM(I) = IPT2 288 : ELSEIF (NTYPE .EQ. 25) THEN 289 : NBFACEL(I) = 5 290 : IMELEM(I) = IPT2 291 : ELSEIF (NTYPE .EQ. 23) THEN 292 : NBFACEL(I) = 4 293 : IMELEM(I) = IPT2 294 : ELSEIF (NTYPE .EQ. 9) THEN 295 : NBFACEL(I) = 5 296 : IMELEM(I) = IPT2 297 : ENDIF 298 : ENDIF 299 : ENDDO 300 : ELSEIF (NBSO.EQ.3) THEN 301 : IPT1 = MELTFA.LISOUS(1) 302 : SEGACT IPT1 303 : NTYPE = IPT1.ITYPEL 304 : c WRITE(6,*) 'NTYPE= ',IPT1.ITYPEL 305 : IPT2 = MELTFA.LISOUS(2) 306 : SEGACT IPT2 307 : NTYPE = IPT2.ITYPEL 308 : c WRITE(6,*) 'NTYPE= ',IPT2.ITYPEL 309 : IPT3 = MELTFA.LISOUS(3) 310 : SEGACT IPT3 311 : NTYPE = IPT3.ITYPEL 312 : c WRITE(6,*) 'NTYPE= ',IPT3.ITYPEL 313 : N1 = IPT1.NUM(/2) 314 : N2 = IPT2.NUM(/2) 315 : N3 = IPT3.NUM(/2) 316 : DO I = 1,K5 317 : IF (I.LE.N1) THEN 318 : NTYPE = IPT1.ITYPEL 319 : IF (NTYPE .EQ. 16) THEN 320 : NBFACEL(I) = 6 321 : IMELEM(I) = IPT1 322 : ELSEIF (NTYPE .EQ. 25) THEN 323 : NBFACEL(I) = 5 324 : IMELEM(I) = IPT1 325 : ELSEIF (NTYPE .EQ. 23) THEN 326 : NBFACEL(I) = 4 327 : IMELEM(I) = IPT1 328 : ELSEIF (NTYPE .EQ. 9) THEN 329 : NBFACEL(I) = 5 330 : IMELEM(I) = IPT1 331 : ENDIF 332 : ELSEIF (I.LE.(N1+N2)) THEN 333 : NTYPE = IPT2.ITYPEL 334 : IF (NTYPE .EQ. 16) THEN 335 : NBFACEL(I) = 6 336 : IMELEM(I) = IPT2 337 : ELSEIF (NTYPE .EQ. 25) THEN 338 : NBFACEL(I) = 5 339 : IMELEM(I) = IPT2 340 : ELSEIF (NTYPE .EQ. 23) THEN 341 : NBFACEL(I) = 4 342 : IMELEM(I) = IPT2 343 : ELSEIF (NTYPE .EQ. 9) THEN 344 : NBFACEL(I) = 5 345 : IMELEM(I) = IPT2 346 : ENDIF 347 : ELSE 348 : NTYPE = IPT3.ITYPEL 349 : IF (NTYPE .EQ. 16) THEN 350 : NBFACEL(I) = 6 351 : IMELEM(I) = IPT3 352 : ELSEIF (NTYPE .EQ. 25) THEN 353 : NBFACEL(I) = 5 354 : IMELEM(I) = IPT3 355 : ELSEIF (NTYPE .EQ. 23) THEN 356 : NBFACEL(I) = 4 357 : IMELEM(I) = IPT3 358 : ELSEIF (NTYPE .EQ. 9) THEN 359 : NBFACEL(I) = 5 360 : IMELEM(I) = IPT3 361 : ENDIF 362 : ENDIF 363 : ENDDO 364 : ELSEIF (NBSO.EQ.4) THEN 365 : IPT1 = MELTFA.LISOUS(1) 366 : SEGACT IPT1 367 : NTYPE = IPT1.ITYPEL 368 : c WRITE(6,*) 'NTYPE= ',IPT1.ITYPEL 369 : IPT2 = MELTFA.LISOUS(2) 370 : SEGACT IPT2 371 : NTYPE = IPT2.ITYPEL 372 : c WRITE(6,*) 'NTYPE= ',IPT2.ITYPEL 373 : IPT3 = MELTFA.LISOUS(3) 374 : SEGACT IPT3 375 : NTYPE = IPT3.ITYPEL 376 : c WRITE(6,*) 'NTYPE= ',IPT3.ITYPEL 377 : IPT4 = MELTFA.LISOUS(4) 378 : SEGACT IPT4 379 : NTYPE = IPT4.ITYPEL 380 : c WRITE(6,*) 'NTYPE= ',IPT4.ITYPEL 381 : N1 = IPT1.NUM(/2) 382 : N2 = IPT2.NUM(/2) 383 : N3 = IPT3.NUM(/2) 384 : N4 = IPT4.NUM(/2) 385 : DO I = 1,K5 386 : IF (I.LE.N1) THEN 387 : NTYPE = IPT1.ITYPEL 388 : IF (NTYPE .EQ. 16) THEN 389 : NBFACEL(I) = 6 390 : IMELEM(I) = IPT1 391 : ELSEIF (NTYPE .EQ. 25) THEN 392 : NBFACEL(I) = 5 393 : IMELEM(I) = IPT1 394 : ELSEIF (NTYPE .EQ. 23) THEN 395 : NBFACEL(I) = 4 396 : IMELEM(I) = IPT1 397 : ELSEIF (NTYPE .EQ. 9) THEN 398 : NBFACEL(I) = 5 399 : IMELEM(I) = IPT1 400 : ENDIF 401 : ELSEIF (I.LE.(N1+N2)) THEN 402 : NTYPE = IPT2.ITYPEL 403 : IF (NTYPE .EQ. 16) THEN 404 : NBFACEL(I) = 6 405 : IMELEM(I) = IPT2 406 : ELSEIF (NTYPE .EQ. 25) THEN 407 : NBFACEL(I) = 5 408 : IMELEM(I) = IPT2 409 : ELSEIF (NTYPE .EQ. 23) THEN 410 : NBFACEL(I) = 4 411 : IMELEM(I) = IPT2 412 : ELSEIF (NTYPE .EQ. 9) THEN 413 : NBFACEL(I) = 5 414 : IMELEM(I) = IPT2 415 : ENDIF 416 : ELSEIF (I.LE.(N1+N2+N3)) THEN 417 : NTYPE = IPT3.ITYPEL 418 : IF (NTYPE .EQ. 16) THEN 419 : NBFACEL(I) = 6 420 : IMELEM(I) = IPT3 421 : ELSEIF (NTYPE .EQ. 25) THEN 422 : NBFACEL(I) = 5 423 : IMELEM(I) = IPT3 424 : ELSEIF (NTYPE .EQ. 23) THEN 425 : NBFACEL(I) = 4 426 : IMELEM(I) = IPT3 427 : ELSEIF (NTYPE .EQ. 9) THEN 428 : NBFACEL(I) = 5 429 : IMELEM(I) = IPT3 430 : ENDIF 431 : ELSE 432 : NTYPE = IPT4.ITYPEL 433 : IF (NTYPE .EQ. 16) THEN 434 : NBFACEL(I) = 6 435 : IMELEM(I) = IPT4 436 : ELSEIF (NTYPE .EQ. 25) THEN 437 : NBFACEL(I) = 5 438 : IMELEM(I) = IPT4 439 : ELSEIF (NTYPE .EQ. 23) THEN 440 : NBFACEL(I) = 4 441 : IMELEM(I) = IPT4 442 : ELSEIF (NTYPE .EQ. 9) THEN 443 : NBFACEL(I) = 5 444 : IMELEM(I) = IPT4 445 : ENDIF 446 : ENDIF 447 : ENDDO 448 : ENDIF 449 : 450 : C ON EST ICI CORRIGER K5 451 : 452 : MLEFA2 = MLEFA 452 : CALL KRIPAD(MELEFA,MLEFA2) 453 : c CAS OU LES FACES SONT DES TRIANGLES OU DES FACES 454 : NFAI1 = 0 455 : NBSOF = MAX(1,MELEFP.LISOUS(/1)) 456 : c WRITE(6,*) 'NBSO FACE= ',NBSOF 457 : IELTFA = MELTFA 458 : IF (NBSOF.EQ.1) THEN 459 : K6 = MELEFP.NUM(/2) 460 : ELSEIF (NBSOF.EQ.2) THEN 461 : IPT5 = MELEFP.LISOUS(1) 462 : SEGACT IPT5 463 : N1 = IPT5.NUM(/2) 464 : NFAI1 = N1 465 : SEGDES IPT5 466 : IPT6 = MELEFP.LISOUS(2) 467 : SEGACT IPT6 468 : N2 = IPT6.NUM(/2) 469 : NFAI2 = N2 470 : SEGDES IPT6 471 : K6 = N1 + N2 472 : ENDIF 473 : c WRITE(6,*) 'K6= ',K6 474 : 475 : SEGINI NBCOT 476 : c WRITE(6,*) 'POINT1' 477 : C ON EST ICI 478 : IF (NBSOF.EQ.1) THEN 479 : DO I = 1,K6 480 : NTYPE = MELEFP.ITYPEL 481 : c WRITE(6,*) 'NTYPE= ',NTYPE 482 : IF (NTYPE .EQ. 5) THEN 483 : NBCOTE(I) = 3 484 : IMECOTE(I) = MELEFP 485 : ELSE 486 : NBCOTE(I) = 4 487 : IMECOTE(I) = MELEFP 488 : ENDIF 489 : c SEGDES MELTFA 490 : ENDDO 491 : ELSEIF (NBSOF.EQ.2) THEN 492 : c WRITE(6,*) 'POINT2' 493 : IPT5 = MELEFP.LISOUS(1) 494 : SEGACT IPT5 495 : IPT6 = MELEFP.LISOUS(2) 496 : SEGACT IPT6 497 : c WRITE(6,*) 'IPT5= ',IPT5.ITYPEL 498 : c WRITE(6,*) 'IPT6= ',IPT6.ITYPEL 499 : DO I = 1,K6 500 : N1 = IPT5.NUM(/2) 501 : C MISE A JOUR DE MLEFA.LECT 502 : IF (I.LE.N1) THEN 503 : N0 = IPT5.NUM(/1) 504 : NGFAUX = IPT5.NUM(N0,I) 505 : MLEFA2.LECT(NGFAUX) = I 506 : c WRITE(6,*) 'NGFAUX = ',NGFAUX, 507 : c & 'MLEFA2=',MLEFA2.LECT(NGFAUX) 508 : IF (IPT5.ITYPEL .EQ. 5) THEN 509 : NBCOTE(I) = 3 510 : IMECOTE(I) = IPT5 511 : ELSE 512 : NBCOTE(I) = 4 513 : IMECOTE(I) = IPT5 514 : ENDIF 515 : c SEGDES IPT5 516 : ELSE 517 : N0 = IPT6.NUM(/1) 518 : NGFAUX = IPT6.NUM(N0,I-NFAI1) 519 : MLEFA2.LECT(NGFAUX) = I 520 : c WRITE(6,*) 'NGFAUX = ',NGFAUX, 521 : c & 'MLEFA2=',MLEFA2.LECT(NGFAUX) 522 : IF (IPT6.ITYPEL .EQ. 5) THEN 523 : NBCOTE(I) = 3 524 : IMECOTE(I) = IPT6 525 : ELSE 526 : NBCOTE(I) = 4 527 : IMECOTE(I) = IPT6 528 : ENDIF 529 : c SEGDES IPT6 530 : ENDIF 531 : c WRITE(6,*) 'I= ',I 532 : c WRITE(6,*) 'NBCOTE= ',NBCOTE(I) 533 : c WRITE(6,*) 'IMECOTE= ',IMECOTE(I) 534 : 535 : ENDDO 536 : ENDIF 537 : C IL FAUDRA EGALEMENT CREER DES POINTEUR POUR LES FACES DE CHAQUE ELEMENT 538 : C EXEMPLE LES PRISMES 539 : 540 : C SEGMENT SERVANT A UN PRECALCUL DE NBMAX 541 : c WRITE(6,*) 'NSOMM= ',NSOMM 542 : K3 = NSOMM 543 : SEGINI INDLI 544 : SEGINI TAB 545 : DO I = 1,K3 546 : INDLI.ID(I) = 0 547 : TAB.ID(I) = 0 548 : ENDDO 549 : 550 : NFAC=MELEFL.NUM(/2) 551 : NBMAX = 0 552 : 553 : C PRECALCUL DE NBMAX 554 : DO NLCF= 1, NFAC, 1 555 : c WRITE(6,*) 'NLCF= ',NLCF 556 : NGCF=MELEFL.NUM(2,NLCF) 557 : NGCG=MELEFL.NUM(1,NLCF) 558 : NGCD=MELEFL.NUM(3,NLCF) 559 : NLCG=MLECEN.LECT(NGCG) 560 : NLCD=MLECEN.LECT(NGCD) 561 : c NFAUX = MELEFA.NUM(NLCF,1) 562 : c WRITE(6,*) 'NFAUX= ',NFAUX 563 : c 564 : c NGFAUX = MELEFA.NUM(NLCF,1) 565 : c WRITE(6,*) 'NGFAUX = ',NGFAUX, 566 : c & 'MLEFA2=',MLEFA2.LECT(NGFAUX) 567 : c NBNO = MELEFP.NUM(/1) - 1 568 : NBNO = NBCOTE(NLCF) 569 : c WRITE(6,*) 'NLCF= ',NLCF 570 : c WRITE(6,*) 'NBNO= ',NBNO 571 : MELEFP = IMECOTE(NLCF) 572 : IF (NLCF.GT.NFAI1) THEN 573 : NLCFAUX = NLCF - NFAI1 574 : ELSE 575 : NLCFAUX = NLCF 576 : ENDIF 577 : DO IA = 1,NBNO 578 : NGS1=MELEFP.NUM(IA,NLCFAUX) 579 : NLS1=MLESOM.LECT(NGS1) 580 : NLS1=MLESOM.LECT(NGS1) 581 : INDLI.ID(NLS1) = INDLI.ID(NLS1) + 1 582 : NBMAX = MAX(NBMAX,INDLI.ID(NLS1)) 583 : ENDDO 584 : 585 : 586 : ENDDO 587 : 588 : 589 : 590 : SEGSUP INDLI 591 : SEGSUP TAB 592 : 593 : c NBMAX = 6 594 : NBMAX = NBMAX +1 595 : c WRITE(6,*) 'DANS NORV1 NBMAX= ',NBMAX 596 : c WRITE(6,*) 'NBSOM= ',NSOMM 597 : 598 : 599 : 600 : 601 : C ON CONNAIT NBMAX, ON PEUT INITIALISER LES SEGMENTS DE TRAVAIL 602 : c INITIALISATION DES MATRICES 603 : c NBMAX = 10 604 : K3 = NSOMM 605 : SEGINI INDLI 606 : SEGINI TAB 607 : DO I = 1,K3 608 : INDLI.ID(I) = 0 609 : TAB.ID(I) = 0 610 : ENDDO 611 : 612 : K1 = NBMAX 613 : K2 = NSOMM 614 : SEGINI IND2 615 : SEGINI IND 616 : SEGINI IND22 617 : SEGINI VAL1 618 : SEGINI VAL2 619 : SEGINI SCMB 620 : 621 : * K1 = NBMAX 622 : * K2 = (NBMAX+1) 623 : 624 : C INITIALISATION DU POINTEUR MATRICE2 625 : K3 = NSOMM 626 : SEGINI IPO2 627 : DO I = 1,K3 628 : K1 = NBMAX 629 : K2 = NBMAX + 1 630 : SEGINI MATR1 631 : IPO2.POINT(I) = MATR1 632 : SEGDES MATR1 633 : ENDDO 634 : 635 : 636 : 637 : 638 : c DO I = 1,K3 639 : c MATR1 = IPO2.POINT(I) 640 : c SEGACT MATR1 *MOD 641 : c MATR1.MAT2(1,1) = 4.D0 642 : c MATR1.MAT2(2,2) = 3.D0 643 : c WRITE(6,*) 'MATR1=', MATR1.MAT2(1,1) 644 : c WRITE(6,*) 'MATR1=', MATR1.MAT2(2,2) 645 : c SEGDES MATR1 646 : c ENDDO 647 : 648 : 649 : 650 : 651 : NFAC=MELEFL.NUM(/2) 652 : 653 : c WRITE(6,*) 'NFAC= ',NFAC 654 : NAUX1 = 0 655 : DO NLCF= 1, NFAC, 1 656 : INDICE = 0 657 : 658 : c ON TIENT COMPTE DU CHANGEMENT DE NUMEROTATION 659 : NGCF=MELEFL.NUM(2,NLCF) 660 : 661 : NGCG=MELEFL.NUM(1,NLCF) 662 : NGCD=MELEFL.NUM(3,NLCF) 663 : NLCG=MLECEN.LECT(NGCG) 664 : NLCD=MLECEN.LECT(NGCD) 665 : 666 : 667 : 668 : 669 : SCNX=MPONOR.VPOCHA(NLCF,1) 670 : SCNY=MPONOR.VPOCHA(NLCF,2) 671 : SCNZ=MPONOR.VPOCHA(NLCF,3) 672 : SCN1X = SCNX 673 : SCN1Y = SCNY 674 : SCN1Z = SCNZ 675 : 676 : 677 : C 4=IDIM+1 678 : ICELL=(4*(NGCG -1))+1 679 : XG=MCOORD.XCOOR(ICELL) 680 : YG=MCOORD.XCOOR(ICELL+1) 681 : ZG=MCOORD.XCOOR(ICELL+2) 682 : ICELL=(4*(NGCD -1))+1 683 : XD=MCOORD.XCOOR(ICELL) 684 : YD=MCOORD.XCOOR(ICELL+1) 685 : ZD=MCOORD.XCOOR(ICELL+2) 686 : ICELL=(4*(NGCF -1))+1 687 : XF=MCOORD.XCOOR(ICELL) 688 : YF=MCOORD.XCOOR(ICELL+1) 689 : ZF=MCOORD.XCOOR(ICELL+2) 690 : 691 : C MISE A ZERO DE NLOC 692 : DO JA=1,4 693 : DO IA=1,3 694 : NLOCFG(IA,JA) = 0 695 : NLOCFD(IA,JA) = 0 696 : ENDDO 697 : ENDDO 698 : 699 : MELTFA = IMELEM(NLCG) 700 : NBF = NBFACEL(NLCG) 701 : IF (NLCG.LE.NMAI1) THEN 702 : NGAUX = NLCG 703 : ELSEIF ((NLCG.GT.NMAI1).AND.(NLCG.LE.(NMAI1+NMAI2))) THEN 704 : NGAUX = NLCG - NMAI1 705 : ELSEIF ((NLCG.GT.(NMAI1+NMAI2)).AND. 706 : & (NLCG.LE.(NMAI1+NMAI2+NMAI3))) THEN 707 : NGAUX = NLCG - (NMAI1+NMAI2) 708 : ELSEIF (NLCG.GT.(NMAI1+NMAI2+NMAI3)) THEN 709 : NGAUX = NLCG - (NMAI1+NMAI2+NMAI3) 710 : ENDIF 711 : c WRITE(6,*) 'NLCG= ',NLCG 712 : c WRITE(6,*) 'NBF= ',NBF 713 : c WRITE(6,*) 'NTYPE= ',MELTFA.ITYPEL 714 : c WRITE(6,*) 'MELTFA= ',MELTFA 715 : c WRITE(6,*) 'DIMENSION1 ',MELTFA.NUM(/1) 716 : c WRITE(6,*) 'DIMENSION2 ',MELTFA.NUM(/2) 717 : c WRITE(6,*) 'NGAUX ',MELTFA.NUM(/2) 718 : 719 : c SEGACT MELTFA 720 : 721 : C ON REPERE LES VECTEURS PRINCIPAUX DE LA BASE 722 : NLCF1 = MLEFA2.LECT(NGCF) 723 : NBNO = NBCOTE(NLCF1) 724 : MELEFP = IMECOTE(NLCF1) 725 : IF (NLCF1.GT.NFAI1) THEN 726 : NLCF1AUX = NLCF1 - NFAI1 727 : ELSE 728 : NLCF1AUX = NLCF1 729 : ENDIF 730 : 731 : DO JA = 1,NBNO 732 : NGS(JA) = MELEFP.NUM(JA,NLCF1AUX) 733 : c IF (NLCF.EQ.14) then 734 : c WRITE(6,*) 'NGAUX= ',NGAUX,'JA= ',JA,'NGS= ',NGS(JA) 735 : c WRITE(6,*) 'NGCF= ',NGCF,'NLCF= ',NLCF 736 : c ENDIF 737 : 738 : ICOUR = 0 739 : DO J = 1,NBF 740 : N1 = MELTFA.NUM(J,NGAUX) 741 : NL1 = MLEFA2.LECT(N1) 742 : NBNO2 = NBCOTE(NL1) 743 : MELEP2 = IMECOTE(NL1) 744 : IF (NL1.GT.NFAI1) THEN 745 : NL1AUX = NL1 - NFAI1 746 : ELSE 747 : NL1AUX = NL1 748 : ENDIF 749 : c IF (NLCF.EQ.14) then 750 : c WRITE(6,*) 'N1= ',N1,'NL1= ',NL1,'NL1AUX= ',NL1AUX 751 : c ENDIF 752 : 753 : 754 : DO IA =1,NBNO2 755 : NSOM1 = MELEP2.NUM(IA,NL1AUX) 756 : c IF (NLCF.EQ.14) then 757 : c WRITE(6,*) 'NBNO2= ',NBNO2,'IA= ',IA,'NSOM1= ',NSOM1 758 : c ENDIF 759 : IF (NSOM1.EQ.NGS(JA)) THEN 760 : 761 : ICELL=(4*(N1 -1))+1 762 : XF=MCOORD.XCOOR(ICELL) 763 : YF=MCOORD.XCOOR(ICELL+1) 764 : ZF=MCOORD.XCOOR(ICELL+2) 765 : 766 : ICOUR = ICOUR + 1 767 : VECXG(ICOUR,JA) = (XF - XG) 768 : VECYG(ICOUR,JA) = (YF - YG) 769 : VECZG(ICOUR,JA) = (ZF - ZG) 770 : NLOCFG(ICOUR,JA) = N1 771 : C ON PERMUTE 772 : C ICI 773 : 774 : IF (N1.EQ.NGCF) THEN 775 : NAUX = NLOCFG(1,JA) 776 : VXAU = VECXG(1,JA) 777 : VYAU = VECYG(1,JA) 778 : VZAU = VECZG(1,JA) 779 : VECXG(1,JA) = (XF - XG) 780 : VECYG(1,JA) = (YF - YG) 781 : VECZG(1,JA) = (ZF - ZG) 782 : NLOCFG(1,JA) = N1 783 : VECXG(ICOUR,JA) = VXAU 784 : VECYG(ICOUR,JA) = VYAU 785 : VECZG(ICOUR,JA) = VZAU 786 : NLOCFG(ICOUR,JA) = NAUX 787 : ENDIF 788 : ENDIF 789 : ENDDO 790 : ENDDO 791 : c IF (NLCF.EQ.14) THEN 792 : c WRITE(6,*) 'JA= ',JA 793 : c WRITE(6,*) 'ICOUR= ',ICOUR 794 : c ENDIF 795 : ENDDO 796 : 797 : 798 : MELTFA = IMELEM(NLCD) 799 : NBF = NBFACEL(NLCD) 800 : c WRITE(6,*) 'NLCD= ',NLCD 801 : c WRITE(6,*) 'NBF= ',NBF 802 : c WRITE(6,*) 'NTYPE= ',MELTFA.ITYPEL 803 : 804 : IF (NLCD.LE.NMAI1) THEN 805 : NDAUX = NLCD 806 : ELSEIF ((NLCD.GT.NMAI1).AND.(NLCD.LE.(NMAI1+NMAI2))) THEN 807 : NDAUX = NLCD - NMAI1 808 : ELSEIF ((NLCD.GT.(NMAI1+NMAI2)).AND. 809 : & (NLCD.LE.(NMAI1+NMAI2+NMAI3))) THEN 810 : NDAUX = NLCD - (NMAI1+NMAI2) 811 : ELSEIF (NLCD.GT.(NMAI1+NMAI2+NMAI3)) THEN 812 : NDAUX = NLCD - (NMAI1+NMAI2+NMAI3) 813 : ENDIF 814 : 815 : C ON REPERE LES VECTEURS PRINCIPAUX DE LA BASE 816 : DO JA = 1,NBNO 817 : NGS(JA) = MELEFP.NUM(JA,NLCF1AUX) 818 : c WRITE(6,*) 'NDAUX= ',NDAUX,'JA= ',JA,'NGS= ',NGS(JA) 819 : c WRITE(6,*) 'NGCF= ',NGCF,'NLCF= ',NLCF 820 : ICOUR = 0 821 : DO J = 1,NBF 822 : N1 = MELTFA.NUM(J,NDAUX) 823 : NL1 = MLEFA2.LECT(N1) 824 : c WRITE(6,*) 'N1= ',N1,'NL1= ',NL1 825 : 826 : NBNO2 = NBCOTE(NL1) 827 : MELEP2 = IMECOTE(NL1) 828 : IF (NL1.GT.NFAI1) THEN 829 : NL1AUX = NL1 - NFAI1 830 : ELSE 831 : NL1AUX = NL1 832 : ENDIF 833 : 834 : 835 : DO IA =1,NBNO2 836 : NSOM1 = MELEP2.NUM(IA,NL1AUX) 837 : c WRITE(6,*) 'NBNO2= ',NBNO2,'IA= ',IA,'NSOM1= ',NSOM1 838 : IF (NSOM1.EQ.NGS(JA)) THEN 839 : 840 : ICELL=(4*(N1 -1))+1 841 : XF=MCOORD.XCOOR(ICELL) 842 : YF=MCOORD.XCOOR(ICELL+1) 843 : ZF=MCOORD.XCOOR(ICELL+2) 844 : 845 : ICOUR = ICOUR + 1 846 : VECXD(ICOUR,JA) = (XF - XD) 847 : VECYD(ICOUR,JA) = (YF - YD) 848 : VECZD(ICOUR,JA) = (ZF - ZD) 849 : NLOCFD(ICOUR,JA) = N1 850 : C ON PERMUTE 851 : IF (N1.EQ.NGCF) THEN 852 : NAUX = NLOCFD(1,JA) 853 : VXAU = VECXD(1,JA) 854 : VYAU = VECYD(1,JA) 855 : VZAU = VECZD(1,JA) 856 : VECXD(1,JA) = (XF - XD) 857 : VECYD(1,JA) = (YF - YD) 858 : VECZD(1,JA) = (ZF - ZD) 859 : NLOCFD(1,JA) = N1 860 : VECXD(ICOUR,JA) = VXAU 861 : VECYD(ICOUR,JA) = VYAU 862 : VECZD(ICOUR,JA) = VZAU 863 : NLOCFD(ICOUR,JA) = NAUX 864 : ENDIF 865 : ENDIF 866 : ENDDO 867 : ENDDO 868 : c WRITE(6,*) 'JA= ',JA 869 : c WRITE(6,*) 'ICOUR= ',ICOUR 870 : ENDDO 871 : 872 : CALCUL DES VOLUMES 873 : c DO JA = 1,NBNO 874 : c DO KA=1,ICOUR 875 : c WRITE(6,*)'JA= ',JA,'KA= ',KA 876 : c WRITE(6,*) 'VECG = ',VECXG(KA,JA),VECYG(KA,JA),VECZG(KA,JA) 877 : c WRITE(6,*)'VECD = ',VECXD(KA,JA),VECYD(KA,JA),VECZD(KA,JA) 878 : c ENDDO 879 : c ENDDO 880 : 881 : DO JA = 1,NBNO 882 : 883 : DO KA = 1,ICOUR 884 : C PRODUIT MIXTES 885 : C PRODUIT VECTORIEL 886 : IF (KA.EQ.1) THEN 887 : PSCAGX = (VECYG(2,JA)*VECZG(3,JA)) - 888 : & (VECZG(2,JA)*VECYG(3,JA)) 889 : PSCAGY = (VECZG(2,JA)*VECXG(3,JA)) - 890 : & (VECXG(2,JA)*VECZG(3,JA)) 891 : PSCAGZ = (VECXG(2,JA)*VECYG(3,JA)) - 892 : & (VECYG(2,JA)*VECXG(3,JA)) 893 : VOLUG(JA) = (VECXG(1,JA)* PSCAGX) + 894 : & (VECYG(1,JA)* PSCAGY) + 895 : & (VECZG(1,JA)* PSCAGZ) 896 : SURFAGX(KA) = 0.5D0* PSCAGX 897 : SURFAGY(KA) = 0.5D0* PSCAGY 898 : SURFAGZ(KA) = 0.5D0* PSCAGZ 899 : IF ( VOLUG(JA).GT.0) THEN 900 : SURFAGX(KA) = - SURFAGX(KA) 901 : SURFAGY(KA) = - SURFAGY(KA) 902 : SURFAGZ(KA) = - SURFAGZ(KA) 903 : ENDIF 904 : VOLUG(JA) = 1.D0/6.D0*ABS(VOLUG(JA)) 905 : ENDIF 906 : 907 : IF (KA.EQ.2) THEN 908 : PSCAGX = (VECYG(3,JA)*VECZG(1,JA)) - 909 : & (VECZG(3,JA)*VECYG(1,JA)) 910 : PSCAGY = (VECZG(3,JA)*VECXG(1,JA)) - 911 : & (VECXG(3,JA)*VECZG(1,JA)) 912 : PSCAGZ = (VECXG(3,JA)*VECYG(1,JA)) - 913 : & (VECYG(3,JA)*VECXG(1,JA)) 914 : SURFAGX(KA) = 0.5D0* PSCAGX 915 : SURFAGY(KA) = 0.5D0* PSCAGY 916 : SURFAGY(KA) = 0.5D0* PSCAGY 917 : SURFAGZ(KA) = 0.5D0* PSCAGZ 918 : PSCA = (VECXG(2,JA)* PSCAGX) + (VECYG(2,JA)* PSCAGY) + 919 : & (VECZG(2,JA)* PSCAGZ) 920 : IF ( PSCA.GT.0) THEN 921 : SURFAGX(KA) = - SURFAGX(KA) 922 : SURFAGY(KA) = - SURFAGY(KA) 923 : SURFAGZ(KA) = - SURFAGZ(KA) 924 : ENDIF 925 : ENDIF 926 : 927 : 928 : IF (KA.EQ.3) THEN 929 : PSCAGX = (VECYG(1,JA)*VECZG(2,JA)) - 930 : & (VECZG(1,JA)*VECYG(2,JA)) 931 : PSCAGY = (VECZG(1,JA)*VECXG(2,JA)) - 932 : & (VECXG(1,JA)*VECZG(2,JA)) 933 : PSCAGZ = (VECXG(1,JA)*VECYG(2,JA)) - 934 : & (VECYG(1,JA)*VECXG(2,JA)) 935 : 936 : SURFAGX(KA) = 0.5D0* PSCAGX 937 : SURFAGY(KA) = 0.5D0* PSCAGY 938 : SURFAGZ(KA) = 0.5D0* PSCAGZ 939 : PSCA = (VECXG(3,JA)* PSCAGX) + (VECYG(3,JA)* PSCAGY) + 940 : & (VECZG(3,JA)* PSCAGZ) 941 : IF ( PSCA.GT.0) THEN 942 : SURFAGX(KA) = - SURFAGX(KA) 943 : SURFAGY(KA) = - SURFAGY(KA) 944 : SURFAGZ(KA) = - SURFAGZ(KA) 945 : ENDIF 946 : ENDIF 947 : 948 : c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS1 949 : IF (ICHTE.EQ.0) THEN 950 : COEFG(KA,JA) = ( (SURFAGX(KA)*SCN1X) + (SURFAGY(KA)*SCN1Y) + 951 : & (SURFAGZ(KA)*SCN1Z)) 952 : & / (3.D0*VOLUG(JA)) 953 : 954 : ELSE 955 : C TENSEUR 956 : IF (MPOTEN.VPOCHA(/2) .EQ.6) THEN 957 : K11G = MPOTEN.VPOCHA(NLCG,1) 958 : K22G = MPOTEN.VPOCHA(NLCG,2) 959 : K33G = MPOTEN.VPOCHA(NLCG,3) 960 : K21G = MPOTEN.VPOCHA(NLCG,4) 961 : K31G = MPOTEN.VPOCHA(NLCG,5) 962 : K32G = MPOTEN.VPOCHA(NLCG,6) 963 : ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN 964 : K11G = MPOTEN.VPOCHA(NLCG,1) 965 : K22G = K11G 966 : K33G = K11G 967 : K21G = 0.0D0 968 : K31G = 0.0D0 969 : K32G = 0.0D0 970 : ELSE 971 : WRITE(6,*) 'TENSEUR NON PREVU' 972 : STOP 973 : ENDIF 974 : 975 : PSCAGX = (K11G*SURFAGX(KA)) + (K21G*SURFAGY(KA)) + 976 : & (K31G*SURFAGZ(KA)) 977 : PSCAGY = (K21G*SURFAGX(KA)) + (K22G*SURFAGY(KA)) + 978 : & (K32G*SURFAGZ(KA)) 979 : PSCAGZ = (K31G*SURFAGX(KA)) + (K32G*SURFAGY(KA)) + 980 : & (K33G*SURFAGZ(KA)) 981 : COEFG(KA,JA) = (PSCAGX*SCN1X) + (PSCAGY*SCN1Y) + 982 : & (PSCAGZ*SCN1Z) 983 : COEFG(KA,JA) = COEFG(KA,JA) / (3.D0*VOLUG(JA)) 984 : ENDIF 985 : c WRITE(6,*)'JA = ',JA, 'KA= ',KA,'VOLUG(JA) = ',VOLUG(JA) 986 : c WRITE(6,*)'SURFAG = ',SURFAGX(KA),SURFAGY(KA),SURFAGZ(KA) 987 : c WRITE(6,*)'VEXG = ',VECXG(KA,JA),VECYG(KA,JA),VECZG(KA,JA) 988 : c WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z 989 : ENDDO 990 : c WRITE(6,*) 'JA = ',JA,'VOLUG(JA) = ',VOLUG(JA) 991 : c WRITE(6,*) 'VECG1 = ',VECXG(1,JA),VECYG(1,JA),VECZG(1,JA) 992 : c WRITE(6,*) 'VECG2 = ',VECXG(2,JA),VECYG(2,JA),VECZG(2,JA) 993 : c WRITE(6,*) 'VECG3 = ',VECXG(3,JA),VECYG(3,JA),VECZG(3,JA) 994 : c WRITE(6,*)'NLCF= ',NLCF,'COEFG = ', 995 : c & COEFG(1,JA),COEFG(2,JA),COEFG(3,JA) 996 : c WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z 997 : c WRITE(6,*)'SURFAG = ',SURFAGX(1),SURFAGY(1),SURFAGZ(1) 998 : c WRITE(6,*)'SURFAG = ',SURFAGX(2),SURFAGY(2),SURFAGZ(2) 999 : c WRITE(6,*)'SURFAG = ',SURFAGX(3),SURFAGY(3),SURFAGZ(3) 1000 : 1001 : ENDDO 1002 : CALCUL DES VOLUMES 1003 : 1004 : DO JA = 1,NBNO 1005 : NGS(JA) = MELEFP.NUM(JA,NLCF1AUX) 1006 : NLS(JA)=MLESOM.LECT(NGS(JA)) 1007 : 1008 : DO KA = 1,ICOUR 1009 : C PRODUIT MIXTES 1010 : C PRODUIT VECTORIEL 1011 : IF (KA.EQ.1) THEN 1012 : PSCADX = (VECYD(2,JA)*VECZD(3,JA)) - 1013 : & (VECZD(2,JA)*VECYD(3,JA)) 1014 : PSCADY = (VECZD(2,JA)*VECXD(3,JA)) - 1015 : & (VECXD(2,JA)*VECZD(3,JA)) 1016 : PSCADZ = (VECXD(2,JA)*VECYD(3,JA)) - 1017 : & (VECYD(2,JA)*VECXD(3,JA)) 1018 : VOLUD(JA) = (VECXD(1,JA)* PSCADX) + 1019 : & (VECYD(1,JA)* PSCADY) + 1020 : & (VECZD(1,JA)* PSCADZ) 1021 : SURFADX(KA) = 0.5D0* PSCADX 1022 : SURFADY(KA) = 0.5D0* PSCADY 1023 : SURFADZ(KA) = 0.5D0* PSCADZ 1024 : IF ( VOLUD(JA).GT.0) THEN 1025 : SURFADX(KA) = - SURFADX(KA) 1026 : SURFADY(KA) = - SURFADY(KA) 1027 : SURFADZ(KA) = - SURFADZ(KA) 1028 : ENDIF 1029 : VOLUD(JA) = 1.D0/6.D0*ABS(VOLUD(JA)) 1030 : 1031 : ENDIF 1032 : 1033 : IF (KA.EQ.2) THEN 1034 : PSCADX = (VECYD(3,JA)*VECZD(1,JA)) - 1035 : & (VECZD(3,JA)*VECYD(1,JA)) 1036 : PSCADY = (VECZD(3,JA)*VECXD(1,JA)) - 1037 : & (VECXD(3,JA)*VECZD(1,JA)) 1038 : PSCADZ = (VECXD(3,JA)*VECYD(1,JA)) - 1039 : & (VECYD(3,JA)*VECXD(1,JA)) 1040 : SURFADX(KA) = 0.5D0* PSCADX 1041 : SURFADY(KA) = 0.5D0* PSCADY 1042 : SURFADY(KA) = 0.5D0* PSCADY 1043 : SURFADZ(KA) = 0.5D0* PSCADZ 1044 : PSCA = (VECXD(2,JA)* PSCADX) + (VECYD(2,JA)* PSCADY) + 1045 : & (VECZD(2,JA)* PSCADZ) 1046 : IF ( PSCA.GT.0) THEN 1047 : SURFADX(KA) = - SURFADX(KA) 1048 : SURFADY(KA) = - SURFADY(KA) 1049 : SURFADZ(KA) = - SURFADZ(KA) 1050 : ENDIF 1051 : ENDIF 1052 : 1053 : 1054 : IF (KA.EQ.3) THEN 1055 : PSCADX = (VECYD(1,JA)*VECZD(2,JA)) - 1056 : & (VECZD(1,JA)*VECYD(2,JA)) 1057 : PSCADY = (VECZD(1,JA)*VECXD(2,JA)) - 1058 : & (VECXD(1,JA)*VECZD(2,JA)) 1059 : PSCADZ = (VECXD(1,JA)*VECYD(2,JA)) - 1060 : & (VECYD(1,JA)*VECXD(2,JA)) 1061 : 1062 : SURFADX(KA) = 0.5D0* PSCADX 1063 : SURFADY(KA) = 0.5D0* PSCADY 1064 : SURFADZ(KA) = 0.5D0* PSCADZ 1065 : PSCA = (VECXD(3,JA)* PSCADX) + (VECYD(3,JA)* PSCADY) + 1066 : & (VECZD(3,JA)* PSCADZ) 1067 : IF ( PSCA.GT.0) THEN 1068 : SURFADX(KA) = - SURFADX(KA) 1069 : SURFADY(KA) = - SURFADY(KA) 1070 : SURFADZ(KA) = - SURFADZ(KA) 1071 : ENDIF 1072 : ENDIF 1073 : 1074 : c WRITE(6,*) 'NLCF=',NLCF 1075 : c WRITE(6,*) 'NLCD=',NLCD 1076 : c WRITE(6,*) 'NLCG=',NLCG 1077 : c WRite(6,*) 'AG1=',AG1 1078 : c WRite(6,*) 'AG2=',AG2 1079 : c WRite(6,*) 'AD1=',AD1 1080 : c WRite(6,*) 'AD2=',AD2 1081 : c WRite(6,*) 'PSCAG1=',PSCAG1 1082 : c WRite(6,*) 'PSCAG2=',PSCAG2 1083 : c WRite(6,*) 'PSCAD1=',PSCAD1 1084 : c WRite(6,*) 'PSCAD2=',PSCAD2 1085 : c WRite(6,*) 'COEF1D=',COEF1D 1086 : c WRite(6,*) 'COEF2D=',COEF2D 1087 : c WRite(6,*) 'BETA1GD=',BETA1GD 1088 : c WRite(6,*) 'BETA2GD=',BETA2GD 1089 : c WRite(6,*) 'INDD2=',INDD2 1090 : 1091 : c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS1 1092 : IF (ICHTE.EQ.0) THEN 1093 : COEFD(KA,JA) = ( (SURFADX(KA)*SCN1X) + (SURFADY(KA)*SCN1Y) + 1094 : & (SURFADZ(KA)*SCN1Z)) 1095 : & / (3.D0*VOLUD(JA)) 1096 : 1097 : ELSE 1098 : C TENSEUR 1099 : IF (MPOTEN.VPOCHA(/2) .EQ.6) THEN 1100 : K11D = MPOTEN.VPOCHA(NLCD,1) 1101 : K22D = MPOTEN.VPOCHA(NLCD,2) 1102 : K33D = MPOTEN.VPOCHA(NLCD,3) 1103 : K21D = MPOTEN.VPOCHA(NLCD,4) 1104 : K31D = MPOTEN.VPOCHA(NLCD,5) 1105 : K32D = MPOTEN.VPOCHA(NLCD,6) 1106 : ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN 1107 : K11D = MPOTEN.VPOCHA(NLCD,1) 1108 : K22D = K11D 1109 : K33D = K11D 1110 : K21D = 0.0D0 1111 : K31D = 0.0D0 1112 : K32D = 0.0D0 1113 : ELSE 1114 : WRITE(6,*) 'TENSEUR NON PREVU' 1115 : STOP 1116 : ENDIF 1117 : 1118 : PSCADX = (K11D*SURFADX(KA)) + (K21D*SURFADY(KA)) + 1119 : & (K31D*SURFADZ(KA)) 1120 : PSCADY = (K21D*SURFADX(KA)) + (K22D*SURFADY(KA)) + 1121 : & (K32D*SURFADZ(KA)) 1122 : PSCADZ = (K31D*SURFADX(KA)) + (K32D*SURFADY(KA)) + 1123 : & (K33D*SURFADZ(KA)) 1124 : COEFD(KA,JA) = (PSCADX*SCN1X) + (PSCADY*SCN1Y) 1125 : & + (PSCADZ*SCN1Z) 1126 : COEFD(KA,JA) = COEFD(KA,JA) / (3.D0*VOLUD(JA)) 1127 : ENDIF 1128 : c WRITE(6,*) 'JA = ',JA,'KA= ',KA,'VOLUD(JA) = ',VOLUD(JA) 1129 : c WRITE(6,*)'SURFAD = ',SURFADX(KA),SURFADY(KA),SURFADZ(KA) 1130 : c WRITE(6,*)'VECD = ',VECXD(KA,JA),VECYD(KA,JA),VECZD(KA,JA) 1131 : ENDDO 1132 : 1133 : c WRITE(6,*) 'JA = ',JA,'VOLUD(JA) = ',VOLUD(JA) 1134 : c WRITE(6,*)'VECD1 = ',VECXD(1,JA),VECYD(1,JA),VECZD(1,JA) 1135 : c WRITE(6,*)'VECD3 = ',VECXD(2,JA),VECYD(2,JA),VECZD(2,JA) 1136 : c WRITE(6,*)'VECD3 = ',VECXD(3,JA),VECYD(3,JA),VECZD(3,JA) 1137 : c WRITE(6,*)'NLCF= ',NLCF,'COEFD = ', 1138 : c & COEFD(1,JA),COEFD(2,JA),COEFD(3,JA) 1139 : c WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z 1140 : c WRITE(6,*)'SURFAD = ',SURFADX(1),SURFADY(1),SURFADZ(1) 1141 : c WRITE(6,*)'SURFAD = ',SURFADX(2),SURFADY(2),SURFADZ(2) 1142 : c WRITE(6,*)'SURFAD = ',SURFADX(3),SURFADY(3),SURFADZ(3) 1143 : 1144 : ENDDO 1145 : CALCUL DES VOLUMES 1146 : 1147 : c WRITE(6,*) 'NLCF= ',NLCF 1148 : c WRITE(6,*) 'NGCF= ',NGCF 1149 : c WRITE(6,*) 'KG=', K11G,K22G,K33G,K21G,K31G,K32G 1150 : c WRITE(6,*) 'KD=', K11D,K22D,K33D,K21D,K31D,K32D 1151 : DO JA = 1,NBNO 1152 : 1153 : XX1 = ABS(COEFG(1,JA)) 1154 : XX2 = ABS(COEFD(1,JA)) 1155 : IF ((XX1.LT.1e-8) .OR.(XX2.LT.1E-8)) THEN 1156 : INDICE = 1 1157 : ENDIF 1158 : 1159 : MARQ = 0 1160 : DO I5 = 1,INDLI.ID(NLS(JA)) 1161 : INDAUX = IND2.NUME(I5,NLS(JA)) 1162 : IF (INDAUX.EQ.NGCF) THEN 1163 : MARQ = 1 1164 : IAFF = I5 1165 : GOTO 4 1166 : ENDIF 1167 : ENDDO 1168 : 4 CONTINUE 1169 : 1170 : 1171 : IF (MARQ.EQ.0) THEN 1172 : INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1 1173 : ICOU = INDLI.ID(NLS(JA)) 1174 : IND2.NUME(ICOU,NLS(JA)) = NGCF 1175 : ELSE 1176 : ICOU = IAFF 1177 : ENDIF 1178 : 1179 : 1180 : COEF = COEFG(1,JA)-COEFD(1,JA) 1181 : MATR1 = IPO2.POINT(NLS(JA)) 1182 : c SEGINI MATR1 1183 : SEGACT MATR1 *MOD 1184 : MATR1.MAT2(ICOU,ICOU) = COEF 1185 : 1186 : MARQ = 0 1187 : DO I5 = 1,INDLI.ID(NLS(JA)) 1188 : INDAUX = IND2.NUME(I5,NLS(JA)) 1189 : IF (INDAUX.EQ.NLOCFG(2,JA)) THEN 1190 : MARQ = 1 1191 : IAFF = I5 1192 : GOTO 5 1193 : ENDIF 1194 : ENDDO 1195 : 5 CONTINUE 1196 : 1197 : 1198 : IF (MARQ.EQ.0) THEN 1199 : INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1 1200 : ICOUCO = INDLI.ID(NLS(JA)) 1201 : IND2.NUME(ICOUCO,NLS(JA)) = NLOCFG(2,JA) 1202 : ELSE 1203 : ICOUCO = IAFF 1204 : ENDIF 1205 : ICOUG2 = ICOUCO 1206 : 1207 : 1208 : MATR1.MAT2(ICOU,ICOUCO) = COEFG(2,JA) 1209 : 1210 : MARQ = 0 1211 : DO I5 = 1,INDLI.ID(NLS(JA)) 1212 : INDAUX = IND2.NUME(I5,NLS(JA)) 1213 : IF (INDAUX.EQ.NLOCFG(3,JA)) THEN 1214 : MARQ = 1 1215 : IAFF = I5 1216 : GOTO 6 1217 : ENDIF 1218 : ENDDO 1219 : 6 CONTINUE 1220 : 1221 : 1222 : IF (MARQ.EQ.0) THEN 1223 : INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1 1224 : ICOUCO = INDLI.ID(NLS(JA)) 1225 : IND2.NUME(ICOUCO,NLS(JA)) = NLOCFG(3,JA) 1226 : ELSE 1227 : ICOUCO = IAFF 1228 : ENDIF 1229 : ICOUG3 = ICOUCO 1230 : MATR1.MAT2(ICOU,ICOUCO) = COEFG(3,JA) 1231 : 1232 : 1233 : MARQ = 0 1234 : DO I5 = 1,INDLI.ID(NLS(JA)) 1235 : INDAUX = IND2.NUME(I5,NLS(JA)) 1236 : IF (INDAUX.EQ.NLOCFD(2,JA)) THEN 1237 : MARQ = 1 1238 : IAFF = I5 1239 : GOTO 59 1240 : ENDIF 1241 : ENDDO 1242 : 59 CONTINUE 1243 : 1244 : 1245 : IF (MARQ.EQ.0) THEN 1246 : INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1 1247 : ICOUCO = INDLI.ID(NLS(JA)) 1248 : IND2.NUME(ICOUCO,NLS(JA)) = NLOCFD(2,JA) 1249 : ELSE 1250 : ICOUCO = IAFF 1251 : ENDIF 1252 : ICOUD2 = ICOUCO 1253 : 1254 : 1255 : MATR1.MAT2(ICOU,ICOUCO) = - COEFD(2,JA) 1256 : 1257 : MARQ = 0 1258 : DO I5 = 1,INDLI.ID(NLS(JA)) 1259 : INDAUX = IND2.NUME(I5,NLS(JA)) 1260 : IF (INDAUX.EQ.NLOCFD(3,JA)) THEN 1261 : MARQ = 1 1262 : IAFF = I5 1263 : GOTO 69 1264 : ENDIF 1265 : ENDDO 1266 : 69 CONTINUE 1267 : 1268 : 1269 : IF (MARQ.EQ.0) THEN 1270 : INDLI.ID(NLS(JA)) = INDLI.ID(NLS(JA)) + 1 1271 : ICOUCO = INDLI.ID(NLS(JA)) 1272 : IND2.NUME(ICOUCO,NLS(JA)) = NLOCFD(3,JA) 1273 : ELSE 1274 : ICOUCO = IAFF 1275 : ENDIF 1276 : ICOUD3 = ICOUCO 1277 : MATR1.MAT2(ICOU,ICOUCO) = - COEFD(3,JA) 1278 : 1279 : c ON EST ICI 1280 : 1281 : SCMB.MAT(ICOU,NLS(JA)) = 1282 : & ((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA)) 1283 : & *MPOCHP.VPOCHA(NLCG,1)) - 1284 : & ((COEFD(1,JA)+COEFD(2,JA)+COEFD(3,JA))* 1285 : & MPOCHP.VPOCHA(NLCD,1)) 1286 : c SCMB.MAT(ICOU,NLS(JA)) = COEF* SCMB.MAT(ICOU,NLS(JA)) 1287 : 1288 : 1289 : c NLS1 = NLS(JA) 1290 : c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU, 1291 : c & 'SCMB', SCMB.MAT(ICOU,NLS1), 1292 : c & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU),'COEF= ',COEF, 1293 : c & 'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2), 1294 : c & 'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3), 1295 : c & 'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2), 1296 : c & 'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3) 1297 : * ON EST ICI 1298 : * IL FAUT VERIFIER CE QUI EST AVANT 1299 : 1300 : 1301 : * COEF POUR INVERSER LA MATRICE 1302 : 1303 : * ON CORRIGE ICI 1304 : VAL1.MAT(ICOU,NLS(JA)) = 1305 : & (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA)) 1306 : c VAL1.MAT(ICOU,NLS(JA)) = COEF*VAL1.MAT(ICOU,NLS(JA)) 1307 : VAL2.MAT(ICOU,NLS(JA)) = 1308 : & - (COEFD(1,JA) + COEFD(2,JA) + COEFD(3,JA)) 1309 : c VAL2.MAT(ICOU,NLS(JA)) = COEF*VAL2.MAT(ICOU,NLS(JA)) 1310 : IND.NUME(ICOU,NLS(JA)) = NGCG 1311 : IND22.NUME(ICOU,NLS(JA)) = NGCD 1312 : 1313 : * CONDITION AUX LIMITE DE DIRICICHLET 1314 : IF (NGCG.EQ.NGCD) THEN 1315 : NLFCL=MLENCL.LECT(NGCF) 1316 : IF (NLFCL.GT.0) THEN 1317 : c WRITE(6,*) 'NLCF= ',NLCF 1318 : c WRITE(6,*) 'NGCF= ',NGCF 1319 : c WRITE(6,*) 'VAL=',MPOVCL.VPOCHA(NLFCL,1) 1320 : COEF = MAX(ABS(COEFG(1,JA)),ABS(COEFG(2,JA))) 1321 : COEF = MAX(COEF,ABS(COEFG(3,JA))) 1322 : MATR1.MAT2(ICOU,ICOU) = COEF 1323 : MATR1.MAT2(ICOU,ICOUG2) = 0.0D0 1324 : MATR1.MAT2(ICOU,ICOUG3) = 0.0D0 1325 : MATR1.MAT2(ICOU,ICOUD2) = 0.0D0 1326 : MATR1.MAT2(ICOU,ICOUD3) = 0.0D0 1327 : SCMB.MAT(ICOU,NLS(JA)) = (COEF*MPOVCL.VPOCHA(NLFCL,1)) 1328 : VAL1.MAT(ICOU,NLS(JA)) = 0.D0 1329 : VAL2.MAT(ICOU,NLS(JA)) = COEF 1330 : c ON AJOUTE ICI UN POINT FACE POUR COMPATIBILITE AVEC LAPN 1331 : IND.NUME(ICOU,NLS(JA)) = NGCG 1332 : IND22.NUME(ICOU,NLS(JA)) = NGCF 1333 : ELSE 1334 : NLFNE=MLENNE.LECT(NGCF) 1335 : 1336 : c CONDITION DE FLUX 1337 : IF (NLFNE.GT.0) THEN 1338 : QIMPX = MPOVNE.VPOCHA(NLFNE,1) 1339 : C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE 1340 : QIMPS = (QIMPX) 1341 : c WRITE(6,*) 'NGCF= ',NGCF 1342 : c WRITE(6,*) 'QIMPS= ',QIMPS 1343 : 1344 : COEF = COEFG(1,JA) 1345 : MATR1.MAT2(ICOU,ICOUD2) = 0.0D0 1346 : MATR1.MAT2(ICOU,ICOUD3) = 0.0D0 1347 : MATR1.MAT2(ICOU,ICOU) = COEF 1348 : MATR1.MAT2(ICOU,ICOUG2) = COEFG(2,JA) 1349 : MATR1.MAT2(ICOU,ICOUG3) = COEFG(3,JA) 1350 : 1351 : SCMB.MAT(ICOU,NLS(JA)) = 1352 : & ((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))*MPOCHP.VPOCHA(NLCG,1)) 1353 : & + (QIMPS) 1354 : VAL1.MAT(ICOU,NLS(JA)) = 1355 : & (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA)) 1356 : VAL2.MAT(ICOU,NLS(JA)) = 1.D0 1357 : IND.NUME(ICOU,NLS(JA)) = NGCG 1358 : IND22.NUME(ICOU,NLS(JA)) = NGCF 1359 : NLS1 = NLS(JA) 1360 : c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU, 1361 : c & 'SCMB', SCMB.MAT(ICOU,NLS1) 1362 : c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU, 1363 : c & 'IND= ',IND.NUME(ICOU,NLS1), 1364 : c & 'IND22= ',IND22.NUME(ICOU,NLS1), 1365 : c & 'SCMB', SCMB.MAT(ICOU,NLS1), 1366 : c & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU,NLS1), 1367 : c & 'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2,NLS1), 1368 : c & 'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3,NLS1), 1369 : c & 'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2,NLS1), 1370 : c & 'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3,NLS1) 1371 : 1372 : ELSE 1373 : c CONDITION MIXTE 1374 : NLFMI=MLENMI.LECT(NGCF) 1375 : IF (NLFMI.GT.0) THEN 1376 : XLAMBDA1 = MPOVMI.VPOCHA(NLFMI,1) 1377 : XLAMBDA2 = MPOVMI.VPOCHA(NLFMI,2) 1378 : QIMPX = MPOVMI.VPOCHA(NLFMI,3) 1379 : C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE 1380 : QIMPS = (QIMPX) 1381 : 1382 : c WRITE(6,*) 'NLCF= ',NLCF 1383 : c WRITE(6,*) 'NGCF= ',NGCF 1384 : c WRITE(6,*) 'XLAMBDA1= ',XLAMBDA1,'XLAMBDA2= ',XLAMBDA2 1385 : COEF = COEFG(1,JA) 1386 : c WRITE(6,*) 'COEF= ',COEF 1387 : c WRITE(6,*) 'COEF= ',COEF,'QIMPS= ',QIMPS 1388 : MATR1.MAT2(ICOU,ICOUD2) = 0.0D0 1389 : MATR1.MAT2(ICOU,ICOUD3) = 0.0D0 1390 : MATR1.MAT2(ICOU,ICOU) = (XLAMBDA1*COEF) - 1391 : & (1.D0*XLAMBDA2) 1392 : MATR1.MAT2(ICOU,ICOUG2) = (XLAMBDA1*COEFG(2,JA)) 1393 : MATR1.MAT2(ICOU,ICOUG3) = (XLAMBDA1*COEFG(3,JA)) 1394 : c ON EST ICI 1395 : SCMB.MAT(ICOU,NLS(JA)) = 1396 : & (XLAMBDA1*((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))* 1397 : & MPOCHP.VPOCHA(NLCG,1))) 1398 : & + (1.D0*QIMPS) 1399 : VAL1.MAT(ICOU,NLS(JA)) = XLAMBDA1* 1400 : & (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA)) 1401 : VAL2.MAT(ICOU,NLS(JA)) = 1.D0 1402 : IND.NUME(ICOU,NLS(JA)) = NGCG 1403 : IND22.NUME(ICOU,NLS(JA)) = NGCF 1404 : NLS1 = NLS(JA) 1405 : c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU, 1406 : c & 'IND= ',IND.NUME(ICOU,NLS1), 1407 : c & 'IND22= ',IND22.NUME(ICOU,NLS1), 1408 : c & 'SCMB', SCMB.MAT(ICOU,NLS1), 1409 : c & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU,NLS1), 1410 : c & 'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2,NLS1), 1411 : c & 'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3,NLS1), 1412 : c & 'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2,NLS1), 1413 : c & 'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3,NLS1) 1414 : ELSE 1415 : C PAR DEFAUT FLUX NUL 1416 : QIMPS = 0 1417 : COEF = COEFG(1,JA) 1418 : MATR1.MAT2(ICOU,ICOU) = COEF 1419 : MATR1.MAT2(ICOU,ICOUG2) = COEFG(2,JA) 1420 : MATR1.MAT2(ICOU,ICOUG3) = COEFG(3,JA) 1421 : SCMB.MAT(ICOU,NLS(JA)) = 1422 : & ((COEFG(1,JA)+COEFG(2,JA)+COEFG(3,JA))*MPOCHP.VPOCHA(NLCG,1)) 1423 : VAL1.MAT(ICOU,NLS(JA)) = 1424 : & (COEFG(1,JA) + COEFG(2,JA) + COEFG(3,JA)) 1425 : VAL2.MAT(ICOU,NLS(JA)) = 0.D0 1426 : IND.NUME(ICOU,NLS(JA)) = NGCG 1427 : IND22.NUME(ICOU,NLS(JA)) = NGCD 1428 : ENDIF 1429 : 1430 : ENDIF 1431 : 1432 : ENDIF 1433 : ENDIF 1434 : 1435 : c WRITE(6,*) 'COEF1 = ',COEFGG,'COEF2= ',COEF2,'COEF3= ', 1436 : c & COEF3,'COEF4=',COEF4,'HG=',MPOCHP.VPOCHA(NLCG,1), 1437 : c & 'HD= ',MPOCHP.VPOCHA(NLCD,1) 1438 : 1439 : NAUX1 = MAX(NAUX1,INDLI.ID(NLS(JA))) 1440 : c WRITE(6,*) 'NLCF= ',NLCF,'NAUX1 = ',NAUX1 1441 : c WRITE(6,*) 'NLS= ',NLS(JA),'NGS= ',NGS(JA), 1442 : c & 'INDLI.ID',INDLI.ID(NLS(JA)) 1443 : c WRITE(6,*) 'JA= ',JA 1444 : c WRITE(6,*) 'NLOCFG= ',NLOCFG(1,JA),NLOCFG(2,JA),NLOCFG(3,JA) 1445 : c WRITE(6,*) 'NLOCFD= ',NLOCFD(1,JA),NLOCFD(2,JA),NLOCFD(3,JA) 1446 : c DO I5 = 1,INDLI.ID(NLS(JA)) 1447 : c INDAUX = IND2.NUME(I5,NLS(JA)) 1448 : c WRITE(6,*) 'I5= ','JA= ','NLS= ',NLS(JA), 1449 : c & 'IND2= ',IND2.NUME(I5,NLS(JA)) 1450 : c ENDDO 1451 : 1452 : C ON DESACTIVE (FIN DE LA BOUCLE SUR LES POINTS) 1453 : c SEGDES MATRICE2 1454 : c SEGACT MATRICE2 1455 : NLS1 = NLS(JA) 1456 : IF (ABS(COEF).LT. (-1.D0)) THEN 1457 : NLFCL=MLENCL.LECT(NGCF) 1458 : WRITE(6,*) 'CLIMD = ',NLFCL 1459 : NLFNE=MLENNE.LECT(NGCF) 1460 : WRITE(6,*) 'CLIMN = ',NLFNE 1461 : WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU, 1462 : & 'SCMB', SCMB.MAT(ICOU,NLS1), 1463 : & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU),'COEF= ',COEF, 1464 : & 'ICOUG2= ',ICOUG2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG2), 1465 : & 'ICOUG3= ',ICOUG3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG3), 1466 : & 'ICOUD2= ',ICOUD2,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD2), 1467 : & 'ICOUD3= ',ICOUD3,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD3), 1468 : & 'COEFG1JA', COEFG(1,JA),'COEFD1JA',COEFD(1,JA) 1469 : 1470 : c WRITE(6,*)'JA = ',JA, 'KA= ',KA,'VOLUG(JA) = ',VOLUG(JA) 1471 : c WRITE(6,*)'SURFAG = ',SURFAGX(KA),SURFAGY(KA),SURFAGZ(KA) 1472 : c WRITE(6,*)'VEXG = ',VECXG(KA,JA),VECYG(KA,JA),VECZG(KA,JA) 1473 : WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z 1474 : WRITE(6,*) 'JA = ',JA,'VOLUG(JA) = ',VOLUG(JA) 1475 : WRITE(6,*) 'VECG1 = ',VECXG(1,JA),VECYG(1,JA),VECZG(1,JA) 1476 : WRITE(6,*) 'VECG2 = ',VECXG(2,JA),VECYG(2,JA),VECZG(2,JA) 1477 : WRITE(6,*) 'VECG3 = ',VECXG(3,JA),VECYG(3,JA),VECZG(3,JA) 1478 : WRITE(6,*)'NLCF= ',NLCF,'COEFG = ', 1479 : & COEFG(1,JA),COEFG(2,JA),COEFG(3,JA) 1480 : WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z 1481 : WRITE(6,*)'SURFAG = ',SURFAGX(1),SURFAGY(1),SURFAGZ(1) 1482 : WRITE(6,*)'SURFAG = ',SURFAGX(2),SURFAGY(2),SURFAGZ(2) 1483 : WRITE(6,*)'SURFAG = ',SURFAGX(3),SURFAGY(3),SURFAGZ(3) 1484 : 1485 : WRITE(6,*) 'JA = ',JA,'VOLUD(JA) = ',VOLUD(JA) 1486 : WRITE(6,*)'VECD1 = ',VECXD(1,JA),VECYD(1,JA),VECZD(1,JA) 1487 : WRITE(6,*)'VECD3 = ',VECXD(2,JA),VECYD(2,JA),VECZD(2,JA) 1488 : WRITE(6,*)'VECD3 = ',VECXD(3,JA),VECYD(3,JA),VECZD(3,JA) 1489 : WRITE(6,*)'NLCF= ',NLCF,'COEFD = ', 1490 : & COEFD(1,JA),COEFD(2,JA),COEFD(3,JA) 1491 : WRITE(6,*) 'SCN1X= ',SCN1X,'SCN1Y= ',SCN1Y,'SCN1Z= ',SCN1Z 1492 : WRITE(6,*)'SURFAD = ',SURFADX(1),SURFADY(1),SURFADZ(1) 1493 : WRITE(6,*)'SURFAD = ',SURFADX(2),SURFADY(2),SURFADZ(2) 1494 : WRITE(6,*)'SURFAD = ',SURFADX(3),SURFADY(3),SURFADZ(3) 1495 : WRITE(6,*) 'KG=', K11G,K22G,K33G,K21G,K31G,K32G 1496 : WRITE(6,*) 'KD=', K11D,K22D,K33D,K21D,K31D,K32D 1497 : 1498 : ENDIF 1499 : 1500 : SEGDES MATR1 * MOD 1501 : 1502 : ENDDO 1503 : 1504 : 1505 : 1506 : c IF (INDICE.EQ.1) THEN 1507 : c WRITE(6,*)'NLCF= ',NLCF,'COEFG(1) OU COEFD(1) TRES PETIT' 1508 : c ENDIF 1509 : ENDDO 1510 : 1511 : 1512 : IF (NAUX1.GT.NBMAX) THEN 1513 : WRITE(6,*) 'ERREUR DANS LES PARAMETRES' 1514 : c STOP 1515 : ENDIF 1516 : c DO J= 1,INDLI.ID(NLS1) 1517 : c WRITE(6,*) 'MELVA1=',MELVA1.VELCHE(J,NLCF) 1518 : c WRITE(6,*) 'MELVA2=',MELVA1.VELCHE(J,NLCF) 1519 : c WRITE(6,*) 'MELEME=',MELEME.NUM(J,NLCF) 1520 : c ENDDO 1521 : 1522 : MELTFA = MAUX 1523 : MELEFP = MAUX2 1524 : IF (NBSO.EQ.2) THEN 1525 : SEGDES IPT1 1526 : SEGDES IPT2 1527 : ELSEIF (NBSO.EQ.3) THEN 1528 : SEGDES IPT1 1529 : SEGDES IPT2 1530 : SEGDES IPT3 1531 : ELSEIF (NBSO.EQ.4) THEN 1532 : SEGDES IPT1 1533 : SEGDES IPT2 1534 : SEGDES IPT3 1535 : SEGDES IPT4 1536 : ENDIF 1537 : IF (NBSOF.EQ.2) THEN 1538 : SEGDES IPT5 1539 : SEGDES IPT6 1540 : ENDIF 1541 : 1542 : c MAUX = MELEFP 1543 : c MELEFP = IMECOTE(1) 1544 : c NGCF=MELEFP.NUM(4,1) 1545 : c WRITE(6,*) 'NGCF= ',NGCF 1546 : c MELEFP = MAUX 1547 : 1548 : c DO NLS1=1,NSOMM,1 1549 : c MATR1 = IPO2.POINT(NLS1) 1550 : c SEGACT MATR1 1551 : c 1552 : c DO I=1,INDLI.ID(NLS1) 1553 : c DO J = 1,INDLI.ID(NLS1) 1554 : c WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,MATR1.MAT2(I,J) 1555 : c ENDDO 1556 : c ENDDO 1557 : c ENDDO 1558 : c SEGDES MATR1 1559 : 1560 : 9999 CONTINUE 1561 : RETURN 1562 : END 1563 : 1564 : 1565 : 1566 : 1567 : 1568 : 1569 : 1570 : 1571 : 1572 : 1573 : 1574 : 1575 : 1576 :
© Cast3M 2003 - All rights reserved.
Disclaimer