1 : C RIGIA SOURCE CHAT 11/03/16 21:31:15 6902 2 : SUBROUTINE RIGIA(IMD,IPCHE1,IPCHE2, 3 : & IMAT,IPOI6,IPM,IPNS,IRET) 4 : C=======================================================================C 5 : C C 6 : C OPERATEUR DE RIGIDITE POUR LES STRUCTURES EN BETON PRECONTRAINTES C 7 : C C 8 : C ENTREES : C 9 : C C 10 : C IPM(*) Pointeurs sur les modeles C 11 : C IPCHE1 Pointeur sur le chamelem de carateristiques C 12 : C IPCHE2 Pointeur sur le chamelem de matrice de HOOKE C 13 : C IMAT (2 il y a une matrice de HOOKE,1 non ) C 14 : C IMD Nombre de modeles dans IPM C 15 : C C 16 : C SORTIES : C 17 : C C 18 : C IPOI6 pointeur sur la rigidite construite C 19 : C IRET (1 OK , 0 erreur ) C 20 : C C 21 : C=======================================================================C 22 : IMPLICIT INTEGER(I-N) 23 : IMPLICIT REAL*8(A-H,O-Z) 24 : C 25 : -INC CCOPTIO 26 : -INC CCHAMP 27 : -INC CCREEL 28 : *- 29 : -INC SMCHAML 30 : -INC SMINTE 31 : -INC SMELEME 32 : -INC SMRIGID 33 : -INC SMMODEL 34 : -INC SMCOORD 35 : -INC SMLREEL 36 : DIMENSION IPDD(200),IPM(*) 37 : C 38 : SEGMENT IPNN 39 : INTEGER IPNNUM(NSOU1) 40 : ENDSEGMENT 41 : C 42 : SEGMENT NOTYPE 43 : CHARACTER*16 TYPE(NBTYPE) 44 : ENDSEGMENT 45 : C 46 : SEGMENT MPTVAL 47 : INTEGER IPOS(NS) ,NSOF(NS) 48 : INTEGER IVAL(NCOSOU) 49 : CHARACTER*16 TYVAL(NCOSOU) 50 : ENDSEGMENT 51 : C 52 : SEGMENT NNUM 53 : INTEGER NNM(NBN,NBELE),NBEM(2,NBELE) 54 : ENDSEGMENT 55 : POINTEUR INN1.NNUM 56 : C 57 : SEGMENT ICCOUN 58 : INTEGER INCOR(NBELEM) 59 : ENDSEGMENT 60 : C 61 : segment icozon 62 : integer iztouc(nsous) 63 : endsegment 64 : C 65 : SEGMENT WRK4 66 : REAL*8 XEC(3,NBN) 67 : ENDSEGMENT 68 : C 69 : CHARACTER*4 CMOT 70 : CHARACTER*8 CMATE 71 : CHARACTER*(NCONCH) CONM 72 : PARAMETER ( INTTYP=3 ) 73 : C INTTYP DEFINIT LE TYPE DE POINTS D'INTEGRATION 74 : C UTILISE PAR RIGI 75 : PARAMETER ( NINF=3 ) 76 : INTEGER INFOS(NINF) 77 : LOGICAL lsupfo,lsupdp,lsupma 78 : C 79 : IPNN=IPNS 80 : SEGACT IPNN 81 : C 82 : MELVAL=0 83 : IRET = 0 84 : IPOI6 = 0 85 : IPMODB=IPM(1) 86 : DO 99999 IMMD=2,IMD 87 : IPMODC=IPM(IMMD) 88 : C 89 : C --- VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES 90 : C ZZZZZZZZ PEUT ETRE A FAIRE PLUTOT SUR LES SOUS-ZONES 91 : C 92 : IF(IPCHE1.NE.0)THEN 92 : CALL QUESUP(IPMODC,IPCHE1,INTTYP,0,ISUP,IRETCA) 93 : IF (ISUP.GT.1) RETURN 94 : ENDIF 95 : C 96 : C --- VERIFICATION DU LIEU SUPPORT DU MCHAML DE HOOKE 97 : C 98 : IF(IMAT.EQ.2.AND.IPCHE2.NE.0)THEN 98 : CALL QUESUP(IPMODC,IPCHE2,INTTYP,1,ISUP1,IRETHO) 99 : IF (ISUP1.NE.0) RETURN 100 : ENDIF 101 : C 102 : C --- ACTIVATION DU MODELE CABLE 103 : C 104 : MMODEL = IPMODC 105 : SEGACT MMODEL 106 : NSOU1 = KMODEL(/1) 107 : C 108 : DO 40 ISOU1=1,NSOU1 109 : IF(IMD.EQ.1) GOTO 45 110 : IF(ISOU1.GT.1) THEN 111 : MMODEL = IPM(IM-1) 112 : SEGACT MMODEL 113 : END IF 114 : IMODEL=KMODEL(ISOU1) 115 : SEGACT IMODEL 116 : C 117 : C --- INITIALISATIONS 118 : C 119 : MELE = NEFMOD 120 : MELEM=MELE 121 : IPMAIL= IMAMOD 122 : CONM = CONMOD 123 : NFOR = FORMOD(/2) 124 : NMAT = MATMOD(/2) 125 : IVAMAC=0 126 : ****** IVACAR=0 127 : NMATR=0 128 : NMATF=0 129 : NCARA=0 130 : NCARF=0 131 : MOCARA=0 132 : MOMATR=0 133 : DESCR=0 134 : IMATRI=0 135 : C 136 : C --- VERIFICATION SUR LA FORMULATION 137 : C 137 : CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT) 138 : IF(CMATE.EQ.' ')THEN 139 : C MESSERR = TENTATIVE D'UTILISATION D'1 OPTION NON IMPLANTE 139 : CALL ERREUR(251) 140 : SEGDES IMODEL,MMODEL 141 : SEGSUP MRIGID 142 : RETURN 143 : ENDIF 144 : C 144 : * CALL ELQUOI(MELE,0,3,IPINF,IMODEL) 145 : * IF ( IERR.NE.0 ) THEN 146 : * SEGDES IMODEL,MMODEL 147 : * SEGSUP MRIGID 148 : * RETURN 149 : * ENDIF 150 : C 151 : * INFO = IPINF 152 : LHOOK = INFELE(10) 153 : LHOO2 = LHOOK*LHOOK 154 : NSTRS = INFELE(16) 155 : MFR = INFELE(13) 156 : LW = INFELE(7) 157 : NDDL = INFELE(15) 158 : IELE = INFELE( 14) 159 : LRE = INFELE(9) 160 : IPORE = INFELE(8) 161 : C 162 : NBG =INFELE(6) 163 : * IPMITC=INFELE(11) 164 : ipmitc=infmod(5) 165 : * IPMINT=INFELE(11) 166 : ipmint=infmod(5) 167 : MINTE=INFELE(11) 168 : SEGACT MINTE 169 : MELEME=IPMAIL 170 : SEGACT MELEME 171 : NBNN = NUM(/1) 172 : IPPORE=0 173 : IF(MFR.EQ.33) IPPORE=NBNN 174 : 175 : NNUMS=IPNNUM(ISOU1) 176 : C write(6,*) 'IPNN NNUM' , ipnn,nnums 177 : C 178 : C --- TRAITEMENT DES CHAMPS EN ENTREE 179 : C 180 : C --- CREATION DU TABLEAU INFOS 181 : C 181 : CALL IDENT(IPMAIL,CONM,IPCHE2,IPCHE1,INFOS,IRTD) 182 : IF (IRTD.EQ.0) GOTO 19990 183 : 184 : IPCHOO=0 185 : C 186 : C ---- CHAMP DE MATERIAU 187 : C 188 : if(lnomid(6).ne.0) then 189 : nomid=lnomid(6) 190 : segact nomid 191 : momatr=nomid 192 : nmatr=lesobl(/2) 193 : nmatf=lesfac(/2) 194 : lsupma=.false. 195 : else 196 : lsupma=.true. 196 : CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF) 197 : endif 198 : C write(6,*) 'MOMATR', (MOMATR(K),K=1,MOMATR(/1)) 199 : CC----------------------------------------- 200 : NBTYPE=1 201 : SEGINI NOTYPE 202 : TYPE(1)='REAL*8' 203 : MOTYPE=NOTYPE 204 : C------------------------------- 205 : C write(6,*) ' constituant sous zone' ,CONM 206 : C write(6,*) ' composantes obl' 207 : C write(6,*) (LESOBL(I),I=1,LESOBL(/1)) 208 : C write(6,*) ' composantes fac' 209 : C write(6,*) (LESFAC(I),I=1,LESFAC(/1)) 210 : C 210 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IVAMAC) 211 : 212 : C------------------------------- 213 : C write(6,*) 'cmate ivamac ' , cmate, ivamac 214 : C write(6,*) ' nmatr nmatf ' ,nmatr,nmatf 215 : 216 : C mptval=ivamac 217 : C nmax = ival(/1) 218 : C do 9064 im=1,nmax 219 : C if (ival(im).ne.0) then 220 : C melval=ival(im) 221 : C ibmn=velche(/2) 222 : C igmn=velche(/1) 223 : C write(6,*) velche(igmn,ibmn) 224 : C endif 225 : C 9064 continue 226 : C write(6,*)'***********' 227 : 228 : C------------------------------ 229 : SEGSUP NOTYPE 230 : IF (IERR.NE.0) GOTO 19991 231 : NMATC=NMATR+NMATF 232 : IF(ISUP.EQ.1)THEN 232 : CALL VALCHE(IVAMAC,NMATC,IPMINT,IPPORE) 233 : IF(IERR.NE.0)THEN 234 : ISUP=0 235 : GOTO 19991 236 : ENDIF 237 : ENDIF 238 : C 239 : MPTVAL=IVAMAC 240 : NBGMAT = 0 241 : NELMAT = 0 242 : DO 11108 IM=1,NMATC 243 : IF(IVAL(IM).NE.0)THEN 244 : MELVAL=IVAL(IM) 245 : IF (CMATE.EQ.'SECTION') THEN 246 : NBGMAT=MAX(NBGMAT,IELCHE(/1)) 247 : NELMAT=MAX(NELMAT,IELCHE(/2)) 248 : ELSE 249 : NBGMAT=MAX(NBGMAT,VELCHE(/1)) 250 : NELMAT=MAX(NELMAT,VELCHE(/2)) 251 : ENDIF 252 : ENDIF 253 : 11108 CONTINUE 254 : C ENDIF 255 : C 256 : C --- CHAMPS DE CARACTERISTIQUES 257 : C 258 : NBROBL=0 259 : NBRFAC=0 260 : MOCARA=0 261 : IVECT=0 262 : C 263 : C --- SECTION POUR LES BARRES ET LES CERCES 264 : C 265 : C IF (MFR.EQ.27) THEN 266 : NBROBL=1 267 : nbrfac=1 268 : SEGINI NOMID 269 : MOCARA=NOMID 270 : LESOBL(1)='SECT' 271 : lesfac(1)='ALPH' 272 : C 273 : NBTYPE=2 274 : SEGINI NOTYPE 275 : MOTYPE=NOTYPE 276 : TYPE(1)='REAL*8' 277 : TYPE(2)='REAL*8' 278 : C 279 : C --- CARACTERISTIQUES POUR LES POUTRES 280 : C 281 : 282 : NCARA=NBROBL 283 : NCARF=NBRFAC 284 : NCARR=NCARA+NCARF 285 : C 286 : IF (IPCHE1.NE.0.AND.MOCARA.NE.0) THEN 286 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,IVACAR) 287 : SEGSUP NOTYPE 288 : IF (IERR.NE.0) GOTO 19991 289 : ENDIF 290 : 291 : IF(ISUP.EQ.1.AND.(MOCARA.NE.0.AND.IPCHE1.NE.0))THEN 291 : CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE) 292 : IF(IERR.NE.0)THEN 293 : ISUP=0 294 : GOTO 19991 295 : ENDIF 296 : ENDIF 297 : 45 CONTINUE 298 : C 299 : 19990 CONTINUE 300 : 19991 CONTINUE 301 : C============================================================ 302 : C = 303 : C ACTIVATION DU MODELE BETON = 304 : C = 305 : C============================================================ 306 : MMODEL = IPMODB 307 : SEGACT MMODEL 308 : NSOUS = KMODEL(/1) 309 : 310 : nbsous = 0 311 : C do 1340 iz=1,nsous 312 : C nnum = IPNNUM(iz) 313 : C segact nnum 314 : C if(NBEM(/2).NE.0) nbsous=nbsous+1 315 : C1340 continue 316 : 317 : segini icozon 318 : nnum=nnums 319 : segact nnum 320 : 321 : do 1340 iel=1,nbem(/2) 322 : izi = nbem(2,iel) 323 : if(iztouc(izi).eq.0) then 324 : iztouc(izi)=1 325 : nbsous = nbsous+1 326 : endif 327 : 1340 continue 328 : 329 : NSOUS=nbsous 330 : C 331 : C --- INITIALISATION DU CHAPEAU DE L'OBJET RIGIDITE 332 : C 333 : NRIGEL=NSOUS 334 : IRT6=1 335 : IRTD=1 336 : IF(IMMD.EQ.2) THEN 337 : SEGINI MRIGID 338 : IPOI6=MRIGID 339 : ELSE 340 : MRIGID=IPOI6 341 : SEGACT MRIGID 342 : END IF 343 : MTYMAT = 'RIGIDITE' 344 : DO 1002 I=1,NSOUS 345 : COERIG(I)=1.D0 346 : DO 1003 J=1,6 347 : IRIGEL(J,I)=0 348 : 1003 CONTINUE 349 : 1002 CONTINUE 350 : IFORIG=IFOMOD 351 : ICHOLE=0 352 : IMGEO1=0 353 : IMGEO2=0 354 : ISUPEQ=0 355 : C----------------------------------------------------------------- 356 : C --- BOUCLE SUR LES ZONES ELEMENTAIRES BETON 357 : C 358 : C --- ETAT ACTUEL DES SEGMENTS : MRIGID ACTIF , MMODEL ACTIF 359 : C IPCHE1 INACTIF, IPCHE2 INACTIF 360 : C----------------------------------------------------------------- 361 : ipasou = 0 362 : 363 : C 364 : DO 500 ISOUS=1,KMODEL(/1) 365 : 366 : C if(NBEM(/2).EQ.0) goto 500 367 : if(iztouc(isous).eq.0) goto 500 368 : ipasou = ipasou + 1 369 : IMODEL=KMODEL(ISOUS) 370 : SEGACT IMODEL 371 : C 372 : C --- INITIALISATIONS 373 : C 374 : MELE = NEFMOD 375 : IPMAIL= IMAMOD 376 : CONM = CONMOD 377 : NFOR = FORMOD(/2) 378 : NMAT = MATMOD(/2) 379 : IVAMAT=0 380 : ****** IVACAR=0 381 : NMATR=0 382 : NMATF=0 383 : NCARA=0 384 : NCARF=0 385 : MOCARA=0 386 : MOMATR=0 387 : DESCR=0 388 : IMATRI=0 389 : C 390 : C --- VERIFICATION SUR LA FORMULATION 391 : C 391 : CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT) 392 : IF (CMATE.EQ.' ')THEN 393 : C MESSERR = TENTATIVE D'UTILISATION D'1 OPTION NON IMPLANTE 393 : CALL ERREUR(251) 394 : SEGDES IMODEL,MMODEL 395 : SEGSUP MRIGID 396 : RETURN 397 : ENDIF 398 : C 399 : Cרררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר 400 : C P H A S E 1 401 : C 402 : C INFOS. ELEMENT FINI ET COMPOSANTES NECESSAIRES 403 : C DANS LES CHAMPS EN ENTREE ET EVENTUELLEMENT EN SORTIE 404 : C 405 : C ON POURRAIT REGROUPER LA PLUS GROSSE PARTIE DE CETTE PHASE DANS 406 : C UN SOUS-PROGRAMME COMMUN A BEAUCOUP D'OPERATEURS 407 : C 408 : Cרררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר 409 : C 409 : * CALL ELQUOI(MELE,0,INTTYP,IPINF,IMODEL) 410 : * IF ( IERR.NE.0 ) THEN 411 : * SEGDES IMODEL,MMODEL 412 : * SEGSUP MRIGID 413 : * RETURN 414 : * ENDIF 415 : C 416 : * INFO = IPINF 417 : LHOOK = INFELE(10) 418 : LHOO2 = LHOOK*LHOOK 419 : NSTRS = INFELE(16) 420 : MFR = INFELE(13) 421 : LW = INFELE(7) 422 : NDDL = INFELE(15) 423 : IELE = INFELE( 14) 424 : LRE = INFELE(9) 425 : IPORE = INFELE(8) 426 : C 427 : C ---- SEGMENTS D'INTEGRATION 428 : C 429 : C Minte : 1er segment d'integration, il existe pour tous les e.f. 430 : C Minte1: 2eme segment d'integration, uniquement pour certains e.f. 431 : C en particulier pour Coq6 et Coq8 432 : C nbpg: nb de points de gauss = nbpgau du segment minte 433 : C iele: no d'element geometrique associe a l'e.f. mele 434 : C nbff: nb de fonctions de forme = nbno du segment minte 435 : C 436 : NBPGAU= INFELE( 6) 437 : ICARA = INFELE( 5) 438 : * MINTE = INFELE(11) 439 : MINTE=INFMOD(2+inttyp) 440 : MINTE1= INFMOD(8) 441 : SEGACT MINTE 442 : IPMINT=MINTE 443 : IPMIN1=MINTE1 444 : 445 : Cרררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר 446 : C P H A S E 2 447 : C 448 : C PREPARATION DES OBJETS RESULTATS 449 : C 450 : Cרררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררררר 451 : C 452 : MELEME=IPMAIL 453 : SEGACT MELEME 454 : 455 : NBNN=NUM(/1) 456 : NBELEM=NUM(/2) 457 : C 458 : NLIGRP= LRE 459 : NLIGRD= LRE 460 : SEGINI DESCR 461 : IPDSCR=DESCR 462 : if(lnomid(1).ne.0) then 463 : nomid=lnomid(1) 464 : segact nomid 465 : modepl=nomid 466 : ndepl=lesobl(/2) 467 : ndum=lesfac(/2) 468 : lsupdp=.false. 469 : else 470 : lsupdp=.true. 470 : CALL IDDEPL(MFR,IFOUR,MODEPL,NDEPL,NDUM) 471 : endif 472 : if(lnomid(2).ne.0) then 473 : nomid=lnomid(2) 474 : segact nomid 475 : moforc=nomid 476 : nforc=lesobl(/2) 477 : lsupfo=.false. 478 : else 479 : lsupfo=.true. 479 : CALL IDFORC(MFR,IFOUR,MOFORC,NFORC,NDUM) 480 : endif 481 : C 482 : IF (NDEPL.EQ.0.OR.NFORC.EQ.0.OR.NDEPL.NE.NFORC) THEN 482 : CALL ERREUR(5) 483 : SEGSUP DESCR,MRIGID 484 : SEGDES MMODEL,MELEME,MINTE 485 : RETURN 486 : ENDIF 487 : C 488 : C --- REMPLISSAGE DU SEGMENT DESCRIPTEUR 489 : C 490 : IDDL=1 491 : NCOMP=NDEPL 492 : NBNNS=NBNN 493 : IF (MFR.EQ.33) NCOMP=NDEPL-1 494 : IF (IFOUR.EQ.-3) THEN 495 : NCOMP=NDEPL-3 496 : NBNNS=NBNN-1 497 : ENDIF 498 : IF (MFR.EQ.19.OR.MFR.EQ.21) NBNNS=NBNN/2 499 : NOMID=MODEPL 500 : SEGACT NOMID 501 : NOMID=MOFORC 502 : SEGACT NOMID 503 : DO 1004 INOEUD=1,NBNNS 504 : DO 1005 ICOMP=1,NCOMP 505 : NOMID=MODEPL 506 : LISINC(IDDL)=LESOBL(ICOMP) 507 : NOMID=MOFORC 508 : LISDUA(IDDL)=LESOBL(ICOMP) 509 : NOELEP(IDDL)=INOEUD 510 : NOELED(IDDL)=INOEUD 511 : IDDL=IDDL+1 512 : 1005 CONTINUE 513 : 1004 CONTINUE 514 : 515 : NOMID=MODEPL 516 : if(lsupdp)SEGsup NOMID 517 : NOMID=MOFORC 518 : if(lsupfo)SEGsup NOMID 519 : SEGDES DESCR 520 : C 521 : C --- INITIALISATION DU SEGMENT CHAPEAU IMATRI 522 : C on ne veut des matrices que pour les elements contenant des cables 523 : 524 : segini iccoun 525 : 526 : C NNUM = NNUMS 527 : C segact nnum 528 : nbele=nnm(/2) 529 : nbn = nnm(/1) 530 : 531 : segini inn1 532 : inmo = inn1 533 : 534 : C ----il faut connaitre le nombre d elements beton touches dans la zone 535 : C et en fabriquer le maillage pour supporter la rigidite 536 : nbelem = nbele 537 : nbnn = NUM(/1) 538 : nbsous = 0 539 : nbref=0 540 : segini ipt4 541 : ipt4.itypel= itypel 542 : 543 : ibnew = 0 544 : do 7000 ic=1,nbele 545 : if(nbem(2,ic).ne.isous) goto 7000 546 : ib = nbem(1,IC) 547 : 548 : if (incor(ib).EQ.0 ) then 549 : ibnew = ibnew + 1 550 : incor(ib) = ibnew 551 : do 7001 in=1,nbnn 552 : ipt4.num(in,ibnew)= num(in,ib) 553 : ibnec=ibnew 554 : 7001 continue 555 : else 556 : ibnec = incor(ib) 557 : endif 558 : 559 : inn1.nbem(1,ic) = ibnec 560 : inn1.nbem(2,ic) = isous 561 : 562 : do 6998 in = 1,nbn 563 : inn1.nnm(in,ic) = nnm(in,ic) 564 : 6998 continue 565 : 566 : 7000 continue 567 : 568 : C write(6,*) ' rigia elt cable dans elt beton ' 569 : do 6666 i2=1,nbele 570 : C write(6,2222) i2,(inn1.nbem(i1,i2),i1=1,nbn),nnm(1,i2),nnm(2,I2) 571 : 6666 continue 572 : 2222 format(i4,4X,2I4,3X,2I4) 573 : nbelem = ibnew 574 : segadj ipt4 575 : imaicab = ipt4 576 : NELRIG = ibnew 577 : segdes inn1,ipt4 578 : 579 : segsup iccoun 580 : C 581 : C IF(IMMD.EQ.2.AND.ISOU1.EQ.1) THEN 582 : C if( ipasou.eq.1) then 583 : SEGINI xMATRI 584 : IPMATR=xMATRI 585 : C IPDD(ISOUS)=IPMATR 586 : IPDD(Ipasou)=IPMATR 587 : C ELSE 588 : C IMATRI=IPDD(ISOUS) 589 : C IMATRI=IPDD(ipasou ) 590 : C IPMATR=IMATRI 591 : C SEGACT IMATRI 592 : C END IF 593 : C# MC 19/01/98 : IPMADG n'est pas crיי ! voir rigi1 594 : C IF (IFOUR.EQ.-3) THEN 595 : C IRIGEL(1,ISO)=IPMADG 596 : C ELSE 597 : * IRIGEL(1,ISOUS)=IPMAIL 598 : irigel(1,ipasou)=ipt4 599 : C ENDIF 600 : C IRIGEL(2,ISOUS)=0 601 : C IRIGEL(3,ISOUS)=IPDSCR 602 : C IRIGEL(4,ISOUS)=xMATRI 603 : C IRIGEL(5,ISOUS)=NIFOUR 604 : C IRIGEL(6,ISOUS)=0 605 : 606 : IRIGEL(2,ipasou)=0 607 : IRIGEL(3,ipasou)=IPDSCR 608 : IRIGEL(4,ipasou)=xMATRI 609 : IRIGEL(5,ipasou)=NIFOUR 610 : IRIGEL(6,ipasou)=0 611 : 612 : C MOTERR(1:4)=NOMTP(MELE) 613 : C MOTERR(9:12)='RIGI1' 613 : C CALL ERREUR(86) 614 : C GOTO 9990 615 : C 616 : C --- MASSIF 617 : C 618 : 4 CONTINUE 619 : 620 : C write(6,*) 'ivamat ivacar ivamac nmatc',ivamat,ivacar,ivamac,nmatc 621 : C write(6,*) 'NNUMS' , nnums 622 : 622 : CALL RIGIB(MATE,MELE,MELEM,imaicab,IPMITC,NBG,LRE,NSTRS, 623 : & IVACAR,IVAMAC,CMATE,MFR,NBGMAT,NELMAT,IMAT,NMATC, 624 : & NDDL,IPMATR,ISOUS,ipasou,inmo,IMMD) 625 : 626 : segsup inn1 627 : SEGDES IMODEL 628 : 629 : meleme = imaicab 630 : segdes meleme 631 : 632 : SEGDES MINTE 633 : * SEGSUP INFO 634 : C 635 : C --- DANS LE CAS D'ERREUR 636 : C 637 : IF(IERR.NE.0) THEN 638 : IF(DESCR.NE.0)SEGSUP DESCR 639 : IF(xMATRI.NE.0)SEGSUP xMATRI 640 : IRT6=0 641 : GOTO 888 642 : ENDIF 643 : C fin de la boucle sur les zones beton 644 : 500 CONTINUE 645 : 888 CONTINUE 646 : IF(ISUP.EQ.1.AND.IMAT.NE.2)THEN 646 : CALL DTMVAL(IVAMAT,3) 647 : ELSE 647 : CALL DTMVAL(IVAMAT,1) 648 : ENDIF 649 : C 650 : IF(ISUP.EQ.1)THEN 650 : CALL DTMVAL(IVACAR,3) 651 : ELSE 651 : CALL DTMVAL(IVACAR,1) 652 : ENDIF 653 : C 654 : IF (MOCARA.NE.0)THEN 655 : NOMID=MOCARA 656 : SEGSUP NOMID 657 : ENDIF 658 : C 659 : IF(MOMATR.NE.0)THEN 660 : NOMID=MOMATR 661 : if(lsupma)SEGSUP NOMID 662 : ENDIF 663 : C 664 : SEGDES MMODEL 665 : C fin de la boucle sue les zones cables 666 : 40 CONTINUE 667 : 668 : segsup icozon 669 : segdes nnum 670 : 671 : IF (IPCHE1.NE.0) THEN 672 : MCHELM=IPCHE1 673 : SEGDES MCHELM 674 : ENDIF 675 : IF (IPCHOO.NE.0) THEN 676 : MCHELM=IPCHOO 677 : SEGDES MCHELM 678 : ENDIF 679 : IF(IERR.NE.0)THEN 680 : SEGSUP MRIGID 681 : ELSE 682 : SEGDES MRIGID 683 : ENDIF 684 : IF(IRT6.EQ.0) IPOI6=0 685 : 99999 CONTINUE 686 : 687 : *? IF (IPOI6.NE.0) IRET = 1 688 : IF (IERR.EQ.0) IRET = 1 689 : RETURN 690 : END 691 : 692 : 693 :
© Cast3M 2003 - All rights reserved.
Disclaimer