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