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