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