1 : C TRESK SOURCE PASCAL 14/01/22 21:15:18 7909 2 : SUBROUTINE TRESK(IPMODL,IPCHE1,IPCHE2,IMIL,IPSCAL,IRET) 3 : *____________________________________________________________________ 4 : * 5 : * Entrees : 6 : * --------- 7 : * 8 : * IPCHE1 Pointeur sur un MCHAML de CONTRAINTES 9 : * IPCHE2 Pointeur sur un MCHAML de CARACTERISTIQUES 10 : * IMIL Indicateur ou on calcul les CONTRAINTES pour 11 : * les COQUES 12 : * 13 : * Sorties : 14 : * --------- 15 : * 16 : * IPSCAL Pointeur sur un MCHAML SCALAIRE 17 : * IRET =1 OU 0 SUIVANT SUCCES OU PAS 18 : * 19 : * Passage aux nouveaux chamelem par jm CAMPENON le 04/91 20 : * 21 : *__________________________________________________________________ 22 : * 23 : IMPLICIT INTEGER(I-N) 24 : IMPLICIT REAL*8(A-H,O-Z) 25 : * 26 : -INC CCOPTIO 27 : -INC CCHAMP 28 : -INC CCGEOME 29 : 30 : -INC SMCHAML 31 : -INC SMMODEL 32 : -INC SMINTE 33 : * 34 : SEGMENT NOTYPE 35 : CHARACTER*16 TYPE(NBTYPE) 36 : ENDSEGMENT 37 : * 38 : SEGMENT MPTVAL 39 : INTEGER IPOS(NS) ,NSOF(NS) 40 : INTEGER IVAL(NCOSOU) 41 : CHARACTER*16 TYVAL(NCOSOU) 42 : ENDSEGMENT 43 : * 44 : PARAMETER ( NINF=3 ) 45 : INTEGER INFOS(NINF) 46 : CHARACTER*(NCONCH) CONM 47 : LOGICAL lsupco 48 : * 49 : DIMENSION A(3,3),D(3),S(3,3) 50 : DIMENSION SIG(9) 51 : 52 : IRET = 0 53 : IPSCAL = 0 54 : * 55 : * Verification du lieu support du MCHAML de CONTRAINTES 56 : * 56 : CALL QUESUP (IPMODL,IPCHE1,5,0,ISUP1,IRETCO) 57 : IF (ISUP1.GT.1) RETURN 58 : * 59 : * Verification du lieu support du MCHAML de CARACTERISTIQUES 60 : * 61 : IF (IPCHE2.NE.0) THEN 61 : CALL QUESUP (IPMODL,IPCHE2,3,0,ISUP2,IRETCA) 62 : IF (ISUP2.GT.1) RETURN 63 : ENDIF 64 : * 65 : IDIMM=IDIM 66 : IDEUX=2 67 : DO 789 I=1,3 68 : D(I)=0.D0 69 : DO 789 J=1,3 70 : A(J,I)=0.D0 71 : S(J,I)=0.D0 72 : 789 CONTINUE 73 : * 74 : * Activation du MMODEL 75 : * 76 : MMODEL=IPMODL 77 : SEGACT MMODEL 78 : NSOUS=KMODEL(/1) 79 : KEL22 = 0 80 : DO ISOUS = 1, NSOUS 81 : IMODEL=KMODEL(ISOUS) 82 : SEGACT,IMODEL 83 : IF (NEFMOD.EQ.22.or.formod.ne.'MECANIQUE') KEL22 = KEL22 + 1 84 : ENDDO 85 : * 86 : * Creation du MCHELM 87 : * 88 : N1=NSOUS-KEL22 89 : L1=8 90 : N3=6 91 : SEGINI MCHELM 92 : IFOCHE=IFOUR 93 : TITCHE='SCALAIRE' 94 : * 95 : * Debut de la boucle sur les differentes sous zones 96 : * 97 : ISOUSS=0 98 : DO 200 ISOUS=1,NSOUS 99 : * 100 : * On recupere l'information generale 101 : * 102 : IMODEL=KMODEL(ISOUS) 103 : MELE=NEFMOD 104 : IF (NEFMOD.EQ.22.OR.FORMOD.NE.'MECANIQUE') GOTO 200 105 : * 106 : ISOUSS=ISOUSS+1 107 : * 108 : IPMAIL=IMAMOD 109 : CONM =CONMOD 110 : C 111 : C COQUE INTEGREE OU PAS ? 112 : C 113 : IF(INFMOD(/1).NE.0)THEN 114 : NPINT=INFMOD(1) 115 : ELSE 116 : NPINT=0 117 : ENDIF 118 : IF (NPINT.NE.0)THEN 118 : CALL ERREUR(615) 119 : GOTO 9999 120 : ENDIF 121 : C 122 : IMACHE(ISOUSS)=IPMAIL 123 : CONCHE(ISOUSS)=CONMOD 124 : * 125 : * Traitement du modele 126 : * 127 : MELE=NEFMOD 128 : * 129 : * Information sur l'element fini 130 : * 130 : * CALL ELQUOI (MELE,0,5,IPINF,IMODEL) 131 : * IF (IERR.NE.0) GOTO 9999 132 : * 133 : * INFO=IPINF 134 : MFR =INFELE(13) 135 : NSTRS =INFELE(16) 136 : NBPGAU=INFELE( 4) 137 : * MINTE =INFELE(11) 138 : MINTE=INFMOD(7) 139 : IPMINT=MINTE 140 : IF (IPMINT.NE.0) SEGACT,MINTE 141 : IPPORE=0 142 : IF(MFR.EQ.33)IPPORE=NBNNE(NUMGEO(MELE)) 143 : * SEGSUP INFO 144 : * 145 : * Creation du tableau INFOS 146 : * 146 : CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,IRTD) 147 : IF (IRTD.EQ.0) GOTO 9998 148 : * 149 : INFCHE(ISOUSS,1)=0 150 : INFCHE(ISOUSS,2)=0 151 : INFCHE(ISOUSS,3)=NIFOUR 152 : INFCHE(ISOUSS,4)=MINTE 153 : INFCHE(ISOUSS,5)=0 154 : INFCHE(ISOUSS,6)=5 155 : * 156 : * Creation du MCHAML 157 : * 158 : N2=1 159 : SEGINI MCHAML 160 : ICHAML(ISOUSS)=MCHAML 161 : NOMCHE(1)='SCAL' 162 : TYPCHE(1)='REAL*8' 163 : * 164 : * Noms de composantes necessaires 165 : * 166 : if(lnomid(4).ne.0) then 167 : nomid=lnomid(4) 168 : segact nomid 169 : mostrs=nomid 170 : nstr=lesobl(/2) 171 : nfac=lesfac(/2) 172 : lsupco=.false. 173 : else 174 : lsupco=.true. 174 : CALL IDCONT(IMODEL,IFOUR,MOSTRS,NSTR,NFAC) 175 : endif 176 : * 177 : * Verification de leur presence 178 : * 179 : NCARA=0 180 : NCARF=0 181 : MOCARA=0 182 : IVACAR=0 183 : IVAMIS=0 184 : * 185 : NBTYPE=1 186 : SEGINI NOTYPE 187 : MOTYPE=NOTYPE 188 : TYPE(1)='REAL*8' 188 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOSTRS,MOTYPE,1,INFOS,3,IVASTR) 189 : SEGSUP NOTYPE 190 : IF (IERR.NE.0) GOTO 9990 191 : * 191 : IF (ISUP1.EQ.1) CALL VALCHE (IVASTR,NSTR,IPMINT,IPPORE) 192 : * 193 : * Recherche de la taille des MELVALs 194 : * 195 : N1EL=0 196 : N1PTEL=0 197 : MPTVAL=IVASTR 198 : DO 20 IO=1,NSTRS 199 : MELVAL=IVAL(IO) 200 : N1PTEL=MAX(N1PTEL,VELCHE(/1)) 201 : N1EL =MAX(N1EL ,VELCHE(/2)) 202 : 20 CONTINUE 203 : IF (N1PTEL.EQ.1.OR.NBPGAU.EQ.1) THEN 204 : N1PTEL=1 205 : ELSE 206 : N1PTEL=NBPGAU 207 : ENDIF 208 : NBPTEL=N1PTEL 209 : NEL =N1EL 210 : * 211 : * Creation du MELVAL de tresca 212 : * 213 : N2PTEL=0 214 : N2EL=0 215 : SEGINI MELVAL 216 : IELVAL(1)=MELVAL 217 : IVAMIS =MELVAL 218 : * 219 : * Traitement des caracteristiques 220 : * 221 : NBROBL=0 222 : NBRFAC=0 223 : * 224 : * Epaisseur dans le cas des coques et coques avec cisaillement 225 : * 226 : IF (MFR.EQ.3.OR.MFR.EQ.9) THEN 227 : NBROBL=1 228 : SEGINI NOMID 229 : MOCARA=NOMID 230 : LESOBL(1)='EPAI' 231 : ENDIF 232 : * 233 : NCARA=NBROBL 234 : NCARF=NBRFAC 235 : NCARR=NCARA+NCARF 236 : * 237 : IF (MOCARA.NE.0) THEN 238 : IF (IPCHE2.NE.0) THEN 239 : NBTYPE=1 240 : SEGINI NOTYPE 241 : MOTYPE=NOTYPE 242 : TYPE(1)='REAL*8' 242 : CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOCARA, 243 : 1 MOTYPE,1,INFOS,3,IVACAR) 244 : SEGSUP NOTYPE 245 : IF (IERR.NE.0) GOTO 9990 246 : ELSE 247 : MOTERR(1:8)='CARACTER' 248 : MOTERR(9:12)=NOMTP(MELE) 249 : MOTERR(13:20)='TRESCA' 249 : CALL ERREUR(145) 250 : IVACAR=0 251 : NCARA=0 252 : NCARF=0 253 : GOTO 9990 254 : ENDIF 255 : IF (ISUP2.EQ.1) THEN 255 : CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE) 256 : ENDIF 257 : ENDIF 258 : * 259 : * Branchement suivant la formulation 260 : * 261 : * MASSI COQUE COQEP POUT CIST THER TUYA LISP 262 : GOTO (30,22,60,22,80,22,22,22,120,22,22,22,22,22,22),MFR 263 : * 264 : 22 CONTINUE 265 : MOTERR(1:8)=NOMFR(MFR/2+1) 265 : CALL ERREUR(193) 266 : GOTO 9990 267 : *_______________________________________________________________________ 268 : * 269 : * FORMULATION MASSIVE 270 : *_______________________________________________________________________ 271 : * 272 : 30 CONTINUE 273 : * 274 : C On distingue le cas IDIM=1 des autres dimensions 275 : IF (IDIM.EQ.1) THEN 276 : DO IB=1,NEL 277 : DO IGAU=1,NBPTEL 278 : MPTVAL=IVASTR 279 : MELVAL=IVAL(1) 280 : IGMN=MIN(IGAU,VELCHE(/1)) 281 : IBMN=MIN(IB ,VELCHE(/2)) 282 : D1=VELCHE(IGMN,IBMN) 283 : MELVAL=IVAL(2) 284 : IGMN=MIN(IGAU,VELCHE(/1)) 285 : IBMN=MIN(IB ,VELCHE(/2)) 286 : D2=VELCHE(IGMN,IBMN) 287 : MELVAL=IVAL(3) 288 : IGMN=MIN(IGAU,VELCHE(/1)) 289 : IBMN=MIN(IB ,VELCHE(/2)) 290 : D3=VELCHE(IGMN,IBMN) 291 : W1=MAX(D1,D2,D3) 292 : W2=MIN(D1,D2,D3) 293 : MELVAL=IVAMIS 294 : VELCHE(IGAU,IB)=ABS(W1-W2) 295 : ENDDO 296 : ENDDO 297 : GOTO 150 298 : ENDIF 299 : 300 : DO 31 IB=1,NEL 301 : DO 31 IGAU=1,NBPTEL 302 : MPTVAL=IVASTR 303 : * 304 : MELVAL=IVAL(1) 305 : IGMN=MIN(IGAU,VELCHE(/1)) 306 : IBMN=MIN(IB ,VELCHE(/2)) 307 : A(1,1)=VELCHE(IGMN,IBMN) 308 : * 309 : MELVAL=IVAL(2) 310 : IGMN=MIN(IGAU,VELCHE(/1)) 311 : IBMN=MIN(IB ,VELCHE(/2)) 312 : A(2,2)=VELCHE(IGMN,IBMN) 313 : * 314 : MELVAL=IVAL(3) 315 : IGMN=MIN(IGAU,VELCHE(/1)) 316 : IBMN=MIN(IB ,VELCHE(/2)) 317 : A(3,3)=VELCHE(IGMN,IBMN) 318 : * 319 : MELVAL=IVAL(4) 320 : IGMN=MIN(IGAU,VELCHE(/1)) 321 : IBMN=MIN(IB ,VELCHE(/2)) 322 : A(1,2)=VELCHE(IGMN,IBMN) 323 : * 324 : A(2,1)=A(1,2) 325 : * 326 : IF(IFOUR.LT.1.AND.IFOUR.GE.-3) GO TO 36 327 : * 328 : IF(IFOUR.EQ.1) IDIMM=3 329 : MELVAL=IVAL(5) 330 : IGMN=MIN(IGAU,VELCHE(/1)) 331 : IBMN=MIN(IB ,VELCHE(/2)) 332 : A(3,1)=VELCHE(IGMN,IBMN) 333 : * 334 : MELVAL=IVAL(6) 335 : IGMN=MIN(IGAU,VELCHE(/1)) 336 : IBMN=MIN(IB ,VELCHE(/2)) 337 : A(3,2)=VELCHE(IGMN,IBMN) 338 : * 339 : A(1,3)=A(3,1) 340 : A(2,3)=A(3,2) 341 : * 342 : 36 CONTINUE 343 : * 343 : CALL JACOB3(A,IDIMM,D,S) 344 : W1=MAX(D(3),D(1),D(2)) 345 : W2=MIN(D(3),D(1),D(2)) 346 : * 347 : MELVAL=IVAMIS 348 : VELCHE(IGAU,IB)=ABS(W1-W2) 349 : 31 CONTINUE 350 : GOTO 150 351 : *_______________________________________________________________________ 352 : * 353 : * FORMULATION COQUE 354 : *_______________________________________________________________________ 355 : * 356 : 60 CONTINUE 357 : * 358 : DO 61 IB=1,NEL 359 : DO 61 IGAU=1,NBPTEL 360 : MPTVAL=IVASTR 361 : DO 62 ICOMP=1,NSTRS 362 : MELVAL=IVAL(ICOMP) 363 : IGMN=MIN(IGAU,VELCHE(/1)) 364 : IBMN=MIN(IB ,VELCHE(/2)) 365 : SIG(ICOMP)=VELCHE(IGMN,IBMN) 366 : 62 CONTINUE 367 : * 368 : MPTVAL=IVACAR 369 : MELVAL=IVAL(1) 370 : IGMN=MIN(IGAU,VELCHE(/1)) 371 : IBMN=MIN(IB ,VELCHE(/2)) 372 : EPAIST=VELCHE(IGMN,IBMN) 373 : * 373 : CALL EFCONT(EPAIST,0.D0,NSTRS,SIG) 374 : * 375 : * Calcul des contraintes 376 : * 377 : IF(IFOUR.GT.0) THEN 378 : A(1,1)=SIG(1)+SIG(4)*IMIL 379 : A(2,2)=SIG(2)+SIG(5)*IMIL 380 : A(1,2)=SIG(3)+SIG(6)*IMIL 381 : A(2,1)=A(1,2) 382 : ELSE IF(IFOUR.LE.0) THEN 383 : A(1,1)=SIG(1)+SIG(3)*IMIL 384 : A(2,2)=SIG(2)+SIG(4)*IMIL 385 : ENDIF 386 : * 386 : CALL JACOB3(A,IDEUX,D,S) 387 : W1=MAX(D(3),D(1),D(2)) 388 : W2=MIN(D(3),D(1),D(2)) 389 : * 390 : MELVAL=IVAMIS 391 : VELCHE(IGAU,IB)=ABS(W1-W2) 392 : 61 CONTINUE 393 : GOTO 150 394 : *_______________________________________________________________________ 395 : * 396 : * FORMULATION COQUE EPAISSE 397 : *_______________________________________________________________________ 398 : * 399 : 80 CONTINUE 400 : * 401 : DO 81 IB=1,NEL 402 : DO 81 IGAU=1,NBPTEL 403 : MPTVAL=IVASTR 404 : * 405 : MELVAL=IVAL(1) 406 : IGMN=MIN(IGAU,VELCHE(/1)) 407 : IBMN=MIN(IB ,VELCHE(/2)) 408 : A(1,1)=VELCHE(IGMN,IBMN) 409 : * 410 : MELVAL=IVAL(2) 411 : IGMN=MIN(IGAU,VELCHE(/1)) 412 : IBMN=MIN(IB ,VELCHE(/2)) 413 : A(2,2)=VELCHE(IGMN,IBMN) 414 : * 415 : MELVAL=IVAL(3) 416 : IGMN=MIN(IGAU,VELCHE(/1)) 417 : IBMN=MIN(IB ,VELCHE(/2)) 418 : A(1,2)=VELCHE(IGMN,IBMN) 419 : * 420 : MELVAL=IVAL(4) 421 : IGMN=MIN(IGAU,VELCHE(/1)) 422 : IBMN=MIN(IB ,VELCHE(/2)) 423 : A(1,3)=VELCHE(IGMN,IBMN) 424 : * 425 : MELVAL=IVAL(5) 426 : IGMN=MIN(IGAU,VELCHE(/1)) 427 : IBMN=MIN(IB ,VELCHE(/2)) 428 : A(2,3)=VELCHE(IGMN,IBMN) 429 : * 430 : A(2,1)=A(1,2) 431 : A(3,1)=A(1,3) 432 : A(3,2)=A(2,3) 433 : * 433 : CALL JACOB3(A,IDIM,D,S) 434 : W1=MAX(D(3),D(1),D(2)) 435 : W2=DMIN1(D(3),D(1),D(2)) 436 : * 437 : MELVAL=IVAMIS 438 : VELCHE(IGAU,IB)=ABS(W1-W2) 439 : 81 CONTINUE 440 : GOTO 150 441 : *_______________________________________________________________________ 442 : * 443 : * FORMULATION COQUE AVEC CISAILLEMENT 444 : *_______________________________________________________________________ 445 : * 446 : 120 CONTINUE 447 : * 448 : DO 121 IB=1,NEL 449 : DO 121 IGAU=1,NBPTEL 450 : MPTVAL=IVASTR 451 : DO 122 ICOMP=1,NSTRS 452 : MELVAL=IVAL(ICOMP) 453 : IGMN=MIN(IGAU,VELCHE(/1)) 454 : IBMN=MIN(IB ,VELCHE(/2)) 455 : SIG(ICOMP)=VELCHE(IGMN,IBMN) 456 : 122 CONTINUE 457 : * 458 : MPTVAL=IVACAR 459 : MELVAL=IVAL(1) 460 : IGMN=MIN(IGAU,VELCHE(/1)) 461 : IBMN=MIN(IB ,VELCHE(/2)) 462 : EPAIST=VELCHE(IGMN,IBMN) 463 : * 463 : CALL EFCONT(EPAIST,0.D0,NSTRS,SIG) 464 : * 465 : * Calcul des contraintes 466 : * 467 : A(1,1)=SIG(1)+SIG(4)*IMIL 468 : A(2,2)=SIG(2)+SIG(5)*IMIL 469 : A(1,2)=SIG(3)+SIG(6)*IMIL 470 : A(2,1)=A(1,2) 471 : A(3,3)=0.D0 472 : A(1,3)=SIG(7) 473 : A(2,3)=SIG(8) 474 : A(3,1)=A(1,3) 475 : A(3,2)=A(2,3) 476 : * 476 : CALL JACOB3(A,IDIM,D,S) 477 : W1=MAX(D(3),D(1),D(2)) 478 : W2=MIN(D(3),D(1),D(2)) 479 : * 480 : MELVAL=IVAMIS 481 : VELCHE(IGAU,IB)=ABS(W1-W2) 482 : 121 CONTINUE 483 : GOTO 150 484 : * 485 : * Desactivation des segments propres a la geometrie ISOUS 486 : * 487 : 150 CONTINUE 488 : IF (IPMINT.NE.0) SEGDES,MINTE 489 : SEGDES IMODEL 490 : * 491 : IF (ISUP1.EQ.1) THEN 491 : CALL DTMVAL(IVASTR,3) 492 : ELSE 492 : CALL DTMVAL(IVASTR,1) 493 : ENDIF 494 : NOMID =MOSTRS 495 : if(lsupco)SEGSUP NOMID 496 : * 497 : MELVAL=IVAMIS 498 : SEGDES MELVAL 499 : * 500 : IF (ISUP2.EQ.1) THEN 500 : CALL DTMVAL(IVACAR,3) 501 : ELSE 501 : CALL DTMVAL(IVACAR,1) 502 : ENDIF 503 : * 504 : NOMID =MOCARA 505 : IF (MOCARA.NE.0) SEGSUP NOMID 506 : * 507 : SEGDES MCHAML 508 : * 509 : 200 CONTINUE 510 : 511 : SEGDES MMODEL 512 : SEGDES MCHELM 513 : IRET = 1 514 : IPSCAL = MCHELM 515 : GOTO 888 516 : * 517 : * Erreur dans une sous zone / desactivation et retour 518 : * 519 : 9990 CONTINUE 520 : * 521 : IF (ISUP1.EQ.1) THEN 521 : CALL DTMVAL(IVASTR,3) 522 : ELSE 522 : CALL DTMVAL(IVASTR,1) 523 : ENDIF 524 : * 525 : IF (ISUP2.EQ.1) THEN 525 : CALL DTMVAL(IVACAR,3) 526 : ELSE 526 : CALL DTMVAL(IVACAR,1) 527 : ENDIF 528 : * 529 : NOMID =MOSTRS 530 : if(lsupco)SEGSUP NOMID 531 : NOMID =MOCARA 532 : IF (MOCARA.NE.0) SEGSUP NOMID 533 : * 534 : MELVAL=IVAMIS 535 : IF (IVAMIS.NE.0) SEGSUP MELVAL 536 : SEGSUP MCHAML 537 : * 538 : 9998 CONTINUE 539 : IF (IPMINT.NE.0) SEGDES,MINTE 540 : 9999 CONTINUE 541 : SEGDES IMODEL 542 : SEGDES MMODEL 543 : * 544 : SEGSUP MCHELM 545 : IPSCAL = 0 546 : IRET = 0 547 : 548 : 888 CONTINUE 549 : DO ISOUS = 1, NSOUS 550 : IMODEL=KMODEL(ISOUS) 551 : SEGDES,IMODEL 552 : ENDDO 553 : SEGDES MMODEL 554 : 555 : RETURN 556 : END 557 : 558 : 559 : 560 :
© Cast3M 2003 - All rights reserved.
Disclaimer