1 : C MOTANA SOURCE AM 13/12/16 21:16:03 7825 2 : SUBROUTINE MOTANA(IPMODL,IPCHE1,IPCHE2,IPCHE3,PRECIS,IPSCAL,IRET) 3 : *______________________________________________________________________ 4 : * 5 : * 6 : * 7 : * ENTREES : 8 : * --------- 9 : * IPMODL pointeur sur un MMODEL 10 : * IPCHE1 pointeur sur un MCHAML de sous type CONTRAINTES 11 : * IPCHE2 pointeur sur un MCHAML de sous type VARIABLES INTERNES 12 : * IPCHE3 pointeur sur le MCHAML de sous type CARACTARISTIQUE 13 : * PRECIS flottant 14 : * 15 : * SORTIES : 16 : * --------- 17 : * IPSCAL pointeur sur l'objet de type RIGIDITE 18 : * IRET = 1 si succes 0 sinon 19 : * 20 : * passage aux nouveaux CHAMELEMs par JM CAMPENON LE 06/91 21 : * 22 : *______________________________________________________________________ 23 : * 24 : IMPLICIT INTEGER(I-N) 25 : IMPLICIT REAL*8(A-H,O-Z) 26 : * 27 : -INC CCOPTIO 28 : -INC CCHAMP 29 : -INC SMINTE 30 : -INC SMMODEL 31 : -INC SMELEME 32 : -INC SMCHAML 33 : -INC SMCOORD 34 : -INC SMLREEL 35 : -INC SMEVOLL 36 : *______________________________________________________________________ 37 : * 38 : * LA VARIABLE KERRE REGIT LES IMPRESSIONS D ERREURS DANS MOTAN 39 : * TOUTES ERREURS DE PLASTICITE GEREES DANS CE SOUS PROGRAMME 40 : * KERRE=0 TOUT OK 41 : * DE 1 A 7 S ALIGNER SUR VALEURS DONNEES PAR ECOINC 42 : * = 21 ON NE TROUVE PAS D INTERSECTION AVEC LA SURFACE DE CHARGE 43 : * = 22 SIG0 A L EXTERIEUR DE LA SURFACE DE CHARGE 44 : * 45 : * = 30 31 32 ANOMALIES AVEC LA COURBE DE TRACTION 46 : * = 33 LIMITE ELASTIQUE NULLE 47 : * = 99 CAS NON ENCORE DISPONIBLE 48 : *---------------------------------------------------------------------- 49 : * 50 : SEGMENT WRK0 51 : REAL*8 XMAT(NCXMAT) 52 : ENDSEGMENT 53 : * 54 : SEGMENT WRK1 55 : REAL*8 DDHOOK(NSTRS,NSTRS),SIG0(NSTRS), 56 : . DSIGT(NSTRS),SIGF(NSTRS),VAR0(NVARI), 57 : . VARF(NVARI),DEFP(NSTRS),XCAR(ICARA) 58 : ENDSEGMENT 59 : * 60 : SEGMENT WRK2 61 : REAL*8 TRAC(LTRAC) 62 : ENDSEGMENT 63 : * 64 : SEGMENT WRK3 65 : REAL*8 WORK(LW) 66 : ENDSEGMENT 67 : * 68 : SEGMENT WRK4 69 : REAL *8 XE(3,NBBB) 70 : ENDSEGMENT 71 : * 72 : SEGMENT WRK5 73 : REAL*8 SIG(LSIG),EPS(LSIG) 74 : ENDSEGMENT 75 : * 76 : SEGMENT WRK6 77 : REAL*8 COVNMS(6) 78 : ENDSEGMENT 79 : * 80 : SEGMENT MPTVAL 81 : INTEGER IPOS(NS) ,NSOF(NS) 82 : INTEGER IVAL(NCOSOU) 83 : CHARACTER*16 TYVAL(NCOSOU) 84 : ENDSEGMENT 85 : * 86 : SEGMENT NOTYPE 87 : CHARACTER*16 TYPE(NBTYPE) 88 : ENDSEGMENT 89 : * 90 : CHARACTER*8 CMATE 91 : CHARACTER*(NCONCH) CONM 92 : PARAMETER ( NINF=3 ) 93 : INTEGER INFOS(NINF) 94 : LOGICAL lsupva,lsupco 95 : * 96 : DIMENSION XEPOU(2),YEPOU(2),ZEPOU(2),DIV(7) 97 : DATA PI4,R33,R22/0.785398164D0,1.732050808D0,1.414213562D0/ 98 : 99 : IRET = 0 100 : NHRM=NIFOUR 101 : * 102 : * Verification du lieu support du MCHAML de contraintes 103 : * 103 : CALL QUESUP(IPMODL,IPCHE1,3,0,ISUPCO,IRETCO) 104 : IF (ISUPCO.GT.1) RETURN 105 : * 106 : * Verification du lieu support du MCHAML de variables internes 107 : * 107 : CALL QUESUP(IPMODL,IPCHE2,3,0,ISUPVA,IRETVA) 108 : IF (ISUPVA.GT.1) RETURN 109 : * 110 : * Verification du lieu support du MCHAML de materiau 111 : * 111 : CALL QUESUP(IPMODL,IPCHE3,3,0,ISUPMA,IRETMA) 112 : IF (ISUPMA.GT.1) RETURN 113 : * 114 : * Activation du MMODEL 115 : * 116 : MMODEL=IPMODL 117 : SEGACT MMODEL 118 : NSOUS=KMODEL(/1) 119 : * 120 : * Creation du MCHELM 121 : * 122 : N1=NSOUS 123 : L1=8 124 : N3=6 125 : SEGINI MCHELM 126 : TITCHE='SCALAIRE' 127 : IFOCHE=IFOUR 128 : IPSCAL=MCHELM 129 : * 130 : DO 500 ISOUS=1,NSOUS 131 : * 132 : * INITIALISATION 133 : * 134 : NSTR=0 135 : MOCONT=0 136 : IVACON=0 137 : MOVARI=0 138 : NVARI=0 139 : IVAVAR=0 140 : NCARA=0 141 : NCARF=0 142 : MOCARA=0 143 : IVACAR=0 144 : NMATF=0 145 : NMATR=0 146 : MOMATR=0 147 : IVAMAT=0 148 : KERRE=0 149 : * 150 : IMODEL=KMODEL(ISOUS) 151 : IPMOD1=IMODEL 152 : SEGACT IMODEL 153 : IPMAIL=IMAMOD 154 : CONM =CONMOD 155 : C 156 : C COQUE INTEGREE OU PAS ? 157 : C 158 : IF(INFMOD(/1).NE.0)THEN 159 : NPINT=INFMOD(1) 160 : ELSE 161 : NPINT=0 162 : ENDIF 163 : IF (NPINT.NE.0)THEN 163 : CALL ERREUR(615) 164 : SEGDES IMODEL,MMODEL 165 : SEGSUP MCHELM 166 : RETURN 167 : ENDIF 168 : C 169 : IMACHE(ISOUS)=IPMAIL 170 : CONCHE(ISOUS)=CONMOD 171 : * 172 : MELE=NEFMOD 173 : MELEME=IMAMOD 174 : * 175 : * Nature du materiau 176 : * 177 : NFOR=FORMOD(/2) 178 : NMAT=MATMOD(/2) 178 : CALL NOMATE (FORMOD,NFOR,MATMOD,NMAT,CMATE,INELAS,INPLAS) 179 : IF (CMATE.EQ.' '.OR.CMATE.NE.'ISOTROPE') THEN 179 : CALL ERREUR(251) 180 : GOTO 9900 181 : ENDIF 182 : * 183 : * Information sur l'element fini 184 : * 184 : * CALL ELQUOI(MELE,0,3,IPINF,IMODEL) 185 : * IF (IERR.NE.0) GOTO 9900 186 : * INFO =IPINF 187 : MFR =INFELE(13) 188 : NBG =INFELE(6) 189 : NBGS =INFELE(4) 190 : NSTRS=INFELE(16) 191 : LW =200 192 : LHOOK=INFELE(10) 193 : * MINTE=INFELE(11) 194 : minte=infmod(5) 195 : IPMIN1=MINTE 196 : * 197 : INFCHE(ISOUS,1)=0 198 : INFCHE(ISOUS,2)=0 199 : INFCHE(ISOUS,3)=NHRM 200 : INFCHE(ISOUS,4)=MINTE 201 : INFCHE(ISOUS,5)=0 202 : INFCHE(ISOUS,6)=3 203 : * 204 : SEGACT MINTE 205 : NBPGAU=POIGAU(/1) 206 : NBNO =SHPTOT(/2) 207 : * 208 : SEGACT MELEME 209 : NBNN =NUM(/1) 210 : NBELEM=NUM(/2) 211 : IPPORE=0 212 : IF(MFR.EQ.33) IPPORE=NBNN 213 : 214 : * INFO=IPINF 215 : * SEGSUP INFO 216 : * 217 : * Creation du tableau INFOS 218 : * 218 : CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD) 219 : IF (IRTD.EQ.0) GOTO 9901 220 : * 221 : * Verification du MCHAML de contraintes 222 : * 223 : if(lnomid(4).ne.0) then 224 : nomid=lnomid(4) 225 : segact nomid 226 : mocont=nomid 227 : nstr=lesobl(/2) 228 : nfac=lesfac(/2) 229 : lsupco=.false. 230 : else 231 : lsupco=.true. 231 : CALL IDCONT(IMODEL,IFOUR,MOCONT,NSTR,NFAC) 232 : endif 233 : * 234 : NBTYPE=1 235 : SEGINI NOTYPE 236 : TYPE(1)='REAL*8' 237 : MOTYPE=NOTYPE 237 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCONT,MOTYPE, 238 : . 1,INFOS,3,IVACON) 239 : SEGSUP NOTYPE 240 : IF (IERR.NE.0) GOTO 9910 241 : * 242 : IF (ISUPCO.EQ.1) THEN 242 : CALL VALCHE(IVACON,NSTRS,IPMIN1,IPPORE) 243 : ENDIF 244 : * 245 : * Verification du MCHAML de variables internes 246 : * 247 : if(lnomid(10).ne.0) then 248 : nomid=lnomid(10) 249 : segact nomid 250 : movari=nomid 251 : nvari=lesobl(/2) 252 : nfac=lesfac(/2) 253 : lsupva=.false. 254 : else 255 : lsupva=.true. 255 : CALL IDVARI(MFR,IPMOD1,MOVARI,NVARI,NFAC) 256 : endif 257 : * 258 : NBTYPE=1 259 : SEGINI NOTYPE 260 : TYPE(1)='REAL*8' 261 : MOTYPE=NOTYPE 261 : CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOVARI,MOTYPE, 262 : . 1,INFOS,3,IVAVAR) 263 : SEGSUP NOTYPE 264 : IF(IERR.NE.0)GOTO 9920 265 : * 266 : IF (ISUPVA.EQ.1) THEN 266 : CALL VALCHE(IVAVAR,NVARI,IPMIN1,IPPORE) 267 : ENDIF 268 : * 269 : * Creation du tableau INFOS 270 : * 270 : CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE3,INFOS,IRTD) 271 : IF (IRTD.EQ.0) GOTO 9920 272 : * 273 : * Verification du MCHAML de materiau 274 : * 275 : NBROBL=0 276 : NBRFAC=0 277 : MOMATR=0 278 : * 279 : IF (INPLAS.EQ.1) THEN 280 : NBROBL=2 281 : SEGINI NOMID 282 : MOMATR=NOMID 283 : LESOBL(1)='YOUN' 284 : LESOBL(2)='SIGY' 285 : * 286 : NBTYPE=1 287 : SEGINI NOTYPE 288 : MOTYPE=NOTYPE 289 : TYPE(1)='REAL*8' 290 : ELSE IF (INPLAS.EQ.4) THEN 291 : NBROBL=3 292 : SEGINI NOMID 293 : MOMATR=NOMID 294 : LESOBL(1)='YOUN' 295 : LESOBL(2)='SIGY' 296 : LESOBL(3)='H ' 297 : * 298 : NBTYPE=1 299 : SEGINI NOTYPE 300 : MOTYPE=NOTYPE 301 : TYPE(1)='REAL*8' 302 : ELSE IF (INPLAS.EQ.5) THEN 303 : NBROBL=2 304 : SEGINI NOMID 305 : MOMATR=NOMID 306 : LESOBL(1)='YOUN' 307 : LESOBL(2)='TRAC' 308 : * 309 : NBTYPE=2 310 : SEGINI NOTYPE 311 : MOTYPE=NOTYPE 312 : TYPE(1)='REAL*8' 313 : TYPE(2)='POINTEUREVOLUTIO' 314 : ELSE 315 : NBROBL=1 316 : SEGINI NOMID 317 : MOMATR=NOMID 318 : LESOBL(1)='YOUN' 319 : * 320 : NBTYPE=1 321 : SEGINI NOTYPE 322 : MOTYPE=NOTYPE 323 : TYPE(1)='REAL*8' 324 : ENDIF 325 : * 326 : NMATR=NBROBL 327 : NMATF=NBRFAC 328 : NMATT=NMATR+NMATF 328 : CALL KOMCHA(IPCHE3,IPMAIL,CONM,MOMATR,MOTYPE, 329 : . 1,INFOS,3,IVAMAT) 330 : SEGSUP NOTYPE 331 : IF (IERR.NE.0) GOTO 9930 332 : 333 : IF (ISUPMA.EQ.1) THEN 333 : CALL VALCHE(IVAMAT,NMATT,IPMIN1,IPPORE) 334 : IF(IERR.NE.0)THEN 335 : ISUPMA=0 336 : GOTO 9930 337 : ENDIF 338 : ENDIF 339 : * 340 : * Verification du MCHAML de caracteristiques 341 : * 342 : NBROBL=0 343 : NBRFAC=0 344 : MOCARA=0 345 : IVECT=0 346 : IF (MFR.EQ.3.OR.MFR.EQ.9) THEN 347 : NBROBL=2 348 : SEGINI NOMID 349 : MOCARA=NOMID 350 : LESOBL(1)='EPAI' 351 : LESOBL(2)='CALF' 352 : * 353 : NBTYPE=1 354 : SEGINI NOTYPE 355 : MOTYPE=NOTYPE 356 : TYPE(1)='REAL*8' 357 : ENDIF 358 : * 359 : * POUR LES POUTRES 360 : * 361 : IF (MFR.EQ.7 ) THEN 362 : NBROBL=4 363 : NBRFAC=6 364 : SEGINI NOMID 365 : MOCARA=NOMID 366 : LESOBL(1)='TORS' 367 : LESOBL(2)='INRY' 368 : LESOBL(3)='INRZ' 369 : LESOBL(4)='SECT' 370 : LESFAC(1)='SECY' 371 : LESFAC(2)='SECZ' 372 : LESFAC(3)='DX ' 373 : LESFAC(4)='DY ' 374 : LESFAC(5)='DZ ' 375 : LESFAC(6)='VECT' 376 : IVECT=1 377 : * 378 : NBTYPE=10 379 : SEGINI NOTYPE 380 : MOTYPE=NOTYPE 381 : TYPE(1)='REAL*8' 382 : TYPE(2)='REAL*8' 383 : TYPE(3)='REAL*8' 384 : TYPE(4)='REAL*8' 385 : TYPE(5)='REAL*8' 386 : TYPE(6)='REAL*8' 387 : TYPE(7)='REAL*8' 388 : TYPE(8)='REAL*8' 389 : TYPE(9)='REAL*8' 390 : TYPE(10)='POINTEURPOINT ' 391 : * 392 : * POUR LES TUYAUX 393 : * 394 : ELSE IF (MFR.EQ.13) THEN 395 : NBROBL=2 396 : NBRFAC=9 397 : SEGINI NOMID 398 : MOCARA=NOMID 399 : LESOBL(1)='EPAI' 400 : LESOBL(2)='RAYO' 401 : LESFAC(1)='RACO' 402 : LESFAC(2)='PRES' 403 : LESFAC(3)='CISA' 404 : LESFAC(4)='CFFX' 405 : LESFAC(5)='CFMX' 406 : LESFAC(6)='CFMY' 407 : LESFAC(7)='CFMZ' 408 : LESFAC(8)='CFPR' 409 : LESFAC(9)='VECT' 410 : IVECT=1 411 : * 412 : NBTYPE=11 413 : SEGINI NOTYPE 414 : MOTYPE=NOTYPE 415 : TYPE(1)='REAL*8' 416 : TYPE(2)='REAL*8' 417 : TYPE(3)='REAL*8' 418 : TYPE(4)='REAL*8' 419 : TYPE(5)='REAL*8' 420 : TYPE(6)='REAL*8' 421 : TYPE(7)='REAL*8' 422 : TYPE(8)='REAL*8' 423 : TYPE(9)='REAL*8' 424 : TYPE(10)='REAL*8' 425 : TYPE(11)='POINTEURPOINT ' 426 : ENDIF 427 : * 428 : IF (MOCARA.NE.0) THEN 428 : CALL KOMCHA(IPCHE3,IPMAIL,CONM,MOCARA,MOTYPE, 429 : . 1,INFOS,3,IVACAR) 430 : SEGSUP NOTYPE 431 : IF (IERR.NE.0) GOTO 9940 432 : * 433 : IF (IVECT.EQ.1) THEN 434 : MPTVAL=IVACAR 435 : IF (IVAL(NBROBL+NBRFAC).EQ.0) THEN 436 : * 437 : * MOT CLE VECT EN CAS DE CONVERSION 438 : * 439 : IVECT=2 440 : NOMID=MOCARA 441 : SEGACT NOMID 442 : NBRFAC=NBRFAC+2 443 : SEGADJ NOMID 444 : MOCARA=NOMID 445 : LESFAC(NBRFAC-2)='VX ' 446 : LESFAC(NBRFAC-1)='VY ' 447 : LESFAC(NBRFAC )='VZ ' 448 : * 449 : NBTYPE=1 450 : SEGINI NOTYPE 451 : MOTYPE=NOTYPE 452 : TYPE(1)='REAL*8' 452 : CALL KOMCHA(IPCHE3,IPMAIL,CONM,MOCARA,MOTYPE, 453 : . 1,INFOS,3,IVACAR) 454 : SEGSUP NOTYPE 455 : IF (IERR.NE.0) GOTO 9940 456 : ENDIF 457 : ENDIF 458 : ENDIF 459 : NCARA=NBROBL 460 : NCARF=NBRFAC 461 : NCARR=NCARA+NCARF 462 : IF (ISUPMA.EQ.1.AND.MOCARA.NE.0) THEN 462 : CALL VALCHE(IVACAR,NCARR,IPMIN1,IPPORE) 463 : IF(IERR.NE.0)THEN 464 : ISUPMA=0 465 : GOTO 9940 466 : ENDIF 467 : ENDIF 468 : ICARA=NCARR 469 : IF((MFR.EQ.7.OR.MFR.EQ.13).AND.IVECT.EQ.1)ICARA=NCARR+IDIM-1 470 : * 471 : * Creation du MCHAML de la sous zone 472 : * 473 : N2=1 474 : SEGINI MCHAML 475 : ICHAML(ISOUS)=MCHAML 476 : NOMCHE(1)='SCAL' 477 : TYPCHE(1)='REAL*8' 478 : * 479 : * Creation du MELVAL de la composante SCAL 480 : * 481 : N1PTEL=NBG 482 : N1EL=NBELEM 483 : N2PTEL=0 484 : N2EL=0 485 : SEGINI MELVAL 486 : IELVAL(1)=MELVAL 487 : IPMELV=MELVAL 488 : * 489 : * Mise a 0 des variables du COMMON NECOU si besoin 490 : * Les bonnes valeurs sont attribuees selon le materiaux 491 : * ( initialisation selon les cas ) 492 : * 493 : IF(INPLAS.EQ.2) GO TO 681 494 : IFOURB=IFOUR 495 : NCOURB=0 496 : IPLAST=0 497 : IMAPLA=1 498 : IT=1 499 : ISOTRO=0 500 : ITYP=0 501 : * 502 : * Correspondance MFR,IFOUR et ITYP faite dans ECOINC 503 : * 504 : * Correspondance MFR,IFOUR et ITYP 505 : * a completer 506 : * 507 : IF(MFR.EQ.1.AND.IFOUR.EQ.-2) ITYP=6 508 : IF(MFR.EQ.1.AND.IFOUR.GE.-1) ITYP=1 509 : IF(MFR.EQ.3) ITYP=2 510 : IF(MFR.EQ.5) ITYP=13 511 : IF(MFR.EQ.7) ITYP=11 512 : IF(MFR.EQ.9) ITYP= 2 513 : * 514 : * cas du coq4 - on ne travaille que sur les 6 eres composantes 515 : * 516 : IF(MFR.EQ.13) ITYP=12 517 : IF(MFR.EQ.25) ITYP=3 518 : IF(MFR.EQ.27) ITYP=4 519 : * 520 : IFLUAG=0 521 : ICINE=0 522 : ITHER=0 523 : IFLUPL=0 524 : ICYCL=0 525 : IBI=0 526 : JFLUAG=0 527 : KFLUAG=0 528 : LFLUAG=0 529 : IRELAX=0 530 : JNTRIN=0 531 : MFLUAG=0 532 : JSOUFL=0 533 : JGRDEF=0 534 : LTRAC=600 535 : * 536 : 681 CONTINUE 537 : * 538 : NCXMAT=NMATT 539 : IF(INPLAS.EQ.5)NCXMAT=NMATT+3 540 : SEGINI WRK0,WRK1,WRK2,WRK3 541 : IF(MFR.EQ.7.OR.MFR.EQ.13) THEN 542 : NBBB=NBNN 543 : SEGINI WRK4 544 : SEGINI WRK6 545 : ENDIF 546 : * 547 : * Boucle sur les elements 548 : * 549 : DO 3004 IB=1,NBELEM 550 : * 551 : * Boucle sur les points de gauss 552 : * 553 : DO 5004 IGAU=1,N1PTEL 554 : * 555 : * On remplit les differentes quantites necessaires a 556 : * ECOULE 557 : * 558 : * Contraintes initiales 559 : * 560 : MPTVAL=IVACON 561 : DO 4004 ICOMP=1,NSTR 562 : MELVAL=IVAL(ICOMP) 563 : IGMN=MIN(IGAU,VELCHE(/1)) 564 : IBMN=MIN(IB ,VELCHE(/2)) 565 : SIG0(ICOMP)=VELCHE(IGMN,IBMN) 566 : 4004 CONTINUE 567 : * 568 : * Variables internes initiales 569 : * 570 : MPTVAL=IVAVAR 571 : DO 4005 ICOMP=1,NVARI 572 : MELVAL=IVAL(ICOMP) 573 : IGMN=MIN(IGAU,VELCHE(/1)) 574 : IBMN=MIN(IB ,VELCHE(/2)) 575 : VAR0(ICOMP)=VELCHE(IGMN,IBMN) 576 : 4005 CONTINUE 577 : IEPS=1 578 : EPSPL=VAR0(IEPS) 579 : * 580 : * Les constantes du materiaux 581 : * 582 : MPTVAL=IVAMAT 583 : IF(INPLAS.EQ.5)THEN 584 : MELVAL=IVAL(1) 585 : IBMN=MIN(IB,VELCHE(/2)) 586 : IGMN=MIN(IGAU,VELCHE(/1)) 587 : XMAT(1)=VELCHE(IGMN,IBMN) 588 : MELVAL=IVAL(2) 589 : IBMN=MIN(IB,IELCHE(/2)) 590 : IGMN=MIN(IGAU,IELCHE(/1)) 591 : MEVOLL = IELCHE(IGMN,IBMN) 592 : *-------- 593 : SEGACT MEVOLL 594 : KEVOLL=IEVOLL(1) 595 : SEGACT KEVOLL 596 : MLREEL = IPROGY 597 : SEGACT MLREEL 598 : LTR2 = PROG(/1) 599 : SEGDES MLREEL,KEVOLL,MEVOLL 600 : IF(LTR2.GT.LTRAC) THEN 601 : LTRAC = LTR2 602 : SEGADJ WRK0 603 : ENDIF 604 : XMAT(5)=MEVOLL 605 : ELSE 606 : DO 4007 ICOMP=1,NMATR 607 : MELVAL=IVAL(ICOMP) 608 : IF(TYVAL(ICOMP)(1:8).NE.'POINTEUR')THEN 609 : IBMN=MIN(IB,VELCHE(/2)) 610 : IGMN=MIN(IGAU,VELCHE(/1)) 611 : XMAT(ICOMP)=VELCHE(IGMN,IBMN) 612 : ELSE 613 : IBMN=MIN(IB,IELCHE(/2)) 614 : IGMN=MIN(IGAU,IELCHE(/1)) 615 : * XMAT(ICOMP)=IELCHE(IGMN,IBMN) 616 : MEVOLL = IELCHE(IGMN,IBMN) 617 : SEGACT MEVOLL 618 : KEVOLL=IEVOLL(1) 619 : SEGACT KEVOLL 620 : MLREEL = IPROGY 621 : SEGACT MLREEL 622 : LTR2 = PROG(/1) 623 : SEGDES MLREEL,KEVOLL,MEVOLL 624 : IF(LTR2.GT.LTRAC) THEN 625 : LTRAC = LTR2 626 : SEGADJ WRK0 627 : ENDIF 628 : XMAT(5)=MEVOLL 629 : *--------------- 630 : ENDIF 631 : 4007 CONTINUE 632 : ENDIF 633 : IYUNG=1 634 : ETANG=XMAT(IYUNG) 635 : * 636 : * Les caracteristiques si besoin 637 : * 638 : IF (ITYP.EQ.2) THEN 639 : ALFAH=1. 640 : IF(MOCARA.NE.0) THEN 641 : MPTVAL=IVACAR 642 : DO 6029 ICOMP=1,NCARR 643 : MELVAL=IVAL(ICOMP) 644 : IBMN=MIN(IB ,VELCHE(/2)) 645 : XCAR(ICOMP)=VELCHE(1,IBMN) 646 : 6029 CONTINUE 647 : IALF=2 648 : ALFAH=XCAR(IALF)*XCAR(IALF) 649 : ENDIF 650 : * 651 : * On transforme les efforts en contraintes pour les 652 : * coques minces 653 : * 653 : CALL EFCONT(XCAR(1),0.D0,NSTRS,SIG0) 654 : IF (NVARI.EQ.NSTRS+1) THEN 654 : CALL EFCONT(XCAR(1),0.D0,NSTRS,VAR0(2)) 655 : ENDIF 656 : ENDIF 657 : * 658 : * cas des tuyaux 659 : * 660 : IF (ITYP.EQ.12) THEN 661 : IF(MOCARA.NE.0) THEN 662 : MPTVAL=IVACAR 663 : DO 5129 ICOMP=1,5 664 : MELVAL=IVAL(ICOMP) 665 : IF (MELVAL.NE.0) THEN 666 : IGMN=MIN(IGAU,VELCHE(/1)) 667 : IBMN=MIN(IB ,VELCHE(/2)) 668 : XCAR(ICOMP)=VELCHE(IGMN,IBMN) 669 : ELSE 670 : XCAR(ICOMP)=0.D0 671 : ENDIF 672 : 5129 CONTINUE 673 : IF(IVECT.EQ.1) THEN 674 : DO 5130 ICOMP=6,NCARR-1 675 : MELVAL=IVAL(ICOMP) 676 : IF (MELVAL.NE.0) THEN 677 : IGMN=MIN(IGAU,VELCHE(/1)) 678 : IBMN=MIN(IB ,VELCHE(/2)) 679 : XCAR(ICOMP)=VELCHE(IGMN,IBMN) 680 : ELSE 681 : XCAR(ICOMP)=-1.D0 682 : ENDIF 683 : 5130 CONTINUE 684 : IF (IVAL(NCARR).NE.0) THEN 685 : MELVAL=IVAL(NCARR) 686 : IBMN=MIN(IB,IELCHE(/2)) 687 : IGMN=MIN(IGAU,IELCHE(/1)) 688 : IP=IELCHE(IGMN,IBMN) 689 : IREF=(IP-1)*(IDIM+1) 690 : DO 5229 IC=1,IDIM 691 : XCAR(NCARR+IC-1)=XCOOR(IREF+IC) 692 : 5229 CONTINUE 693 : ELSE 694 : DO 5329 IC=1,IDIM 695 : XCAR(NCARR+IC-1)=0.D0 696 : 5329 CONTINUE 697 : ENDIF 698 : ELSE 699 : DO 5330 ICOMP=6,10 700 : MELVAL=IVAL(ICOMP) 701 : IF (MELVAL.NE.0) THEN 702 : IGMN=MIN(IGAU,VELCHE(/1)) 703 : IBMN=MIN(IB ,VELCHE(/2)) 704 : XCAR(ICOMP)=VELCHE(IGMN,IBMN) 705 : ELSE 706 : XCAR(ICOMP)=-1.D0 707 : ENDIF 708 : 5330 CONTINUE 709 : DO 5339 ICOMP=11,ICARA 710 : MELVAL=IVAL(ICOMP) 711 : IF (MELVAL.NE.0) THEN 712 : IGMN=MIN(IGAU,VELCHE(/1)) 713 : IBMN=MIN(IB ,VELCHE(/2)) 714 : XCAR(ICOMP)=VELCHE(IGMN,IBMN) 715 : ELSE 716 : XCAR(ICOMP)=0.D0 717 : ENDIF 718 : 5339 CONTINUE 719 : ENDIF 720 : * 721 : * REARRANGEMENT DU TABLEAU XCAR POUR QU'ON AI LA MEME ORDRE 722 : * QUE L'ANCIEN CHAMELEM 723 : * 724 : NWORK = 7 725 : DO 5349 IC=4,10 726 : WORK(IC-3)=XCAR(IC) 727 : 5349 CONTINUE 728 : IF(IDIM.EQ.2)THEN 729 : XCAR(4)=XCAR(ICARA-1) 730 : XCAR(5)=XCAR(ICARA) 731 : DO 5359 IC=1,NWORK 732 : XCAR(IC+5)=WORK(IC) 733 : 5359 CONTINUE 734 : ELSE IF(IDIM.EQ.3)THEN 735 : XCAR(4)=XCAR(ICARA-2) 736 : XCAR(5)=XCAR(ICARA-1) 737 : XCAR(6)=XCAR(ICARA) 738 : DO 5369 IC=1,NWORK 739 : XCAR(IC+6)=WORK(IC) 740 : 5369 CONTINUE 741 : ENDIF 742 : ENDIF 743 : ENDIF 744 : * 745 : * cas des poutres 746 : * 747 : IF (ITYP.EQ.11) THEN 748 : IF(MOCARA.NE.0) THEN 749 : MPTVAL=IVACAR 750 : IF(IVECT.EQ.1) THEN 751 : DO 6129 ICOMP=1,NCARR-1 752 : MELVAL=IVAL(ICOMP) 753 : IF (MELVAL.NE.0) THEN 754 : IGMN=MIN(IGAU,VELCHE(/1)) 755 : IBMN=MIN(IB ,VELCHE(/2)) 756 : XCAR(ICOMP)=VELCHE(IGMN,IBMN) 757 : ELSE 758 : XCAR(ICOMP)=0.D0 759 : ENDIF 760 : 6129 CONTINUE 761 : IF (IVAL(NCARR).NE.0) THEN 762 : MELVAL=IVAL(NCARR) 763 : IBMN=MIN(IB,IELCHE(/2)) 764 : IGMN=MIN(IGAU,IELCHE(/1)) 765 : IP=IELCHE(IGMN,IBMN) 766 : IREF=(IP-1)*(IDIM+1) 767 : DO 6229 IC=1,IDIM 768 : XCAR(NCARR+IC-1)=XCOOR(IREF+IC) 769 : 6229 CONTINUE 770 : ELSE 771 : DO 6329 IC=1,IDIM 772 : XCAR(NCARR+IC-1)=0.D0 773 : 6329 CONTINUE 774 : ENDIF 775 : ELSE 776 : DO 6339 ICOMP=1,ICARA 777 : MELVAL=IVAL(ICOMP) 778 : IF (MELVAL.NE.0) THEN 779 : IGMN=MIN(IGAU,VELCHE(/1)) 780 : IBMN=MIN(IB ,VELCHE(/2)) 781 : XCAR(ICOMP)=VELCHE(IGMN,IBMN) 782 : ELSE 783 : XCAR(ICOMP)=0.D0 784 : ENDIF 785 : 6339 CONTINUE 786 : ENDIF 787 : * 788 : * REARRANGEMENT DU TABLEAU XCAR POUR QU'ON AI LA MEME ORDRE 789 : * QUE L'ANCIEN CHAMELEM 790 : * 791 : IF(IDIM.EQ.2)THEN 792 : VX=XCAR(ICARA-3) 793 : VY=XCAR(ICARA-2) 794 : XCAR(ICARA-3)=XCAR(ICARA-1) 795 : XCAR(ICARA-2)=XCAR(ICARA) 796 : XCAR(ICARA-1)=VX 797 : XCAR(ICARA)=VY 798 : ELSEIF(IDIM.EQ.3)THEN 799 : VX=XCAR(ICARA-5) 800 : VY=XCAR(ICARA-4) 801 : VZ=XCAR(ICARA-3) 802 : XCAR(ICARA-5)=XCAR(ICARA-2) 803 : XCAR(ICARA-4)=XCAR(ICARA-1) 804 : XCAR(ICARA-3)=XCAR(ICARA) 805 : XCAR(ICARA-2)=VX 806 : XCAR(ICARA-1)=VY 807 : XCAR(ICARA)=VZ 808 : ENDIF 809 : ENDIF 810 : ENDIF 811 : C 812 : IF(ITYP.EQ.11) THEN 813 : DIV(1)=1.D0/XCAR(4) 814 : DIV(2)=1.D0 815 : DIV(3)=1.D0 816 : DIV(4)=XCAR(5)/XCAR(1) 817 : DIV(5)=XCAR(6)/XCAR(2) 818 : DIV(6)=XCAR(7)/XCAR(3) 819 : IF(DIV(4).EQ.0.D0) DIV(4)=1.D-10/SQRT(XCAR(1)*XCAR(4)) 820 : IF(DIV(5).EQ.0.D0) DIV(5)=1.D-10/SQRT(XCAR(2)*XCAR(4)) 821 : IF(DIV(6).EQ.0.D0) DIV(6)=1.D-10/SQRT(XCAR(3)*XCAR(4)) 822 : ENDIF 823 : C 824 : IF(ITYP.EQ.12) THEN 825 : EPAIS=XCAR(1) 826 : REXT =XCAR(2) 827 : RMOY =REXT-EPAIS*0.5D0 828 : RACO =XCAR(3) 829 : PRES =XCAR(4) 830 : CISA =XCAR(5) 831 : C 832 : GAM=1.D0 833 : IF(RACO.EQ.0.D0) GO TO 6429 834 : XLAM=RMOY*RMOY/EPAIS/RACO 835 : GAM=0.8888888888888889D0*(XLAM)**0.6666666666666667D0 836 : IF(GAM.LT.1.D0) GAM=1.D0 837 : 6429 CONTINUE 838 : C 839 : C NB 23/09/98 840 : C VALEURS PAR DEFAUT POUR LES CFFX CFMX CFMY 841 : C CFMZ CFPR ( COEFFICIENTS POUR CALCULER LES 842 : C CONTRAINTES DE MEMBRANE, TORSION, FLEXIONS 843 : C DANS LE PLAN, HORS PLAN ET CIRCONFERENTIELLE 844 : C DUE A LA PRESSION ) 845 : C POUR L'INSTANT PAS DE CONTRAINTE CIRCONFERENTIELLE 846 : C DUE A LA PRESSION ON N'UTILISE DONC PAS DIV(7) 847 : C 848 : C 849 : DIV(1)=1.D0 850 : DIV(2)=1.D0 851 : DIV(3)=1.D0 852 : DIV(4)=R33 853 : DIV(5)=PI4*GAM 854 : DIV(6)=DIV(5) 855 : DIV(7)=0.D0 856 : C 857 : IF(IDIM.EQ.2) THEN 858 : PRES1=XCAR(6) 859 : CISA1=XCAR(7) 860 : IDEB1=8 861 : ELSE IF(IDIM.EQ.3) THEN 862 : PRES1=XCAR(7) 863 : CISA1=XCAR(8) 864 : IDEB1=9 865 : ENDIF 866 : C 867 : JDIV1=2 868 : DO 6529 ICOMP=IDEB1,ICARA 869 : JDIV1=JDIV1+1 870 : VCAR1=XCAR(ICOMP) 871 : IF (VCAR1.NE.-1.D0) DIV(JDIV1)=XCAR(ICOMP) 872 : 6529 CONTINUE 873 : C 874 : C NB 23/09/98 875 : C TRANSFERT DE CFFX DANS DIV(1) ET REMISE A 876 : C 1.D0 DE DIV(3) 877 : C 878 : DIV(1) = DIV(3) 879 : DIV(3)=1.D0 880 : C 881 : IF(IDIM.EQ.2) CISA=XCAR(7) 882 : IF(IDIM.EQ.3) CISA=XCAR(8) 883 : VX=XCAR(4) 884 : VY=XCAR(5) 885 : VZ=XCAR(6) 885 : CALL TUYCAR(XCAR,CISA,VX,VY,VZ,KERRE,1) 886 : DIV(1)=DIV(1)/XCAR(4) 887 : DIV(4)=DIV(4)*RMOY/XCAR(1) 888 : DIV(5)=DIV(5)*RMOY/XCAR(2) 889 : DIV(6)=DIV(6)*RMOY/XCAR(3) 890 : ENDIF 891 : * 892 : * On transforme les efforts en contraintes pour les 893 : * poutres et tuyaux 894 : * 895 : IF (ITYP.EQ.11.OR.ITYP.EQ.12) THEN 896 : DO 6629 ICOMP=1,NSTR 897 : SIG0(ICOMP)=SIG0(ICOMP)*DIV(ICOMP) 898 : 6629 CONTINUE 899 : ENDIF 900 : *______________________________________________________________________ 901 : * 902 : * MATERIAU PUREMENT ELASTIQUE 903 : *_____________________________________________________________________ 904 : * 905 : IF(INPLAS.EQ.0) THEN 906 : GO TO 510 907 : ENDIF 908 : *====================================================================== 909 : * 910 : * NUMERO DES ETIQUETTES : 911 : * 912 : * 1 A 99 POUR LES MODELES DE PLASTICITE ( INDICE INPLAS ) 913 : * 914 : *====================================================================== 915 : * 916 : GOTO (1, 2,99, 4, 5,99, 7,99,99,99, 7, 7, 7,99,99,99,99,99,99,99, 917 : & 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 918 : & 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99, 919 : & 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99),INPLAS 920 : * 921 : 99 CONTINUE 922 : MOTERR(1:4)=NOMAC(INPLAS) 923 : MOTERR(5:12)=NOMFR(MFR) 923 : CALL ERREUR(269) 924 : SEGSUP MCHAML 925 : MELVAL=IPMELV 926 : SEGSUP MELVAL 927 : GOTO 9940 928 : *_______________________________________________________________________ 929 : * 930 : * MODELE VON MISES ISOTROPE ASSOCIE ( D'APRES INCA ) 931 : *_______________________________________________________________________ 932 : * 933 : 1 CONTINUE 934 : * 935 : * Cas de la plasticite parfaite 936 : * 937 : NCOURB=2 938 : TRAC(1)=XMAT(2) 939 : TRAC(2)=0.D0 940 : TRAC(3)=XMAT(2) 941 : TRAC(4)=1.D0 942 : IF(XMAT(2).EQ.0.D0) THEN 943 : KERRE=33 944 : GO TO 510 945 : ENDIF 946 : * 947 : * On cherche si on est sur la surface de charge 948 : * 949 : IF(EPSPL.EQ.0.) GO TO 682 950 : SIGVM=VONMIS(SIG0,ITYP,ALFAH,COMIS) 951 : IF(SIGVM.LT.PRECIS*TRAC(1)) GO TO 682 952 : ETANG=0. 953 : GOTO 682 954 : * 955 : 4 CONTINUE 956 : * 957 : * Cas de la plasticite cinematique bilineaire 958 : * 959 : ICINE=1 960 : NCOURB=2 961 : TRAC(1)=XMAT(2) 962 : TRAC(2)=0.D0 963 : TRAC(3)=XMAT(2)+XMAT(3) 964 : TRAC(4)=1.D0 965 : IF(XMAT(2).EQ.0.D0) THEN 966 : KERRE=33 967 : GO TO 510 968 : ENDIF 969 : * 970 : * On cherche si on est sur la surface de charge 971 : * 972 : IF(EPSPL.EQ.0.) GO TO 682 973 : ISPHER=2 973 : CALL AEQBPC(SIG0,SIG0,VAR0(ISPHER),1.D0,-1.D0,NSTRS) 974 : * 975 : SIGVM=VONMIS(SIG0,ITYP,ALFAH,COMIS) 976 : IF(SIGVM.LT.PRECIS*TRAC(1)) GO TO 682 977 : H=TRAC(3) 978 : ETANG=ETANG*H/(ETANG+H) 979 : GOTO 682 980 : C 981 : 5 CONTINUE 982 : * 983 : * Cas de la plasticite isotrope ecrouissable 984 : * 985 : * On recupere la courbe de traction 986 : * 986 : CALL COTRAC(WRK0,WRK2,NCOURB,KERRE) 987 : IF(KERRE.GT.0) GO TO 510 988 : IF(EPSPL.EQ.0.) GO TO 682 989 : LSIG=NCOURB 990 : SEGINI WRK5 991 : * 992 : DO 7000 IZ=1,LSIG 993 : SIG(IZ)=TRAC(2*(IZ-1)+1) 994 : EPS(IZ)=TRAC(2*IZ) 995 : 7000 CONTINUE 996 : * 996 : CALL TRACTI(SELAS,EPSPL,SIG,EPS,NCOURB,2,IBI) 997 : IF(IBI.NE.0) THEN 998 : KERRE=75 999 : GO TO 510 1000 : ENDIF 1001 : SIGVM=VONMIS(SIG0,ITYP,ALFAH,COMIS) 1002 : * 1003 : IF(SIGVM.LT.PRECIS*SELAS) GO TO 7001 1003 : CALL TRACTI(H,EPSPL,SIG,EPS,NCOURB,1,IBI) 1004 : IF(IBI.NE.0) THEN 1005 : KERRE=75 1006 : GO TO 510 1007 : ENDIF 1008 : ETANG=ETANG*H/(ETANG+H) 1009 : * 1010 : 7001 CONTINUE 1011 : SEGSUP WRK5 1012 : GO TO 682 1013 : * 1014 : 7 CONTINUE 1015 : * 1016 : * Cas du modele CHABOCHE 1017 : * 1018 : ICINE=1 1019 : IMAPLA=4 1020 : GOTO 682 1021 : * 1022 : 682 CONTINUE 1023 : DO 675 IC=1,NCARR 1024 : WORK(IC)=XCAR(IC) 1025 : 675 CONTINUE 1026 : GOTO 510 1027 : * 1028 : * Modele LINESPRING 1029 : * 1030 : 2 CONTINUE 1031 : GOTO 510 1032 : * 1033 : 510 CONTINUE 1034 : * 1035 : * 1036 : * Remplissage du segment contenant les contraintes a la fin 1037 : * 1038 : IF (KERRE.EQ.0) THEN 1039 : MELVAL=IPMELV 1040 : VELCHE(IGAU,IB)=ETANG 1041 : * 1042 : * Impression des message d'erreurs 1043 : * 1044 : ELSE IF(KERRE.NE.0) THEN 1045 : IRT0=0 1046 : IRT6=0 1047 : IRT7=0 1048 : INTERR(1)=IB 1049 : INTERR(2)=IGAU 1050 : MOTERR(1:4)=NOMTP(MELE) 1051 : IF(KERRE.EQ.1) THEN 1051 : CALL ERREUR(267) 1052 : ELSE IF(KERRE.EQ.2) THEN 1052 : CALL ERREUR(268) 1053 : ELSE IF(KERRE.EQ.30) THEN 1053 : CALL ERREUR(270) 1054 : ELSE IF(KERRE.EQ.31) THEN 1054 : CALL ERREUR(271) 1055 : ELSE IF(KERRE.EQ.32) THEN 1055 : CALL ERREUR(272) 1056 : ELSE IF(KERRE.EQ.33) THEN 1056 : CALL ERREUR(273) 1057 : ELSE IF(KERRE.EQ.34) THEN 1057 : CALL ERREUR(325) 1058 : ELSE IF(KERRE.EQ.35) THEN 1058 : CALL ERREUR(331) 1059 : ELSE IF(KERRE.EQ.36) THEN 1059 : CALL ERREUR(330) 1060 : ELSE IF(KERRE.EQ.37) THEN 1060 : CALL ERREUR(354) 1061 : ELSE IF(KERRE.EQ.21) THEN 1061 : CALL ERREUR(276) 1062 : ELSE IF(KERRE.EQ.22) THEN 1062 : CALL ERREUR(275) 1063 : ELSE IF(KERRE.EQ.75) THEN 1063 : CALL ERREUR(876) 1064 : ENDIF 1065 : GOTO 444 1066 : ENDIF 1067 : * 1068 : 5004 CONTINUE 1069 : 3004 CONTINUE 1070 : * 1071 : 444 CONTINUE 1072 : SEGSUP WRK0,WRK1,WRK2,WRK3 1073 : IF(MFR.EQ.7.OR.MFR.EQ.13) THEN 1074 : SEGSUP WRK4,WRK6 1075 : ENDIF 1076 : * 1077 : IF (ISUPCO.EQ.1) THEN 1077 : CALL DTMVAL (IVACON,3) 1078 : ELSE 1078 : CALL DTMVAL (IVACON,1) 1079 : ENDIF 1080 : * 1081 : IF (ISUPVA.EQ.1) THEN 1081 : CALL DTMVAL (IVAVAR,3) 1082 : ELSE 1082 : CALL DTMVAL (IVAVAR,1) 1083 : ENDIF 1084 : * 1085 : IF (ISUPMA.EQ.1) THEN 1085 : CALL DTMVAL (IVAMAT,3) 1086 : ELSE 1086 : CALL DTMVAL (IVAMAT,1) 1087 : ENDIF 1088 : * 1089 : IF (ISUPMA.EQ.1) THEN 1089 : CALL DTMVAL (IVACAR,3) 1090 : ELSE 1090 : CALL DTMVAL (IVACAR,1) 1091 : ENDIF 1092 : * 1093 : SEGDES,MINTE 1094 : SEGDES MELEME 1095 : NOMID=MOCONT 1096 : if(lsupco)SEGSUP NOMID 1097 : NOMID=MOVARI 1098 : if(lsupva)SEGSUP NOMID 1099 : NOMID=MOMATR 1100 : SEGSUP NOMID 1101 : IF (MOCARA.NE.0) THEN 1102 : NOMID=MOCARA 1103 : SEGSUP NOMID 1104 : ENDIF 1105 : * INFO=IPINF 1106 : * SEGSUP INFO 1107 : SEGDES IMODEL 1108 : * 1109 : IF(KERRE.NE.0)THEN 1110 : SEGSUP MCHAML 1111 : MELVAL=IPMELV 1112 : SEGSUP MELVAL 1113 : GOTO 888 1114 : ELSE 1115 : SEGDES MCHAML 1116 : MELVAL=IPMELV 1117 : SEGDES MELVAL 1118 : ENDIF 1119 : * 1120 : 500 CONTINUE 1121 : * 1122 : 888 CONTINUE 1123 : SEGDES MMODEL 1124 : IF(KERRE.NE.0) THEN 1125 : IRET=0 1126 : SEGSUP MCHELM 1127 : ELSE 1128 : IRET=1 1129 : SEGDES MCHELM 1130 : ENDIF 1131 : C 1132 : RETURN 1133 : *______________________________________________________________________ 1134 : * 1135 : * Erreurs dans une sous zone desactivation et retour 1136 : *______________________________________________________________________ 1137 : * 1138 : 9940 CONTINUE 1139 : IF (ISUPMA.EQ.1) THEN 1139 : CALL DTMVAL (IVACAR,3) 1140 : ELSE 1140 : CALL DTMVAL (IVACAR,1) 1141 : ENDIF 1142 : NOMID=MOCARA 1143 : IF(NOMID.NE.0)SEGSUP NOMID 1144 : * 1145 : 9930 CONTINUE 1146 : IF (ISUPMA.EQ.1) THEN 1146 : CALL DTMVAL (IVAMAT,3) 1147 : ELSE 1147 : CALL DTMVAL (IVAMAT,1) 1148 : ENDIF 1149 : NOMID=MOMATR 1150 : IF(NOMID.NE.0)SEGSUP NOMID 1151 : * 1152 : 9920 CONTINUE 1153 : IF (ISUPVA.EQ.1) THEN 1153 : CALL DTMVAL (IVAVAR,3) 1154 : ELSE 1154 : CALL DTMVAL (IVAVAR,1) 1155 : ENDIF 1156 : NOMID=MOVARI 1157 : IF(lsupva.and.NOMID.NE.0)SEGSUP NOMID 1158 : * 1159 : 9910 CONTINUE 1160 : IF (ISUPCO.EQ.1) THEN 1160 : CALL DTMVAL (IVACON,3) 1161 : ELSE 1161 : CALL DTMVAL (IVACON,1) 1162 : ENDIF 1163 : NOMID=MOCONT 1164 : IF(lsupco.and.NOMID.NE.0)SEGSUP NOMID 1165 : * 1166 : 9901 CONTINUE 1167 : SEGDES,MELEME,MINTE 1168 : 9900 CONTINUE 1169 : SEGDES IMODEL,MMODEL 1170 : SEGSUP MCHELM 1171 : IRET = 0 1172 : 1173 : RETURN 1174 : END 1175 : 1176 : 1177 : 1178 :
© Cast3M 2003 - All rights reserved.
Disclaimer