1 : C ECHI2 SOURCE MAGN 10/05/18 21:15:23 6675 2 : SUBROUTINE ECHI2(IKAS,IVOL1,MTAB1,MTAB2,MTAB3,MPOVA1,MPOVA2, 3 : & IKH,IKT,IKP,MELEVF,MLENT1,NOMP,NOMD) 4 : C----------------------------------------------------------------------- 5 : C Discrétisation de l'opérateur ECHIMP en implicite EF et VF, le 6 : C coeff d'échange étant un SCAL ou CHPO CENTRE, le champ exterieur 7 : C un SCAL, un CHPO CENTRE ou un CHPO SOMMET. 8 : C----------------------------------------------------------------------- 9 : C 10 : C-------------------- 11 : C Paramètres Entrée : 12 : C-------------------- 13 : C 14 : C E/ IKAS : Type de situation à traiter (1=EF, 2 ou 3=VF) 15 : C E/ IVOL1 : Type d'échange (0=surfacique, 1=volumique) 16 : C E/ MTAB1 : Pointeur de la table EQEX 17 : C E/ MTAB2 : Pointeur de la table DOMAINE locale 18 : C E/ MTAB3 : Pointeur de la table KIZX 19 : C E/ MPOVA1 : MPOVAL des valeurs du coefficient d'échange 20 : C E/ MPOVA2 : MPOVAL des valeurs du champ exterieur 21 : C E/ IKH : Forme originel du coefficient d'échange 22 : C (0=CHPO CENTRE, 1=FLOTTANT, 4=CHPO SOMMET) 23 : C E/ IKT : Forme originel du champ exterieur 24 : C (0=CHPO CENTRE, 1=FLOTTANT, 4=CHPO SOMMET) 25 : C E/ IKP : Support de l'inconnue primale 26 : C (0=CHPO CENTRE, 4=CHPO SOMMET) 27 : C E/ MELEVF : Pointeur vers les points CENTRE du maillage volumique 28 : C en correspondance avec les points CENTRE surfacique 29 : C (Utilisé en Formulation VF et échange surfacique) 30 : C E/ MLENT1 : Correspondance de numérotations pour le champ exterieur 31 : C MLENT1.LECT(I)=J : point I en Jième position du spg 32 : C (Utilisé lorsque le champ exterieur est au SOMMET) 33 : C E/ NOMP : Nom de l'inconnue primale 34 : C E/ NOMD : Nom de l'inconnue duale 35 : C 36 : C------------------ 37 : C Champs calculés : 38 : C------------------ 39 : C 40 : C MTAB3.'MATELM' : Matrice associé à l'opérateur ECHIMP 41 : C MTAB1.'SMBR' : Second membre du système matriciel issu de la 42 : C discrétisation, la contribution de ECHIMP y est 43 : C assemblée. 44 : C 45 : C----------------------------------------------------------------------- 46 : IMPLICIT INTEGER(I-N) 47 : IMPLICIT REAL*8 (A-H,O-Z) 48 : C 49 : -INC CCGEOME 50 : -INC CCOPTIO 51 : -INC SIZFFB 52 : -INC SMCHPOI 53 : -INC SMCHAML 54 : -INC SMCOORD 55 : -INC SMELEME 56 : -INC SMLENTI 57 : -INC SMMATRIK 58 : C 59 : CHARACTER*8 NOMP,NOMD,NOM0,TYPE,TYPC,TYPS 60 : INTEGER SPGP,SPGD 61 : C 62 : C- Initialisations 63 : C 63 : CALL ACME(MTAB1,'NAVISTOK',NASTOK) 64 : MLENT2 = 0 65 : MCHPO1 = 0 66 : MCHELM = 0 67 : NBCOMP = 1 68 : IAXI = 0 69 : IF (IFOMOD.EQ.0) IAXI=2 70 : SEGACT MPOVA1 71 : SEGACT MPOVA2 72 : C 73 : C- Récupération des informations géométriques locales 74 : C 74 : CALL LEKTAB(MTAB2,'CENTRE ',MELEMC) 74 : CALL LEKTAB(MTAB2,'SOMMET ',MELEMS) 74 : CALL LEKTAB(MTAB2,'MAILLAGE ',MELEME) 74 : CALL KRIPAD(MELEMS,MLENTI) 75 : C 76 : C- En echange surfacique et option VF création du spg du second-membre 77 : C- différent de MELEVF à cause des coins (dans le spg chaque point 78 : C- n'est présent qu'une fois meme si il est connecté plusieurs fois) 79 : C 80 : IF (IKAS.NE.1 .AND. IVOL1.EQ.0) THEN 81 : IPT1 = MELEVF 82 : SEGACT IPT1 83 : SEGINI, IPT2=IPT1 84 : IOK1 = 1 85 : NUMPD = IPT2.NUM(/2) 86 : DO 10 I=2,NUMPD 87 : ITEST = IPT1.NUM(1,I) 88 : DO 5 J=1,IOK1 89 : JTEST = IPT2.NUM(1,J) 90 : IF (JTEST.EQ.ITEST) GOTO 10 91 : 5 CONTINUE 92 : IOK1 = IOK1 + 1 93 : IPT2.NUM(1,IOK1) = ITEST 94 : 10 CONTINUE 95 : IF (IOK1.NE.NUMPD) THEN 96 : NBSOUS = 0 97 : NBELEM = IOK1 98 : NBREF = 0 99 : NBNN = 1 100 : SEGADJ IPT2 101 : ENDIF 102 : SEGDES IPT2 103 : ENDIF 104 : C 105 : C- Maillage de connectivités et supports géométriques des inconnues 106 : C 107 : C SPGP : Support géométrique local de l'inconnue primale 108 : C SPGD : Idem pour la duale 109 : C MLOCP : Connectivité local pour l'inconnue primale 110 : C MLOCD : Idem pour la duale 111 : C 112 : IF (IKAS.EQ.1) THEN 113 : TYPS = 'SOMMET ' 114 : SPGD = MELEMS 115 : IF (IKP.EQ.0) THEN 116 : SPGP = MELEMC 117 : MLOCD = MELEME 118 : MLOCP = MELEMC 119 : ELSE 120 : SPGP = MELEMS 121 : MLOCD = MELEME 122 : MLOCP = MELEME 123 : ENDIF 124 : ELSE 125 : TYPS = 'CENTRE ' 126 : IF (IVOL1.EQ.0) THEN 127 : SPGD = IPT2 128 : MLOCD = MELEVF 129 : ELSE 130 : SPGD = MELEMC 131 : MLOCD = MELEMC 132 : ENDIF 133 : IF (IKP.EQ.0) THEN 134 : SPGP = MELEMC 135 : MLOCP = MELEMC 136 : ELSE 137 : SPGP = MELEMS 138 : MLOCP = MELEME 139 : ENDIF 139 : CALL KRIPAD(SPGD,MLENT2) 140 : ENDIF 141 : C 142 : C- Création du CHPO contenant la contribution au second membre de ECHIMP 143 : C 144 : NAT = 1 145 : NSOUPO = 1 146 : SEGINI MCHPOI 147 : MTYPOI = TYPS 148 : JATTRI(1) = 2 149 : IFOPOI = IFOMOD 150 : NC = 1 151 : SEGINI MSOUPO 152 : IPCHP(1) = MSOUPO 153 : SEGDES MCHPOI 154 : NOCOMP(1)= NOMD(1:4) 155 : IGEOC = SPGD 156 : IPT3 = SPGD 157 : SEGACT IPT3 158 : N = IPT3.NUM(/2) 159 : SEGDES IPT3 160 : SEGINI MPOVAL 161 : IPOVAL = MPOVAL 162 : SEGDES MSOUPO 163 : C 164 : C------------------- 165 : C- Cas EF Implicite 166 : C------------------- 167 : C 168 : IF (IKAS.EQ.1) THEN 169 : C 170 : C- Matrice EF dans le cas ou l'inconnue primale est au CENTRE 171 : C- (matrice colonne : h fois diagonale de la matrice MASSE condensée) 172 : C 173 : IF (IKP.EQ.0) THEN 173 : CALL LEKTAB(MTAB2,'XXPSOML ',MCHELM) 174 : IF (IERR.NE.0) RETURN 175 : SEGACT MCHELM 176 : NRIGE = 7 177 : NKID = 9 178 : NKMT = 7 179 : NMATRI = 1 180 : SEGINI MATRIK 181 : IRIGEL(1,1) = MLOCP 182 : IRIGEL(2,1) = MLOCD 183 : IRIGEL(7,1) = 3 184 : NBME = 1 185 : SEGACT MELEME 186 : NBSOUS = LISOUS(/1) 187 : IF (NBSOUS.EQ.0) NBSOUS=1 188 : SEGINI IMATRI 189 : IRIGEL(4,1) = IMATRI 190 : SEGDES MATRIK 191 : KSPGP = SPGP 192 : KSPGD = SPGD 193 : LISPRI(1) = NOMP(1:4)//' ' 194 : LISDUA(1) = NOMD(1:4)//' ' 195 : NUTOEL = 0 196 : DO 30 L=1,NBSOUS 197 : IPT1 = MELEME 198 : IF (NBSOUS.NE.1) IPT1=LISOUS(L) 199 : SEGACT IPT1 200 : NP = 1 201 : MP = IPT1.NUM(/1) 202 : NBEL = IPT1.NUM(/2) 203 : SEGINI IZAFM 204 : LIZAFM(L,1) = IZAFM 205 : MCHAML = ICHAML(L) 206 : SEGACT MCHAML 207 : MELVAL = IELVAL(1) 208 : SEGACT MELVAL 209 : DO 20 K=1,NBEL 210 : NK = NUTOEL + K 211 : KPOS = 1 + (1-IKH)*(NK-1) 212 : DO 15 I=1,MP 213 : VAL1 = MPOVA1.VPOCHA(KPOS,1)*VELCHE(I,K) 214 : AM(K,1,I) = AM(K,1,I) + VAL1 215 : C write(6,*) 'EF CENTRE AM K I',K,I,AM(K,1,I) 216 : 15 CONTINUE 217 : 20 CONTINUE 218 : SEGDES IZAFM 219 : SEGDES IPT1 220 : SEGDES MCHAML,MELVAL 221 : NUTOEL = NUTOEL + NBEL 222 : 30 CONTINUE 223 : IF (NBSOUS.NE.1) SEGDES MELEME 224 : SEGDES MCHELM 225 : SEGDES IMATRI 226 : C 227 : C- Matrice EF dans le cas ou l'inconnue primale est au SOMMET 228 : C- (matrice carrée : h fois matrice MASSE consistante) 229 : C 230 : ELSE 231 : NRIGE = 7 232 : NKID = 9 233 : NKMT = 7 234 : NMATRI = 1 235 : SEGINI MATRIK 236 : IRIGEL(1,1) = MLOCP 237 : IRIGEL(2,1) = MLOCD 238 : IRIGEL(7,1) = 2 239 : NBME = 1 240 : SEGACT MELEME 241 : NBSOUS = LISOUS(/1) 242 : IF (NBSOUS.EQ.0) NBSOUS=1 243 : SEGINI IMATRI 244 : IRIGEL(4,1) = IMATRI 245 : SEGDES MATRIK 246 : KSPGP = SPGP 247 : KSPGD = SPGD 248 : LISPRI(1) = NOMP(1:4)//' ' 249 : LISDUA(1) = NOMD(1:4)//' ' 250 : NUTOEL = 0 251 : DO 100 L=1,NBSOUS 252 : IPT1 = MELEME 253 : IF (NBSOUS.NE.1) IPT1=LISOUS(L) 254 : SEGACT IPT1 255 : NP = IPT1.NUM(/1) 256 : NBEL = IPT1.NUM(/2) 257 : MP = NP 258 : SEGINI IZAFM 259 : LIZAFM(L,1) = IZAFM 260 : NOM0 = NOMS(IPT1.ITYPEL)//' ' 260 : CALL KALPBG(NOM0,'FONFORM ',IZFFM) 261 : IF (IZFFM.EQ.0) THEN 262 : C Echec lors de la lecture des fonctions de forme d'un élément. 262 : CALL ERREUR(662) 263 : RETURN 264 : ENDIF 265 : SEGACT IZFFM*MOD 266 : IZHR = KZHR(1) 267 : SEGACT IZHR*MOD 268 : NPG = GR(/3) 269 : NES = GR(/1) 270 : DO 90 K=1,NBEL 271 : NK = NUTOEL + K 272 : KPOS = 1 + (1-IKH)*(NK-1) 273 : DO 50 I=1,NP 274 : II = IPT1.NUM(I,K) 275 : DO 40 N=1,IDIM 276 : XYZ(N,I) = XCOOR((II-1)*(IDIM+1)+N) 277 : 40 CONTINUE 278 : 50 CONTINUE 278 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP, 279 : & NPG,IAXI,AIRE) 280 : DO 80 I=1,NP 281 : DO 70 J=1,NP 282 : UU = 0.D0 283 : DO 60 LG=1,NPG 284 : UU = UU + FN(I,LG)*FN(J,LG)*PGSQ(LG) 285 : 60 CONTINUE 286 : CCC modif alex 287 : IF(IKH.EQ.4)THEN 288 : JPOS = MLENT1.LECT(IPT1.NUM(J,K)) 289 : AM(K,I,J) = MPOVA1.VPOCHA(JPOS,1) * UU 290 : ELSE 291 : AM(K,I,J) = MPOVA1.VPOCHA(KPOS,1) * UU 292 : C write(6,*) 'EF SOMMET AM K I J',K,I,J,AM(K,I,J) 293 : ENDIF 294 : 70 CONTINUE 295 : 80 CONTINUE 296 : 90 CONTINUE 297 : SEGDES IPT1 298 : SEGDES IZAFM 299 : SEGDES IZFFM*MOD 300 : SEGDES IZHR 301 : NUTOEL = NUTOEL + NBEL 302 : 100 CONTINUE 303 : IF (NBSOUS.NE.1) SEGDES MELEME 304 : SEGDES IMATRI 305 : ENDIF 306 : C 307 : C- Second membre EF, champ exterieur FLOTTANT ou CHPO CENTRE 308 : C- (matrice MASSE condensée saturé par h*champ exterieur) 309 : C 310 : IF (IKT.EQ.0.OR.IKT.EQ.1) THEN 310 : IF (MCHELM.EQ.0) CALL LEKTAB(MTAB2,'XXPSOML ',MCHELM) 311 : IF (IERR.NE.0) RETURN 312 : SEGACT MCHELM 313 : SEGACT MELEME 314 : NBSOUS = LISOUS(/1) 315 : IF (NBSOUS.EQ.0) NBSOUS=1 316 : NUTOEL = 0 317 : DO 130 L=1,NBSOUS 318 : IPT1 = MELEME 319 : IF (NBSOUS.NE.1) IPT1=LISOUS(L) 320 : SEGACT IPT1 321 : NP = IPT1.NUM(/1) 322 : NBEL = IPT1.NUM(/2) 323 : MCHAML = ICHAML(L) 324 : SEGACT MCHAML 325 : MELVAL = IELVAL(1) 326 : SEGACT MELVAL 327 : DO 120 K=1,NBEL 328 : NK = NUTOEL + K 329 : KPOS = 1 + (1-IKH)*(NK-1) 330 : KTEX = 1 + (1-IKT)*(NK-1) 331 : DO 110 I=1,NP 332 : II = IPT1.NUM(I,K) 333 : IPOS = LECT(II) 334 : VAL1 = MPOVA1.VPOCHA(KPOS,1)*VELCHE(I,K) 335 : & * MPOVA2.VPOCHA(KTEX,1) 336 : VPOCHA(IPOS,1) = VPOCHA(IPOS,1) + VAL1 337 : C write(6,*) 'EF CENTRE VPOCHA IPOS',IPOS,VPOCHA(IPOS,1) 338 : 110 CONTINUE 339 : 120 CONTINUE 340 : SEGDES IPT1 341 : SEGDES MCHAML,MELVAL 342 : NUTOEL = NUTOEL + NBEL 343 : 130 CONTINUE 344 : IF (NBSOUS.NE.1) SEGDES MELEME 345 : SEGDES MCHELM 346 : C 347 : C- Second membre EF, champ exterieur CHPO SOMMET 348 : C- (matrice MASSE consistante saturée par h*champ exterieur) 349 : C 350 : ELSE 351 : SEGACT MELEME 352 : NBSOUS = LISOUS(/1) 353 : IF (NBSOUS.EQ.0) NBSOUS=1 354 : NUTOEL = 0 355 : DO 200 L=1,NBSOUS 356 : IPT1 = MELEME 357 : IF (NBSOUS.NE.1) IPT1=LISOUS(L) 358 : SEGACT IPT1 359 : NP = IPT1.NUM(/1) 360 : NBEL = IPT1.NUM(/2) 361 : NOM0 = NOMS(IPT1.ITYPEL)//' ' 361 : CALL KALPBG(NOM0,'FONFORM ',IZFFM) 362 : IF (IZFFM.EQ.0) THEN 363 : C Echec lors de la lecture des fonctions de forme d'un élément. 363 : CALL ERREUR(662) 364 : RETURN 365 : ENDIF 366 : SEGACT IZFFM*MOD 367 : IZHR = KZHR(1) 368 : SEGACT IZHR*MOD 369 : NPG = GR(/3) 370 : NES = GR(/1) 371 : DO 190 K=1,NBEL 372 : NK = NUTOEL + K 373 : KPOS = 1 + (1-IKH)*(NK-1) 374 : DO 150 I=1,NP 375 : II = IPT1.NUM(I,K) 376 : DO 140 N=1,IDIM 377 : XYZ(N,I) = XCOOR((II-1)*(IDIM+1)+N) 378 : 140 CONTINUE 379 : 150 CONTINUE 379 : CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP, 380 : & NPG,IAXI,AIRE) 381 : DO 180 I=1,NP 382 : II = IPT1.NUM(I,K) 383 : IPOS = LECT(II) 384 : SOM1 = 0.D0 385 : DO 170 J=1,NP 386 : JPOS = MLENT1.LECT(IPT1.NUM(J,K)) 387 : UU = 0.D0 388 : DO 160 LG=1,NPG 389 : UU = UU + FN(I,LG)*FN(J,LG)*PGSQ(LG) 390 : 160 CONTINUE 391 : CCC modif alex 392 : IF(IKH.EQ.4)THEN 393 : SOM1 = SOM1 + MPOVA1.VPOCHA(IPOS,1) 394 : & * MPOVA2.VPOCHA(JPOS,1) * UU 395 : ELSE 396 : SOM1 = SOM1 + MPOVA1.VPOCHA(KPOS,1) 397 : & * MPOVA2.VPOCHA(JPOS,1) * UU 398 : ENDIF 399 : 170 CONTINUE 400 : VPOCHA(IPOS,1) = VPOCHA(IPOS,1) + SOM1 401 : C write(6,*) 'EF SOMMET VPOCHA IPOS',IPOS,VPOCHA(IPOS,1) 402 : 180 CONTINUE 403 : 190 CONTINUE 404 : SEGDES IPT1 405 : SEGDES IZFFM*MOD 406 : SEGDES IZHR 407 : NUTOEL = NUTOEL + NBEL 408 : 200 CONTINUE 409 : IF (NBSOUS.NE.1) SEGDES MELEME 410 : ENDIF 411 : C 412 : C------------------- 413 : C- Cas VF Implicite 414 : C------------------- 415 : C 416 : ELSE 417 : C 418 : C- Matrice VF dans le cas ou l'inconnue primale est au CENTRE 419 : C- (matrice IDENTITE multipliée par h*VOLUME) 420 : C 421 : IF (IKP.EQ.0) THEN 421 : CALL LEKTAB(MTAB2,'XXVOLUM ',MCHPO3) 422 : IF (IERR.NE.0) RETURN 422 : CALL LICHT(MCHPO3,MPOVA3,TYPC,IGEOM) 423 : NRIGE = 7 424 : NKID = 9 425 : NKMT = 7 426 : NMATRI = 1 427 : SEGINI MATRIK 428 : IRIGEL(1,1) = MLOCP 429 : IRIGEL(2,1) = MLOCD 430 : IF (MLOCP.EQ.MLOCD) THEN 431 : IF (NOMP(1:4).EQ.NOMD(1:4)) THEN 432 : IRIGEL(7,1) = 5 433 : ELSE 434 : IRIGEL(7,1) = 2 435 : ENDIF 436 : ELSE 437 : IRIGEL(7,1) = 3 438 : ENDIF 439 : NBME = 1 440 : NBSOUS = 1 441 : SEGINI IMATRI 442 : IRIGEL(4,1) = IMATRI 443 : SEGDES MATRIK 444 : KSPGP = SPGP 445 : KSPGD = SPGD 446 : LISPRI(1) = NOMP(1:4)//' ' 447 : LISDUA(1) = NOMD(1:4)//' ' 448 : NBEL = MPOVA3.VPOCHA(/1) 449 : NP = 1 450 : MP = 1 451 : SEGINI IZAFM 452 : LIZAFM(1,1) = IZAFM 453 : SEGDES IMATRI 454 : DO 210 NK=1,NBEL 455 : KPOS = 1 + (1-IKH)*(NK-1) 456 : AM(NK,1,1) = AM(NK,1,1) + 457 : & MPOVA1.VPOCHA(KPOS,1) * MPOVA3.VPOCHA(NK,1) 458 : C write(6,*) 'VF CENTRE AM NK',NK,AM(NK,1,1) 459 : 210 CONTINUE 460 : C 461 : C- Matrice VF dans le cas ou l'inconnue primale est au SOMMET 462 : C- (matrice ligne : h fois diagonale matrice MASSE condensée) 463 : C 464 : ELSE 464 : CALL LEKTAB(MTAB2,'XXPSOML ',MCHELM) 465 : IF (IERR.NE.0) RETURN 466 : SEGACT MCHELM 467 : NRIGE = 7 468 : NKID = 9 469 : NKMT = 7 470 : NMATRI = 1 471 : SEGINI MATRIK 472 : IRIGEL(1,1) = MLOCP 473 : IRIGEL(2,1) = MLOCD 474 : IRIGEL(7,1) = 3 475 : NBME = 1 476 : SEGACT MELEME 477 : NBSOUS = LISOUS(/1) 478 : IF (NBSOUS.EQ.0) NBSOUS=1 479 : SEGINI IMATRI 480 : IRIGEL(4,1) = IMATRI 481 : SEGDES MATRIK 482 : KSPGP = SPGP 483 : KSPGD = SPGD 484 : LISPRI(1) = NOMP(1:4)//' ' 485 : LISDUA(1) = NOMD(1:4)//' ' 486 : NUTOEL = 0 487 : DO 240 L=1,NBSOUS 488 : IPT1 = MELEME 489 : IF (NBSOUS.NE.1) IPT1=LISOUS(L) 490 : SEGACT IPT1 491 : NP = IPT1.NUM(/1) 492 : MP = 1 493 : NBEL = IPT1.NUM(/2) 494 : SEGINI IZAFM 495 : LIZAFM(L,1) = IZAFM 496 : MCHAML = ICHAML(L) 497 : SEGACT MCHAML 498 : MELVAL = IELVAL(1) 499 : SEGACT MELVAL 500 : DO 230 K=1,NBEL 501 : NK = NUTOEL + K 502 : KPOS = 1 + (1-IKH)*(NK-1) 503 : DO 220 I=1,NP 504 : VAL1 = MPOVA1.VPOCHA(KPOS,1)*VELCHE(I,K) 505 : AM(K,I,1) = AM(K,I,1) + VAL1 506 : C write(6,*) 'VF SOMMET AM K I',K,I,AM(K,I,1) 507 : 220 CONTINUE 508 : 230 CONTINUE 509 : SEGDES IPT1 510 : SEGDES MCHAML,MELVAL 511 : SEGDES IZAFM 512 : NUTOEL = NUTOEL + NBEL 513 : 240 CONTINUE 514 : IF (NBSOUS.NE.1) SEGDES MELEME 515 : SEGDES MCHELM 516 : SEGDES IMATRI 517 : ENDIF 518 : C 519 : C- Second membre VF dans le cas ou le champ exterieur est au CENTRE 520 : C- (matrice diagonale h*VOLUME saturée par le champ exterieur) 521 : C 522 : IF (IKT.EQ.0.OR.IKT.EQ.1) THEN 522 : IF (MCHPO1.EQ.0) CALL LEKTAB(MTAB2,'XXVOLUM ',MCHPO1) 523 : IF (IERR.NE.0) RETURN 523 : CALL LICHT(MCHPO1,MPOVA3,TYPC,IGEOM) 524 : NBEL = MPOVA3.VPOCHA(/1) 525 : IPT2 = MLOCD 526 : SEGACT IPT2 527 : DO 250 NK=1,NBEL 528 : IPOS = MLENT2.LECT(IPT2.NUM(1,NK)) 529 : KPOS = 1 + (1-IKH)*(NK-1) 530 : KTEX = 1 + (1-IKT)*(NK-1) 531 : VAL1 = MPOVA1.VPOCHA(KPOS,1) * MPOVA2.VPOCHA(KTEX,1) 532 : & * MPOVA3.VPOCHA(NK,1) 533 : VPOCHA(IPOS,1) = VPOCHA(IPOS,1) + VAL1 534 : C write(6,*) 'VF CENTRE VPOCHA IPOS',IPOS,VPOCHA(IPOS,1) 535 : 250 CONTINUE 536 : SEGDES IPT2 537 : SEGDES MPOVA3 538 : C 539 : C- Second membre VF dans le cas ou l'inconnue primale est au SOMMET 540 : C- (matrice MASSE condensée saturée par h*champ exterieur) 541 : C 542 : ELSE 542 : IF (MCHELM.EQ.0) CALL LEKTAB(MTAB2,'XXPSOML ',MCHELM) 543 : IF (IERR.NE.0) RETURN 544 : SEGACT MCHELM 545 : SEGACT MELEME 546 : NBSOUS = LISOUS(/1) 547 : IF (NBSOUS.EQ.0) NBSOUS=1 548 : NUTOEL = 0 549 : IPT2 = MLOCD 550 : SEGACT IPT2 551 : DO 280 L=1,NBSOUS 552 : IPT1 = MELEME 553 : IF (NBSOUS.NE.1) IPT1=LISOUS(L) 554 : SEGACT IPT1 555 : NP = IPT1.NUM(/1) 556 : NBEL = IPT1.NUM(/2) 557 : MCHAML = ICHAML(L) 558 : SEGACT MCHAML 559 : MELVAL = IELVAL(1) 560 : SEGACT MELVAL 561 : DO 270 K=1,NBEL 562 : NK = NUTOEL + K 563 : IPOS = MLENT2.LECT(IPT2.NUM(1,NK)) 564 : KPOS = 1 + (1-IKH)*(NK-1) 565 : SOM1 = 0.D0 566 : DO 260 J=1,NP 567 : JPOS = MLENT1.LECT(IPT1.NUM(J,K)) 568 : SOM1 = SOM1 + MPOVA2.VPOCHA(JPOS,1)*VELCHE(J,K) 569 : 260 CONTINUE 570 : VAL1 = SOM1 * MPOVA1.VPOCHA(KPOS,1) 571 : VPOCHA(IPOS,1) = VPOCHA(IPOS,1) + VAL1 572 : C write(6,*) 'VF SOMMET VPOCHA IPOS',IPOS,VPOCHA(IPOS,1) 573 : 270 CONTINUE 574 : SEGDES IPT1 575 : SEGDES MCHAML,MELVAL 576 : NUTOEL = NUTOEL + NBEL 577 : 280 CONTINUE 578 : IF (NBSOUS.NE.1) SEGDES MELEME 579 : SEGDES MCHELM 580 : SEGDES IPT2 581 : ENDIF 582 : ENDIF 583 : C 584 : C- Désactivation 585 : C 586 : SEGDES MPOVA2 587 : SEGDES MPOVA1 588 : SEGDES MPOVAL 589 : SEGSUP MLENTI 590 : IF (MLENT2.NE.0) SEGSUP MLENT2 591 : C 592 : C- Ecriture de la matrice et du second-membre 593 : C 594 : IF(NASTOK.EQ.0)THEN 594 : CALL ECMO(MTAB3,'MATELM','MATRIK',MATRIK) 595 : TYPE = ' ' 595 : CALL ACMO(MTAB1,'SMBR',TYPE,MCHPO4) 596 : IF (TYPE.NE.'CHPOINT ') THEN 596 : CALL ECMO(MTAB1,'SMBR','CHPOINT ',MCHPOI) 597 : ELSE 597 : CALL ECROBJ('CHPOINT ',MCHPO4) 597 : CALL ECROBJ('CHPOINT ',MCHPOI) 597 : CALL PRFUSE 597 : CALL LIROBJ('CHPOINT ',MCHPOI,1,IRET) 598 : IF (IERR.NE.0) RETURN 598 : CALL ECMO(MTAB1,'SMBR','CHPOINT ',MCHPOI) 599 : ENDIF 600 : ELSE 600 : CALL ECROBJ('MATRIK',MATRIK) 600 : CALL ECROBJ('CHPOINT',MCHPOI) 601 : ENDIF 602 : C write(6,*) 'IKAS IVOL IKH IKT IKP',IKAS,IVOL1,IKH,IKT,IKP 603 : RETURN 604 : END 605 : 606 : 607 : 608 : 609 : 610 : 611 : 612 : 613 : 614 : 615 : 616 : 617 : 618 :
© Cast3M 2003 - All rights reserved.
Disclaimer