1 : C VFSYM1 SOURCE LEPOTIER 10/03/24 21:15:37 6649 2 : C NORV1 SOURCE PV 09/03/12 21:29:38 6325 3 : 4 : SUBROUTINE VFSYM1(IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,IELTFA, 5 : & IMAIL,INORM,ISURF,ICHPO,ICHTE,ICHCL,ICHNE,ICHMI, 6 : & ICHCO,IOP,ICHGRA,MPOGRA,ICOEFF,LOGBOR,LOGCOE,LOGCCL) 7 : C 8 : C************************************************************************ 9 : C 10 : C PROJET : CASTEM 2000 11 : C 12 : C NOM : NORV1 13 : C 14 : C DESCRIPTION : Appelle par NORV 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,MPOVNE.MPOVAL,MPOVMI.MPOVAL, 35 : & MPOVCO.MPOVAL 36 : POINTEUR MLENCL.MLENTI, MLECEN.MLENTI, MLESOM.MLENTI, 37 : & MLEFA.MLENTI,MLENNE.MLENTI,MLENMI.MLENTI, 38 : & MLEFA2.MLENTI,MLENCO.MLENTI 39 : -INC SMCHAML 40 : INTEGER NBNN,NBREF,NBMAX 41 : 42 : 43 : 44 : C 45 : C**** Variables de COOPTIO 46 : C 47 : C 48 : C**** Variables de COOPTIO 49 : C 50 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 51 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 52 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 53 : C & ,IECHO, IIMPI, IOSPI 54 : C & ,IDIM 55 : C & ,MCOORD 56 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 57 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 58 : C & ,NORINC,NORVAL,NORIND,NORVAD 59 : C & ,NUCROU, IPSAUV 60 : 61 : C**** Variable de SMLENTI, SMCHPOI 62 : C 63 : INTEGER JG, N, NC, NSOUPO, NAT, NBSOUS, NBNO,NBELEM 64 : C 65 : C**** Les includes 66 : C 67 : INTEGER I1,ICOMP,ICOMGR,IGEOM 68 : & ,IOP1,ICEN,ISOMM,IFAC,IFACEL,IFACEP,INORM 69 : & ,ISURF,IMAIL,ICHPO,ICHCL,ICHNE,ICHGRA,ICOEFF 70 : & ,NTOT,NSOMM,NCOMP,NFAC,NCEN 71 : & ,NLCF,NGCF,NGCF1,NGCF2,NGCG,NGCD,NLCG,NLCD,NGS1,NGS2 72 : & ,NLS1,NLS2,NLFCL 73 : & ,ISOUS,IELEM,INOEUD,ICELL 74 : INTEGER ICEN2 75 : REAL*8 SCNX,SCNY,SCNZ,SURF,VOL,VAL,VALX,VALY,XG,XD,XF,XS1,XS2 76 : & ,YG,YD,YF,YS1,YS2,PSCA,XNORM,VECX,VECY,PSCAGX,PSCAGY, 77 : & PSCADX,PSCADY,K11G,K22G,K21G,K11D,K22D,K21D,VXG1,VXG2, 78 : & VXAU,VYAU,VXD1,VXD2,VYG1,VYG2,TRG1,TRG2, 79 : & TRD1,TRD2,TRG,TRD 80 : REAL*8 XLONG,AG1,AG2,AD1,AD2,PSCAG1,PSCAG2,PSCAD1,PSCAD2, 81 : & COEF1,COEF2,COEF3,COEF4,SCN1X,SCN1Y,SCN1Z,VX,VY,COEF1X,COEF2X, 82 : & COEF1Y,COEF2Y,CX,CY,ANCX,ANCY,DIFFX,DIFFY,XLONGG,XLONGD 83 : & VALD,VALG,COEF,GX,GY,XMINK11,XMAXK11,XMINK22,XMAXK22 84 : & QIMPX,QIMPY,QIMPZ 85 : 86 : REAL*8 VECXG1(2),VECYG1(2) 87 : REAL*8 VECXG2(2),VECYG2(2) 88 : REAL*8 VECXD1(2),VECYD1(2) 89 : REAL*8 VECXD2(2),VECYD2(2) 90 : REAL*8 EPS 91 : INTEGER ICRIT 92 : CHARACTER*(4) NOMCOM(18),NOMCOM3(9) 93 : CHARACTER*8 TYPE 94 : INTEGER LOGBOR,LOGCOE,LOGCCL 95 : C 96 : DATA NOMCOM /'P1DX','P1DY', 97 : & 'P2DX','P2DY', 98 : & 'P3DX','P3DY', 99 : & 'P4DX','P4DY', 100 : & 'P5DX','P5DY', 101 : & 'P6DX','P6DY', 102 : & 'P7DX','P7DY', 103 : & 'P8DX','P8DY', 104 : & 'P9DX','P9DY'/ 105 : 106 : DATA NOMCOM3 /'P1DX','P1DY','P1DZ', 107 : & 'P2DX','P2DY','P2DZ', 108 : & 'P3DX','P3DY','P3DZ'/ 109 : 110 : INTEGER NDIM 111 : SEGMENT MMAT1 112 : REAL*8 PM(NDIM,NDIM),PM1(NDIM,NDIM),XSOL(NDIM) 113 : INTEGER IC(NDIM) 114 : ENDSEGMENT 115 : 116 : INTEGER K1,K2 117 : SEGMENT INDICE 118 : INTEGER NUME(K1,K2) 119 : ENDSEGMENT 120 : POINTEUR IND.INDICE,IND2.INDICE,IND22.INDICE 121 : 122 : SEGMENT MATRICE 123 : REAL*8 MAT(K1,K2) 124 : ENDSEGMENT 125 : POINTEUR VAL1.MATRICE,VAL2.MATRICE,SCMB.MATRICE 126 : 127 : 128 : SEGMENT POINT2 129 : INTEGER POINT(K3) 130 : ENDSEGMENT 131 : POINTEUR IPO2.POINT2 132 : 133 : SEGMENT MATRICE2 134 : REAL*8 MAT2(K1,K2) 135 : ENDSEGMENT 136 : 137 : SEGMENT POINT3 138 : INTEGER POINT33(K3) 139 : ENDSEGMENT 140 : POINTEUR IPO3.POINT3 141 : 142 : SEGMENT INDICE3 143 : INTEGER NU(K1,K2) 144 : ENDSEGMENT 145 : POINTEUR INDIC.INDICE3 146 : 147 : SEGMENT REP 148 : INTEGER ID(K3) 149 : ENDSEGMENT 150 : POINTEUR TAB.REP,INDLI.REP 151 : 152 : INTEGER K5 153 : SEGMENT NBFAC 154 : INTEGER NBFACEL(K5) 155 : INTEGER IMELEM(K5) 156 : ENDSEGMENT 157 : 158 : INTEGER K6 159 : SEGMENT NBCOT 160 : INTEGER NBCOTE(K6) 161 : INTEGER IMECOTE(K6) 162 : ENDSEGMENT 163 : 164 : 165 : 166 : C 167 : C 168 : C**** Nombre total de points (HP IDIM .EQ. 2) 169 : C 170 : c SEGACT MCOORD *MOD 171 : IOP1 = 3 172 : NTOT = MCOORD.XCOOR(/1)/(IDIM+1) 173 : 174 : C 175 : C**** Le MELEME CENTRE (SPG du CHPOINT dont on veux calculer le gradient) 176 : C 176 : CALL KRIPAD(ICEN,MLECEN) 177 : C SEGMENT INTERVENANT POUR PRENDRE EN COMPTE PLUSIEURS SOUS DOMAINES 178 : MELEME = ICEN 179 : NCEN=MELEME.NUM(/2) 180 : SEGDES MELEME 181 : K5 = NCEN 182 : SEGINI NBFAC 183 : 184 : C 185 : C**** Le MELEME FACE (SPG du CHPOINT dont on veux calculer le gradient) 186 : C 186 : CALL KRIPAD(IFAC,MLEFA) 187 : MELEME = IFAC 188 : K6=MELEME.NUM(/2) 189 : SEGDES MELEME 190 : c SEGINI NBCOT 191 : 192 : 193 : 194 : C 195 : C 196 : 197 : C 198 : C**** Le MELEME SOMMET 199 : C 199 : CALL KRIPAD(ISOMM,MLESOM) 200 : C 201 : C**** En KRIPAD 202 : C SEGACT ISOMM 203 : C SEGINI MLESOM 204 : C 205 : MELEME = ISOMM 206 : NSOMM = MELEME.NUM(/2) 207 : SEGDES MELEME 208 : C 209 : C**** Le MPOVAL des SURFACES des FACES 210 : C 210 : CALL LICHT(ISURF,MPOSUR,TYPE,IGEOM) 211 : C 212 : C**** Le MPOVAL des NORMALES aux FACES 213 : C 213 : CALL LICHT(INORM,MPONOR,TYPE,IGEOM) 214 : C 215 : C**** Le MPOVAL du CHPOINT 216 : C 216 : CALL LICHT(ICHPO,MPOCHP,TYPE,IGEOM) 217 : 218 : C**** Le MPOVAL du CHPOINT DU TENSEURS DE DIFFUSIONS 219 : C 220 : IF (ICHTE.GT.0) THEN 220 : CALL LICHT(ICHTE,MPOTEN,TYPE,IGEOM) 221 : ENDIF 222 : C 223 : C**** En LICHT 224 : C SEGACT*MOD MPOCHP 225 : C 226 : NCOMP = MPOCHP.VPOCHA(/2) 227 : IF (ICHTE.GT.0) THEN 227 : c CALL ECCHPO(ICHTE) 228 : ENDIF 229 : 230 : C 231 : C**** Conditions limites (DIRICHLET) 232 : C 233 : IF (ICHCL .GT. 0) THEN 234 : TYPE=' ' 234 : CALL LICHT(ICHCL,MPOVCL,TYPE,IGEOM) 235 : C 236 : C******* En LICHT 237 : C SEGACT*MOD MPOVCL 238 : C 238 : CALL KRIPAD(IGEOM,MLENCL) 239 : C 240 : C******* En KRIPAD 241 : C SEGACT IGEOM, MLENCL 242 : C 243 : MELEME = IGEOM 244 : SEGDES MELEME 245 : ELSE 246 : JG = NTOT 247 : SEGINI MLENCL 248 : DO I1 = 1 , JG, 1 249 : MLENCL.LECT(I1)=0 250 : ENDDO 251 : MPOVCL = -1 252 : ENDIF 253 : 254 : c CONDITIONS DE FLUX 255 : IF (ICHNE .GT. 0) THEN 256 : TYPE=' ' 256 : CALL LICHT(ICHNE,MPOVNE,TYPE,IGEOM) 257 : C 258 : C******* En LICHT 259 : C SEGACT*MOD MPOVNE 260 : C 260 : CALL KRIPAD(IGEOM,MLENNE) 261 : C 262 : C******* En KRIPAD 263 : C SEGACT IGEOM, MLENCL 264 : C 265 : MELEME = IGEOM 266 : SEGDES MELEME 267 : ELSE 268 : JG = NTOT 269 : SEGINI MLENNE 270 : DO I1 = 1 , JG, 1 271 : MLENNE.LECT(I1)=0 272 : ENDDO 273 : MPOVNE = -1 274 : ENDIF 275 : 276 : c CONDITIONS MIXTES 277 : IF (ICHMI .GT. 0) THEN 278 : TYPE=' ' 278 : CALL LICHT(ICHMI,MPOVMI,TYPE,IGEOM) 279 : C 280 : C******* En LICHT 281 : C SEGACT*MOD MPOVNE 282 : C 282 : CALL KRIPAD(IGEOM,MLENMI) 283 : C 284 : C******* En KRIPAD 285 : C SEGACT IGEOM, MLENCL 286 : C 287 : MELEME = IGEOM 288 : SEGDES MELEME 289 : ELSE 290 : JG = NTOT 291 : SEGINI MLENMI 292 : DO I1 = 1 , JG, 1 293 : MLENMI.LECT(I1)=0 294 : ENDDO 295 : MPOVMI = -1 296 : ENDIF 297 : C 298 : c OPTION FLUX CONVECTIFS 299 : IF (ICHCO .GT. 0) THEN 300 : TYPE=' ' 300 : CALL LICHT(ICHCO,MPOVCO,TYPE,IGEOM) 301 : C 302 : C******* En LICHT 303 : C SEGACT*MOD MPOVNE 304 : C 304 : CALL KRIPAD(IGEOM,MLENCO) 305 : C 306 : C******* En KRIPAD 307 : C SEGACT IGEOM, MLENCL 308 : C 309 : MELEME = IGEOM 310 : SEGDES MELEME 311 : ELSE 312 : JG = NTOT 313 : SEGINI MLENCO 314 : DO I1 = 1 , JG, 1 315 : MLENCO.LECT(I1)=0 316 : ENDDO 317 : MPOVCO = -1 318 : ENDIF 319 : C 320 : C 321 : C**** Boucle sur le FACEL 322 : C 323 : MELEFL=IFACEL 324 : MELEFP=IFACEP 325 : MELEFA=IFAC 326 : MELTFA = IELTFA 327 : SEGACT MELEFL 328 : SEGACT MELEFP 329 : SEGACT MELEFA 330 : SEGACT MELTFA 331 : C FACEL = MAILLAGE NON PARTITIONE 332 : NFAC=MELEFL.NUM(/2) 333 : 334 : IF (IDIM.EQ.2) THEN 335 : c INITIALISATION DU CHAMPOINT POUR LE GRADIENT AUX FACES 336 : NAT=1 337 : NSOUPO=1 338 : SEGINI MCHPOI 339 : ICHGRA=MCHPOI 340 : MCHPOI.MOCHDE= 341 : &'Gradient VF ' 342 : MCHPOI.JATTRI=2 343 : MCHPOI.IFOPOI=IFOUR 344 : NC=1 345 : SEGINI MSOUPO 346 : MCHPOI.IPCHP(1)=MSOUPO 347 : SEGDES MCHPOI 348 : DO I1=1,NC,1 349 : MSOUPO.NOCOMP(I1)='FLUX' 350 : ENDDO 351 : C 352 : C******* Gradient aux faces 353 : 354 : N=NFAC 355 : NC=1 356 : C 357 : C 358 : C**** Division par les volumes 359 : C 360 : 361 : C CAS OU ON CALCULE LES COEFFICIENTS DE LA MATRICE 362 : C ON EST ICI 363 : IF ((LOGCOE.EQ.1).AND.(LOGCCL.EQ.1).AND.(LOGBOR.EQ.1)) THEN 364 : 365 : 366 : C PARAMETRES POUR LE GRADIENT AUX FACES 367 : SEGINI MPOGRA 368 : MSOUPO.IGEOC=IFAC 369 : MSOUPO.IPOVAL=MPOGRA 370 : SEGDES MSOUPO 371 : 372 : c ASSEMBLAGES DES MATRICES LOCALES POUR CHAQUE NOEUD 372 : CALL VFSYM2(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR, 373 : & MPOSUR,MELTFA,MLEFA,MPOTEN,MPOCHP,MLENCL,MLENNE, 374 : & MLENMI,MPOVCL,MPOVNE,MPOVMI,ICHTE,ICHCL,ICHNE, 375 : & IPO2,SCMB,INDLI,TAB,VAL1,VAL2,IND22,IND2,IND, 376 : & NBFAC,NSOMM,NBMAX) 377 : 378 : c INVERSION DE CHAQUE MATRICE LOCALE 378 : CALL NORV3(NSOMM,NBMAX,IPO2,SCMB,INDLI, 379 : & VAL1,VAL2,IND22,IND2,IND,IPO3,VAUX,TAB) 380 : 381 : c RECONSTITUTION DU GRADIENT ET DES COEFFICIENTS PERMETTANT DE CALCULER CES 382 : c GRADIENTS 383 : 383 : CALL VFSYM4(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR, 384 : & MPOSUR,MELTFA,MLEFA,MPOTEN,MPOCHP,MLENCL, 385 : & MPOVCL,ICHTE,ICHCL,ICHCO,MPOVCO,IOP, 386 : & IPO2,SCMB,INDLI,VAL1,VAL2,IND22,IND2,IND, 387 : & IPO3,VAUX,TAB,MELEME,MPOGRA,MELVA1,MELVA2, 388 : & NBNN,NBFAC,MCHELM,MCHAML) 389 : ICOEFF = MCHELM 390 : 391 : ELSE 392 : C ON CONNAIT LES COEFFICIENTS : ON EN DEDUIT LE GRADIENT 393 : SEGINI MPOGRA 394 : MSOUPO.IGEOC=IFAC 395 : MSOUPO.IPOVAL=MPOGRA 396 : SEGDES MSOUPO 397 : 397 : CALL NORV5(NFAC,MPOGRA,ICOEFF,MELVA1,MELEFL,MLECEN, 398 : & MLEFA,MPOCHP, 399 : & MLENCL,MPOVCL,MLENNE,MPOVNE,MLENMI,MPOVMI, 400 : & LOGBOR,LOGCCL,LOGCOE) 401 : ENDIF 402 : SEGDES MPOGRA 403 : 404 : 405 : 406 : C CAS 3 DIMENSIONS 407 : ELSE 408 : 409 : c INITIALISATION DU CHAMPOINT POUR LE GRADIENT AUX FACES 410 : NAT=1 411 : NSOUPO=1 412 : SEGINI MCHPOI 413 : ICHGRA=MCHPOI 414 : MCHPOI.MOCHDE= 415 : &'Gradient VF ' 416 : MCHPOI.JATTRI=2 417 : MCHPOI.IFOPOI=IFOUR 418 : NC=1 419 : SEGINI MSOUPO 420 : MCHPOI.IPCHP(1)=MSOUPO 421 : SEGDES MCHPOI 422 : DO I1=1,NC,1 423 : MSOUPO.NOCOMP(I1)='FLUX' 424 : ENDDO 425 : C 426 : C******* Gradient aux faces 427 : 428 : N=NFAC 429 : NC=1 430 : C 431 : C 432 : C**** Division par les volumes 433 : C 434 : 435 : C CAS OU ON CALCULE LES COEFFICIENTS DE LA MATRICE 436 : IF ((LOGCOE.EQ.1).AND.(LOGCCL.EQ.1).AND.(LOGBOR.EQ.1)) THEN 437 : 438 : 439 : C PARAMETRES POUR LE GRADIENT AUX FACES 440 : SEGINI MPOGRA 441 : MSOUPO.IGEOC=IFAC 442 : MSOUPO.IPOVAL=MPOGRA 443 : SEGDES MSOUPO 444 : 445 : c ASSEMBLAGES DES MATRICES LOCALES POUR CHAQUE NOEUD 445 : CALL SYM2D3(MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR, 446 : & MPOSUR,MELTFA,MLEFA,MLEFA2,MPOTEN,MPOCHP,MLENCL, 447 : & MLENNE, 448 : & MLENMI,MPOVCL,MPOVNE,MPOVMI,ICHTE,ICHCL,ICHNE, 449 : & IPO2,SCMB,INDLI,TAB,VAL1,VAL2,IND22,IND2,IND, 450 : & NBFAC,NBCOT,NSOMM,NBMAX) 451 : 452 : c INVERSION DE CHAQUE MATRICE LOCALE 452 : CALL NORV3(NSOMM,NBMAX,IPO2,SCMB,INDLI, 453 : & VAL1,VAL2,IND22,IND2,IND,IPO3,VAUX,TAB) 454 : 455 : c RECONSTITUTION DU GRADIENT ET DES COEFFICIENTS PERMETTANT DE CALCULER CES 456 : c GRADIENTS 456 : CALL SYM4D3( 457 : & MELEFA,MELEFL,MLECEN,MELEFP,MLESOM,MPONOR, 458 : & MPOSUR,MELTFA,MLEFA,MLEFA2,MPOTEN,MPOCHP,MLENCL, 459 : & MPOVCL,ICHTE,ICHCL,ICHCO,MPOVCO,IOP, 460 : & IPO2,SCMB,INDLI,VAL1,VAL2,IND22,IND2,IND, 461 : & IPO3,TAB,MPOGRA,MELVA1,MELVA2, 462 : & NSOMM,NBMAX,NBFAC,NBCOT,MCHELM,MCHAML) 463 : ICOEFF = MCHELM 464 : 465 : ELSE 466 : 467 : C ON CONNAIT LES COEFFICIENTS : ON EN DEDUIT LE GRADIENT 468 : SEGINI MPOGRA 469 : MSOUPO.IGEOC=IFAC 470 : MSOUPO.IPOVAL=MPOGRA 471 : SEGDES MSOUPO 471 : CALL NORV5(NFAC,MPOGRA,ICOEFF,MELVA1,MELEFL,MLECEN,MLEFA, 472 : & MPOCHP,MLENCL,MPOVCL,MLENNE,MPOVNE,MLENMI, 473 : & MPOVMI,LOGBOR,LOGCCL,LOGCOE) 474 : 475 : ENDIF 476 : SEGDES MPOGRA 477 : ENDIF 478 : 479 : 480 : 481 : 482 : SEGSUP MLECEN 483 : SEGDES MPOSUR 484 : SEGDES MPONOR 485 : SEGDES MPOCHP 486 : IF(MPOVCL .GT. 0)THEN 487 : SEGDES MPOVCL 488 : ENDIF 489 : IF(MPOVNE .GT. 0)THEN 490 : SEGDES MPOVNE 491 : ENDIF 492 : IF(MPOVMI .GT. 0)THEN 493 : SEGDES MPOVMI 494 : ENDIF 495 : IF(MPOVCO .GT. 0)THEN 496 : SEGDES MPOVCO 497 : ENDIF 498 : SEGSUP MLENCL 499 : SEGSUP MLENNE 500 : SEGSUP MLENMI 501 : SEGSUP MLENCO 502 : SEGSUP MLESOM 503 : SEGSUP NBFAC 504 : SEGDES MELEFL 505 : SEGDES MELEFP 506 : SEGDES MELEFA 507 : SEGDES MELTFA 508 : 509 : C 510 : 9999 CONTINUE 511 : RETURN 512 : END 513 : 514 : 515 : 516 : 517 : 518 : 519 : 520 : 521 : 522 : 523 : 524 : 525 : 526 :
© Cast3M 2003 - All rights reserved.
Disclaimer