1 : C VMISPO SOURCE AM 13/12/16 21:16:12 7825 2 : SUBROUTINE VMISPO(IPMODL,IPCHE1,IPCHE2,ICONV,IPCHE3,IRET) 3 : C_______________________________________________________________________ 4 : C 5 : C Entrées: 6 : C ________ 7 : C 8 : C IPMODL Pointeur sur un MMODEL 9 : C IPCHE1 Pointeur sur un MCHAML de contraintes 10 : C IPCHE2 Pointeur sur un MCHAML de caractéristiques 11 : C ICONV Flag précisant s'il y a eu conversion 12 : C 13 : C SORTIES: 14 : C ________ 15 : C 16 : C IPCHE3 Pointeur sur un MCHAML de VONMISES 17 : C IRET =1 OU 0 suivant succes ou pas (Message d'erreur 18 : C imprimé dans ce cas) 19 : C 20 : C Passage aux nouveaux CHAMELEMs par I.Monnier le 13.06.90 21 : C 22 : *_______________________________________________________________________ 23 : * 24 : IMPLICIT INTEGER(I-N) 25 : IMPLICIT REAL*8(A-H,O-Z) 26 : * 27 : -INC CCOPTIO 28 : -INC CCHAMP 29 : -INC CCGEOME 30 : -INC SMCHAML 31 : -INC SMMODEL 32 : -INC SMCOORD 33 : -INC SMINTE 34 : * 35 : SEGMENT NOTYPE 36 : CHARACTER*16 TYPE(NBTYPE) 37 : ENDSEGMENT 38 : * 39 : SEGMENT MPTVAL 40 : INTEGER IPOS(NS) ,NSOF(NS) 41 : INTEGER IVAL(NCOSOU) 42 : CHARACTER*16 TYVAL(NCOSOU) 43 : ENDSEGMENT 44 : * 45 : CHARACTER*(NCONCH) CONM 46 : PARAMETER ( NINF=3 ) 47 : DIMENSION SIG(9) 48 : DIMENSION CARAC(25),DIV(7) 49 : INTEGER INFOS(NINF) 50 : LOGICAL lsupco 51 : DATA ALPH1/.4444444444444444D0/ 52 : DATA PI4,R33,R22/0.785398164D0,1.732050808D0,1.414213562D0/ 53 : 54 : * WRITE(*,*) 'Entrée dans VMISPO.' 55 : IRET = 0 56 : IPCHE3 = 0 57 : * 58 : * Verification du lieu support du MCHAML de CONTRAINTES 59 : * 60 : ISUP1 = 0 61 : IRET1 = 0 61 : CALL QUESUP (IPMODL,IPCHE1,0,0,ISUP1,IRET1) 62 : * IF (ISUP1.GT.0) RETURN 63 : * 64 : * Verification du lieu support du MCHAML de CARACTERISTIQUES 65 : * 66 : IF (IPCHE2.NE.0) THEN 67 : ISUP2 = 0 68 : IRET2 = 0 68 : CALL QUESUP (IPMODL,IPCHE2,IRET1,1,ISUP2,IRET2) 69 : IF (ISUP2.GT.0) RETURN 70 : ENDIF 71 : * 72 : *_______________________________________________________________________ 73 : * 74 : * ACTIVATION DU MODELE 75 : *_______________________________________________________________________ 76 : * 77 : MMODEL=IPMODL 78 : SEGACT,MMODEL 79 : NSOUS=KMODEL(/1) 80 : KEL22 = 0 81 : DO ISOUS = 1, NSOUS 82 : IMODEL=KMODEL(ISOUS) 83 : SEGACT,IMODEL 84 : IF (NEFMOD.EQ.22.or.formod.ne.'MECANIQUE') KEL22 = KEL22 + 1 85 : ENDDO 86 : * 87 : * ACTIVATION DES CONTRAINTES 88 : * 89 : IRET=1 90 : MCHEL1=IPCHE1 91 : SEGACT MCHEL1 92 : * 93 : * INITIALISATION DU MCHELM DE VON MISES 94 : * 95 : L1=9 96 : N1=NSOUS - KEL22 97 : N3=6 98 : SEGINI MCHELM 99 : IFOCHE=IFOUR 100 : TITCHE='VON MISES' 101 : *_______________________________________________________________________ 102 : * 103 : * BOUCLE SUR LES SOUS ZONES 104 : *_______________________________________________________________________ 105 : * 106 : isouss=0 107 : DO 200 ISOUS=1,NSOUS 108 : C 109 : C QUELQUES INITIALISATIONS 110 : C 111 : MOSTRS = 0 112 : MOCARA = 0 113 : IVASTR = 0 114 : IVACAR = 0 115 : IVAMIS = 0 116 : C 117 : C TRAITEMENT DU MODELE 118 : C 119 : IMODEL=KMODEL(ISOUS) 120 : C* SEGACT IMODEL 121 : MELE=NEFMOD 122 : IF (NEFMOD.EQ.22.or.formod.ne.'MECANIQUE') goto 200 123 : ISOUSS=ISOUSS+1 124 : * 125 : IPMAIL=IMAMOD 126 : CONM =CONMOD 127 : C 128 : C CREATION DU TABLEAU INFOS 129 : C 129 : CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD) 130 : IF (IRTD.EQ.0) GOTO 9990 131 : C 132 : C COQUE INTEGREE OU PAS ? 133 : C 134 : IF(INFMOD(/1).NE.0)THEN 135 : NPINT=INFMOD(1) 136 : ELSE 137 : NPINT=0 138 : ENDIF 139 : C_______________________________________________________________________ 140 : C 141 : C INFORMATIONS SUR L'ELEMENT FINI 142 : C_______________________________________________________________________ 143 : C 143 : * CALL ELQUOI(MELE,0,IRET1,IPINF,IMODEL) 144 : * IF (IERR.NE.0) THEN 145 : * SEGDES IMODEL,MMODEL 146 : * SEGSUP MCHELM 147 : * SEGDES MCHEL1 148 : * RETURN 149 : * ENDIF 150 : * INFO=IPINF 151 : MFR =INFELE(13) 152 : NSTRS =INFELE(16) 153 : NBPGAU=INFELE( 4) 154 : * MINTE =INFELE(11) 155 : MINTE=INFMOD(iret1+2) 156 : IPPORE=0 157 : IF(MFR.EQ.33)IPPORE=NBNNE(NUMGEO(MELE)) 158 : IPMINT=MINTE 159 : SEGACT,MINTE 160 : * SEGSUP INFO 161 : C 162 : C RECOPIE DU MCHELM 163 : C 164 : IMACHE(ISOUSS)=IPMAIL 165 : CONCHE(ISOUSS)=CONMOD 166 : C 167 : INFCHE(ISOUSS,1)=0 168 : INFCHE(ISOUSS,2)=0 169 : INFCHE(ISOUSS,3)=NIFOUR 170 : INFCHE(ISOUSS,4)=MINTE 171 : INFCHE(ISOUSS,5)=0 172 : INFCHE(ISOUSS,6)=IRET1 173 : C 174 : C CREATION DU MCHAML 175 : C 176 : N2=1 177 : SEGINI MCHAML 178 : ICHAML(ISOUSS)=MCHAML 179 : NOMCHE(1)='SCAL' 180 : TYPCHE(1)='REAL*8' 181 : C_______________________________________________________________________ 182 : C 183 : C NOMS DE COMPOSANTES NECESSAIRES 184 : C_______________________________________________________________________ 185 : C 186 : if(lnomid(4).ne.0) then 187 : nomid=lnomid(4) 188 : segact nomid 189 : mostrs=nomid 190 : nstr=lesobl(/2) 191 : nfac=lesfac(/2) 192 : lsupco=.false. 193 : else 194 : lsupco=.true. 194 : CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC) 195 : endif 196 : C 197 : C VERIFICATION DE LEUR PRESENCE 198 : C 199 : NBTYPE=1 200 : SEGINI NOTYPE 201 : MOTYPE=NOTYPE 202 : TYPE(1)='REAL*8' 203 : C 203 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR) 204 : SEGSUP NOTYPE 205 : IF (IERR.NE.0) GOTO 9990 206 : * 206 : IF (ISUP1.EQ.1) CALL VALCHE (IVASTR,NSTR,IPMINT,IPPORE) 207 : C 208 : C RECHERCHE DES TAILLES DE MELVAL 209 : C 210 : N1EL=0 211 : N1PTEL=0 212 : MPTVAL=IVASTR 213 : DO 20 IO=1,NSTRS 214 : MELVAL=IVAL(IO) 215 : N1PTEL=MAX(N1PTEL,VELCHE(/1)) 216 : N1EL =MAX(N1EL ,VELCHE(/2)) 217 : 20 CONTINUE 218 : IF (N1PTEL.EQ.1.OR.NBPGAU.EQ.1) THEN 219 : N1PTEL=1 220 : ELSE 221 : *PVPVPV N1PTEL=NBPGAU 222 : ENDIF 223 : NBPTEL=N1PTEL 224 : NEL =N1EL 225 : C 226 : C CREATION DU MELVAL VMISES 227 : C 228 : N2PTEL=0 229 : N2EL=0 230 : SEGINI MELVAL 231 : IELVAL(1)=MELVAL 232 : IVAMIS =MELVAL 233 : * 234 : * ON TRAITE LES COQUES INTEGREES COMME LES MASSIFS 235 : * 236 : IF(NPINT.NE.0)THEN 237 : MFR1=1 238 : ELSE 239 : MFR1=MFR 240 : ENDIF 241 : C_______________________________________________________________________ 242 : * 243 : * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES * 244 : C_______________________________________________________________________ 245 : * 246 : NBROBL=0 247 : NBRFAC=0 248 : MOCARA=0 249 : IVECT=0 250 : * 251 : * EPAISSEUR ET ALFA DANS LE CAS DES COQUES 252 : * 253 : IF (MFR1.EQ.3.OR.MFR1.EQ.5.OR.MFR1.EQ.9) THEN 254 : NBROBL=1 255 : NBRFAC=1 256 : SEGINI NOMID 257 : MOCARA=NOMID 258 : LESOBL(1)='EPAI' 259 : LESFAC(1)='CALF' 260 : * 261 : NBTYPE=1 262 : SEGINI NOTYPE 263 : TYPE(1)='REAL*8' 264 : * 265 : * CARACTERISTIQUES POUR LES POUTRES 266 : * 267 : ELSE IF (MFR1.EQ.7 ) THEN 268 : NBROBL=4 269 : NBRFAC=3 270 : SEGINI NOMID 271 : MOCARA=NOMID 272 : LESOBL(1)='TORS' 273 : LESOBL(2)='INRY' 274 : LESOBL(3)='INRZ' 275 : LESOBL(4)='SECT' 276 : LESFAC(1)='DX ' 277 : LESFAC(2)='DY ' 278 : LESFAC(3)='DZ ' 279 : * 280 : NBTYPE=1 281 : SEGINI NOTYPE 282 : TYPE(1)='REAL*8' 283 : * 284 : * CARACTERISTIQUES POUR LES TUYAUX 285 : * 286 : ELSE IF (MFR1.EQ.13) THEN 287 : NBROBL=2 288 : NBRFAC=9 289 : SEGINI NOMID 290 : MOCARA=NOMID 291 : LESOBL(1)='EPAI' 292 : LESOBL(2)='RAYO' 293 : LESFAC(1)='RACO' 294 : LESFAC(2)='PRES' 295 : LESFAC(3)='CISA' 296 : LESFAC(4)='CFFX' 297 : LESFAC(5)='CFMX' 298 : LESFAC(6)='CFMY' 299 : LESFAC(7)='CFMZ' 300 : LESFAC(8)='CFPR' 301 : LESFAC(9)='VECT' 302 : IVECT=1 303 : * 304 : NBTYPE=11 305 : SEGINI NOTYPE 306 : TYPE(1)='REAL*8' 307 : TYPE(2)='REAL*8' 308 : TYPE(3)='REAL*8' 309 : TYPE(4)='REAL*8' 310 : TYPE(5)='REAL*8' 311 : TYPE(6)='REAL*8' 312 : TYPE(7)='REAL*8' 313 : TYPE(8)='REAL*8' 314 : TYPE(9)='REAL*8' 315 : TYPE(10)='REAL*8' 316 : TYPE(11)='POINTEURPOINT ' 317 : ENDIF 318 : * 319 : NCARA=NBROBL 320 : NCARF=NBRFAC 321 : NCARR=NCARA+NCARF 322 : IF (MOCARA.NE.0) THEN 323 : MOTYPE=NOTYPE 324 : IF (IPCHE2.NE.0) THEN 324 : CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA,MOTYPE, 325 : 1 1,INFOS,3,IVACAR) 326 : SEGSUP NOTYPE 327 : IF (IERR.NE.0) GOTO 9990 328 : ELSE 329 : SEGSUP NOTYPE 330 : MOTERR(1:8)='CARACTER' 331 : MOTERR(9:12)=NOMTP(MELE) 332 : MOTERR(13:20)='VMIS' 332 : CALL ERREUR(145) 333 : GOTO 9990 334 : ENDIF 335 : * 336 : IF (ISUP2.EQ.1) THEN 336 : CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE) 337 : IF(IERR.NE.0)THEN 338 : ISUP2=0 339 : GOTO 9990 340 : ENDIF 341 : ENDIF 342 : ENDIF 343 : * 344 : C_______________________________________________________________________ 345 : C 346 : C BRANCHEMENT SUIVANT LA FORMULATION 347 : C 348 : C_______________________________________________________________________ 349 : C MASSI COQUE COQEP POUT CIST THER TUYA LISP 350 : GOTO (30,22,60,22,80,22,120,22,70,22,22,22,120,22,90,22,22, 351 : C INCO PORE 352 : . 22,22,22,22,22,22,22,22,22,22,22,22,22,30,22,30),MFR1 353 : c cas Xfem: identique au cas massif 354 : IF(MFR.EQ.63) goto 30 355 : C 356 : 22 CONTINUE 357 : MOTERR(1:8)=NOMFR(MFR1/2+1) 357 : CALL ERREUR(193) 358 : GOTO 9990 359 : C_______________________________________________________________________ 360 : C 361 : C FORMULATION MASSIVE 362 : C_______________________________________________________________________ 363 : C 364 : 30 CONTINUE 365 : DO 31 IB=1,NEL 366 : DO 31 IGAU=1,NBPTEL 367 : MPTVAL=IVASTR 368 : DO 35 ICOMP=1,NSTRS 369 : MELVAL=IVAL(ICOMP) 370 : IGMN=MIN(IGAU,VELCHE(/1)) 371 : IBMN=MIN(IB ,VELCHE(/2)) 372 : SIG(ICOMP)=VELCHE(IGMN,IBMN) 373 : 35 CONTINUE 374 : VONMIS=SIG(1)*SIG(1)+SIG(2)*SIG(2)+SIG(3)*SIG(3)-SIG(1)*SIG(2) 375 : + -SIG(1)*SIG(3)-SIG(2)*SIG(3) 376 : C 377 : IF (IDIM.NE.1) THEN 378 : DO 33 IE=4,NSTRS 379 : VONMIS=VONMIS+3.D0*(SIG(IE)*SIG(IE)) 380 : 33 CONTINUE 381 : ENDIF 382 : C 383 : XXXX=SQRT(ABS(VONMIS)) 384 : MELVAL=IVAMIS 385 : VELCHE(IGAU,IB)=XXXX 386 : 31 CONTINUE 387 : GOTO 150 388 : C_______________________________________________________________________ 389 : C 390 : C FORMULATION COQUE 391 : C_______________________________________________________________________ 392 : C 393 : 60 CONTINUE 394 : C 395 : DO 61 IB=1,NEL 396 : DO 61 IGAU=1,NBPTEL 397 : MPTVAL=IVASTR 398 : DO 62 ICOMP=1,NSTRS 399 : MELVAL=IVAL(ICOMP) 400 : IGMN=MIN(IGAU,VELCHE(/1)) 401 : IBMN=MIN(IB ,VELCHE(/2)) 402 : SIG(ICOMP)=VELCHE(IGMN,IBMN) 403 : 62 CONTINUE 404 : C 405 : MPTVAL=IVACAR 406 : MELVAL=IVAL(1) 407 : IGMN=MIN(IGAU,VELCHE(/1)) 408 : IBMN=MIN(IB ,VELCHE(/2)) 409 : EPAIST=VELCHE(IGMN,IBMN) 410 : * 410 : CALL EFCONT(EPAIST,0.D0,NSTRS,SIG) 411 : MPTVAL=IVACAR 412 : MELVAL=IVAL(2) 413 : IF (MELVAL.NE.0) THEN 414 : IGMN=MIN(IGAU,VELCHE(/1)) 415 : IBMN=MIN(IB ,VELCHE(/2)) 416 : ALPHA=VELCHE(IGMN,IBMN) 417 : ELSE 418 : ALPHA=0.666666666666666666D0 419 : ENDIF 420 : ALPHA=ALPHA*ALPHA 421 : C 422 : IF(IFOUR.GT.0) THEN 423 : VONMIS=SQRT(ABS(SIG(1)*SIG(1)+SIG(2)*SIG(2)-SIG(1)*SIG(2)+ 424 : + 3.D0*SIG(3)*SIG(3)+ALPHA*(SIG(4)*SIG(4)+SIG(5)*SIG(5)- 425 : + SIG(4)*SIG(5)+3.D0*SIG(6)*SIG(6)))) 426 : ELSE IF(IFOUR.LE.0) THEN 427 : VONMIS= SIG(1)*SIG(1)+SIG(2)*SIG(2)-SIG(1)*SIG(2)+ 428 : + ALPHA*(SIG(3)*SIG(3)+SIG(4)*SIG(4)-SIG(3)*SIG(4)) 429 : VONMIS=SQRT(VONMIS) 430 : ENDIF 431 : C 432 : MELVAL=IVAMIS 433 : VELCHE(IGAU,IB)=VONMIS 434 : 61 CONTINUE 435 : GOTO 150 436 : C_______________________________________________________________________ 437 : C 438 : C FORMULATION COQUE AVEC CISAILLEMENT TRANSVERSE (COQ4) 439 : C_______________________________________________________________________ 440 : C 441 : 70 CONTINUE 442 : C 443 : DO 71 IB=1,NEL 444 : DO 71 IGAU=1,NBPTEL 445 : MPTVAL=IVASTR 446 : DO 72 ICOMP=1,NSTRS 447 : MELVAL=IVAL(ICOMP) 448 : IGMN=MIN(IGAU,VELCHE(/1)) 449 : IBMN=MIN(IB ,VELCHE(/2)) 450 : SIG(ICOMP)=VELCHE(IGMN,IBMN) 451 : 72 CONTINUE 452 : C 453 : MPTVAL=IVACAR 454 : MELVAL=IVAL(1) 455 : IGMN=MIN(IGAU,VELCHE(/1)) 456 : IBMN=MIN(IB ,VELCHE(/2)) 457 : EPAIST=VELCHE(IGMN,IBMN) 458 : * 458 : CALL EFCONT(EPAIST,0.D0,NSTRS,SIG) 459 : MPTVAL=IVACAR 460 : MELVAL=IVAL(2) 461 : IF (MELVAL.NE.0) THEN 462 : IGMN=MIN(IGAU,VELCHE(/1)) 463 : IBMN=MIN(IB ,VELCHE(/2)) 464 : ALPHA=VELCHE(IGMN,IBMN) 465 : ELSE 466 : ALPHA=0.666666666666666666D0 467 : ENDIF 468 : ALPHA=ALPHA*ALPHA 469 : C 470 : VONMIS=SQRT(ABS(SIG(1)*SIG(1)+SIG(2)*SIG(2)-SIG(1)*SIG(2)+ 471 : + 3.D0*SIG(7)*SIG(7)+3.D0*SIG(8)*SIG(8)+ 472 : + 3.D0*SIG(3)*SIG(3)+ALPHA*(SIG(4)*SIG(4)+SIG(5)*SIG(5)- 473 : + SIG(4)*SIG(5)+3.D0*SIG(6)*SIG(6)))) 474 : C 475 : MELVAL=IVAMIS 476 : VELCHE(IGAU,IB)=VONMIS 477 : 71 CONTINUE 478 : GOTO 150 479 : C_______________________________________________________________________ 480 : C 481 : C FORMULATION COQUE EPAISSE 482 : C_______________________________________________________________________ 483 : C 484 : 80 CONTINUE 485 : DO 81 IB=1,NEL 486 : DO 81 IGAU=1,NBPTEL 487 : MPTVAL=IVASTR 488 : DO 85 ICOMP=1,NSTRS 489 : MELVAL=IVAL(ICOMP) 490 : IGMN=MIN(IGAU,VELCHE(/1)) 491 : IBMN=MIN(IB ,VELCHE(/2)) 492 : SIG(ICOMP)=VELCHE(IGMN,IBMN) 493 : 85 CONTINUE 494 : VONMIS=SIG(1)*SIG(1)+SIG(2)*SIG(2)-SIG(1)*SIG(2) 495 : 1 + 3.D0*(SIG(3)*SIG(3)+SIG(4)*SIG(4)+SIG(5)*SIG(5)) 496 : C 497 : XXXX=SQRT(ABS(VONMIS)) 498 : MELVAL=IVAMIS 499 : VELCHE(IGAU,IB)=XXXX 500 : 81 CONTINUE 501 : GOTO 150 502 : C_______________________________________________________________________ 503 : C 504 : C FORMULATION LINESPRING 505 : C_______________________________________________________________________ 506 : C 507 : 90 CONTINUE 508 : DO 110 IB=1,NEL 509 : DO 110 IGAU=1,NBPTEL 510 : MPTVAL=IVASTR 511 : DO 100 ICOMP=1,NSTRS 512 : MELVAL=IVAL(ICOMP) 513 : IGMN=MIN(IGAU,VELCHE(/1)) 514 : IBMN=MIN(IB ,VELCHE(/2)) 515 : SIG(ICOMP)=VELCHE(IGMN,IBMN) 516 : 100 CONTINUE 517 : VONMIS=SQRT(ABS(SIG(1)*SIG(1)+ALPH1*SIG(4)*SIG(4))) 518 : C 519 : MELVAL=IVAMIS 520 : VELCHE(IGAU,IB)=VONMIS 521 : 110 CONTINUE 522 : GOTO 150 523 : C_______________________________________________________________________ 524 : C 525 : C FORMULATION POUTRE ET TUYAU 526 : C_______________________________________________________________________ 527 : C 528 : 120 CONTINUE 529 : DO 121 IB=1,NEL 530 : DO 121 IGAU=1,NBPTEL 531 : MPTVAL=IVASTR 532 : DO 122 ICOMP=1,NSTRS 533 : MELVAL=IVAL(ICOMP) 534 : IGMN=MIN(IGAU,VELCHE(/1)) 535 : IBMN=MIN(IB ,VELCHE(/2)) 536 : SIG(ICOMP)=VELCHE(IGMN,IBMN) 537 : 122 CONTINUE 538 : C 539 : MPTVAL=IVACAR 540 : NCARR1=NCARR 541 : IF(IVECT.EQ.1) NCARR1=NCARR-1 542 : DO 123 ICOMP=1,NCARR1 543 : MELVAL=IVAL(ICOMP) 544 : IF (MELVAL.NE.0) THEN 545 : IGMN=MIN(IGAU,VELCHE(/1)) 546 : IBMN=MIN(IB ,VELCHE(/2)) 547 : CARAC(ICOMP)=VELCHE(IGMN,IBMN) 548 : ELSE 549 : CARAC(ICOMP)=0.D0 550 : ENDIF 551 : 123 CONTINUE 552 : C 553 : C CAS OU ON A LU LE MOT VECTEUR 554 : C 555 : IF (IVECT.EQ.1) THEN 556 : IF (IVAL(NCARR).NE.0) THEN 557 : MELVAL=IVAL(NCARR) 558 : IBMN=MIN(IB,IELCHE(/2)) 559 : IP=IELCHE(1,IBMN) 560 : IREF=(IP-1)*(IDIM+1) 561 : DO 6129 IC=1,IDIM 562 : CARAC(NCARR+IC-1)=XCOOR(IREF+IC) 563 : 6129 CONTINUE 564 : ELSE 565 : DO 6229 IC=1,IDIM 566 : CARAC(NCARR+IC-1)=0.D0 567 : 6229 CONTINUE 568 : ENDIF 569 : ENDIF 570 : C 571 : SIGPRE=0.D0 572 : IF(MFR1.EQ.7) THEN 573 : DIV(1)=1.D0/CARAC(4) 574 : DIV(2)=1.D0 575 : DIV(3)=1.D0 576 : DIV(4)=CARAC(5)/CARAC(1) 577 : DIV(5)=CARAC(6)/CARAC(2) 578 : DIV(6)=CARAC(7)/CARAC(3) 579 : ELSE IF(MFR1.EQ.13) THEN 580 : EPAIS=CARAC(1) 581 : REXT =CARAC(2) 582 : RMOY =REXT-EPAIS*0.5D0 583 : RACO =CARAC(3) 584 : PRES =CARAC(4) 585 : CISA =CARAC(5) 586 : C 587 : GAM=1.D0 588 : IF(RACO.EQ.0.D0) GO TO 125 589 : XLAM=RMOY*RMOY/EPAIS/RACO 590 : GAM=0.8888888888888889D0*(XLAM)**0.6666666666666667D0 591 : IF(GAM.LT.1.D0) GAM=1.D0 592 : 125 CONTINUE 593 : C 594 : C NB 23/09/98 595 : C VALEURS PAR DEFAUT POUR LES CFFX CFMX CFMY 596 : C CFMZ CFPR ( COEFFICIENTS POUR CALCULER LES 597 : C CONTRAINTES DE MEMBRANE, TORSION, FLEXIONS 598 : C DANS LE PLAN, HORS PLAN ET CIRCONFERENTIELLE 599 : C DUE A LA PRESSION ) 600 : C 601 : DIV(1)=1.D0 602 : DIV(2)=1.D0 603 : DIV(3)=1.D0 604 : DIV(4)=R33 605 : DIV(5)=PI4*GAM 606 : DIV(6)=DIV(5) 607 : DIV(7)=0.D0 608 : C 609 : DO 1255 ICOMP=6,10 610 : MELVAL=IVAL(ICOMP) 611 : IF (MELVAL.NE.0) DIV(ICOMP-3)=CARAC(ICOMP) 612 : 1255 CONTINUE 613 : C 614 : C NB 23/09/98 615 : C TRANSFERT DE CFFX DANS DIV(1) ET REMISE A 616 : C 1.D0 DE DIV(3) 617 : C 618 : DIV(1) = DIV(3) 619 : DIV(3)=1.D0 620 : C 621 : C RE-ARRANGEMENT DE CARAC POUR TUYCAR 622 : C 623 : CISA=CARAC(5) 624 : CARAC(4)=CARAC(11) 625 : CARAC(5)=CARAC(12) 626 : CARAC(6)=CARAC(13) 627 : C 628 : VX=CARAC(4) 629 : VY=CARAC(5) 630 : VZ=CARAC(6) 630 : CALL TUYCAR(CARAC,CISA,VX,VY,VZ,KERRE,1) 631 : DIV(1)=DIV(1)/CARAC(4) 632 : DIV(4)=DIV(4)*RMOY/CARAC(1) 633 : DIV(5)=DIV(5)*RMOY/CARAC(2) 634 : DIV(6)=DIV(6)*RMOY/CARAC(3) 635 : SIGPRE=DIV(7)*RMOY*PRES/EPAIS 636 : ENDIF 637 : C 638 : VONMIS=SQRT(ABS((SIG(1)*DIV(1))**2+(SIG(4)*DIV(4))**2+ 639 : . (SIG(5)*DIV(5))**2+(SIG(6)*DIV(6))**2+ 640 : . SIGPRE**2 )) 641 : C 642 : MELVAL=IVAMIS 643 : VELCHE(IGAU,IB)=VONMIS 644 : C 645 : 121 CONTINUE 646 : GOTO 150 647 : C 648 : C_______________________________________________________________________ 649 : C 650 : C AUTRE FORMULATION 651 : C_______________________________________________________________________ 652 : C 653 : 150 CONTINUE 654 : C 655 : C DESACTIVATION DES SEGMENTS PROPRES A LA ZONE GEOMETRIQUE ISOUS 656 : C 657 : IF(ISUP1.EQ.1)THEN 657 : CALL DTMVAL(IVASTR,3) 658 : ELSE 658 : CALL DTMVAL(IVASTR,1) 659 : ENDIF 660 : * 661 : MELVAL=IVAMIS 662 : SEGDES MELVAL 663 : * 664 : IF(ISUP2.EQ.1)THEN 664 : CALL DTMVAL(IVACAR,3) 665 : ELSE 665 : CALL DTMVAL(IVACAR,1) 666 : ENDIF 667 : * 668 : NOMID =MOSTRS 669 : if(lsupco)SEGSUP NOMID 670 : NOMID =MOCARA 671 : IF (MOCARA.NE.0) SEGSUP NOMID 672 : * 673 : SEGDES MCHAML 674 : 201 CONTINUE 675 : SEGDES,MINTE 676 : C 677 : 200 CONTINUE 678 : 679 : SEGDES MCHELM 680 : SEGDES MCHEL1 681 : IRET = 1 682 : IPCHE3 = MCHELM 683 : GOTO 888 684 : * 685 : * ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR 686 : * 687 : 9990 CONTINUE 688 : * 689 : IF(ISUP1.EQ.1)THEN 689 : CALL DTMVAL(IVASTR,3) 690 : ELSE 690 : CALL DTMVAL(IVASTR,1) 691 : ENDIF 692 : * 693 : IF(ISUP2.EQ.1)THEN 693 : CALL DTMVAL(IVACAR,3) 694 : ELSE 694 : CALL DTMVAL(IVACAR,1) 695 : ENDIF 696 : * 697 : NOMID =MOSTRS 698 : if(lsupco)SEGSUP NOMID 699 : NOMID =MOCARA 700 : IF (MOCARA.NE.0) SEGSUP NOMID 701 : * 702 : IF (IVAMIS.NE.0) THEN 703 : MELVAL=IVAMIS 704 : SEGSUP MELVAL 705 : ENDIF 706 : * 707 : SEGDES,MINTE 708 : SEGSUP MCHAML 709 : * 710 : SEGDES MCHEL1 711 : SEGSUP MCHELM 712 : 713 : IRET = 0 714 : IPCHE3 = 0 715 : * 716 : 888 CONTINUE 717 : DO ISOUS = 1, NSOUS 718 : IMODEL=KMODEL(ISOUS) 719 : SEGDES,IMODEL 720 : ENDDO 721 : SEGDES MMODEL 722 : 723 : RETURN 724 : END 725 : 726 : 727 : 728 : 729 :
© Cast3M 2003 - All rights reserved.
Disclaimer