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