1 : C YDIAG SOURCE MAGN 09/07/30 21:21:55 6458 2 : SUBROUTINE YDIAG 3 : C====================================================================== 4 : C L'opérateur MDIA calcul une matrice de couplage entre deux inconnues. 5 : C---------------------------------------------------------------------- 6 : C La discrétisation est de type 0D ou multiD. Le sous type de la table 7 : C d'entrée permet d'identifier la discrétisation utilisée. 8 : C---------------------------------------------------------------------- 9 : C 10 : C------------------------- 11 : C Phrase d'appel GIBIANE : 12 : C------------------------- 13 : C 14 : C 'MDIA' TAB1 ; 15 : C 16 : C TAB1 : Table de sous-type 'OPER_0D' ou 'KIZX' selon la discrétisation 17 : C 18 : C-------------------------------- 19 : C Construction de KIZX via EQEX : 20 : C-------------------------------- 21 : C 22 : C 'ZONE' TAB2 'OPER' 'MDIA' OBJ1 'INCO' MOT1 (MOT2) 23 : C 24 : C TAB2 : TABLE DOMAINE associée à la zone d'action de l'opérateur. 25 : C OBJ1 : Coefficient multiplicateur h (CHPO, ENTIER, FLOTTANT, 26 : C POINT ou MOT). 27 : C MOT1 : Nom de l'inconnue primale (MOT). 28 : C MOT2 : Nom de l'inconnue duale (facultatif si égal à MOT1 - MOT). 29 : C 30 : C----------- 31 : C Résultat : 32 : C----------- 33 : C 34 : C On crée une matrice diagonale : en multiD, stockée dans un MATRIK et 35 : C rangée à l'indice 'MATELM' de la table de sous-type 'KIZX' ; en 0D, 36 : C dans un objet 'RIGIDITE' à l'indice 'LHS' de la table de sous-type 37 : C 'OPER_0D'. 38 : C 39 : C------------------------------------ 40 : C Dimensions et supports des données : 41 : C------------------------------------ 42 : C 43 : C Les cas considérés sont les suivants : 44 : C 45 : C +--------------------------------+ 46 : C | D i m e n s i o n | 47 : C --------------+--------------------------------+ 48 : C cas considéré | duale V | primale T | coeff. a | 49 : C --------------+--------------------------------+ 50 : C a T dans V 1 1 1 51 : C ->-> 52 : C a T dans V 1 IDIM IDIM 53 : C -> -> 54 : C a T dans V IDIM 1 IDIM 55 : C -> -> 56 : C a T dans V IDIM IDIM 1 57 : C --------------+--------------------------------+ 58 : C 59 : C 60 : C Pour chaque champ, on désigne par S, C et F les spg SOMMET, CENTRE 61 : C et FACE. Les cas considérés sont : 62 : C 63 : C --------------+-------------+ 64 : C cas considéré | 1 2 3 4 5 6 | 65 : C --------------+-------------+ 66 : C primale S C F S S C 67 : C duale S C F C C S 68 : C coeff S C F S C C 69 : C --------------+-------------+ 70 : C IKAS 1 1 1 si primale et duale meme nom 71 : C 2 2 2 3 3 4 si nom primal <> nom dual 72 : C --------------+-------------+ 73 : C 74 : C Le croisement de ces deux tableaux donnent les différents cas. 75 : C 76 : C 77 : C----------------------- 78 : C Variables importante : 79 : C----------------------- 80 : C 81 : C IK1 = Type du coefficient (0:CHPOINT, 1:ENTIERouFLOTTANT, 2:POINT) 82 : C IKOU = 0 si la matrice de couplage est sur la diagonale, 1 sinon 83 : C KFORM = Discrétisation spatiale (0:SI, 1:EF, 2:VF) 84 : C KIMPL = Discrétisation temporelle (0:EXPL, 1:IMPL, 2:CN) 85 : C KK = Rang d'un élément dans la numérotation globale 86 : C KPOIN = Support du CHAMPOIN (0:SOMMET, 1:FACE, 2:CENTRE) 87 : C NC = Rang de la composante du champ multiplicateur à considérer 88 : C 89 : C---------------------------------------------------------------------- 90 : IMPLICIT INTEGER(I-N) 91 : IMPLICIT REAL*8 (A-H,O-Z) 92 : C 93 : -INC CCOPTIO 94 : -INC CCGEOME 95 : -INC SMCOORD 96 : -INC SMLENTI 97 : -INC SMELEME 98 : POINTEUR MELEMP.MELEME 99 : -INC SMCHPOI 100 : -INC SMCHAML 101 : -INC SMMATRIK 102 : -INC SMTABLE 103 : -INC SMLMOTS 104 : C 105 : CHARACTER*8 TYPE,TYPC,NOM,NOMP,NOMD,CHAI,MTYP 106 : PARAMETER (NTB=2) 107 : CHARACTER*8 LTAB(NTB) 108 : DIMENSION KTAB(NTB),IXV(4) 109 : 110 : C****************************************************************** 111 : CMDIA 112 : C write(6,*)' Debut MDIA ' 113 : 114 : C Nouvelle directive EQUA de EQEX 115 : MTYP=' ' 115 : CALL QUETYP(MTYP,0,IRET) 116 : IF(IRET.EQ.0)THEN 117 : C% On attend un des objets : %m1:8 %m9:16 %m17:24 %m25:32 %m33:40 118 : MOTERR( 1: 8) = 'CHAI ' 119 : MOTERR( 9:16) = 'MMODEL ' 120 : MOTERR(17:24) = 'TABLE ' 120 : CALL ERREUR(472) 121 : RETURN 122 : ENDIF 123 : 124 : IF(MTYP.EQ.'MMODEL')THEN 124 : CALL YTCLSF(' M ','MDIA ') 125 : RETURN 126 : ELSEIF(MTYP.EQ.'MOT ')THEN 126 : CALL LIRCHA(CHAI,1,IRET) 126 : CALL YTCLSF(CHAI,'MDIA ') 127 : RETURN 128 : ENDIF 129 : C Fin Nouvelle directive EQUA de EQEX 130 : 131 : C 132 : C- LECTURE de la table TAB1 contenant les données et bifurcation si 0D. 133 : C- (repérage de la discrétisation 2D/3D ou 0D par le sous-type de TAB1 134 : C- [respectivement, KIZX ou OPER_0D]). 135 : C 136 : LTAB(1) = 'KIZX ' 137 : LTAB(2) = 'OPER_0D ' 138 : KTAB(1) = 0 139 : KTAB(2) = 0 139 : CALL LITABS(LTAB,KTAB,NTB,0,IRET) 140 : IF (IERR.NE.0) RETURN 141 : IF (KTAB(1).NE.0) THEN 142 : MTABX = KTAB(1) 143 : ELSEIF (KTAB(2).NE.0) THEN 144 : IPTAB1 = KTAB(2) 144 : CALL TDIAG (IPTAB1) 145 : RETURN 146 : ELSE 147 : C Le sous-type de la table est incorrect 147 : CALL ERREUR(648) 148 : RETURN 149 : ENDIF 150 : C 151 : C- Récupération de la table des options KOPT 152 : C 152 : CALL LEKTAB(MTABX,'KOPT',KOPTI) 153 : IF (KOPTI.EQ.0) THEN 154 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 155 : MOTERR( 1: 8) = ' KOPT ' 156 : MOTERR( 9:16) = ' KOPT ' 157 : MOTERR(17:24) = ' KIZX ' 157 : CALL ERREUR(786) 158 : RETURN 159 : ELSE 159 : CALL ACME(KOPTI,'KIMPL',KIMPL) 160 : IF (IERR.NE.0) RETURN 160 : CALL ACME(KOPTI,'KFORM',KFORM) 161 : IF (IERR.NE.0) RETURN 162 : ENDIF 163 : IF (KIMPL.NE.1) THEN 164 : C Tentative d'utilisation d'une option non implémentée 164 : CALL ERREUR(251) 165 : RETURN 166 : ENDIF 167 : C 168 : C- Récupération des tables : EQEX, INCO, DOMAINE 169 : C 169 : CALL LEKTAB(MTABX,'EQEX',MTAB1) 170 : IF (MTAB1.EQ.0) THEN 171 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 172 : MOTERR( 1: 8) = ' EQEX ' 173 : MOTERR( 9:16) = ' EQEX ' 174 : MOTERR(17:24) = ' KIZX ' 174 : CALL ERREUR(786) 175 : RETURN 176 : ENDIF 176 : CALL ACME(MTAB1,'NAVISTOK',NASTOK) 176 : CALL LEKTAB(MTAB1,'INCO',KINC) 177 : IF (KINC.EQ.0) THEN 178 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 179 : MOTERR( 1: 8) = ' INCO ' 180 : MOTERR( 9:16) = ' INCO ' 181 : MOTERR(17:24) = ' EQEX ' 181 : CALL ERREUR(786) 182 : RETURN 183 : ENDIF 183 : CALL LEKTAB(MTABX,'DOMZ',MTABZ) 184 : IF (MTABZ.EQ.0) THEN 185 : C Indice %m1:8 : Indice %m9:16 non trouvé dans la table %m17:24 186 : MOTERR( 1: 8) = ' DOMZ ' 187 : MOTERR( 9:16) = ' DOMZ ' 188 : MOTERR(17:24) = ' EQEX ' 188 : CALL ERREUR(786) 189 : RETURN 190 : ENDIF 191 : C 192 : C- Récupération des indices MAILLAGE, CENTRE, FACE 193 : C- et SOMMET du DOMAINE local 194 : C 195 : TYPE = 'MAILLAGE' 195 : CALL ACMO(MTABZ,'CENTRE',TYPE,MELEMC) 196 : IF (IERR.NE.0) RETURN 196 : CALL ACMO(MTABZ,'FACE',TYPE,MELEMF) 197 : IF (IERR.NE.0) RETURN 197 : CALL ACMO(MTABZ,'SOMMET',TYPE,MELEMS) 198 : IF (IERR.NE.0) RETURN 198 : CALL ACMO(MTABZ,'MAILLAGE',TYPE,MELEME) 199 : IF (IERR.NE.0) RETURN 200 : C 201 : C- Récupération du nom des inconnues primale et duale 202 : C 203 : TYPE = 'LISTMOTS' 203 : CALL ACMO(MTABX,'LISTINCO',TYPE,MLMOTS) 204 : SEGACT MLMOTS 205 : NBINC = MOTS(/2) 206 : IF (NBINC.LE.0.OR.NBINC.GE.3) THEN 207 : C Indice %m1:8 : contient plus de %i1 %m9:16 208 : MOTERR( 1:8) = 'LISTINCO' 209 : INTERR(1) = 2 210 : MOTERR(9:16) = ' MOTS ' 210 : CALL ERREUR(799) 211 : RETURN 212 : ENDIF 213 : NOMP = MOTS(1)//' ' 214 : IF (NBINC.EQ.1) THEN 215 : NOMD = NOMP 216 : IKOU = 0 217 : ELSE 218 : NOMD = MOTS(2)//' ' 219 : IF (NOMP.EQ.NOMD) THEN 220 : IKOU = 0 221 : ELSE 222 : IKOU = 1 223 : ENDIF 224 : ENDIF 225 : SEGDES MLMOTS 226 : C 227 : C- Récupération de l'inconnue primale et de son spg 228 : C 229 : TYPE = ' ' 229 : CALL ACMO(KINC,NOMP,TYPE,MCHPOI) 230 : IF (TYPE.NE.'CHPOINT ') THEN 231 : C Indice %m1:8 : ne contient pas un objet de type %m9:16 232 : MOTERR( 1: 8) = 'INCO'//NOMP(1:4) 233 : MOTERR( 9:16) = 'CHPOINT ' 233 : CALL ERREUR(800) 234 : RETURN 235 : ELSE 235 : CALL LICHT(MCHPOI,MPOVAL,TYPC,MELEMP) 236 : NINKOP = VPOCHA(/2) 237 : SEGDES MPOVAL 238 : IF (NINKOP.NE.1.AND.NINKOP.NE.IDIM) THEN 239 : C Indice %m1:8 : Le %m9:16 n'a pas le bon nombre de composantes 240 : MOTERR( 1: 8) = 'INCO'//NOMP(1:4) 241 : MOTERR( 9:16) = 'CHPOINT ' 241 : CALL ERREUR(784) 242 : RETURN 243 : ENDIF 244 : ENDIF 245 : C 246 : C- Récupération de l'inconnue duale et de son spg 247 : C 248 : IF (IKOU.EQ.0) THEN 249 : MELEMD = MELEMP 250 : NINKOD = NINKOP 251 : ELSE 252 : TYPE = ' ' 252 : CALL ACMO(KINC,NOMD,TYPE,MCHPOI) 253 : IF (TYPE.NE.'CHPOINT ') THEN 254 : C Indice %m1:8 : ne contient pas un objet de type %m9:16 255 : MOTERR( 1: 8) = 'INCO'//NOMD(1:4) 256 : MOTERR( 9:16) = 'CHPOINT ' 256 : CALL ERREUR(800) 257 : RETURN 258 : ELSE 258 : CALL LICHT(MCHPOI,MPOVAL,TYPC,MELEMD) 259 : NINKOD = VPOCHA(/2) 260 : SEGDES MPOVAL 261 : IF (NINKOD.NE.1.AND.NINKOD.NE.IDIM) THEN 262 : C Indice %m1:8 : Le %m9:16 n'a pas le bon nombre de comp... 263 : MOTERR( 1: 8) = 'INCO'//NOMD(1:4) 264 : MOTERR( 9:16) = 'CHPOINT ' 264 : CALL ERREUR(784) 265 : RETURN 266 : ENDIF 267 : ENDIF 268 : ENDIF 269 : C 270 : C- Identification du spg de l'inconnue primale 271 : C Cas 1D (IRET1=1) : face et sommet sont confondus 272 : C Elt de degré 2 (IRET1=0) : face et centre inclus dans sommet 273 : C 273 : CALL KRIPAD(MELEMP,MLENT1) 273 : CALL VERPAD(MLENT1,MELEMS,IRETS) 273 : CALL VERPAD(MLENT1,MELEMF,IRETF) 273 : CALL VERPAD(MLENT1,MELEMC,IRETC) 274 : SEGSUP MLENT1 275 : IRET1 = IRETS + IRETC + IRETF 276 : IF (IRET1.EQ.0) THEN 277 : IRETF = 1 278 : IRETC = 1 279 : IRET1 = 2 280 : ENDIF 281 : IF (IRET1.EQ.1.AND.IRETF.EQ.1) THEN 282 : IRETS = 1 283 : IRET1 = 2 284 : ENDIF 285 : IF (IRET1.EQ.1.AND.IRETC.EQ.1) THEN 286 : IRETF = 1 287 : IRET1 = 2 288 : ENDIF 289 : IF (IRET1.EQ.2) THEN 290 : IF (IRETS.EQ.0) THEN 291 : KPOINP = 0 292 : MELEMP = MELEMS 293 : ELSEIF (IRETF.EQ.0) THEN 294 : KPOINP = 1 295 : MELEMP = MELEMF 296 : ELSEIF (IRETC.EQ.0) THEN 297 : KPOINP = 2 298 : MELEMP = MELEMC 299 : ENDIF 300 : ELSE 301 : C Indice %m1:8 : L'objet %m9:16 n'a pas le bon support géométrique 302 : MOTERR(1: 8) = 'INCO'//NOMP(1:4) 303 : MOTERR(9:16) = 'CHPOINT ' 303 : CALL ERREUR(788) 304 : RETURN 305 : ENDIF 306 : C 307 : C- Identification du spg de l'inconnue duale 308 : C 309 : IF (IKOU.EQ.0) THEN 310 : KPOIND = KPOINP 311 : MELEMD = MELEMP 312 : ELSE 312 : CALL KRIPAD(MELEMD,MLENT2) 312 : CALL VERPAD(MLENT2,MELEMS,IRETS) 312 : CALL VERPAD(MLENT2,MELEMF,IRETF) 312 : CALL VERPAD(MLENT2,MELEMC,IRETC) 313 : SEGSUP MLENT2 314 : IRET1 = IRETS + IRETC + IRETF 315 : IF (IRET1.EQ.0) THEN 316 : IRETF = 1 317 : IRETC = 1 318 : IRET1 = 2 319 : ENDIF 320 : IF (IRET1.EQ.1.AND.IRETF.EQ.1) THEN 321 : IRETS = 1 322 : IRET1 = 2 323 : ENDIF 324 : IF (IRET1.EQ.1.AND.IRETC.EQ.1) THEN 325 : IRETF = 1 326 : IRET1 = 2 327 : ENDIF 328 : IF (IRET1.EQ.2) THEN 329 : IF (IRETS.EQ.0) THEN 330 : KPOIND = 0 331 : MELEMD = MELEMS 332 : ELSEIF (IRETF.EQ.0) THEN 333 : KPOIND = 1 334 : MELEMD = MELEMF 335 : ELSEIF (IRETC.EQ.0) THEN 336 : KPOIND = 2 337 : MELEMD = MELEMC 338 : ENDIF 339 : ELSE 340 : C Indice %m1:8 : L'objet %m9:16 n'a pas le bon spg 341 : MOTERR(1: 8) = 'INCO'//NOMD(1:4) 342 : MOTERR(9:16) = 'CHPOINT ' 342 : CALL ERREUR(788) 343 : RETURN 344 : ENDIF 345 : ENDIF 346 : C 347 : C- Compatibilité du spg de la duale avec les options 348 : C 349 : IF (KPOIND.NE.2.AND.KFORM.EQ.2) THEN 350 : C Option %m1:8 incompatible avec les données 351 : MOTERR( 1: 8) = ' VF ' 351 : CALL ERREUR(803) 352 : RETURN 353 : ENDIF 354 : C 355 : C- Identification du cas à traiter 356 : C 357 : IF (KPOINP.EQ.KPOIND) THEN 358 : IF (IKOU.EQ.0) THEN 359 : IKAS = 1 360 : ELSE 361 : IKAS = 2 362 : ENDIF 363 : ELSEIF (KPOINP.EQ.0.AND.KPOIND.EQ.2) THEN 364 : IKAS = 3 365 : ELSEIF (KPOINP.EQ.2.AND.KPOIND.EQ.0)THEN 366 : IKAS = 4 367 : ELSE 368 : C Option indisponible 368 : CALL ERREUR(19) 369 : RETURN 370 : ENDIF 371 : C 372 : C- Récupération suivant IKAS des "matrices masses" élémentaires 373 : C 374 : IF (IKAS.EQ.1.OR.IKAS.EQ.2) THEN 375 : IF (KPOINP.EQ.0) THEN 375 : CALL LEKTAB(MTABZ,'XXDIAGSI',MCHPOI) 376 : ELSEIF (KPOINP.EQ.1) THEN 376 : CALL LEKTAB(MTABZ,'XXDIAGFA',MCHPOI) 377 : ELSEIF (KPOINP.EQ.2) THEN 377 : CALL LEKTAB(MTABZ,'XXVOLUM ',MCHPOI) 378 : ENDIF 379 : IF (IERR.NE.0) RETURN 380 : ELSE 380 : CALL LEKTAB(MTABZ,'XXPSOML',MCHELM) 381 : IF (IERR.NE.0) RETURN 382 : ENDIF 383 : C 384 : C- Lecture du coefficient multiplicateur : 385 : C- 1) son support est celui de la primale ou CENTRE si primale<>FACE 386 : C- 2) sa dimension dépend de primale et duale (cf cas prévu en tete) 387 : C 387 : CALL ACME(MTABX,'IARG',IARG) 388 : IF (IERR.NE.0) RETURN 389 : IF (IARG.NE.1)THEN 390 : C Indice %m1:8 : nombre d'argument incorrect 391 : MOTERR(1:8) = 'IARG ' 391 : CALL ERREUR(804) 392 : RETURN 393 : ENDIF 394 : IF (NINKOP.EQ.NINKOD) THEN 395 : IXV(1) = MELEMP 396 : IXV(2) = 1 397 : IXV(3) = 0 398 : IF (IKAS.NE.3) THEN 399 : IRET = 0 400 : ELSE 401 : IRET = 4 402 : IXV(4) = MELEMC 403 : ENDIF 404 : ELSE 405 : IXV(1) = - MELEMP 406 : IXV(2) = 1 407 : IXV(3) = 1 408 : IF (IKAS.NE.3) THEN 409 : IRET = 0 410 : ELSE 411 : IRET = 4 412 : IXV(4) = - MELEMC 413 : ENDIF 414 : ENDIF 414 : CALL LEKCOF('Opérateur MDIA : ', 415 : & MTABX,KINC,1,IXV,MCHPO1,MPOVA1,NPT1,NCOF,IK1,IRET) 416 : IF (IRET.EQ.0) RETURN 417 : C 418 : C------------------------------------------------------------ 419 : C- Spg des inconnues primale et duale identique (IKAS=1 ou 2) 420 : C------------------------------------------------------------ 421 : C 422 : IF (IKAS.EQ.1.OR.IKAS.EQ.2) THEN 423 : NBSOUS = 1 424 : NRIGE = 7 425 : NKID = 9 426 : NKMT = 7 427 : NMATRI = 1 428 : SEGINI MATRIK 429 : IRIGEL(1,1) = MELEMP 430 : IRIGEL(2,1) = MELEMD 431 : IF (IKOU.EQ.0) THEN 432 : IRIGEL(7,1) = 5 433 : ELSE 434 : IRIGEL(7,1) = 2 435 : ENDIF 436 : IF (NINKOD*NINKOP.EQ.1) THEN 437 : NBME = 1 438 : ELSE 439 : NBME = IDIM 440 : ENDIF 441 : SEGINI IMATRI 442 : IRIGEL(4,1) = IMATRI 443 : KSPGP = MELEMP 444 : KSPGD = MELEMD 445 : SEGACT MELEMP 446 : NP = 1 447 : MP = 1 448 : NBEL = MELEMP.NUM(/2) 449 : SEGDES MELEMP 449 : CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOM) 450 : DO 130 N=1,NBME 451 : NC = MIN(N,NCOF) 452 : C 453 : C- Initialisation du nom des composantes primale et duale 454 : C- associées au Nième bloc de matrices élémentaires 455 : C 456 : IF (NINKOP.EQ.1) THEN 457 : NOM = NOMP 458 : ELSE 459 : WRITE(NOM,FMT='(I1,A7)') N,NOMP(1:7) 460 : ENDIF 461 : LISPRI(N)=NOM(1:4)//' ' 462 : IF (NINKOD.EQ.1) THEN 463 : NOM = NOMD 464 : ELSE 465 : WRITE(NOM,FMT='(I1,A7)') N,NOMD(1:7) 466 : ENDIF 467 : LISDUA(N)=NOM(1:4)//' ' 468 : C 469 : C- Calcul des matrices élémentaires associées au Nième bloc 470 : C 471 : SEGINI IZAFM 472 : LIZAFM(1,N) = IZAFM 473 : IF (IK1.EQ.1) THEN 474 : DO 100 K=1,NBEL 475 : AM(K,1,1) = VPOCHA(K,1) * MPOVA1.VPOCHA(1,1) 476 : 100 CONTINUE 477 : ELSEIF(IK1.EQ.2)THEN 478 : DO 110 K=1,NBEL 479 : AM(K,1,1) = VPOCHA(K,1) * MPOVA1.VPOCHA(1,N) 480 : 110 CONTINUE 481 : ELSEIF(IK1.EQ.0)THEN 482 : DO 120 K=1,NBEL 483 : AM(K,1,1) = VPOCHA(K,1) * MPOVA1.VPOCHA(K,NC) 484 : 120 CONTINUE 485 : ENDIF 486 : SEGDES IZAFM 487 : 130 CONTINUE 488 : SEGDES MPOVAL 489 : SEGDES IMATRI,MATRIK 490 : C 491 : C------------------------------------- 492 : C Primale au CENTRE et Duale au SOMMET 493 : C------------------------------------- 494 : C 495 : ELSEIF (IKAS.EQ.3) THEN 496 : IF (IK1.EQ.0) THEN 497 : ITEST = ABS(IXV(1)) 497 : CALL KRIPAD(ITEST,MLENT3) 498 : ENDIF 499 : SEGACT MCHELM 500 : NBSOUS = IMACHE(/1) 501 : NRIGE = 7 502 : NKID = 9 503 : NKMT = 7 504 : NMATRI = 1 505 : SEGINI MATRIK 506 : IRIGEL(1,1) = MELEME 507 : IRIGEL(2,1) = MELEMC 508 : IRIGEL(7,1) = 3 509 : IF (NINKOD*NINKOP.EQ.1) THEN 510 : NBME = 1 511 : ELSE 512 : NBME = IDIM 513 : ENDIF 514 : SEGINI IMATRI 515 : IRIGEL(4,1) = IMATRI 516 : KSPGP = MELEMS 517 : KSPGD = MELEMC 518 : DO 350 N=1,NBME 519 : NC = MIN(N,NCOF) 520 : C 521 : C- Initialisation du nom des composantes primale et duale 522 : C- associées au Nième bloc de matrices élémentaires 523 : C 524 : IF (NINKOP.EQ.1) THEN 525 : NOM = NOMP 526 : ELSE 527 : WRITE(NOM,FMT='(I1,A7)') N,NOMP(1:7) 528 : ENDIF 529 : LISPRI(N)=NOM(1:4)//' ' 530 : IF (NINKOD.EQ.1) THEN 531 : NOM = NOMD 532 : ELSE 533 : WRITE(NOM,FMT='(I1,A7)') N,NOMD(1:7) 534 : ENDIF 535 : LISDUA(N)=NOM(1:4)//' ' 536 : C 537 : C- Calcul des matrices élémentaires associées au Nième bloc 538 : C 539 : KK = 0 540 : DO 340 L=1,NBSOUS 541 : MCHAML = ICHAML(L) 542 : SEGACT MCHAML 543 : MELVAL = IELVAL(1) 544 : SEGACT MELVAL 545 : IPT1 = IMACHE(L) 546 : SEGACT IPT1 547 : MP = 1 548 : NP = IPT1.NUM(/1) 549 : NBEL = IPT1.NUM(/2) 550 : SEGINI IZAFM 551 : LIZAFM(L,N) = IZAFM 552 : IF (IK1.EQ.1) THEN 553 : DO 300 K=1,NBEL 554 : DO 300 II=1,NP 555 : AM(K,II,1) = VELCHE(II,K) * MPOVA1.VPOCHA(1,1) 556 : 300 CONTINUE 557 : ELSEIF (IK1.EQ.2) THEN 558 : DO 310 K=1,NBEL 559 : DO 310 II=1,NP 560 : AM(K,II,1) = VELCHE(II,K) * MPOVA1.VPOCHA(1,N) 561 : 310 CONTINUE 562 : ELSEIF (IK1.EQ.4) THEN 563 : DO 320 K=1,NBEL 564 : KK = KK + 1 565 : DO 320 II=1,NP 566 : AM(K,II,1)=VELCHE(II,K)*MPOVA1.VPOCHA(KK,NC) 567 : 320 CONTINUE 568 : ELSEIF (IK1.EQ.0) THEN 569 : DO 330 K=1,NBEL 570 : DO 330 II=1,NP 571 : KD = MLENT3.LECT(IPT1.NUM(II,K)) 572 : AM(K,II,1) = VELCHE(II,K) * MPOVA1.VPOCHA(KD,NC) 573 : 330 CONTINUE 574 : ENDIF 575 : SEGDES IZAFM 576 : SEGDES IPT1,MELVAL,MCHAML 577 : 340 CONTINUE 578 : 350 CONTINUE 579 : SEGDES IMATRI,MATRIK 580 : SEGDES MCHELM 581 : IF (IK1.EQ.0) SEGSUP MLENT3 582 : C 583 : C------------------------------------- 584 : C Primale au CENTRE et Duale au SOMMET 585 : C------------------------------------- 586 : C 587 : ELSEIF (IKAS.EQ.4) THEN 588 : SEGACT MCHELM 589 : NBSOUS = IMACHE(/1) 590 : NRIGE = 7 591 : NKID = 9 592 : NKMT = 7 593 : NMATRI = 1 594 : SEGINI MATRIK 595 : IRIGEL(1,1) = MELEMC 596 : IRIGEL(2,1) = MELEME 597 : IRIGEL(7,1) = 3 598 : IF (NINKOD*NINKOP.EQ.1) THEN 599 : NBME = 1 600 : ELSE 601 : NBME = IDIM 602 : ENDIF 603 : SEGINI IMATRI 604 : IRIGEL(4,1) = IMATRI 605 : KSPGP = MELEMC 606 : KSPGD = MELEMS 607 : DO 440 N=1,NBME 608 : NC = MIN(N,NCOF) 609 : C 610 : C- Initialisation du nom des composantes primale et duale 611 : C- associées au Nième bloc de matrices élémentaires 612 : C 613 : IF (NINKOP.EQ.1) THEN 614 : NOM = NOMP 615 : ELSE 616 : WRITE(NOM,FMT='(I1,A7)') N,NOMP(1:7) 617 : ENDIF 618 : LISPRI(N)=NOM(1:4)//' ' 619 : IF (NINKOD.EQ.1) THEN 620 : NOM = NOMD 621 : ELSE 622 : WRITE(NOM,FMT='(I1,A7)') N,NOMD(1:7) 623 : ENDIF 624 : LISDUA(N)=NOM(1:4)//' ' 625 : C 626 : C- Calcul des matrices élémentaires associées au Nième bloc 627 : C 628 : KK = 0 629 : DO 430 L=1,NBSOUS 630 : MCHAML = ICHAML(L) 631 : SEGACT MCHAML 632 : MELVAL = IELVAL(1) 633 : SEGACT MELVAL 634 : IPT1 = IMACHE(L) 635 : SEGACT IPT1 636 : MP = IPT1.NUM(/1) 637 : NP = 1 638 : NBEL = IPT1.NUM(/2) 639 : SEGINI IZAFM 640 : LIZAFM(L,N) = IZAFM 641 : IF (IK1.EQ.1) THEN 642 : DO 400 K=1,NBEL 643 : DO 400 II=1,MP 644 : AM(K,1,II) = VELCHE(II,K) * MPOVA1.VPOCHA(1,1) 645 : 400 CONTINUE 646 : ELSEIF (IK1.EQ.2) THEN 647 : DO 410 K=1,NBEL 648 : DO 410 II=1,MP 649 : AM(K,1,II) = VELCHE(II,K) * MPOVA1.VPOCHA(1,N) 650 : 410 CONTINUE 651 : ELSEIF (IK1.EQ.0) THEN 652 : DO 420 K=1,NBEL 653 : KK = KK + 1 654 : DO 420 II=1,MP 655 : AM(K,1,II) = VELCHE(II,K) * MPOVA1.VPOCHA(KK,NC) 656 : 420 CONTINUE 657 : ENDIF 658 : SEGDES IZAFM 659 : SEGDES IPT1,MELVAL,MCHAML 660 : 430 CONTINUE 661 : 440 CONTINUE 662 : SEGDES IMATRI,MATRIK 663 : SEGDES MCHELM 664 : ENDIF 665 : SEGDES MPOVA1 666 : C 667 : IF(NASTOK.EQ.0)THEN 668 : C 669 : C- Ecriture du résultat à l'indice 'MATELM' de la table 'KIZX' 670 : C 670 : CALL ECMO(MTABX,'MATELM','MATRIK',MATRIK) 671 : ELSE 672 : C 673 : C- Ecriture des résultats dans la pile des objets 674 : C 675 : NAT=2 676 : NSOUPO=0 677 : SEGINI MCHPO1 678 : MCHPO1.JATTRI(1)=2 678 : CALL ECROBJ('MATRIK',MATRIK) 678 : CALL ECROBJ('CHPOINT',MCHPO1) 679 : ENDIF 680 : RETURN 681 : END 682 : 683 : 684 : 685 : 686 : 687 : 688 : 689 : 690 : 691 : 692 : 693 :
© Cast3M 2003 - All rights reserved.
Disclaimer