1 : C RELA SOURCE CHAT 09/10/09 21:22:41 6519 2 : SUBROUTINE RELA 3 : C 4 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 5 : C C FABRIQUE UN OBJET ATTACHE CORRESPONDANT A UNE LIAISON ELEMENTAIRE 6 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 7 : C 8 : IMPLICIT INTEGER(I-N) 9 : IMPLICIT REAL*8 (a-h,o-z) 10 : -INC CCOPTIO 11 : -INC CCHAMP 12 : -INC SMELSTR 13 : -INC SMCLSTR 14 : -INC SMSTRUC 15 : -INC SMELEME 16 : -INC SMCOORD 17 : -INC SMRIGID 18 : -INC SMCHPOI 19 : -INC SMATTAC 20 : -INC SMLREEL 21 : SEGMENT ITRA1(0) 22 : SEGMENT IWOR1(0) 23 : SEGMENT ITRA2(0) 24 : SEGMENT ITRA3(0) 25 : SEGMENT ITRA4(0) 26 : SEGMENT ITRA5(0) 27 : SEGMENT RCOEF(0) 28 : SEGMENT IGEO(0) 29 : SEGMENT IDEN(NPO) 30 : SEGMENT ICO(NPO) 31 : SEGMENT SINCO 32 : CHARACTER*4 INCO(ICMAX) 33 : ENDSEGMENT 34 : SEGMENT NTABK(NLIGRE) 35 : SEGMENT MNOC 36 : CHARACTER*4 NOCO(ICMAX,NPO) 37 : ENDSEGMENT 38 : SEGMENT/MVAL/(VALE(ICMAX,NPO)) 39 : CHARACTER*4 NOMCO 40 : DATA ICMAX/15/ 40 : CALL LIROBJ ('ELEMSTRU',IRET,0,IRETO1) 41 : IRETO2=0 41 : IF (IRETO1.EQ.0) CALL LIROBJ ('BLOQSTRU',IRET,0,IRETO2) 42 : IF ((IRETO1+IRETO2).EQ.0) THEN 42 : CALL RELA1 43 : RETURN 44 : ENDIF 45 : SEGINI ITRA1 46 : SEGINI IWOR1 47 : MJON=0 48 : NBCLST=0 49 : IF (IRETO1.EQ.1) GO TO 15 50 : IF (IRETO2.EQ.1) GO TO 25 51 : 1 CONTINUE 52 : C 53 : C LECTURE DES MELSTR 54 : C 54 : CALL LIROBJ('ELEMSTRU',IRET,0,IRETOU) 55 : IF(IRETOU.EQ.0) GOTO 10 56 : 15 MELSTR=IRET 56 : CALL LIRMOT(NOMDD,LNOMDD,IMOT,1) 57 : IF(IERR.EQ.0) GOTO 2 58 : C *** OUBLI DE LA COMPOSANTE 58 : CALL ERREUR(116) 59 : GOTO 3 60 : 2 NOMCO=NOMDD(IMOT) 60 : CALL LIRPRO(NBVAL,IPROG) 61 : IF(IPROG.EQ.0) GOTO 3 62 : SEGACT MELSTR 63 : NBSTRU=ISOSTU(/1) 64 : MSOSTU=ISOSTU(1) 65 : MELEME=IMELEM(1) 66 : SEGDES MELSTR 67 : IF(NBSTRU.EQ.1) GOTO 4 68 : C *** LA SOUS-STRUCTURE N'EST PAS ELEMENTAIRE 69 : INTERR(1)=MSOSTU 69 : CALL ERREUR(90) 70 : 3 CONTINUE 71 : SEGSUP ITRA1,IWOR1 72 : RETURN 73 : 4 ITRA1(**)=MSOSTU 74 : ITRA1(**)=MELEME 75 : READ (NOMCO,FMT='(A4)') IPV 76 : ITRA1(**)=IPV 77 : ITRA1(**)=IPROG 78 : GOTO 1 79 : 10 CONTINUE 80 : C 81 : C LECTURE DES CLSTR 82 : C 82 : CALL LIROBJ('BLOQSTRU',IRET,0,IRETOU) 83 : IF(IRETOU.EQ.0) GOTO 20 84 : 25 MCLSTR=IRET 84 : CALL LIRMOT(NOMDD,LNOMDD,IMOT,1) 85 : IF(IERR.EQ.0) GOTO 11 86 : C *** OUBLI DE LA COMPOSANTE 86 : CALL ERREUR(116) 87 : GOTO 3 88 : 11 IF(NOMDD(IMOT).EQ.'LX ') GOTO 12 89 : C *** LA COMPOSANTE DOIT ETRE LX 89 : CALL ERREUR(120) 90 : GOTO 3 91 : 12 CONTINUE 91 : CALL LIRPRO(NBVAL,IPROG) 92 : IF(IPROG.EQ.0) GOTO 3 93 : SEGACT MCLSTR 94 : NBSTRU=ISOSTR(/1) 95 : MSOSTU=ISOSTR(1) 96 : IRIG=IRIGCL(1) 97 : SEGDES MCLSTR 98 : IF(NBSTRU.EQ.1) GOTO 13 99 : C *** LA SOUS-STRUCTURE N'EST PAS ELEMENTAIRE 100 : INTERR(1)=MSOSTU 100 : CALL ERREUR(90) 101 : GOTO 3 102 : 13 IWOR1(**)=MSOSTU 103 : IWOR1(**)=IRIG 104 : IWOR1(**)=IPROG 105 : GOTO 1 106 : 20 NBELST=ITRA1(/1)/4 107 : IF(NBELST.EQ.0) GOTO 380 108 : C 109 : C TRAITEMENT DES MELSTRS 110 : C ********************** 111 : C 112 : SEGINI ITRA5 113 : C 114 : C RECHERCHE DES SOUS STRUCTURES INTERVENANT DS LA LIAISON 115 : C BOUCLE SUR L'ENSMBLE DES MELSTRS 116 : C QUAND UNE SOUS STRUCTURE EST EPUISEE ITRA1( )=0 117 : C 118 : DO 350 NB=1,NBELST 119 : IT=4*(NB-1) 120 : MSOSTU=ITRA1(IT+1) 121 : IF(MSOSTU.EQ.0) GOTO 350 122 : C 123 : C *********** 1 *********** 124 : C 125 : C CREATION DES TABLEAUX AUXILLIAIRES : 126 : C IGEO(IP)=NUM LE IP-IEME PT A LE NUMERO NUM 127 : C ITRA2(IKI)=IP NUMERO D'ORDRE DU PT NUM DS IGEO 128 : C ITRA2(IKI+1)=NOMCO NOM DU DDL ASSOCIE AU PT 129 : C RCOEF(I)=COEF COEFFICIENT ASSOCIE AU DDL NOMCO DU IP-IEME P 130 : C 131 : SEGINI ITRA2,IGEO,RCOEF 132 : C 133 : C RECHERCHE DES MELEMES D'UNE MEME SOUS STRUCTURE 134 : C 135 : IP=0 136 : NPO=0 137 : DO 140 NBB=NB,NBELST 138 : IT=4*(NBB-1) 139 : IF(MSOSTU.NE.ITRA1(IT+1)) GOTO 140 140 : MELEME=ITRA1(IT+2) 141 : MLREEL=ITRA1(IT+4) 142 : SEGACT MELEME,MLREEL 143 : NBELEM=NUM(/2) 144 : NBVAL=PROG(/1) 145 : IF(NBVAL.EQ.NBELEM) GOTO 80 146 : C *** LE NB DE COEF N'EST PAS EGAL AU NB DE PTS 146 : CALL ERREUR(117) 147 : SEGDES MELEME,MLREEL 148 : SEGSUP ITRA2,ITRA5,IGEO,RCOEF 149 : GOTO 3 150 : C 151 : C BOUCLE SUR LES PTS DU MELEME DU MELSTR 152 : C 153 : 80 DO 130 NBE=1,NBELEM 154 : IKI=NUM(1,NBE) 155 : IF(NPO.EQ.0) GOTO 100 156 : DO 90 J=1,NPO 157 : IPP=J 158 : IF(IKI.EQ.IGEO(J)) GOTO 120 159 : 90 CONTINUE 160 : 100 IP=IP+1 161 : IGEO(**)=IKI 162 : IPP=IP 163 : 120 ITRA2(**)=IPP 164 : ITRA2(**)=ITRA1(IT+3) 165 : RCOEF(**)=PROG(NBE) 166 : 130 CONTINUE 167 : SEGDES MELEME,MLREEL 168 : NPO=IGEO(/1) 169 : ITRA1(IT+1)=0 170 : 140 CONTINUE 171 : I2=ITRA2(/1) 172 : I21=I2-1 173 : I3=RCOEF(/1) 174 : I4=IGEO(/1) 175 : IF(IIMPI.EQ.2) WRITE(IOIMP,1000)(I,ITRA2(I),I=1,I21,2) 176 : IF(IIMPI.EQ.2) WRITE(IOIMP,1001)(I,ITRA2(I),I=2,I2,2) 177 : IF(IIMPI.EQ.2) WRITE(IOIMP,1002)(I,RCOEF(I),I=1,I3) 178 : IF(IIMPI.EQ.2) WRITE(IOIMP,1003)(I,IGEO(I) ,I=1,I4) 179 : 1000 FORMAT(1X,' ITRA2 ',10(I4,I4,1X)) 180 : 1001 FORMAT(1X,' ITRA2 ',10(I4,1X,A4,1X)) 181 : 1002 FORMAT(1X,' RCOEF ',8(I4,1PE12.5,1X)) 182 : 1003 FORMAT(1X,' IGEO ',10(I4,I4,1X)) 183 : C 184 : C ********** 2 ********** 185 : C 186 : C RECHERCHE ET REPERAGE DES DDL 187 : C CREATION DES TABLEAUX AUXILLIAIRES : 188 : C NOCO(IC,IP) NOM DU IC-IEME DDL DU PT IP 189 : C IDEN(IP) SI IDEN(IP)=IDEN(IPP) =>IP ET IPP ONT MEMES DDLS 190 : C ICO(IP) NB DE DDL DU PT IP 191 : C INCO(NUCO) NOM DU NUCO-IEME DDL 192 : C 193 : SEGACT MSOSTU 194 : MRIGID=ISRAID 195 : SEGDES MSOSTU 196 : SEGACT MRIGID 197 : NRIGEL=IRIGEL(/2) 198 : NDDL=0 199 : SEGINI MNOC,IDEN,ICO,SINCO 200 : ICMA=0 201 : C 202 : C BOUCLE SUR LES POINTS DE LA SOUS STRUCTURE 203 : C 204 : DO 250 IP=1,NPO 205 : NDCP=0 206 : C 207 : C BOUCLE SUR LES ZONES GEOMETRIQUES DE LA SOUS STRUCTURE 208 : C 209 : DO 240 IAA=1,NRIGEL 210 : MELEME=IRIGEL(1,IAA) 211 : SEGACT MELEME 212 : IF(ITYPEL.EQ.22) GOTO 235 213 : NBELEM=NUM(/2) 214 : NBPT=NUM(/1) 215 : DO 150 NBE=1,NBELEM 216 : DO 150 NP=1,NBPT 217 : IKI=NUM(NP,NBE) 218 : NPEL=NP 219 : IF(IKI.EQ.IGEO(IP)) GOTO 160 220 : 150 CONTINUE 221 : GOTO 235 222 : 160 DESCR=IRIGEL(3,IAA) 223 : SEGACT DESCR 224 : NLIGRE=NOELEP(/1) 225 : IC=0 226 : ICC=0 227 : C 228 : C BOUCLE SUR LES INCONNUES DE LA MATRICE DE RIGIDITE DE L'ELEMENT 229 : C 230 : DO 230 I=1,NLIGRE 231 : IF(NOELEP(I).NE.NPEL) GOTO 230 232 : NOMCO=LISINC(I) 233 : IF(NDDL.EQ.0) GOTO 180 234 : C 235 : C BOUCLE SUR LES DDL TOTAUX DEJA CREES,ON DONNE UN NUMERO (NUCO) AU DD 236 : C 237 : DO 170 ND=1,NDDL 238 : NUCO=ND 239 : IF(NOMCO.EQ.INCO(ND)) GOTO 190 240 : 170 CONTINUE 241 : 180 IC=IC+1 242 : NUCO=NDDL+IC 243 : INCO(NUCO)=NOMCO 244 : 190 CONTINUE 245 : IF(NDCP.EQ.0) GOTO 210 246 : C 247 : C BOUCLE SUR LES DDL DU PT DEJA CREES 248 : C 249 : DO 200 NDC=1,NDCP 250 : IF(NOMCO.EQ.NOCO(NDC,IP)) GOTO 220 251 : 200 CONTINUE 252 : 210 ICC=ICC+1 253 : NDIC=NDCP+ICC 254 : IF(NDIC.LE.ICMAX) GOTO 215 255 : C *** A LA NUCO-IEME COMPOSANTE ON ASSOCIE LE NB 2**(NUCO-1) 256 : C TROP DE COMPOSANTES,ON DEPASSE LA CAPACITE DE LA MACHINE 256 : CALL ERREUR(119) 257 : SEGDES DESCR,MELEME,MRIGID,MSOSTU 258 : SEGSUP ITRA2,ITRA5,IGEO,RCOEF,MNOC,IDEN,ICO,SINCO 259 : GOTO 3 260 : 215 NOCO(NDIC,IP)=NOMCO 261 : IF(NUCO.EQ.1) IDEN(IP)=IDEN(IP)+1 262 : IF(NUCO.NE.1) IDEN(IP)=IDEN(IP)+2**(NUCO-1) 263 : 220 CONTINUE 264 : 230 CONTINUE 265 : SEGDES DESCR 266 : NDDL=NDDL+IC 267 : NDCP=NDCP+ICC 268 : 235 CONTINUE 269 : SEGDES MELEME 270 : 240 CONTINUE 271 : ICO(IP)=NDCP 272 : IF(NDCP.GT.ICMA) ICMA=NDCP 273 : 250 CONTINUE 274 : I1=NOCO(/2) 275 : I2=NOCO(/3) 276 : I3=IDEN(/1) 277 : I4=ICO(/1) 278 : I5=INCO(/2) 279 : IF(IIMPI.EQ.2) WRITE(IOIMP,1004)((J,I,NOCO(I,J),I=1,I1),J=1,I2) 280 : IF(IIMPI.EQ.2) WRITE(IOIMP,1005)(I,IDEN(I),I=1,I3) 281 : IF(IIMPI.EQ.2) WRITE(IOIMP,1006)(I,ICO(I),I=1,I4) 282 : IF(IIMPI.EQ.2) WRITE(IOIMP,1007)(I,INCO(I),I=1,I5) 283 : 1004 FORMAT(1X,' NOCO ',8(I4,1X,I4,1X,A4,1X)) 284 : 1005 FORMAT(1X,' IDEN ',10(I4,1X,I4,1X)) 285 : 1006 FORMAT(1X,' ICO ',10(I4,1X,I4,1X)) 286 : 1007 FORMAT(1X,' INCO ',10(I4,1X,A4,1X)) 287 : SEGDES MRIGID 288 : SEGSUP SINCO 289 : C 290 : C ********** 3 ********** 291 : C 292 : C COMPATIBILITE DES DONNEES CORRESPONDANT AUX DDL ET 293 : C CREATION DU TABLEAU AUXILLIAIRE : 294 : C VALE(IC,IP) COEF POUR LE IC-IEME DDL DU IP-IEME PT 295 : C 296 : IKIMA=ITRA2(/1)/2 297 : ICMAX=ICMA 298 : SEGINI MVAL 299 : C 300 : C BOUCLE SUR LES POINTS DE LA SOUS-STRUCTURE 301 : C 302 : DO 290 IP=1,NPO 303 : NDCP=ICO(IP) 304 : DO 255 IC=1,ICMAX 305 : VALE(IC,IP)=0. 306 : 255 CONTINUE 307 : C 308 : C RECHERCHE DU(ES) DDL DE LIAISON DU PT 309 : C ON PARCOURS LE TABLEAU ITRA2 310 : C 311 : DO 280 IKI=1,IKIMA 312 : IT=2*(IKI-1) 313 : IKIN=ITRA2(IT+1) 314 : IF(IKIN.NE.IP) GOTO 280 315 : WRITE (NOMCO,FMT='(A4)') ITRA2(IT+2) 316 : C 317 : C BOUCLE SUR LES DDL DU PT 318 : C 319 : DO 260 IC=1,NDCP 320 : ICC=IC 321 : IF(NOMCO.EQ.NOCO(IC,IP)) GOTO 270 322 : 260 CONTINUE 323 : C *** LE DDL N'EXISTE PAS 324 : INTERR(1)=MSOSTU 325 : MOTERR(1:4)=NOMCO 325 : CALL ERREUR(118) 326 : SEGSUP ITRA2,ITRA5,IGEO,RCOEF,MVAL,MNOC,ICO,IDEN 327 : GOTO 3 328 : 270 VALE(ICC,IP)=RCOEF(IKI) 329 : 280 CONTINUE 330 : 290 CONTINUE 331 : SEGSUP ITRA2,RCOEF 332 : I1=VALE(/1) 333 : I2=VALE(/2) 334 : IF(IIMPI.EQ.2) WRITE(IOIMP,1008)((J,I,VALE(I,J),I=1,I1),J=1,I2) 335 : 1008 FORMAT(1X,' VALE ',5(I4,1X,I4,1X,1PE12.5,1X)) 336 : C 337 : C ********** 4 ********** 338 : C 339 : SEGINI ITRA4 340 : DO 330 IP=1,NPO 341 : IA=IDEN(IP) 342 : IF(IA.EQ.0) GOTO 330 343 : SEGINI ITRA3 344 : C 345 : C CREATION DES MSOUPO DU CHAMPOINT (ITRA4) 346 : C RECHERCHE DES PTS AYANT LES MEMES DDDL (ITRA3) 347 : C 348 : DO 300 IPP=IP,NPO 349 : IF(IA.NE.IDEN(IPP)) GOTO 300 350 : ITRA3(**)=IPP 351 : IDEN(IPP)=0 352 : 300 CONTINUE 353 : NC=ICO(IP) 354 : SEGINI MSOUPO 355 : ITRA4(**)=MSOUPO 356 : NBSOUS=0 357 : NBREF=0 358 : NBNN=1 359 : NBELEM=ITRA3(/1) 360 : SEGINI MELEME 361 : IGEOC=MELEME 362 : ITYPEL=1 363 : N=NBELEM 364 : SEGINI MPOVAL 365 : IPOVAL=MPOVAL 366 : DO 310 IC=1,NC 367 : NOCOMP(IC)=NOCO(IC,IP) 368 : NOHARM(IC)=NIFOUR 369 : 310 CONTINUE 370 : DO 320 NBE=1,NBELEM 371 : IPP=ITRA3(NBE) 372 : NUM(1,NBE)=IGEO(IPP) 373 : DO 320 IC=1,NC 374 : DO 315 ICC=1,NC 375 : IC1=ICC 376 : IF(NOCO(IC1,IPP).EQ.NOCOMP(IC)) GOTO 317 377 : 315 CONTINUE 378 : 317 VPOCHA(NBE,IC)=VALE(IC1,IPP) 379 : 320 CONTINUE 380 : SEGDES MELEME,MPOVAL,MSOUPO 381 : SEGSUP ITRA3 382 : 330 CONTINUE 383 : SEGSUP IDEN,ICO,IGEO,MNOC,MVAL 384 : NSOUPO=ITRA4(/1) 385 : NAT=1 386 : SEGINI MCHPOI 387 : IFOPOI=IFOUR 388 : DO 340 NS=1,NSOUPO 389 : IPCHP(NS)=ITRA4(NS) 390 : 340 CONTINUE 391 : SEGDES MCHPOI 392 : SEGSUP ITRA4 393 : C 394 : C ********** ********** 395 : C 396 : ITRA5(**)=MSOSTU 397 : ITRA5(**)=MCHPOI 398 : 350 CONTINUE 399 : C 400 : C CREATION DU MJONCT 401 : C 402 : 355 N=ITRA5(/1)/2 403 : SEGINI MJONCT 404 : MJOTYP='MECA' 405 : MJODDL='LX' 406 : C NBCLST=0 LIAISON LIBRE NBCLST#0 LIAISON BLOQUE 407 : IF(NBCLST.NE.0) MJODDL='FLX' 408 : SEGACT MCOORD*MOD 409 : NBNO=XCOOR(/1)/(IDIM+1) 410 : XCOOR(**)=0. 411 : XCOOR(**)=0. 412 : IF(IDIM.EQ.3) XCOOR(**)=0. 413 : XCOOR(**)=0. 414 : NBNN=1 415 : NBELEM=1 416 : NBREF=0 417 : NBSOUS=0 418 : SEGINI MELEME 419 : ITYPEL=1 420 : NUM(1,1)=NBNO+1 421 : SEGDES MELEME 422 : MJOPOI=MELEME 423 : IF(NBCLST.EQ.0) MJOPO1=NBNO+1 424 : IF(NBCLST.NE.0) MJOPO2=NBNO+1 425 : DO 360 NN=1,N 426 : NNN=2*NN 427 : ISTRJO(NN)=ITRA5(NNN-1) 428 : IPCHJO(NN)=ITRA5(NNN) 429 : 360 CONTINUE 430 : SEGSUP ITRA5 431 : SEGDES MJONCT 432 : IF(MJON.EQ.0) MJON=MJONCT 433 : IF(NBCLST.NE.0) GOTO 500 434 : 380 NBCLST=IWOR1(/1)/3 435 : IF(NBCLST.EQ.0) GOTO 500 436 : C 437 : C TRAITEMENT DES CLSTRS 438 : C ********************* 439 : C 440 : SEGINI ITRA5 441 : C 442 : C RECHERCHE DES SOUS STRUCTURES INTERVENANT DS LA LIAISON 443 : 444 : C BOUCLE SUR L'ENSEMBLE DES CLSTR 445 : C 446 : DO 490 NB=1,NBCLST 447 : IT=3*(NB-1) 448 : MSOSTU=IWOR1(IT+1) 449 : IF(MSOSTU.EQ.0) GOTO 490 450 : NPO=0 451 : SEGINI IGEO,RCOEF 452 : C 453 : C RECHERCHE DES CLSTR D'UNE MEME SOUS STRUCTURE 454 : C 455 : DO 470 NBB=NB,NBCLST 456 : IT=3*(NBB-1) 457 : IF(MSOSTU.NE.IWOR1(IT+1)) GOTO 470 458 : MRIGID=IWOR1(IT+2) 459 : SEGACT MRIGID 460 : NRIGEL=IRIGEL(/2) 461 : C 462 : C BOUCLE SUR LES BLOCAGES DE LA SOUS STRUCTURE 463 : C 464 : DO 440 IAA=1,NRIGEL 465 : C RECHERCHE DE LA POSITION DES INCONNUES DE LAGRANGE 466 : DESCR=IRIGEL(3,IAA) 467 : SEGACT DESCR 468 : NLIGRE=LISINC(/2) 469 : SEGINI NTABK 470 : JK=0 471 : DO 400 I=1,NLIGRE 472 : NOMCO=LISINC(I) 473 : IF(NOMCO.NE.'LX ') GOTO 400 474 : JK=JK+1 475 : NTABK(JK)=NOELEP(I) 476 : 400 CONTINUE 477 : SEGDES DESCR 478 : MELEME=IRIGEL(1,IAA) 479 : SEGACT MELEME 480 : NBELEM=NUM(/2) 481 : C 482 : C BOUCLES SUR LES NOEUDS DU BLOCAGE 483 : C 484 : DO 430 NBE=1,NBELEM 485 : DO 420 NP=1,JK 486 : IKI=NUM(NTABK(NP),NBE) 487 : IF(NPO.EQ.0) GOTO 415 488 : DO 410 J=1,NPO 489 : IF(IKI.EQ.IGEO(J)) GOTO 450 490 : 410 CONTINUE 491 : 415 IGEO(**)=IKI 492 : 420 CONTINUE 493 : 430 CONTINUE 494 : SEGSUP NTABK 495 : SEGDES MELEME 496 : NPO=IGEO(/1) 497 : 440 CONTINUE 498 : MLREEL=IWOR1(IT+3) 499 : SEGACT MLREEL 500 : NBVAL=PROG(/1) 501 : IF(NBVAL.EQ.NPO) GOTO 460 502 : C *** LE NB DE COEF N'EST PAS EGAL AU NB DE PTS 502 : CALL ERREUR(117) 503 : SEGDES MLREEL 504 : 445 SEGDES MRIGID 505 : SEGSUP IGEO,RCOEF 506 : GOTO 3 506 : 450 CALL ERREUR(120) 507 : SEGDES MELEME 508 : C *** UN DDL EST DONNE PLUSIEURS FOIS 509 : GOTO 445 510 : 460 IWOR1(IT+1)=0 511 : SEGDES MRIGID 512 : DO 465 NV=1,NBVAL 513 : RCOEF(**)=PROG(NV) 514 : 465 CONTINUE 515 : SEGDES MLREEL 516 : 470 CONTINUE 517 : IF(IIMPI.EQ.2) WRITE(IOIMP,1009)(I,IGEO(I),RCOEF(I),I=1,NPO) 518 : 1009 FORMAT(1X,' IGEO=',5(I4,1X,I4,1X,1PE12.5,1X)) 519 : C 520 : C CREATION DU CHAMPOINT (ITRA5) 521 : C 522 : NSOUPO=1 523 : NAT=1 524 : SEGINI MCHPOI 525 : IFOPOI=IFOUR 526 : NC=1 527 : SEGINI MSOUPO 528 : IPCHP(1)=MSOUPO 529 : SEGDES MCHPOI 530 : ITRA5(**)=MSOSTU 531 : ITRA5(**)=MCHPOI 532 : NBSOUS=0 533 : NBREF=0 534 : NBNN=1 535 : NBELEM=NPO 536 : SEGINI MELEME 537 : IGEOC=MELEME 538 : ITYPEL=1 539 : N=NBELEM 540 : SEGINI MPOVAL 541 : DO 480 I=1,N 542 : NUM(1,I)=IGEO(I) 543 : VPOCHA(I,1)=RCOEF(I) 544 : 480 CONTINUE 545 : NOCOMP(1)='LX' 546 : NOHARM(1)=NIFOUR 547 : IPOVAL=MPOVAL 548 : SEGDES MELEME,MPOVAL,MSOUPO 549 : SEGSUP IGEO,RCOEF 550 : 490 CONTINUE 551 : GOTO 355 552 : C 553 : C CREATION DU MATTAC 554 : C 555 : 500 SEGSUP ITRA1,IWOR1 556 : IF(MJON.NE.0) GOTO 510 557 : C *** PAS D'OPERANDE CORRECT 557 : CALL ERREUR(92) 558 : RETURN 559 : 510 N=1 560 : M=0 561 : C SI MJON # MJONCT LA LIAISON EST MIXTE 562 : IF(MJON.NE.MJONCT) N=2 563 : IF(MJON.NE.MJONCT) M=1 564 : SEGINI MSOUMA 565 : ITYATT='MECA' 566 : IGEOCH=0 567 : IPHYCH=0 568 : IATREL(1)=MJON 569 : IF(N.EQ.1) GOTO 520 570 : IATREL(2)=MJONCT 571 : C *** CREATION DE LA MATRICE DUE A LA LIAISON MIXTE 572 : * LVAL=3 573 : NLIGRE=2 574 : NLIGRP=2 575 : NLIGRD=2 576 : nelrig=1 577 : SEGINI XMATRI 578 : RE(1,1,1)=0. 579 : RE(2,1,1)=-1. 580 : RE(2,2,1)=0. 581 : RE(1,2,1)=-1. 582 : SEGDES XMATRI 583 : * NELRIG=1 584 : * SEGINI IMATRI 585 : * IMATTT(1)=XMATRI 586 : * SEGDES IMATRI 587 : NLIGRP=2 588 : NLIGRD=2 589 : SEGINI DESCR 590 : NOELEP(1)=1 591 : NOELEP(2)=2 592 : NOELED(1)=1 593 : NOELED(2)=2 594 : LISINC(1)='BETA' 595 : LISINC(2)='FBET' 596 : LISDUA(1)='FBET' 597 : LISDUA(2)='BETA' 598 : SEGDES DESCR 599 : NBNN=2 600 : NBELEM=1 601 : NBSOUS=0 602 : NBREF=0 603 : SEGINI MELEME 604 : ITYPEL=23 605 : NUM(1,1)=MJOPO1 606 : NUM(2,1)=MJOPO2 607 : SEGDES MELEME 608 : NRIGE=4 609 : NRIGEL=1 610 : SEGINI MRIGID 611 : COERIG(1)=1.D0 612 : IRIGEL(1,1)=MELEME 613 : IRIGEL(2,1)=0 614 : IRIGEL(3,1)=DESCR 615 : IRIGEL(4,1)=xMATRI 616 : MTYMAT='RIGIDITE' 617 : ICHOLE=0 618 : SEGDES MRIGID 619 : IPMATK(1)=MRIGID 620 : 520 CONTINUE 621 : SEGDES MSOUMA 622 : N=1 623 : SEGINI MATTAC 624 : LISATT(1)=MSOUMA 624 : CALL ECROBJ('ATTACHE ',MATTAC) 625 : SEGDES MATTAC 626 : RETURN 627 : END 628 : 629 :
© Cast3M 2003 - All rights reserved.
Disclaimer