1 : C NORV2 SOURCE PV 09/03/12 21:29:40 6325 2 : SUBROUTINE NORV2(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR, 3 : & MPOSUR,MELTFA,MLEFA,MPOTEN,MPOCHP,MLENCL, 4 : & MLENNE,MLENMI,MPOVCL, 5 : & MPOVNE,MPOVMI,ICHTE,ICHCL,ICHNE,IPO2,SCMB,INDLI, 6 : & TAB,VAL1,VAL2,IND22,IND2,IND,NBFAC,NSOMM,NBMAX) 7 : 8 : 9 : 10 : C 11 : C************************************************************************ 12 : C 13 : C PROJET : CASTEM 2000 14 : C 15 : C NOM : NORV2 16 : C 17 : C DESCRIPTION : Appelle par NORV1 18 : C 19 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) 20 : C 21 : C AUTEUR : C. LE POTIER, DM2S/SFME/MTMS 22 : C 23 : C************************************************************************ 24 : C 25 : IMPLICIT INTEGER(I-N) 26 : IMPLICIT real*8 (a-h,o-z) 27 : -INC SMLENTI 28 : -INC SMELEME 29 : -INC SMCHPOI 30 : -INC CCOPTIO 31 : -INC SMCOORD 32 : -INC SMLREEL 33 : POINTEUR MELEFL.MELEME, MELEFP.MELEME, MELEFA.MELEME, 34 : & MELTFA.MELEME 35 : POINTEUR MPOSUR.MPOVAL, MPONOR.MPOVAL, 36 : & MPOCHP.MPOVAL, MPOVCL.MPOVAL, MPGSOM.MPOVAL, MPVOSO.MPOVAL, 37 : & MPOGRA.MPOVAL,MPOTEN.MPOVAL,MPOVNE.MPOVAL,MPOVMI.MPOVAL 38 : POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLESOM.MLENTI, 39 : & MLEFA.MLENTI,MLENNE.MLENTI,MLENMI.MLENTI 40 : -INC SMCHAML 41 : INTEGER NBNN,NBREF 42 : 43 : 44 : 45 : C 46 : C**** Variables de COOPTIO 47 : C 48 : C 49 : C**** Variables de COOPTIO 50 : C 51 : c INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 52 : c & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 53 : c & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 54 : c & ,IECHO, IIMPI, IOSPI 55 : c & ,IDIM 56 : C & ,MCOORD 57 : c & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 58 : c & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 59 : c & ,NORINC,NORVAL,NORIND,NORVAD 60 : c & ,NUCROU, IPSAUV 61 : 62 : C**** Variable de SMLENTI, SMCHPOI 63 : C 64 : INTEGER JG, N, NC, NSOUPO, NAT, NBSOUS, NBNO,NBELEM 65 : C 66 : C**** Les includes 67 : C 68 : INTEGER I1,ICOMP,ICOMGR,IGEOM 69 : & ,IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,INORM 70 : & ,ISURF,IMAIL,ICHPO,ICHCL,ICHGRA,ICOEFF 71 : & ,NTOT,NSOMM,NCOMP,NFAC,NCEN 72 : & ,NLCF,NGCF,NGCF1,NGCF2,NGCG,NGCD,NLCG,NLCD,NGS1,NGS2 73 : & ,NLS1,NLS2,NLFCL 74 : & ,ISOUS,IELEM,INOEUD,ICELL 75 : INTEGER ICEN2 76 : REAL*8 SCNX,SCNY,SURF,VOL,VAL,VALX,VALY,XG,XD,XF,XS1,XS2 77 : & ,YG,YD,YF,YS1,YS2,PSCA,XNORM,VECX,VECY,PSCAGX,PSCAGY, 78 : & PSCADX,PSCADY,K11G,K22G,K21G,K11D,K22D,K21D,VXG1,VXG2, 79 : & VXAU,VYAU,VXD1,VXD2,VYG1,VYG2,TRG1,TRG2, 80 : & TRD1,TRD2,TRG,TRD 81 : REAL*8 XLONG,AG1,AG2,AD1,AD2,PSCAG1,PSCAG2,PSCAD1,PSCAD2, 82 : & COEF1,COEF2,COEF3,COEF4,SCN1X,SCN1Y,VX,VY,COEF1X,COEF2X, 83 : & COEF1Y,COEF2Y,CX,CY,ANCX,ANCY,DIFFX,DIFFY,XLONGG,XLONGD 84 : & VALD,VALG,COEF,GX,GY,XMINK11,XMAXK11,XMINK22,XMAXK22, 85 : & QIMPX,QIMPY,QIMPS,XLAMBDA1,XLAMBDA2 86 : 87 : REAL*8 VECXG1(2),VECYG1(2) 88 : REAL*8 VECXG2(2),VECYG2(2) 89 : REAL*8 VECXD1(2),VECYD1(2) 90 : REAL*8 VECXD2(2),VECYD2(2) 91 : REAL*8 EPS 92 : INTEGER ICRIT 93 : CHARACTER*(4) NOMCOM(18) 94 : CHARACTER*8 TYPE 95 : C 96 : DATA NOMCOM /'P1DX','P1DY', 97 : & 'P2DX','P2DY', 98 : & 'P3DX','P3DY', 99 : & 'P4DX','P4DY', 100 : & 'P5DX','P5DY', 101 : & 'P6DX','P6DY', 102 : & 'P7DX','P7DY', 103 : & 'P8DX','P8DY', 104 : & 'P9DX','P9DY'/ 105 : 106 : INTEGER NDIM 107 : SEGMENT MMAT1 108 : REAL*8 PM(NDIM,NDIM),PM1(NDIM,NDIM),XSOL(NDIM) 109 : INTEGER IC(NDIM) 110 : ENDSEGMENT 111 : 112 : INTEGER K1,K2 113 : SEGMENT INDICE 114 : INTEGER NUME(K1,K2) 115 : ENDSEGMENT 116 : POINTEUR IND.INDICE,IND2.INDICE,IND22.INDICE 117 : 118 : SEGMENT MATRICE 119 : REAL*8 MAT(K1,K2) 120 : ENDSEGMENT 121 : POINTEUR VAL1.MATRICE,VAL2.MATRICE,SCMB.MATRICE 122 : 123 : INTEGER K3 124 : SEGMENT POINT2 125 : INTEGER POINT(K3) 126 : ENDSEGMENT 127 : POINTEUR IPO2.POINT2 128 : 129 : SEGMENT MATRICE2 130 : REAL*8 MAT2(K1,K2) 131 : ENDSEGMENT 132 : POINTEUR MATR1.MATRICE2,MATR2.MATRICE2 133 : 134 : SEGMENT INDICE3 135 : INTEGER IND3(K1,K2,K3) 136 : ENDSEGMENT 137 : 138 : 139 : SEGMENT REP 140 : INTEGER ID(K3) 141 : ENDSEGMENT 142 : POINTEUR TAB.REP,INDLI.REP 143 : 144 : INTEGER K5 145 : SEGMENT NBFAC 146 : INTEGER NBFACEL(K5) 147 : INTEGER IMELEM(K5) 148 : ENDSEGMENT 149 : 150 : 151 : c CALCUL DES DIFFERENTS POINTEURS A ACTIVER DANS POUR PLUSIIEURS 152 : c SOUS DOMAINE 153 : 154 : MAUX = MELTFA 155 : NMAI1 = 0 156 : NBSO = MAX(1,MELTFA.LISOUS(/1)) 157 : c WRITE(6,*) 'NBSO= ',NBSO 158 : IELTFA = MELTFA 159 : IF (NBSO.EQ.1) THEN 160 : K5 = MELTFA.NUM(/2) 161 : ELSEIF (NBSO.EQ.2) THEN 162 : IPT1 = MELTFA.LISOUS(1) 163 : SEGACT IPT1 164 : N1 = IPT1.NUM(/2) 165 : NMAI1 = N1 166 : SEGDES IPT1 167 : IPT2 = MELTFA.LISOUS(2) 168 : SEGACT IPT2 169 : N2 = IPT2.NUM(/2) 170 : NMAI2 = N2 171 : SEGDES IPT2 172 : K5 = N1 + N2 173 : ENDIF 174 : 175 : 176 : 177 : IF (NBSO.EQ.1) THEN 178 : DO I = 1,K5 179 : NTYPE = MELTFA.ITYPEL 180 : IF (NTYPE .EQ. 4) THEN 181 : NBFACEL(I) = 3 182 : IMELEM(I) = MELTFA 183 : ELSE 184 : NBFACEL(I) = 4 185 : IMELEM(I) = MELTFA 186 : ENDIF 187 : c SEGDES MELTFA 188 : ENDDO 189 : ELSEIF (NBSO.EQ.2) THEN 190 : IPT1 = MELTFA.LISOUS(1) 191 : SEGACT IPT1 192 : IPT2 = MELTFA.LISOUS(2) 193 : SEGACT IPT2 194 : DO I = 1,K5 195 : N1 = IPT1.NUM(/2) 196 : IF (I.LE.N1) THEN 197 : IF (IPT1.ITYPEL .EQ. 4) THEN 198 : NBFACEL(I) = 3 199 : IMELEM(I) = IPT1 200 : ELSE 201 : NBFACEL(I) = 4 202 : IMELEM(I) = IPT1 203 : ENDIF 204 : c SEGDES IPT1 205 : ELSE 206 : IF (IPT2.ITYPEL .EQ. 4) THEN 207 : NBFACEL(I) = 3 208 : IMELEM(I) = IPT2 209 : ELSE 210 : NBFACEL(I) = 4 211 : IMELEM(I) = IPT2 212 : ENDIF 213 : c SEGDES IPT2 214 : ENDIF 215 : ENDDO 216 : ENDIF 217 : 218 : C SEGMENT SERVANT A UN PRECALCUL DE NBMAX 219 : K3 = NSOMM 220 : SEGINI INDLI 221 : SEGINI TAB 222 : DO I = 1,K3 223 : INDLI.ID(I) = 0 224 : TAB.ID(I) = 0 225 : ENDDO 226 : 227 : NFAC=MELEFL.NUM(/2) 228 : NBMAX = 0 229 : 230 : C PRECALCUL DE NBMAX 231 : DO NLCF= 1, NFAC, 1 232 : c WRITE(6,*) 'NLCF= ',NLCF 233 : NGCF=MELEFL.NUM(2,NLCF) 234 : NGCF1=MELEFA.NUM(1,NLCF) 235 : NGCF2=MELEFP.NUM(3,NLCF) 236 : IF((NGCF.NE.NGCF1) .OR. (NGCF.NE.NGCF2))THEN 237 : WRITE(IOIMP,*) 238 : & 'Il ne faut pas jouer avec la table domaine!' 238 : CALL ERREUR(5) 239 : GOTO 9999 240 : ENDIF 241 : NGCG=MELEFL.NUM(1,NLCF) 242 : NGCD=MELEFL.NUM(3,NLCF) 243 : NLCG=MLECEN.LECT(NGCG) 244 : NLCD=MLECEN.LECT(NGCD) 245 : 246 : NGS1=MELEFP.NUM(1,NLCF) 247 : NGS2=MELEFP.NUM(2,NLCF) 248 : NLS1=MLESOM.LECT(NGS1) 249 : NLS2=MLESOM.LECT(NGS2) 250 : 251 : INDLI.ID(NLS1) = INDLI.ID(NLS1) + 1 252 : NBMAX = MAX(NBMAX,INDLI.ID(NLS1)) 253 : 254 : INDLI.ID(NLS2) = INDLI.ID(NLS2) + 1 255 : NBMAX = MAX(NBMAX,INDLI.ID(NLS2)) 256 : 257 : ENDDO 258 : SEGSUP INDLI 259 : SEGSUP TAB 260 : 261 : 262 : 263 : 264 : C ON CONNAIT NBMAX, ON PEUT INITIALISER LES SEGMENTS DE TRAVAIL 265 : c INITIALISATION DES MATRICES 266 : c NBMAX = 10 267 : c NBMAX = NBMAX + 1 268 : c WRITE(6,*) 'NBMAX= ',NBMAX 269 : K3 = NSOMM 270 : SEGINI INDLI 271 : SEGINI TAB 272 : DO I = 1,K3 273 : INDLI.ID(I) = 0 274 : TAB.ID(I) = 0 275 : ENDDO 276 : 277 : K1 = NBMAX 278 : K2 = NSOMM 279 : SEGINI IND2 280 : SEGINI IND 281 : SEGINI IND22 282 : SEGINI VAL1 283 : SEGINI VAL2 284 : SEGINI SCMB 285 : 286 : C INITIALISATION DU POINTEUR MATRICE2 287 : K3 = NSOMM 288 : SEGINI IPO2 289 : DO I = 1,K3 290 : K1 = NBMAX 291 : K2 = NBMAX + 1 292 : SEGINI MATR1 293 : IPO2.POINT(I) = MATR1 294 : SEGDES MATR1 295 : ENDDO 296 : 297 : NFAC=MELEFL.NUM(/2) 298 : 299 : 300 : DO NLCF= 1, NFAC, 1 301 : c WRITE(6,*) 'NLCF= ',NLCF 302 : NGCF=MELEFL.NUM(2,NLCF) 303 : NGCF1=MELEFA.NUM(1,NLCF) 304 : NGCF2=MELEFP.NUM(3,NLCF) 305 : IF((NGCF.NE.NGCF1) .OR. (NGCF.NE.NGCF2))THEN 306 : WRITE(IOIMP,*) 307 : & 'Il ne faut pas jouer avec la table domaine!' 307 : CALL ERREUR(5) 308 : GOTO 9999 309 : ENDIF 310 : NGCG=MELEFL.NUM(1,NLCF) 311 : NGCD=MELEFL.NUM(3,NLCF) 312 : NLCG=MLECEN.LECT(NGCG) 313 : NLCD=MLECEN.LECT(NGCD) 314 : 315 : NGS1=MELEFP.NUM(1,NLCF) 316 : NGS2=MELEFP.NUM(2,NLCF) 317 : NLS1=MLESOM.LECT(NGS1) 318 : NLS2=MLESOM.LECT(NGS2) 319 : SCNX=MPONOR.VPOCHA(NLCF,1) 320 : SCNY=MPONOR.VPOCHA(NLCF,2) 321 : SCN1X = SCNX 322 : SCN1Y = SCNY 323 : SURF=0.5D0*MPOSUR.VPOCHA(NLCF,1) 324 : SCNX=SCNX*SURF 325 : SCNY=SCNY*SURF 326 : 327 : 328 : C 3=IDIM+1 329 : ICELL=(3*(NGCG -1))+1 330 : XG=MCOORD.XCOOR(ICELL) 331 : YG=MCOORD.XCOOR(ICELL+1) 332 : ICELL=(3*(NGCD -1))+1 333 : XD=MCOORD.XCOOR(ICELL) 334 : YD=MCOORD.XCOOR(ICELL+1) 335 : ICELL=(3*(NGCF -1))+1 336 : XF=MCOORD.XCOOR(ICELL) 337 : YF=MCOORD.XCOOR(ICELL+1) 338 : 339 : ICELL=(3*(NGS1 -1))+1 340 : XS1=MCOORD.XCOOR(ICELL) 341 : YS1=MCOORD.XCOOR(ICELL+1) 342 : ICELL=(3*(NGS2 -1))+1 343 : XS2=MCOORD.XCOOR(ICELL) 344 : YS2=MCOORD.XCOOR(ICELL+1) 345 : 346 : XLONG = (((XS1-XS2)**2) + ((YS1-YS2)**2)) 347 : XLONG = SQRT(XLONG) 348 : 349 : AG1 = 0.0D0 350 : AD1 = 0.0D0 351 : AG2 = 0.0D0 352 : AD2 = 0.0D0 353 : 354 : PSCAG1 = 0.0D0 355 : PSCAG2 = 0.0D0 356 : PSCAD1 = 0.0D0 357 : PSCAD2 = 0.0D0 358 : 359 : IG1 = 1 360 : ID1 = 1 361 : IG2 = 1 362 : ID2 = 1 363 : 364 : 365 : MELTFA = IMELEM(NLCG) 366 : NBF = NBFACEL(NLCG) 367 : 368 : IF (NLCG.GT.NMAI1) THEN 369 : NGAUX = NLCG - NMAI1 370 : ELSE 371 : NGAUX = NLCG 372 : ENDIF 373 : c WRITE(6,*) 'NLCG= ',NLCG 374 : c WRITE(6,*) 'NBF= ',NBFA 375 : c WRITE(6,*) 'MELTFA= ',MELTFA 376 : c WRITE(6,*) 'DIMENSION1 ',MELTFA.NUM(/1) 377 : c WRITE(6,*) 'DIMENSION2 ',MELTFA.NUM(/2) 378 : c WRITE(6,*) 'NGAUX ',MELTFA.NUM(/2) 379 : 380 : c SEGACT MELTFA 381 : DO J = 1,NBF 382 : N1 = MELTFA.NUM(J,NGAUX) 383 : NL1 = MLEFA.LECT(N1) 384 : 385 : NSOM1 = MELEFP.NUM(1,NL1) 386 : NSOM2 = MELEFP.NUM(2,NL1) 387 : 388 : IF ((NSOM1.EQ.NGS1).OR.(NSOM2.EQ.NGS1)) THEN 389 : 390 : ICELL=(3*(N1 -1))+1 391 : XF=MCOORD.XCOOR(ICELL) 392 : YF=MCOORD.XCOOR(ICELL+1) 393 : ICELL=(3*(NGS1 -1))+1 394 : XS1=MCOORD.XCOOR(ICELL) 395 : YS1=MCOORD.XCOOR(ICELL+1) 396 : 397 : 398 : VECXG1(IG1) = -(YF - YG) 399 : VECYG1(IG1) = (XF - XG) 400 : VX = (XG - XS1) 401 : VY = (YG - YS1) 402 : PSCA = (VX*VECXG1(IG1)) + (VY*VECYG1(IG1)) 403 : IF (PSCA.LT.0.0D0) THEN 404 : VECXG1(IG1) = +(YF - YG) 405 : VECYG1(IG1) = -(XF - XG) 406 : ENDIF 407 : 408 : c ON REPERE l'INDICE 409 : IF ((NSOM2.NE.NGS2).AND.(NSOM1.NE.NGS2)) THEN 410 : INDG1 = IG1 411 : NG1 = N1 412 : ENDIF 413 : 414 : 415 : IG1 = IG1 + 1 416 : 417 : c WRITE(6,*) 'NLCF= ',NLCF,'VECXG11= ',VECXG1(1) 418 : c WRITE(6,*) 'NLCF= ',NLCF,'VECYG11= ',VECYG1(1) 419 : c WRITE(6,*) 'NLCF= ',NLCF,'VECXG12= ',VECXG1(2) 420 : c WRITE(6,*) 'NLCF= ',NLCF,'VECYG12= ',VECYG1(2) 421 : c WRITE(6,*) 'NGCF= ',NGCF 422 : c WRITE(6,*) 'N1= ',N1,'XF= ',XF,'YF= ',YF 423 : c WRITE(6,*) 'N1= ',N1,'XG= ',XG,'YG= ',YG 424 : ENDIF 425 : IF ((NSOM1.EQ.NGS2).OR.(NSOM2.EQ.NGS2)) THEN 426 : 427 : ICELL=(3*(N1 -1))+1 428 : XF=MCOORD.XCOOR(ICELL) 429 : YF=MCOORD.XCOOR(ICELL+1) 430 : ICELL=(3*(NGS2 -1))+1 431 : XS2=MCOORD.XCOOR(ICELL) 432 : YS2=MCOORD.XCOOR(ICELL+1) 433 : 434 : VECXG2(IG2) = -(YF - YG) 435 : VECYG2(IG2) = (XF - XG) 436 : VX = (XG - XS2) 437 : VY = (YG - YS2) 438 : PSCA = (VX*VECXG2(IG2)) + (VY*VECYG2(IG2)) 439 : IF (PSCA.LT.0.0D0) THEN 440 : VECXG2(IG2) = +(YF - YG) 441 : VECYG2(IG2) = -(XF - XG) 442 : ENDIF 443 : 444 : IF ((NSOM2.NE.NGS1).AND.(NSOM1.NE.NGS1)) THEN 445 : INDG2 = IG2 446 : NG2 = N1 447 : ENDIF 448 : IG2 = IG2 + 1 449 : 450 : ENDIF 451 : ENDDO 452 : c SEGDES MELTFA 453 : 454 : MELTFA = IMELEM(NLCD) 455 : NBF = NBFACEL(NLCD) 456 : c WRITE(6,*) 'NLCD= ',NLCD 457 : c WRITE(6,*) 'NBF= ',NBF 458 : c WRITE(6,*) 'MELTFA= ',MELTFA 459 : c WRITE(6,*) 'DIMENSION1 ',MELTFA.NUM(/1) 460 : c WRITE(6,*) 'DIMENSION2 ',MELTFA.NUM(/2) 461 : IF (NLCD.GT.NMAI1) THEN 462 : NDAUX = NLCD -NMAI1 463 : ELSE 464 : NDAUX = NLCD 465 : ENDIF 466 : c SEGACT MELTFA 467 : DO J = 1,NBF 468 : N1 = MELTFA.NUM(J,NDAUX) 469 : NL1 = MLEFA.LECT(N1) 470 : 471 : NSOM1 = MELEFP.NUM(1,NL1) 472 : NSOM2 = MELEFP.NUM(2,NL1) 473 : 474 : IF ((NSOM1.EQ.NGS1).OR.(NSOM2.EQ.NGS1)) THEN 475 : 476 : ICELL=(3*(N1 -1))+1 477 : XF=MCOORD.XCOOR(ICELL) 478 : YF=MCOORD.XCOOR(ICELL+1) 479 : ICELL=(3*(NGS1 -1))+1 480 : XS1=MCOORD.XCOOR(ICELL) 481 : YS1=MCOORD.XCOOR(ICELL+1) 482 : 483 : 484 : VECXD1(ID1) = - (YF - YD) 485 : VECYD1(ID1) = (XF - XD) 486 : VX = (XD - XS1) 487 : VY = (YD - YS1) 488 : PSCA = (VX*VECXD1(ID1)) + (VY*VECYD1(ID1)) 489 : IF (PSCA.LT.0.0D0) THEN 490 : VECXD1(ID1) = +(YF - YD) 491 : VECYD1(ID1) = -(XF - XD) 492 : ENDIF 493 : 494 : IF ((NSOM2.NE.NGS2).AND.(NSOM1.NE.NGS2)) THEN 495 : INDD1 = ID1 496 : ND1 = N1 497 : ENDIF 498 : 499 : ID1 = ID1 + 1 500 : 501 : ENDIF 502 : IF ((NSOM1.EQ.NGS2).OR.(NSOM2.EQ.NGS2)) THEN 503 : 504 : ICELL=(3*(N1 -1))+1 505 : XF=MCOORD.XCOOR(ICELL) 506 : YF=MCOORD.XCOOR(ICELL+1) 507 : ICELL=(3*(NGS2 -1))+1 508 : XS2=MCOORD.XCOOR(ICELL) 509 : YS2=MCOORD.XCOOR(ICELL+1) 510 : 511 : 512 : VECXD2(ID2) = - (YF - YD) 513 : VECYD2(ID2) = (XF - XD) 514 : VX = (XD - XS2) 515 : VY = (YD - YS2) 516 : PSCA = (VX*VECXD2(ID2)) + (VY*VECYD2(ID2)) 517 : IF (PSCA.LT.0.0D0) THEN 518 : VECXD2(ID2) = +(YF - YD) 519 : VECYD2(ID2) = -(XF - XD) 520 : ENDIF 521 : 522 : IF ((NSOM2.NE.NGS1).AND.(NSOM1.NE.NGS1)) THEN 523 : INDD2 = ID2 524 : ND2 = N1 525 : ENDIF 526 : ID2 = ID2 + 1 527 : 528 : ENDIF 529 : ENDDO 530 : c SEGDES MELTFA 531 : AG1=0.5D0*ABS( ( (VECXG1(1)*VECYG1(2)) - 532 : & (VECYG1(1))*VECXG1(2)) ) 533 : 534 : AG2=0.5D0*ABS( ( (VECXG2(1)*VECYG2(2)) - 535 : & (VECYG2(1))*VECXG2(2)) ) 536 : 537 : AD1=0.5D0*ABS( ( (VECXD1(1)*VECYD1(2)) - 538 : & (VECYD1(1))*VECXD1(2)) ) 539 : 540 : 541 : AD2=0.5D0*ABS( ( (VECXD2(1)*VECYD2(2)) - 542 : & (VECYD2(1))*VECXD2(2)) ) 543 : 544 : c WRITE(6,*) 'NLCF=',NLCF 545 : c WRITE(6,*) 'NLCD=',NLCD 546 : c WRITE(6,*) 'NLCG=',NLCG 547 : c WRite(6,*) 'AG1=',AG1 548 : c WRite(6,*) 'AG2=',AG2 549 : c WRite(6,*) 'AD1=',AD1 550 : c WRite(6,*) 'AD2=',AD2 551 : c WRITE(6,*) 'NLCF= ',NLCF,'VECXG11= ',VECXG1(1) 552 : c WRITE(6,*) 'NLCF= ',NLCF,'VECYG11= ',VECYG1(1) 553 : c WRITE(6,*) 'NLCF= ',NLCF,'VECXG12= ',VECXG1(2) 554 : c WRITE(6,*) 'NLCF= ',NLCF,'VECYG12= ',VECYG1(2) 555 : c WRite(6,*) 'PSCAG1=',PSCAG1 556 : c WRite(6,*) 'PSCAG2=',PSCAG2 557 : c WRite(6,*) 'PSCAD1=',PSCAD1 558 : c WRite(6,*) 'PSCAD2=',PSCAD2 559 : c WRite(6,*) 'COEF1D=',COEF1D 560 : c WRite(6,*) 'COEF2D=',COEF2D 561 : c WRite(6,*) 'BETA1GD=',BETA1GD 562 : c WRite(6,*) 'BETA2GD=',BETA2GD 563 : c WRite(6,*) 'INDD2=',INDD2 564 : 565 : c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS1 566 : IF (ICHTE.EQ.0) THEN 567 : COEF1 = ( (VECXG1(INDG1)*SCN1X) + (VECYG1(INDG1)*SCN1Y) ) 568 : & / AG1 569 : IAUX = 3 - INDG1 570 : COEF2 = ( (VECXG1(IAUX)*SCN1X) + (VECYG1(IAUX)*SCN1Y) ) 571 : & / AG1 572 : 573 : COEF3 = ( (VECXD1(INDD1)*SCN1X) + (VECYD1(INDD1)*SCN1Y) ) 574 : & / AD1 575 : IAUX = 3 - INDD1 576 : COEF4 = ( (VECXD1(IAUX)*SCN1X) + (VECYD1(IAUX)*SCN1Y) ) 577 : & / AD1 578 : ELSE 579 : c WRITE(6,*) 'NLCG= ',NLCG,'NLCG2= ',NLCG2 580 : c WRITE(6,*) 'NLCD= ',NLCD,'NLCD2= ',NLCD2 581 : IF (MPOTEN.VPOCHA(/2) .EQ.3) THEN 582 : c LE TENSEUR EST ANISOTROPE 583 : K11G = MPOTEN.VPOCHA(NLCG,1) 584 : K22G = MPOTEN.VPOCHA(NLCG,2) 585 : K21G = MPOTEN.VPOCHA(NLCG,3) 586 : 587 : K11D = MPOTEN.VPOCHA(NLCD,1) 588 : K22D = MPOTEN.VPOCHA(NLCD,2) 589 : K21D = MPOTEN.VPOCHA(NLCD,3) 590 : ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN 591 : c LE TENSEUR EST DIAGONAL 592 : K11G = MPOTEN.VPOCHA(NLCG,1) 593 : K22G = K11G 594 : K21G = 0.0D0 595 : K11D = MPOTEN.VPOCHA(NLCD,1) 596 : K22D = K11D 597 : K21D = 0.0D0 598 : ELSE 599 : WRITE(6,*) 'TENSEUR NON PREVU' 600 : STOP 601 : ENDIF 602 : c xmink11 = min(K11G,xmink11) 603 : c xmink11 = min(K11D,xmink11) 604 : c xmaxk11 = max(K11G,xmaxk11) 605 : c xmaxk11 = max(K11D,xmaxk11) 606 : c xmink22 = min(K22G,xmink22) 607 : c xmink22 = min(K22D,xmink22) 608 : c xmaxk22 = max(K22G,xmaxk22) 609 : c xmaxk22 = max(K22D,xmaxk22) 610 : c WRITE(6,*) 'NLCF= ',NLCF 611 : c WRITE(6,*) 'NLCG= ',NLCG, 'NLCD= ',NLCD 612 : c WRite(6,*) 'K11G=',K11G,'K22G= ',K22G,'K21G=',K21G 613 : c WRite(6,*) 'K11D=',K11D,'K22D= ',K22D,'K21D=',K21D 614 : c ON EST ICI 615 : 616 : c PRODUIT TENSEUR VECTEUR 617 : IAUX = 3 - INDD1 618 : XLONGD = (VECXD1(IAUX)*VECXD1(IAUX)) + 619 : & (VECYD1(IAUX)*VECYD1(IAUX)) 620 : XLONGD = XLONGD**0.5 621 : IAUX = 3 - INDG1 622 : XLONGG = (VECXG1(IAUX)*VECXG1(IAUX)) + 623 : & (VECYG1(IAUX)*VECYG1(IAUX)) 624 : XLONGG = XLONGG**0.5 625 : PSCAGX = (K11G*(VECXG1(INDG1)/AG1)) + (K21G*(VECYG1(INDG1)/AG1)) 626 : PSCAGY = (K21G*(VECXG1(INDG1))/AG1) + (K22G*(VECYG1(INDG1)/AG1)) 627 : COEF1 = ( (PSCAGX*SCN1X) + (PSCAGY*SCN1Y) ) 628 : 629 : IAUX = 3 - INDG1 630 : PSCAGX = (K11G*(VECXG1(IAUX)/AG1)) + (K21G*(VECYG1(IAUX)/AG1)) 631 : PSCAGY = (K21G*(VECXG1(IAUX)/AG1)) + (K22G*(VECYG1(IAUX)/AG1)) 632 : COEF2 = ( (PSCAGX*SCN1X) + (PSCAGY*SCN1Y) ) 633 : 634 : PSCADX = (K11D*(VECXD1(INDD1)/AD1)) + (K21D*(VECYD1(INDD1)/AD1)) 635 : PSCADY = (K21D*(VECXD1(INDD1)/AD1)) + (K22D*(VECYD1(INDD1)/AD1)) 636 : COEF3 = ( (PSCADX*SCN1X) + (PSCADY*SCN1Y) ) 637 : 638 : IAUX = 3 - INDD1 639 : PSCADX = (K11D*(VECXD1(IAUX)/AD1)) + (K21D*(VECYD1(IAUX)/AD1)) 640 : PSCADY = (K21D*(VECXD1(IAUX)/AD1)) + (K22D*(VECYD1(IAUX)/AD1)) 641 : COEF4 = ( (PSCADX*SCN1X) + (PSCADY*SCN1Y) ) 642 : 643 : ENDIF 644 : 645 : c WRite(6,*) 'COEF1=',COEF1 646 : c WRite(6,*) 'COEF2=',COEF2 647 : c WRite(6,*) 'COEF3=',COEF3 648 : c WRite(6,*) 'COEF4=',COEF4 649 : 650 : MARQ = 0 651 : DO I5 = 1,INDLI.ID(NLS1) 652 : INDAUX = IND2.NUME(I5,NLS1) 653 : IF (INDAUX.EQ.NGCF) THEN 654 : MARQ = 1 655 : IAFF = I5 656 : GOTO 4 657 : ENDIF 658 : ENDDO 659 : 4 CONTINUE 660 : 661 : 662 : IF (MARQ.EQ.0) THEN 663 : INDLI.ID(NLS1) = INDLI.ID(NLS1) + 1 664 : ICOU = INDLI.ID(NLS1) 665 : IND2.NUME(ICOU,NLS1) = NGCF 666 : ELSE 667 : ICOU = IAFF 668 : ENDIF 669 : 670 : 671 : COEF = (COEF1 - COEF3) 672 : MATR1 = IPO2.POINT(NLS1) 673 : SEGACT MATR1 *MOD 674 : MATR1.MAT2(ICOU,ICOU) = COEF 675 : 676 : MARQ = 0 677 : DO I5 = 1,INDLI.ID(NLS1) 678 : INDAUX = IND2.NUME(I5,NLS1) 679 : IF (INDAUX.EQ.NG1) THEN 680 : MARQ = 1 681 : IAFF = I5 682 : GOTO 5 683 : ENDIF 684 : ENDDO 685 : 5 CONTINUE 686 : 687 : 688 : IF (MARQ.EQ.0) THEN 689 : INDLI.ID(NLS1) = INDLI.ID(NLS1) + 1 690 : ICOUCO = INDLI.ID(NLS1) 691 : IND2.NUME(ICOUCO,NLS1) = NG1 692 : ELSE 693 : ICOUCO = IAFF 694 : ENDIF 695 : ICOUG = ICOUCO 696 : 697 : 698 : MATR1.MAT2(ICOU,ICOUCO) = COEF2 699 : 700 : 701 : MARQ = 0 702 : DO I5 = 1,INDLI.ID(NLS1) 703 : INDAUX = IND2.NUME(I5,NLS1) 704 : IF (INDAUX.EQ.ND1) THEN 705 : MARQ = 1 706 : IAFF = I5 707 : GOTO 6 708 : ENDIF 709 : ENDDO 710 : 6 CONTINUE 711 : 712 : 713 : IF (MARQ.EQ.0) THEN 714 : INDLI.ID(NLS1) = INDLI.ID(NLS1) + 1 715 : ICOUCO = INDLI.ID(NLS1) 716 : IND2.NUME(ICOUCO,NLS1) = ND1 717 : ELSE 718 : ICOUCO = IAFF 719 : ENDIF 720 : ICOUD = ICOUCO 721 : 722 : 723 : 724 : MATR1.MAT2(ICOU,ICOUCO) = -COEF4 725 : 726 : SCMB.MAT(ICOU,NLS1) = 727 : & (((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1)) - 728 : & ((COEF3+COEF4)*MPOCHP.VPOCHA(NLCD,1))) 729 : 730 : 731 : 732 : 733 : * COEF POUR INVERSER LA MATRICE 734 : 735 : * ON CORRIGE ICI 736 : VAL1.MAT(ICOU,NLS1) = (COEF1 + COEF2) 737 : VAL2.MAT(ICOU,NLS1) = - ((COEF3 + COEF4)) 738 : IND.NUME(ICOU,NLS1) = NGCG 739 : IND22.NUME(ICOU,NLS1) = NGCD 740 : 741 : * CONDITION AUX LIMITE DE DIRICICHLET 742 : IF (NGCG.EQ.NGCD) THEN 743 : NLFCL=MLENCL.LECT(NGCF) 744 : IF (NLFCL.GT.0) THEN 745 : COEF = COEF1 746 : MATR1.MAT2(ICOU,ICOU) = COEF 747 : MATR1.MAT2(ICOU,ICOUG) = 0.0D0 748 : MATR1.MAT2(ICOU,ICOUD) = 0.0D0 749 : SCMB.MAT(ICOU,NLS1) = COEF*MPOVCL.VPOCHA(NLFCL,1) 750 : VAL1.MAT(ICOU,NLS1) = COEF 751 : VAL2.MAT(ICOU,NLS1) = 0.0D0 752 : c ON AJOUTE ICI UN POINT FACE POUR COMPATIBILITE AVEC LAPN 753 : IND.NUME(ICOU,NLS1) = NGCF 754 : IND22.NUME(ICOU,NLS1) = NGCD 755 : ELSE 756 : NLFNE=MLENNE.LECT(NGCF) 757 : 758 : c CONDITION DE FLUX 759 : IF (NLFNE.GT.0) THEN 760 : QIMPX = MPOVNE.VPOCHA(NLFNE,1) 761 : C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE 762 : QIMPS = (QIMPX) 763 : 764 : COEF = COEF1 765 : MATR1.MAT2(ICOU,ICOU) = COEF 766 : MATR1.MAT2(ICOU,ICOUG) = COEF2 767 : 768 : SCMB.MAT(ICOU,NLS1) = ( 769 : & ((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1))) + (2.D0*QIMPS) 770 : VAL1.MAT(ICOU,NLS1) = (COEF1 + COEF2) 771 : VAL2.MAT(ICOU,NLS1) = 2.D0 772 : IND.NUME(ICOU,NLS1) = NGCG 773 : IND22.NUME(ICOU,NLS1) = NGCF 774 : 775 : ELSE 776 : c CONDITION MIXTE 777 : NLFMI=MLENMI.LECT(NGCF) 778 : IF (NLFMI.GT.0) THEN 779 : XLAMBDA1 = MPOVMI.VPOCHA(NLFMI,1) 780 : XLAMBDA2 = MPOVMI.VPOCHA(NLFMI,2) 781 : QIMPX = MPOVMI.VPOCHA(NLFMI,3) 782 : C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE 783 : QIMPS = (QIMPX) 784 : 785 : c WRITE(6,*) 'NLCF= ',NLCF 786 : c WRITE(6,*) 'NGCF= ',NGCF 787 : c WRITE(6,*) 'XLAMBDA1= ',XLAMBDA1,'XLAMBDA2= ',XLAMBDA2 788 : c WRITE(6,*) 'QIMPX= ',QIMPX,'QIMPY= ',QIMPY 789 : COEF = COEF1 790 : MATR1.MAT2(ICOU,ICOU) = (XLAMBDA1*COEF) - 791 : & (2.D0*XLAMBDA2) 792 : MATR1.MAT2(ICOU,ICOUG) = (XLAMBDA1*COEF2) 793 : SCMB.MAT(ICOU,NLS1) = 794 : & (XLAMBDA1*((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1))) 795 : & + (2.D0*QIMPS) 796 : VAL1.MAT(ICOU,NLS1) = XLAMBDA1*(COEF1 + COEF2) 797 : VAL2.MAT(ICOU,NLS1) = 2.D0 798 : IND.NUME(ICOU,NLS1) = NGCG 799 : IND22.NUME(ICOU,NLS1) = NGCF 800 : ELSE 801 : C PAR DEFAUT FLUX NUL 802 : QIMPS = 0 803 : COEF = COEF1 804 : MATR1.MAT2(ICOU,ICOU) = COEF 805 : MATR1.MAT2(ICOU,ICOUG) = COEF2 806 : SCMB.MAT(ICOU,NLS1) = 807 : & (((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1))) 808 : VAL1.MAT(ICOU,NLS1) = (COEF1 + COEF2) 809 : VAL2.MAT(ICOU,NLS1) = 0.D0 810 : IND.NUME(ICOU,NLS1) = NGCG 811 : IND22.NUME(ICOU,NLS1) = NGCD 812 : ENDIF 813 : 814 : ENDIF 815 : 816 : ENDIF 817 : ENDIF 818 : 819 : c WRITE(6,*) 'NLS1= ',NLS1,'ICOU=',ICOU, 820 : c & 'IND= ',IND.NUME(ICOU,NLS1), 821 : c & 'IND22= ',IND22.NUME(ICOU,NLS1), 822 : c & 'SCMB', SCMB.MAT(ICOU,NLS1), 823 : c & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU,NLS1), 824 : c & 'ICOUG= ',ICOUG,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG,NLS1), 825 : c & 'ICOUD= ',ICOUD,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD,NLS1) 826 : c WRITE(6,*) 'COEF1 = ',COEF1,'COEF2= ',COEF2,'COEF3= ', 827 : c & COEF3,'COEF4=',COEF4,'HG=',MPOCHP.VPOCHA(NLCG,1), 828 : c & 'HD= ',MPOCHP.VPOCHA(NLCD,1) 829 : 830 : SEGDES MATR1 *MOD 831 : 832 : c CALCUL DE MATRICE POUR LE NOEUD D INDICE NS2 833 : 834 : IF (ICHTE.EQ.0) THEN 835 : COEF1 = ( (VECXG2(INDG2)*SCN1X) + (VECYG2(INDG2)*SCN1Y) ) 836 : & / AG2 837 : IAUX = 3 - INDG2 838 : COEF2 = ( (VECXG2(IAUX)*SCN1X) + (VECYG2(IAUX)*SCN1Y) ) 839 : & / AG2 840 : 841 : COEF3 = ( (VECXD2(INDD2)*SCN1X) + (VECYD2(INDD2)*SCN1Y) ) 842 : & / AD2 843 : IAUX = 3 - INDD2 844 : COEF4 = ( (VECXD2(IAUX)*SCN1X) + (VECYD2(IAUX)*SCN1Y) ) 845 : & / AD2 846 : ELSE 847 : 848 : IF (MPOTEN.VPOCHA(/2) .EQ.3) THEN 849 : c LE TENSEUR EST ANISOTROPE 850 : K11G = MPOTEN.VPOCHA(NLCG,1) 851 : K22G = MPOTEN.VPOCHA(NLCG,2) 852 : K21G = MPOTEN.VPOCHA(NLCG,3) 853 : 854 : K11D = MPOTEN.VPOCHA(NLCD,1) 855 : K22D = MPOTEN.VPOCHA(NLCD,2) 856 : K21D = MPOTEN.VPOCHA(NLCD,3) 857 : ELSEIF (MPOTEN.VPOCHA(/2) .EQ.1) THEN 858 : c LE TENSEUR EST DIAGONAL 859 : K11G = MPOTEN.VPOCHA(NLCG,1) 860 : K22G = K11G 861 : K21G = 0.0D0 862 : K11D = MPOTEN.VPOCHA(NLCD,1) 863 : K22D = K11D 864 : K21D = 0.0D0 865 : ELSE 866 : WRITE(6,*) 'TENSEUR NON PREVU' 867 : STOP 868 : ENDIF 869 : 870 : c PRODUIT TENSEUR VECTEUR 871 : IAUX = 3 - INDD1 872 : XLONGD = (VECXD1(IAUX)*VECXD1(IAUX)) + 873 : & (VECYD1(IAUX)*VECYD1(IAUX)) 874 : XLONGD = XLONGD**0.5 875 : IAUX = 3 - INDG1 876 : XLONGG = (VECXG1(IAUX)*VECXG1(IAUX)) + 877 : & (VECYG1(IAUX)*VECYG1(IAUX)) 878 : XLONGG = XLONGG**0.5 879 : 880 : PSCAGX = (K11G*(VECXG2(INDG2)/AG2)) + (K21G*(VECYG2(INDG2)/AG2)) 881 : PSCAGY = (K21G*(VECXG2(INDG2))/AG2) + (K22G*(VECYG2(INDG2)/AG2)) 882 : COEF1 = ( (PSCAGX*SCN1X) + (PSCAGY*SCN1Y) ) 883 : 884 : IAUX = 3 - INDG2 885 : PSCAGX = (K11G*(VECXG2(IAUX)/AG2)) + (K21G*(VECYG2(IAUX)/AG2)) 886 : PSCAGY = (K21G*(VECXG2(IAUX)/AG2)) + (K22G*(VECYG2(IAUX)/AG2)) 887 : COEF2 = ( (PSCAGX*SCN1X) + (PSCAGY*SCN1Y) ) 888 : 889 : PSCADX = (K11D*(VECXD2(INDD2)/AD2)) + (K21D*(VECYD2(INDD2)/AD2)) 890 : PSCADY = (K21D*(VECXD2(INDD2)/AD2)) + (K22D*(VECYD2(INDD2)/AD2)) 891 : COEF3 = ( (PSCADX*SCN1X) + (PSCADY*SCN1Y) ) 892 : 893 : IAUX = 3 - INDD2 894 : PSCADX = (K11D*(VECXD2(IAUX)/AD2)) + (K21D*(VECYD2(IAUX)/AD2)) 895 : PSCADY = (K21D*(VECXD2(IAUX)/AD2)) + (K22D*(VECYD2(IAUX)/AD2)) 896 : COEF4 = ( (PSCADX*SCN1X) + (PSCADY*SCN1Y) ) 897 : ENDIF 898 : 899 : MARQ = 0 900 : DO I5 = 1,INDLI.ID(NLS2) 901 : INDAUX = IND2.NUME(I5,NLS2) 902 : IF (INDAUX.EQ.NGCF) THEN 903 : MARQ = 1 904 : IAFF = I5 905 : GOTO 41 906 : ENDIF 907 : ENDDO 908 : 41 CONTINUE 909 : 910 : 911 : IF (MARQ.EQ.0) THEN 912 : INDLI.ID(NLS2) = INDLI.ID(NLS2) + 1 913 : ICOU = INDLI.ID(NLS2) 914 : IND2.NUME(ICOU,NLS2) = NGCF 915 : ELSE 916 : ICOU = IAFF 917 : ENDIF 918 : 919 : COEF = (COEF1 - COEF3) 920 : 921 : MATR1 = IPO2.POINT(NLS2) 922 : SEGACT MATR1 *MOD 923 : MATR1.MAT2(ICOU,ICOU) = COEF 924 : 925 : MARQ = 0 926 : DO I5 = 1,INDLI.ID(NLS2) 927 : INDAUX = IND2.NUME(I5,NLS2) 928 : IF (INDAUX.EQ.NG2) THEN 929 : MARQ = 1 930 : IAFF = I5 931 : GOTO 51 932 : ENDIF 933 : ENDDO 934 : 51 CONTINUE 935 : 936 : 937 : IF (MARQ.EQ.0) THEN 938 : INDLI.ID(NLS2) = INDLI.ID(NLS2) + 1 939 : ICOUCO = INDLI.ID(NLS2) 940 : IND2.NUME(ICOUCO,NLS2) = NG2 941 : ELSE 942 : ICOUCO = IAFF 943 : ENDIF 944 : ICOUG = ICOUCO 945 : 946 : 947 : MATR1.MAT2(ICOU,ICOUCO) = COEF2 948 : 949 : 950 : MARQ = 0 951 : DO I5 = 1,INDLI.ID(NLS2) 952 : INDAUX = IND2.NUME(I5,NLS2) 953 : IF (INDAUX.EQ.ND2) THEN 954 : MARQ = 1 955 : IAFF = I5 956 : GOTO 61 957 : ENDIF 958 : ENDDO 959 : 61 CONTINUE 960 : 961 : 962 : IF (MARQ.EQ.0) THEN 963 : INDLI.ID(NLS2) = INDLI.ID(NLS2) + 1 964 : ICOUCO = INDLI.ID(NLS2) 965 : IND2.NUME(ICOUCO,NLS2) = ND2 966 : ELSE 967 : ICOUCO = IAFF 968 : ENDIF 969 : ICOUD = ICOUCO 970 : 971 : 972 : 973 : MATR1.MAT2(ICOU,ICOUCO) = -COEF4 974 : 975 : SCMB.MAT(ICOU,NLS2) =( 976 : & ((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1)) - 977 : & ((COEF3+COEF4)*MPOCHP.VPOCHA(NLCD,1))) 978 : 979 : VAL1.MAT(ICOU,NLS2) = (COEF1 + COEF2) 980 : VAL2.MAT(ICOU,NLS2) = - ((COEF3 + COEF4)) 981 : IND.NUME(ICOU,NLS2) = NGCG 982 : IND22.NUME(ICOU,NLS2) = NGCD 983 : 984 : * CONDITION AUX LIMITE DE DIRICICHLET 985 : IF (NGCG.EQ.NGCD) THEN 986 : NLFCL=MLENCL.LECT(NGCF) 987 : 988 : IF (NLFCL.GT.0) THEN 989 : c WRITE(6,*) 'NLCF= ',NLCF,'NGCF= ',NGCF 990 : c WRITE(6,*) 'CLIM= ', MPOVCL.VPOCHA(NLFCL,1) 991 : COEF = MAX(ABS(COEF1),ABS(COEF2)) 992 : c WRITE(6,*) 'COEF= ',COEF 993 : c WRITE(6,*) 'COEF1= ',COEF1 994 : c WRITE(6,*) 'COEF2= ',COEF2 995 : MATR1.MAT2(ICOU,ICOU) = COEF 996 : MATR1.MAT2(ICOU,ICOUG) = 0.0D0 997 : MATR1.MAT2(ICOU,ICOUD) = 0.0D0 998 : 999 : SCMB.MAT(ICOU,NLS2) = (COEF*MPOVCL.VPOCHA(NLFCL,1)) 1000 : VAL1.MAT(ICOU,NLS2) = COEF 1001 : VAL2.MAT(ICOU,NLS2) = 0.0D0 1002 : c ON AJOUTE ICI UN POINT FACE POUR COMPATIBILITE AVEC LAPN 1003 : IND.NUME(ICOU,NLS2) = NGCF 1004 : IND22.NUME(ICOU,NLS2) = NGCD 1005 : ELSE 1006 : c CONDITION DE FLUX 1007 : NLFNE=MLENNE.LECT(NGCF) 1008 : 1009 : IF (NLFNE.GT.0) THEN 1010 : QIMPX = MPOVNE.VPOCHA(NLFNE,1) 1011 : C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE 1012 : QIMPS = (QIMPX) 1013 : 1014 : COEF = COEF1 1015 : MATR1.MAT2(ICOU,ICOU) = COEF 1016 : MATR1.MAT2(ICOU,ICOUG) = COEF2 1017 : SCMB.MAT(ICOU,NLS2) = 1018 : & (((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1))) 1019 : & + (2.D0*QIMPS) 1020 : VAL1.MAT(ICOU,NLS2) = (COEF1 + COEF2) 1021 : VAL2.MAT(ICOU,NLS2) = 2.D0 1022 : IND.NUME(ICOU,NLS2) = NGCG 1023 : IND22.NUME(ICOU,NLS2) = NGCF 1024 : ELSE 1025 : c CONDITION MIXTE 1026 : NLFMI=MLENMI.LECT(NGCF) 1027 : IF (NLFMI.GT.0) THEN 1028 : XLAMBDA1 = MPOVMI.VPOCHA(NLFMI,1) 1029 : XLAMBDA2 = MPOVMI.VPOCHA(NLFMI,2) 1030 : QIMPX = MPOVMI.VPOCHA(NLFMI,3) 1031 : C PRODUIT SCALAIRE DU FLUX IMPOSE AVEC LA NORMALE 1032 : QIMPS = (QIMPX) 1033 : c WRITE(6,*) 'QIMPX= ',QIMPX,'QIMPY= ',QIMPY 1034 : c 1035 : COEF = COEF1 1036 : c WRITE(6,*) 'NGCF= ',NGCF 1037 : c WRITE(6,*) 'XLAMBDA1= ',XLAMBDA1,'XLAMBDA2= ',XLAMBDA2 1038 : c WRITE(6,*) 'COEF= ',COEF 1039 : MATR1.MAT2(ICOU,ICOU) = (XLAMBDA1*COEF) - 1040 : & (2.D0*XLAMBDA2) 1041 : MATR1.MAT2(ICOU,ICOUG) = (XLAMBDA1*COEF2) 1042 : SCMB.MAT(ICOU,NLS2) = 1043 : & (XLAMBDA1*((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1))) 1044 : & + (2.D0*QIMPS) 1045 : VAL1.MAT(ICOU,NLS2) = XLAMBDA1*(COEF1 + COEF2) 1046 : VAL2.MAT(ICOU,NLS2) = 2.D0 1047 : IND.NUME(ICOU,NLS2) = NGCG 1048 : IND22.NUME(ICOU,NLS2) = NGCF 1049 : ELSE 1050 : C PAR DEFAUT FLUX NUL 1051 : QIMPS = 0 1052 : COEF = COEF1 1053 : MATR1.MAT2(ICOU,ICOU) = COEF 1054 : MATR1.MAT2(ICOU,ICOUG) = COEF2 1055 : SCMB.MAT(ICOU,NLS2) = 1056 : & (((COEF1+COEF2)*MPOCHP.VPOCHA(NLCG,1))) 1057 : VAL1.MAT(ICOU,NLS2) = (COEF1 + COEF2) 1058 : VAL2.MAT(ICOU,NLS2) = 0.D0 1059 : IND.NUME(ICOU,NLS2) = NGCG 1060 : IND22.NUME(ICOU,NLS2) = NGCD 1061 : ENDIF 1062 : 1063 : ENDIF 1064 : 1065 : ENDIF 1066 : ENDIF 1067 : 1068 : SEGDES MATR1 *MOD 1069 : c WRITE(6,*) 'NLS2= ',NLS2,'ICOU=',ICOU, 1070 : c & 'IND= ',IND.NUME(ICOU,NLS2), 1071 : c & 'IND22= ',IND22.NUME(ICOU,NLS2) 1072 : c WRITE(6,*) 'NLS2= ',NLS2,'ICOU=',ICOU,'SCMB', SCMB.MAT(NLS2,ICOU) 1073 : c WRITE(6,*) 'COEF1 = ',COEF1,'COEF2= ',COEF2,'COEF3= ', 1074 : c & COEF3,'COEF4=',COEF4,'HG=',MPOCHP.VPOCHA(NLCG,1), 1075 : c & 'HD= ',MPOCHP.VPOCHA(NLCD,1) 1076 : 1077 : c WRITE(6,*) 'NLS2= ',NLS2,'ICOU=',ICOU, 1078 : c & 'IND= ',IND.NUME(ICOU,NLS2), 1079 : c & 'IND22= ',IND22.NUME(ICOU,NLS2), 1080 : c & 'SCMB', SCMB.MAT(ICOU,NLS2), 1081 : c & 'ICOU =',ICOU,'NOUED2= ',MATR1.MAT2(ICOU,ICOU,NLS2), 1082 : c & 'ICOUG= ',ICOUG,'NOUED2= ',MATR1.MAT2(ICOU,ICOUG,NLS2), 1083 : c & 'ICOUD= ',ICOUD,'NOUED2= ',MATR1.MAT2(ICOU,ICOUD,NLS2) 1084 : c WRITE(6,*) 'COEF1 = ',COEF1,'COEF2= ',COEF2,'COEF3= ', 1085 : c DO I=1,INDLI.ID(NLS1) 1086 : c DO J = 1,INDLI.ID(NLS1) 1087 : c WRITE(6,*) 'NLS1= ',NLS1,'I=',I,'J=',J,MATR1.MAT2(I,J,NLS1) 1088 : c WRITE(6,*) 'NLS2= ',NLS2,'I=',I,'J=',J,MATR1.MAT2(I,J,NLS2) 1089 : c ENDDO 1090 : c ENDDO 1091 : 1092 : 1093 : ENDDO 1094 : c DO J= 1,INDLI.ID(NLS1) 1095 : c WRITE(6,*) 'MELVA1=',MELVA1.VELCHE(J,NLCF) 1096 : c WRITE(6,*) 'MELVA2=',MELVA1.VELCHE(J,NLCF) 1097 : c WRITE(6,*) 'MELEME=',MELEME.NUM(J,NLCF) 1098 : c ENDDO 1099 : 1100 : MELTFA = MAUX 1101 : IF (NBSO.EQ.2) THEN 1102 : SEGDES IPT1 1103 : SEGDES IPT2 1104 : ENDIF 1105 : 1106 : 1107 : 9999 CONTINUE 1108 : RETURN 1109 : END 1110 : 1111 : 1112 : 1113 : 1114 : 1115 : 1116 : 1117 : 1118 : 1119 : 1120 : 1121 : 1122 : 1123 :
© Cast3M 2003 - All rights reserved.
Disclaimer