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