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