1 : C ASNS1 SOURCE CHAT 09/10/09 21:15:45 6519 2 : SUBROUTINE ASNS1 ( IPOIRI,MMATRX,INUINY,ITOPOY,IMINIY,IPOY, 3 : & INCTRY,INCTRZ,IITOPY,ITOPOD,IITOPD,IPODD) 4 : 5 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 6 : C CE SUBROUTINE SERT A L'ASSEMBLAGE DE MATRICES SYMETRIQUES 7 : C EN VUE D'UNE INVERSION PAR UNE METHODE DE CROUT 8 : C 9 : C EN ENTREE: 10 : C **** IPOIRI: POINTEUR SUR OBJET MRIGIDITE,NON MODIFIE 11 : C EN SORTIE: 12 : C **** INUINV IMINI ITOPO IPOY INCTRY SONT DES POINTEURS DES SEGMENTS 13 : C DE TRAVAIL SERVANT A L'ASSEMBLAGE ILS SONT DETRUITS EN FIN 14 : C D'ASSEMBLAGE OU DE TRIANGULARISATION 15 : C **** MMATRI EST LE POINTEUR DE L'OBJET FUTUR MATRICE TRIANGULARISEE. 16 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 17 : 18 : IMPLICIT INTEGER(I-N) 19 : -INC CCOPTIO 20 : -INC SMELEME 21 : -INC SMCOORD 22 : 23 : SEGMENT,IMIN(NNOE) 24 : SEGMENT,IMINB(NNOE) 25 : SEGMENT ICPR(XCOOR(/1)/(IDIM+1)) 26 : C 27 : -INC SMRIGID 28 : -INC SMMATRI 29 : C 30 : SEGMENT,INUINV(NNGLOB) 31 : SEGMENT,ITOPO(IENNO) 32 : SEGMENT,IITOP(NNOE+1) 33 : SEGMENT,ITOPOB(IENNO) 34 : SEGMENT,IITOPB(NNOE+1) 35 : SEGMENT,IMINI(INC) 36 : SEGMENT,IPOS(NNOE1) 37 : SEGMENT,IPOD(NNOE1) 38 : SEGMENT,INCTRR(NIRI) 39 : SEGMENT,INCTRD(NIRI) 40 : SEGMENT,INCTRA(NLIGRE) 41 : segment mondu 42 : character*4 mondua(nnn) 43 : integer ipris(nnn),inosel(nnn) 44 : endsegment 45 : 46 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 47 : C **** CES TABLEAUX SERVENT AU REPERAGE DE LA MATRICE POUR L'ASSEMBLAG 48 : C **** IL SERONT TOUS SUPPRIMES EN FIN D'ASSEMBLAGE. 49 : C 50 : C 51 : C **** MAXINC= MAXIMUM DE COMPOSANTES CONCERNANT UN NOEUD 52 : C 53 : C 54 : C **** IITOP(K)=I LE 1ER ELEMENT TOUCHANT LE NOEUD K SE TROUVE EN 55 : C IEME POSITION DANS ITOPO 56 : C **** ITOPO(I)=L: LE 1ER ELEMENT TOUCHANT LE K EME NOEUD DE LA 57 : C ITOPO(I+1)=M MATRICE EST LE LIEME DE L'OBJET GEOMETRIE 58 : C DEFINI PAR LE POINTEUR M 59 : C **** IPOS(I)=J : LA 1 ERE INCONNUE DU NOEUD I EST EN J+1 EME 60 : C POSITION 61 : C **** IMINI(I)=J LA PLUS PETITE INCONNUE QUI EST RELIEE A LA IEME 62 : C EST L'INCONNUE J. 63 : C **** INUINV(I)=J J EST LE NOUVEAU NUMERO DU NOEUD I 64 : C 65 : C **** INCTRR(NIRI) - NIRI=NRIGEL du IPOIRI (objet MRIGID passé en argument) 66 : C pointeurs sur INCTRA 67 : C 68 : C Variables locales : 69 : C -------------------- 70 : C * NNVA = NRIGEL (nombre d'objets MRIGID élémentaires) dans IPOIRI (objet 71 : C MRIGID) passé en argument) 72 : C * NLIGRE = NLIGRP - nombre de variables primales (dans un segment DESCR) 73 : C * IMELP = pointeur d'un MELEME contenant un noeud "normal" 74 : C * ICDOUR = ??? 75 : C 76 : CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 77 : 78 : CHARACTER*4 CNOHA,lisi 79 : DATA CNOHA/'NOHA'/ 80 : DATA IPOIN/1/ 81 : 82 : READ (CNOHA,FMT='(A4)') NOHA 83 : NNGLOB=XCOOR(/1)/(IDIM+1) 84 : 85 : MRIGID=IPOIRI 86 : SEGACT,MRIGID 87 : 88 : NNVA=IRIGEL(/2) 89 : NIRI=NNVA 90 : SEGINI,INCTRR 91 : SEGINI,INCTRD 92 : 93 : MELEME=IRIGEL(1,1) 94 : SEGACT MELEME 95 : C ... ITYPEL = 27 correspond aux éléments 'ATTA' ... 96 : IF(ITYPEL.NE.27) GO TO 801 97 : SEGDES MELEME 98 : C 99 : C **** ASSEMBLAGE DANS LE CAS DE L'ANALYSE MODALE. ON COMPTE LES POINTS 100 : C **** DANS ICPR 101 : C 102 : SEGINI INUINV,ICPR 103 : IKI=0 104 : DO 700 I=1,NNVA 105 : MELEME=IRIGEL(1,I) 106 : SEGACT MELEME 107 : NBNN=NUM(/1) 108 : NBELEM=NUM(/2) 109 : DO 701 I1=1,NBELEM 110 : DO 701 I2=1,NBNN 111 : IP1=NUM(I2,I1) 112 : IF(ICPR(IP1).NE.0) GO TO 701 113 : IKI=IKI+1 114 : ICPR(IP1)=IKI 115 : 701 CONTINUE 116 : SEGDES MELEME 117 : 700 CONTINUE 118 : C 119 : C **** FABRICATION DU TABLEAU INUINV 120 : C **** ON MET LES POINTS QUI ONT POUR INCONNUE ALFA EN TETE 121 : C 122 : NNOE=IKI 123 : NBETA=0 124 : DO 710 I=1,NNVA 125 : MELEME=IRIGEL(1,I) 126 : DESCR =IRIGEL(3,I) 127 : SEGACT MELEME,DESCR 128 : NBNN=NUM(/1) 129 : NBELEM=NUM(/2) 130 : NLIGRE=LISINC(/2) 131 : DO 711 I1=1,NBELEM 132 : DO 711 I2=1,NBNN 133 : IP1=NUM(I2,I1) 134 : IF(ICPR(IP1).EQ.0) GO TO 711 135 : 715 CONTINUE 136 : NBETA=NBETA+1 137 : IKI=NNOE-NBETA+1 138 : 716 CONTINUE 139 : INUINV(IP1)=IKI 140 : ICPR(IP1)=0 141 : 711 CONTINUE 142 : SEGDES MELEME,DESCR 143 : * SEGSUP IPB 144 : 710 CONTINUE 145 : SEGSUP ICPR 146 : ICDOUR=NNOE 147 : GO TO 800 148 : C 149 : C **** ON FABRIQUE UN NOUVEL OBJET GEOMETRIE CONTENANT TOUTES LES 150 : C **** GEOMETRIES ELEMENTAIRES. CET OBJET CONTIENT NNVA OBJETS 151 : C **** GEOMETRIQUES ELEMENTAIRES. PUIS ON ENVOIE DANS NUMOPT QUI 152 : C **** FOURNIT EN RETOUR INUINV(NUM(I,J))=K DONNE LE NOUVEAU 153 : C **** NUMERO LOCAL DU POINT NUM(I,J).K VARIE DE 1 A ICDOUR. 154 : C **** LE PREMIER NOEUD DE L'OBJET GEOMETRIQUE EST LE PREMIER NOEUD 155 : C **** DE LA MATRICE, ETC... 156 : C 157 : 801 CONTINUE 158 : IKK=1 159 : 722 CONTINUE 160 : MELEME=IRIGEL(1,IKK) 161 : SEGACT,MELEME 162 : 163 : DESCR=IRIGEL(3,IKK) 164 : SEGACT,DESCR 165 : 166 : NLIGRE=LISINC(/2) 167 : DO 720 K=1,NLIGRE 168 : IF(LISINC(K).NE.'LX ') GO TO 721 169 : 720 CONTINUE 170 : SEGDES,MELEME 171 : SEGDES,DESCR 172 : IKK=IKK+1 173 : IF(IKK.LE.NNVA) GO TO 722 174 : DO 4862 I=1,NNVA 175 : MELEME= IRIGEL(1,I) 176 : SEGACT MELEME 177 : IF(ITYPEL.EQ.22) THEN 178 : DESCR=IRIGEL(3,I ) 179 : SEGACT,DESCR 180 : K = 3 181 : GO TO 721 182 : ELSE 183 : SEGDES MELEME 184 : ENDIF 185 : 4862 CONTINUE 186 : K=1 187 : MELEME= IRIGEL(1,1) 188 : DESCR= IRIGEL(3,1) 189 : SEGACT MELEME,DESCR 190 : 191 : C ... On arrive ici si : 192 : C * LISINC(K) != 'LX ' => K est le premier parmi K tels que LISINC(K) != 'LX ' 193 : C * ITYPEL d'un des maillages = 22 (élément 'MULT') => K = 3 194 : C * tous les autres cas => K = 1 195 : 196 : C ... IA = numéro (dans l'élément) du noeud concerné par le DDL No K ... 197 : C ... I1 = numéro (absolu) du noeud concerné par le DDL No K, 198 : C Ce noeud sera mis dans un MELEME dont le pointeur est stocké dans IMELP ... 199 : 200 : 721 IA=NOELEP(K) 201 : I1=NUM(IA,1) 202 : SEGDES,MELEME,DESCR 203 : 204 : NBSOUS=0 205 : NBNN=1 206 : NBREF=0 207 : NBELEM=1 208 : SEGINI,MELEME 209 : ITYPEL=1 210 : NUM(1,1)=I1 211 : SEGDES,MELEME 212 : IMELP=MELEME 213 : 214 : C ... Le MELEME créé ici est un MELEME composé qui contiendra le MELEME 215 : C pointé par IMELP et tous les MELEME pointés par IRIGEL(1,*) ... 216 : NBSOUS=NNVA+1 217 : NBREF=0 218 : NBNN=0 219 : NBELEM=0 220 : SEGINI,MELEME 221 : LISOUS(1)=IMELP 222 : DO 12 I=1,NNVA 223 : LISOUS(I+1)=IRIGEL(1,I) 224 : 12 CONTINUE 225 : SEGDES,MELEME 226 : 227 : ICDOUR=0 228 : SEGINI,INUINV 229 : SEGDES,INUINV 229 : CALL NUMOPT(MELEME,INUINV,ICDOUR) 230 : C ... A la sortie INUINV contient l'ordre des noeuds et ICDOUR le nombre de noeuds présents dans MELEME ... 231 : SEGACT INUINV 232 : SEGSUP,MELEME 233 : MELEME=IMELP 234 : SEGDES,MELEME 235 : C 236 : C **** CREATION D'UN OBJET GEOMETRIE QU'IL FAUDRA CHANGER EN CAS DE 237 : C **** RENUMEROTATION GENERALE.ON PROFITE DE LA BOUCLE POUR CREE LE 238 : C **** TABLEAU IMIN(I)=J QUI DIT QUE J ELEMENTS TOUCHE LE NOEUD I(NU- 239 : C **** MEROTATION LOCALE). 240 : C 241 : 800 CONTINUE 242 : NNOE=ICDOUR 243 : SEGINI,IMIN,IMINB 244 : NNOE1=NNOE+1 245 : SEGINI,IPOS,IPOD 246 : NBSOUS=0 247 : NBREF=0 248 : NBNN=1 249 : NBELEM=ICDOUR 250 : SEGINI,IPT1 251 : IPT1.ITYPEL=IPOIN 252 : DO 16 IRI=1,NNVA 253 : DO 170 I=1,NNOE 254 : ipod(I)=0 255 : 170 IPOS(I)=0 256 : MELEME=IRIGEL(1,IRI) 257 : SEGACT,MELEME 258 : DESCR=IRIGEL(3,IRI) 259 : segact descr 260 : N1=NUM(/1) 261 : N2=NUM(/2) 262 : * write(6,*) 'noelep', ( noelep(iu),iu=1,noelep(/1)) 263 : * write(6,*) 'noeled', ( noeled(iu),iu=1,noeled(/1)) 264 : DO 17 I=1,N2 265 : DO 171 J=1,NOELEP(/1) 266 : K = NUM( NOELEP(J),I) 267 : M=INUINV(K) 268 : IF(IPOS(M).NE.I) THEN 269 : IMIN(M)=IMIN(M)+1 270 : IPT1.NUM(1,M)=K 271 : IPOS(M)=I 272 : ENDIF 273 : 171 CONTINUE 274 : DO 172 J=1,NOELED(/1) 275 : K = NUM( NOELED(J),I) 276 : M=INUINV(K) 277 : IF(IPOD(M).NE.I) THEN 278 : IMINB(M)=IMINB(M)+1 279 : IPOD(M)=I 280 : ENDIF 281 : 172 CONTINUE 282 : 17 CONTINUE 283 : SEGDES,MELEME 284 : 16 CONTINUE 285 : C 286 : C **** INITIALISATION DE ITOPO. ON UTILISE IMIN POUR SE POSITIONNER 287 : C **** DANS ITOPO . 288 : C ... ITOPO contiendra pour chaque noeud et chaque élément contenant 289 : C ce noeud 2 nombres : 290 : C 1. numéro de l'élément dans son maillage 291 : C 2. numéro du maillage (dans IRIGEL) de cet élément 292 : C 293 : C ... IITOP servira pour déterminer la taille de ITOPO ainsi que pour 294 : C se retrouver dedans ... 295 : C 296 : SEGINI,IITOP,IITOPB 297 : IITOP(1)=1 298 : IITOPB(1)=1 299 : * write(6,*) ' imin', ( imin(iu),iu=1,imin(/1)) 300 : * write(6,*) ' iminb', ( iminb(iu),iu=1,iminb(/1)) 301 : DO 18 I=1,NNOE 302 : IITOP(I+1)=IMIN(I)* 2 + IITOP(I) 303 : IITOPB(I+1)=IMINB(I)* 2 + IITOPB(I) 304 : 18 CONTINUE 305 : DO 19 I=1,NNOE 306 : IMINB(I)=0 307 : 19 IMIN(I)=0 308 : C ... IENNO = taille d'ITOPO ... 309 : IENNO=IITOP(NNOE+1) 310 : SEGINI,ITOPO 311 : IENNO=IITOPB(NNOE+1) 312 : SEGINI ITOPOB 313 : DO 21 IRI=1,NNVA 314 : DO 220 I=1,NNOE 315 : IPOD(I)=0 316 : 220 IPOS(I)=0 317 : MELEME=IRIGEL(1,IRI) 318 : SEGACT,MELEME 319 : DESCR = IRIGEL(3,IRI) 320 : N2=NUM(/2) 321 : DO 22 I=1,N2 322 : DO 221 J=1,NOELEP(/1) 323 : M=INUINV(NUM(NOELEP(J),I)) 324 : IF(IPOS(M).NE.I) THEN 325 : IMIN(M)=IMIN(M)+1 326 : IUY= 2* ( IMIN(M)-1 ) + IITOP(M) 327 : C ... Remplissage d'ITOPO ... 328 : ITOPO(IUY)=I 329 : ITOPO(IUY+1)=IRI 330 : IPOS(M)=I 331 : ENDIF 332 : 221 CONTINUE 333 : DO 222 J=1,NOELED(/1) 334 : M=INUINV(NUM(NOELED(J),I)) 335 : IF(IPOD(M).NE.I) THEN 336 : IMINB(M)=IMINB(M)+1 337 : IUY= 2* ( IMINB(M)-1 ) + IITOPB(M) 338 : C ... Remplissage d'ITOPO ... 339 : ITOPOB(IUY)=I 340 : ITOPOB(IUY+1)=IRI 341 : IPOD(M)=I 342 : ENDIF 343 : 222 CONTINUE 344 : 22 CONTINUE 345 : SEGDES,MELEME 346 : 21 CONTINUE 347 : C 348 : C RECHERCHE DE LA VALEUR PAR DEFAUT DE L'HARMONIQUE DANS LE CAS 349 : C DE L'UTILISATION DE " OPTION MODE FOUR NOHAR " 350 : C 351 : C ... On passe cette boucle sans erreur si tous les IRIGEL(5,*) sont égaux 352 : C soit à NOHA soit à une autre valeur fixe (IARDEF) ... 353 : C 354 : DO 230 IRI=1,NNVA 355 : IHARIR=IRIGEL(5,IRI) 356 : IF( IHARIR . NE. NOHA) THEN 357 : IARDEF = IHARIR 358 : GO TO 231 359 : ENDIF 360 : 230 CONTINUE 360 : CALL ERREUR ( 21) 361 : RETURN 362 : 363 : 231 CONTINUE 364 : DO 232 IRI=1,NNVA 365 : IF( IRIGEL(5,IRI) .EQ.NOHA) GO TO 232 366 : IF( IRIGEL(5,IRI).EQ.IARDEF ) GO TO 232 366 : CALL ERREUR (21) 367 : RETURN 368 : 232 CONTINUE 369 : C 370 : C **** RECHERCHE DE LA VALEUR MAXINC QUI PERMET DE DIMENSIONNER INCPOS 371 : C 372 : C ... Les quatre segments sont à l'origine de longueur nulle ... 373 : SEGINI,MIDUA 374 : SEGINI,MIMIK 375 : SEGINI,MHARK 376 : SEGINI,MHAR1 377 : 378 : DESCR=IRIGEL(3,1) 379 : SEGACT,DESCR 380 : 381 : IMIK(**)=LISINC(1) 382 : IAAR=IRIGEL(5,1) 383 : IF(IAAR.EQ.NOHA) IAAR = IARDEF 384 : IHAR(**)= IAAR 385 : IDUA(**)=LISDUA(1) 386 : MHAR1.IHAR(**)= IAAR 387 : 388 : MAXINC=1 389 : DO 23 IRI=1,NNVA 390 : DESCR=IRIGEL(3,IRI) 391 : IHARIR=IRIGEL(5,IRI) 392 : IF(IHARIR. EQ.NOHA ) IHARIR = IARDEF 393 : SEGACT,DESCR 394 : NLIGRE=LISINC(/2) 395 : DO 26 I=1,NLIGRE 396 : DO 24 J=1,MAXINC 397 : IF(IMIK(J).NE.LISINC(I)) GO TO 24 398 : IF(IHAR(J).EQ.IHARIR) GO TO 26 399 : 24 CONTINUE 400 : C ... On empile les valeurs d'IHARIR et LISINC dans 401 : C leurs segments si le couple (IHARIR,LISINC) n'y est pas 402 : C encore représenté ... 403 : MAXINC=MAXINC+1 404 : IHAR(**)=IHARIR 405 : IMIK(**)=LISINC(I) 406 : 26 CONTINUE 407 : 23 CONTINUE 408 : 409 : MAXDUA=1 410 : DO 2322 IRI=1,NNVA 411 : DESCR=IRIGEL(3,IRI) 412 : IHARIR=IRIGEL(5,IRI) 413 : IF(IHARIR. EQ.NOHA ) IHARIR = IARDEF 414 : SEGACT,DESCR 415 : NLIGRE=LISDUA(/2) 416 : DO 262 I=1,NLIGRE 417 : DO 242 J=1,MAXDUA 418 : IF(IDUA(J).NE.LISDUA(I)) GO TO 242 419 : IF(MHAR1.IHAR(J).EQ.IHARIR) GO TO 262 420 : 242 CONTINUE 421 : C ... On empile les valeurs d'IHARIR et LISDUA dans 422 : C leurs segments si le couple (IHARIR,LISDUA) n'y est pas 423 : C encore représenté ... 424 : MAXDUA=MAXDUA+1 425 : MHAR1.IHAR(**)=IHARIR 426 : IDUA(**)=LISDUA(I) 427 : 262 CONTINUE 428 : SEGDES,DESCR 429 : 2322 CONTINUE 430 : * write(6,*) ' imik' 431 : * write(6,*) ( imik(iu),iu=1,imik(/2)) 432 : * write(6,*) ' idua avant' 433 : * write(6,*) ( idua(iu),iu=1,idua(/2)) 434 : nnn = idua(/2) 435 : nqq = imik(/2) 436 : if(nnn.ne.nqq) then 437 : * on verra plus tard 437 : call erreur(5) 438 : stop 439 : endif 440 : * petit travail pour mettre dans le meme ordre les inconnues 441 : segini mondu 442 : do 476 iu=1,imik(/2) 443 : lisi=imik(iu) 444 : do 477 io=1,idua(/2) 445 : if( idua(io).eq.lisi) go to 478 446 : 477 continue 447 : inosel(iu)=1 448 : go to 476 449 : 478 mondua(iu)= idua(io) 450 : ipris(io)=1 451 : 476 continue 452 : do 472 iu=1,inosel(/1) 453 : if( inosel(iu).eq.0) go to 472 454 : do 473 io=1,ipris(/1) 455 : if( ipris(io).eq.1) go to 473 456 : ipris(io)=1 457 : mondua(iu)=idua(io) 458 : go to 472 459 : 473 continue 460 : 472 continue 461 : do 479 iu=1,idua(/2) 462 : idua(iu)=mondua(iu) 463 : 479 continue 464 : segsup mondu 465 : * write(6,*) ' idua apres' 466 : * write(6,*) ( idua(iu),iu=1,idua(/2)) 467 : C 468 : C **** INITIALISATION DE INCPOS ET DE INCTRA. 469 : C 470 : C ... Les dimensions des segments MINCPO initialisés ci-dessous sont les 471 : C suivantes : MAXI = nombre de différentes variables primales (ou duales) 472 : C NNOE = nombre de noeuds effectivement présents 473 : MAXI=MAXINC 474 : SEGINI,MINCPO 475 : 476 : MAXI=MAXDUA 477 : SEGINI,MIPO1 478 : 479 : DO 29 IRI=1,NNVA 480 : IHARIR=IRIGEL(5,1) 481 : IF(IHARIR.EQ.NOHA ) IHARIR = IARDEF 482 : 483 : DESCR=IRIGEL(3,IRI) 484 : SEGACT,DESCR 485 : 486 : NLIGRE=LISINC(/2) 487 : SEGINI,INCTRA 488 : INCTRR(IRI)=INCTRA 489 : 490 : MELEME=IRIGEL(1,IRI) 491 : SEGACT,MELEME 492 : N2=NUM(/2) 493 : 494 : DO 34 J=1,NLIGRE 495 : DO 33 K=1,MAXINC 496 : IF(LISINC(J).NE.IMIK(K)) GO TO 33 497 : IF(IHAR(K).EQ.IHARIR) GO TO 32 498 : 33 CONTINUE 499 : 32 CONTINUE 500 : C ... K est tel que LISINC(J)=IMIK(K) et IHARIR=IHAR(K), 501 : C on le met dans INCTRA(J) (J numérote les variables) correspondant ... 502 : INCTRA(J)=K 503 : C ... Dans la boucle ci-dessous on met à 1 les INCPO correspondants à la 504 : C variable K pour les noeuds des éléments du maillage ... 505 : DO 31 I=1,N2 506 : IJ=INUINV(NUM(NOELEP(J),I)) 507 : 31 INCPO(K,IJ)=1 508 : 34 CONTINUE 509 : 510 : SEGDES,INCTRA 511 : 512 : NLIGRE=LISDUA(/2) 513 : SEGINI,INCTRA 514 : INCTRD(IRI)=INCTRA 515 : 516 : DO 342 J=1,NLIGRE 517 : DO 332 K=1,MAXDUA 518 : IF(LISDUA(J).NE.IDUA(K)) GO TO 332 519 : IF(MHAR1.IHAR(K).EQ.IHARIR) GO TO 322 520 : 332 CONTINUE 521 : 322 CONTINUE 522 : C ... K est tel que LISDUA(J)=IDUA(K) et IHARIR=IHAR(K), 523 : C on le met dans INCTRA(J) (J numérote les variables) correspondant ... 524 : INCTRA(J)=K 525 : C ... Dans la boucle ci-dessous on met à 1 les INCPO correspondants à la 526 : C variable K pour les noeuds des éléments du maillage ... 527 : DO 312 I=1,N2 528 : IJ=INUINV(NUM(NOELED(J),I)) 529 : 312 MIPO1.INCPO(K,IJ)=1 530 : 342 CONTINUE 531 : 532 : SEGDES,DESCR 533 : SEGDES,INCTRA 534 : SEGDES,MELEME 535 : 29 CONTINUE 536 : C 537 : C **** INITIALISATION DE IPOS 538 : C 539 : C ... IPOS(I+1)-IPOS(I) = nombre de colonnes liées au noeud I ... 540 : C ... IPOS(I)+1 = numéro de la première colonne concernant le noeud I ... 541 : IPOS(1)=0 542 : C ... NA = nombre de 1 dans INCPO => nombre de colonnes de la matrice ... 543 : NA=0 544 : DO 37 I=1,NNOE 545 : DO 35 K=1,MAXINC 546 : IF(INCPO(K,I).NE.0) THEN 547 : NA=NA+1 548 : C ... INCPO(K,I) = numéro de l'équation ... 549 : INCPO(K,I)=NA 550 : ENDIF 551 : 35 CONTINUE 552 : IPOS(I+1)=NA 553 : 37 CONTINUE 554 : IPOD(1)=0 555 : C ... ND = nombre de 1 dans MIPO1.INCPO => nombre de lignes de la matrice ... 556 : ND=0 557 : DO 372 I=1,NNOE 558 : DO 352 K=1,MAXDUA 559 : IF(MIPO1.INCPO(K,I).NE.0) THEN 560 : ND=ND+1 561 : C ... MIPO1.INCPO(K,I) = numéro de l'équation ... 562 : MIPO1.INCPO(K,I)=ND 563 : ENDIF 564 : 352 CONTINUE 565 : IPOD(I+1)=ND 566 : 372 CONTINUE 567 : * write(*,*) 'Nb de colonnes de la matrice : ',NA,maxinc 568 : * write(*,*) 'Nb de lignes de la matrice : ',ND,maxdua 569 : 570 : 571 : SEGDES,MIDUA,MIMIK,MHARK,MHAR1 572 : 573 : C ... On va tester que tout est OK pour la suite ... 574 : 575 : IF(NA.NE.ND) THEN 576 : * write(6,*) ' ipos' 577 : * write(6,*) ( ipos(IU),IU=1,ipos(/1)) 578 : * write(6,*) ' ipod ' 579 : * write(6,*) ( ipod(IU),IU=1,ipod(/1)) 579 : CALL ERREUR(756) 580 : RETURN 581 : ENDIF 582 : 583 : DO 567 IINO=1,NNOE1 584 : IF(IPOS(IINO).NE.IPOD(IINO)) THEN 585 : WRITE(*,*) 'ERREUR dans ASNS1 !!! IPOS != IPOD !!!' 586 : RETURN 587 : ENDIF 588 : 567 CONTINUE 589 : C 590 : C **** INITIALISATION DE IMINI a été supprimée car ce segment 591 : C ne servait à rien ... 592 : * write(6,*) ' ipos', ( ipos(iu),iu=1,ipos(/1)) 593 : * write(6,*) ' ipod', ( ipod(iu),iu=1,ipod(/1)) 594 : * write(6,*) ' itopo', ( itopo(iu),iu=1,itopo(/1)) 595 : * write(6,*) ' itopob', ( itopob(iu),iu=1,itopob(/1)) 596 : * write(6,*) ' iitop', ( iitop(iu),iu=1,iitop(/1)) 597 : * write(6,*) ' iitopb', ( iitopb(iu),iu=1,iitopb(/1)) 598 : SEGDES,MRIGID 599 : SEGDES,IPOS,IPOD 600 : SEGDES,ITOPO,ITOPOB 601 : SEGDES,IITOP,IITOPB 602 : SEGDES,INUINV 603 : SEGDES,IPT1 604 : SEGDES,MINCPO 605 : SEGDES,MIPO1 606 : SEGSUP,IMIN,IMINB 607 : SEGDES,INCTRR 608 : INCTRY=INCTRR 609 : SEGDES,INCTRD 610 : INCTRZ=INCTRD 611 : SEGINI,MMATRI 612 : NENS=0 613 : IGEOMA=IPT1 614 : IIDUA=MIDUA 615 : IINCPO=MINCPO 616 : IDUAPO=MIPO1 617 : IIMIK=MIMIK 618 : IHARK=MHARK 619 : IHARDU=MHAR1 620 : INUINY=INUINV 621 : ITOPOY=ITOPO 622 : ITOPOD=ITOPOB 623 : IITOPD=IITOPB 624 : IITOPY=IITOP 625 : MMATRX=MMATRI 626 : ccc IMINIY=IMINI 627 : iminiy=0 628 : IPOY=IPOS 629 : IPODD=IPOD 630 : SEGDES,MMATRI 631 : RETURN 632 : END 633 : 634 : 635 : 636 : 637 : 638 : 639 : 640 : 641 : 642 : 643 : 644 : 645 :
© Cast3M 2003 - All rights reserved.
Disclaimer