1 : C EPTHP SOURCE AM 12/06/07 21:15:12 7390 2 : 3 : C======================================================================= 4 : C= E P T H P = 5 : C= --------- = 6 : C= = 7 : C= Fonction : = 8 : C= ---------- = 9 : C= Calcul des deformations d'origine thermique. = 10 : C= Sous-programme appele par EPTH (epth.eso). = 11 : C= = 12 : C= Parametres : (E)=Entree (S)=Sortie = 13 : C= ------------ = 14 : C= IPMODL (E) Pointeur sur le segment MMODEL = 15 : C= IPCHE1 (E) Pointeur sur le segment MCHELM de CARACTERISTIQUES = 16 : C= IPCHE2 (E) Pointeur sur le segment MCHELM de TEMPERATURES = 17 : C= IPEPTH (S) Pointeur sur le segment MCHPOI de forces nodales = 18 : C= IRET (S) Entier valant 1 en cas de succes, 0 sinon (et un = 19 : C= message d'erreur est imprime dans ce cas) = 20 : C= = 21 : C= Remarque : Variation parabolique de la temperature dans les COQUES = 22 : C ---------- Cas ORTHOTROPE et ANISOTROPE traites pour les MASSIFS = 23 : C======================================================================= 24 : 25 : SUBROUTINE EPTHP (IPMODL,IPCHE1,IPCHE2,IPEPTH,IRET) 26 : 27 : IMPLICIT INTEGER(I-N) 28 : IMPLICIT REAL*8 (A-H,O-Z) 29 : 30 : -INC CCOPTIO 31 : -INC CCREEL 32 : -INC CCHAMP 33 : -INC SMCHAML 34 : -INC SMELEME 35 : -INC SMINTE 36 : -INC SMMODEL 37 : -INC SMCOORD 38 : 39 : SEGMENT NOTYPE 40 : CHARACTER*16 TYPE(NBTYPE) 41 : ENDSEGMENT 42 : 43 : SEGMENT MPTVAL 44 : INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU) 45 : CHARACTER*16 TYVAL(NCOSOU) 46 : ENDSEGMENT 47 : 48 : SEGMENT MVELCH 49 : REAL*8 VALMAT(NV1) 50 : ENDSEGMENT 51 : 52 : SEGMENT MWRK2 53 : REAL*8 XE(3,NBNN) 54 : REAL*8 TXR(IDIM,IDIM),XLOC(IDIM,IDIM),XGLOB(IDIM,IDIM) 55 : REAL*8 ROTS(NEPTH,NEPTH) 56 : ENDSEGMENT 57 : 58 : SEGMENT MWRK3 59 : REAL*8 RES(NEPTH) 60 : ENDSEGMENT 61 : 62 : PARAMETER (NINF=3) 63 : INTEGER INFOS(NINF) 64 : DIMENSION CRIGI(12) 65 : CHARACTER*8 CMATE,PHAM 66 : CHARACTER*(NCONCH) CONM 67 : LOGICAL LOGMA,LOGMF,lsupde,lsupma,lsupte 68 : 69 : IRET=0 70 : 71 : C 1 - VERIFICATIONS DES DONNEES DE L'OPERATEUR 72 : C ============================================== 73 : C 1.1 - Verification du lieu support du MCHAML de caracteristiques 74 : C ===== 75 : ISupC=0 75 : CALL QUESUP(IPMODL,IPCHE1,5,0,ISupC,iOK) 76 : IF (ISupC.GT.1) RETURN 77 : C ===== 78 : C 1.2 - Verification du lieu support du MCHAML de temperatures 79 : C ===== 80 : ISupT=0 80 : CALL QUESUP(IPMODL,IPCHE2,5,0,ISupT,iOK) 81 : IF (ISupT.GT.1) RETURN 82 : 83 : C 2 - QUELQUES INITIALISATIONS 84 : C ============================== 85 : C 2.1 - Activation du MMODEL 86 : C ===== 87 : MMODEL=IPMODL 88 : SEGACT,MMODEL 89 : NSOUS=KMODEL(/1) 90 : C ===== 91 : C 2.2 - Activation du MCHELM associe au champ de deformations 92 : C ===== 93 : L1=12 94 : N1=NSOUS 95 : N3=6 96 : SEGINI,MCHELM 97 : TITCHE='DEFORMATIONS' 98 : IFOCHE=IFOUR 99 : IPEPTH=MCHELM 100 : C ===== 101 : C 2.3 - Initialisation du segment du type des composantes du champ de 102 : C temperatures et defini une seule fois (identique sur IPMODL) 103 : C ===== 104 : NBTYPE=1 105 : SEGINI,NOTYPE 106 : TYPE(1)='REAL*8' 107 : MOTYTE=NOTYPE 108 : 109 : C 3 - BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE (iSou) 110 : C ======================================================== 111 : DO iSou=1,NSOUS 112 : C ===== 113 : C 3.1 - Quelques initialisations 114 : C ===== 115 : lsupma=.true. 116 : lsupte=.true. 117 : MOTEMP=0 118 : IVATEM=0 119 : MOMATR=0 120 : IVAMAT=0 121 : MOCARA=0 122 : IVACAR=0 123 : MOEPTH=0 124 : IVAETH=0 125 : MCHAML=0 126 : TEMP=XZero 127 : THM=XZero 128 : THIF=XZero 129 : THSU=XZero 130 : IPMINT=0 131 : C ===== 132 : C 3.2 - Activation du sous-modele (iSou) 133 : C ===== 134 : IMODEL=KMODEL(iSou) 135 : SEGACT,IMODEL 136 : MELE=NEFMOD 137 : IPMAIL=IMAMOD 138 : CONM=CONMOD 139 : PHAM=conm(17:24) 140 : NPINT=0 141 : IF (INFMOD(/1).NE.0) NPINT=INFMOD(1) 142 : C ===== 143 : C 3.3 - Determination ... 144 : C ===== 144 : CALL IDENT(IPMAIL,CONM,IPCHE1,IPCHE2,INFOS,iOK) 145 : IF (iOK.EQ.0) GOTO 210 146 : iOK=0 147 : C ===== 148 : C 3.4 - Determination de la nature du materiau et verification 149 : C ===== 150 : C* NFOR=FORMOD(/2) 151 : C* NMAT=MATMOD(/2) 151 : C* CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INAT) 152 : CMATE = CMATEE 153 : MATE = IMATEE 154 : INAT = INATUU 155 : C* IF (CMATE.EQ.' ') THEN 155 : C* CALL ERREUR(251) 156 : C* GOTO 210 157 : C* ENDIF 158 : LOGMA = CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'ANISOTRO'.OR. 159 : & CMATE.EQ.'UNIDIREC' 160 : C ===== 161 : C 3.5 - Recuperation d'informations sur l'element fini du sous-modele 162 : C Activation du segment d'integration 163 : C ===== 163 : * CALL ELQUOI(MELE,0,5,IPINF,IMODEL) 164 : * IF (IERR.NE.0) GOTO 210 165 : * INFO=IPINF 166 : NBGS=INFELE(4) 167 : IPORE=INFELE(8) 168 : * IPMINT=INFELE(11) 169 : IPMINT=infmod(7) 170 : MINTE=IPMINT 171 : IF (IPMINT.NE.0) SEGACT,MINTE 172 : if (mele.eq.260) then 173 : nbpgau=5 174 : else 175 : NBPGAU=POIGAU(/1) 176 : endif 177 : MFR=INFELE(13) 178 : NEPTH=INFELE(16) 179 : LOGMF = MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33.OR.MFR.EQ.63 180 : C ===== 181 : C 3.6 - Recuperation d'informations liees au maillage IPMAIL 182 : C ===== 183 : MELEME=IPMAIL 184 : SEGACT,MELEME 185 : NBNN=NUM(/1) 186 : NBELEM=NUM(/2) 187 : NBNO=NBNN 188 : IPPORE=0 189 : IF (MFR.EQ.33) THEN 190 : NBNO=IPORE 191 : IPPORE=NBNN 192 : ENDIF 193 : IF (MFR.EQ.63) THEN 194 : C NBNO=IPORE 195 : IPPORE=NBNN 196 : ENDIF 197 : C ===== 198 : C 3.7 - Recuperation des temperatures associees au sous-modele 199 : C Verification de leur presence dans le MCHAML (IPCHE2) 200 : C ===== 201 : NFAC=0 202 : if(lnomid(8).ne.0) then 203 : lsupte=.false. 204 : nomid=lnomid(8) 205 : segact nomid 206 : motemp=nomid 207 : ntem=lesobl(/2) 208 : nfac=lesfac(/2) 209 : else 209 : CALL IDTEMP(MFR,IFOUR,NPINT,MOTEMP,NTEM,NFAC) 210 : endif 210 : CALL KOMCHA(IPCHE2,IPMAIL,CONM,MOTEMP,MOTYTE,1,INFOS,3,IVATEM) 211 : IF (IERR.NE.0) GOTO 230 212 : IF (ISupT.EQ.1)THEN 212 : CALL VALCHE(IVATEM,NTEM,IPMINT,IPPORE) 213 : IF (IERR.NE.0) THEN 214 : ISupT=0 215 : GOTO 230 216 : ENDIF 217 : ENDIF 218 : C ===== 219 : C 3.8 - Recuperation des noms des caracteristiques MATERIAU 220 : C Traitement suivant la formulation MFR et l'element fini MELE 221 : C Verification de leur presence dans le MCHAML (IPCHE1) 222 : C ===== 223 : NBROBL=0 224 : NBRFAC=0 225 : NOMID=0 226 : C= 3.8.1 - Elements POUTRE,BARRE,POI1,TUYAUX... 227 : IF (MELE.EQ.29.OR.MELE.EQ. 42.OR.MELE.EQ. 45.OR.MELE.EQ. 46.OR. 228 : . MELE.EQ.95.OR.MELE.EQ.123.OR.MELE.EQ.124) THEN 229 : NBROBL=1 230 : SEGINI,NOMID 231 : LESOBL(1)='ALPH' 232 : C= 3.8.2 - Materiau isotrope 233 : ELSE IF (CMATE.EQ.'ISOTROPE') THEN 234 : NBROBL=1 235 : SEGINI,NOMID 236 : IF (MFR.EQ.35) THEN 237 : LESOBL(1)='ALPN' 238 : ELSE 239 : LESOBL(1)='ALPH' 240 : ENDIF 241 : C= 3.8.3 - Materiau orthotrope 242 : ELSE IF (CMATE.EQ.'ORTHOTRO') THEN 243 : IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN 244 : NBROBL=4 245 : SEGINI,NOMID 246 : LESOBL(1)='ALP1' 247 : LESOBL(2)='ALP2' 248 : LESOBL(3)='V1X' 249 : LESOBL(4)='V1Y' 250 : ELSE IF (MFR.EQ.75) THEN 251 : IF (IDIM.EQ.3) THEN 252 : NBROBL=6 253 : SEGINI,NOMID 254 : LESOBL(1)='ALPN' 255 : LESOBL(2)='ALP1' 256 : LESOBL(3)='ALP2' 257 : LESOBL(4)='ALQN' 258 : LESOBL(5)='ALQ1' 259 : LESOBL(6)='ALQ2' 260 : ELSE IF (IDIM.EQ.2) THEN 261 : NBROBL=3 262 : SEGINI,NOMID 263 : LESOBL(1)='ALPN' 264 : LESOBL(2)='ALPS' 265 : LESOBL(3)='ALQS' 266 : ENDIF 267 : ELSE IF (MFR.EQ.35) THEN 268 : NBROBL=3 269 : SEGINI,NOMID 270 : LESOBL(1)='ALPN' 271 : LESOBL(2)='V1X' 272 : LESOBL(3)='V1Y' 273 : ELSE IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33) THEN 274 : IF (IFOUR.EQ.-2) THEN 275 : NBROBL=4 276 : SEGINI,NOMID 277 : LESOBL(1)='ALP1' 278 : LESOBL(2)='ALP2' 279 : LESOBL(3)='V1X' 280 : LESOBL(4)='V1Y' 281 : ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-3.OR. 282 : . IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN 283 : NBROBL=5 284 : SEGINI,NOMID 285 : LESOBL(1)='ALP1' 286 : LESOBL(2)='ALP2' 287 : LESOBL(3)='ALP3' 288 : LESOBL(4)='V1X' 289 : LESOBL(5)='V1Y' 290 : ELSE IF (IFOUR.EQ.2) THEN 291 : NBROBL=9 292 : SEGINI,NOMID 293 : LESOBL(1)='ALP1' 294 : LESOBL(2)='ALP2' 295 : LESOBL(3)='ALP3' 296 : LESOBL(4)='V1X ' 297 : LESOBL(5)='V1Y ' 298 : LESOBL(6)='V1Z ' 299 : LESOBL(7)='V2X ' 300 : LESOBL(8)='V2Y ' 301 : LESOBL(9)='V2Z ' 302 : ELSE IF (IFOUR.GE.3.AND.IFOUR.LE.15) THEN 303 : IF (IFOUR.EQ.6) THEN 304 : NBROBL=1 305 : SEGINI,NOMID 306 : LESOBL(1)='ALP1' 307 : ELSE IF (IFOUR.EQ.5.OR.IFOUR.EQ.10) THEN 308 : NBROBL=2 309 : SEGINI,NOMID 310 : LESOBL(1)='ALP1' 311 : LESOBL(2)='ALP3' 312 : ELSE IF (IFOUR.EQ.4.OR.IFOUR.EQ.8.OR.IFOUR.EQ.13) THEN 313 : NBROBL=2 314 : SEGINI,NOMID 315 : LESOBL(1)='ALP1' 316 : LESOBL(2)='ALP2' 317 : ELSE 318 : NBROBL=3 319 : SEGINI,NOMID 320 : LESOBL(1)='ALP1' 321 : LESOBL(2)='ALP2' 322 : LESOBL(3)='ALP3' 323 : ENDIF 324 : ENDIF 325 : ENDIF 326 : C= 3.8.4 - Materiau anisotrope 327 : ELSE IF (CMATE.EQ.'ANISOTRO') THEN 328 : IF (MFR.EQ.1.OR.MFR.EQ.31.OR.MFR.EQ.33) THEN 329 : IF (IFOUR.EQ.-2) THEN 330 : NBROBL=5 331 : SEGINI,NOMID 332 : LESOBL(1)='ALP1' 333 : LESOBL(2)='ALP2' 334 : LESOBL(3)='AL12' 335 : LESOBL(4)='V1X ' 336 : LESOBL(5)='V1Y ' 337 : ELSE IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-1.OR. 338 : . IFOUR.EQ.0.OR.IFOUR.EQ.1) THEN 339 : NBROBL=6 340 : SEGINI,NOMID 341 : LESOBL(1)='ALP1' 342 : LESOBL(2)='ALP2' 343 : LESOBL(3)='AL12' 344 : LESOBL(4)='ALP3' 345 : LESOBL(5)='V1X ' 346 : LESOBL(6)='V1Y ' 347 : ELSE IF (IFOUR.EQ.2) THEN 348 : NBROBL=12 349 : SEGINI,NOMID 350 : LESOBL(1)='ALP1' 351 : LESOBL(2)='ALP2' 352 : LESOBL(3)='ALP3' 353 : LESOBL(4)='AL12' 354 : LESOBL(5)='AL13' 355 : LESOBL(6)='AL23' 356 : LESOBL(7)='V1X ' 357 : LESOBL(8)='V1Y ' 358 : LESOBL(9)='V1Z ' 359 : LESOBL(10)='V2X ' 360 : LESOBL(11)='V2Y ' 361 : LESOBL(12)='V2Z ' 362 : ENDIF 363 : ELSE IF (MFR.EQ.75) THEN 364 : IF (IDIM.EQ.3) THEN 365 : NBROBL=6 366 : SEGINI,NOMID 367 : LESOBL(1)='ALP1' 368 : LESOBL(2)='ALP2' 369 : LESOBL(3)='ALP3' 370 : LESOBL(4)='ALQ1' 371 : LESOBL(5)='ALQ2' 372 : LESOBL(6)='ALQ3' 373 : ELSE IF (IDIM.EQ.2) THEN 374 : NBROBL=3 375 : SEGINI,NOMID 376 : LESOBL(1)='ALP1' 377 : LESOBL(2)='ALP2' 378 : LESOBL(3)='ALQ3' 379 : ENDIF 380 : ENDIF 381 : C= 3.8.5 - Materiau unidirectionnel 382 : ELSE IF (CMATE.EQ.'UNIDIREC') THEN 383 : IF (MFR.EQ.1.AND.IDIM.EQ.3) THEN 384 : NBROBL=7 385 : SEGINI,NOMID 386 : LESOBL(1)='ALPH' 387 : LESOBL(2)='V1X ' 388 : LESOBL(3)='V1Y ' 389 : LESOBL(4)='V1Z ' 390 : LESOBL(5)='V2X ' 391 : LESOBL(6)='V2Y ' 392 : LESOBL(7)='V2Z ' 393 : ELSE 394 : NBROBL=3 395 : SEGINI,NOMID 396 : LESOBL(1)='ALPH' 397 : LESOBL(2)='V1X ' 398 : LESOBL(3)='V1Y ' 399 : ENDIF 400 : ELSE 401 : if(lnomid(6).ne.0) then 402 : lsupma=.false. 403 : nomid=lnomid(6) 404 : segact nomid 405 : momatr=nomid 406 : nmatr=lesobl(/2) 407 : nmatf=lesfac(/2) 408 : else 408 : CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF) 409 : endif 410 : NOMID=MOMATR 411 : NBROBL=NMATR 412 : NBRFAC=NMATF 413 : ENDIF 414 : MOMATR=NOMID 415 : NMATR=NBROBL 416 : NMATF=NBRFAC 417 : NMATT=NMATR+NMATF 418 : NBGMAT=0 419 : NELMAT=0 420 : C= 3.8.6 - Verification de la presence des caracteristiques dans IPCHE1 421 : IF (MOMATR.NE.0) THEN 422 : IF (CMATE.EQ.'SECTION') THEN 423 : NBTYPE=3 424 : SEGINI,NOTYPE 425 : TYPE(1)='POINTEURMMODEL' 426 : TYPE(2)='POINTEURMCHAML' 427 : TYPE(3)='POINTEURLISTREEL' 428 : ELSE 429 : NBTYPE=1 430 : SEGINI,NOTYPE 431 : TYPE(1)='REAL*8' 432 : ENDIF 433 : MOTYPE=NOTYPE 433 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1, 434 : . INFOS,3,IVAMAT) 435 : SEGSUP,NOTYPE 436 : IF (IERR.NE.0) GOTO 240 437 : IF (ISupC.EQ.1) THEN 437 : CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE) 438 : IF (IERR.NE.0)THEN 439 : ISupC=0 440 : GOTO 240 441 : ENDIF 442 : ENDIF 443 : MPTVAL=IVAMAT 444 : MELVAL=IVAL(1) 445 : DO i=1,NMATT 446 : IF (IVAL(i).NE.0) THEN 447 : MELVAL=IVAL(i) 448 : IF (CMATE.EQ.'SECTION') THEN 449 : NBGMAT=MAX(NBGMAT,IELCHE(/1)) 450 : NELMAT=MAX(NELMAT,IELCHE(/2)) 451 : ELSE 452 : NBGMAT=MAX(NBGMAT,VELCHE(/1)) 453 : NELMAT=MAX(NELMAT,VELCHE(/2)) 454 : ENDIF 455 : ENDIF 456 : ENDDO 457 : ENDIF 458 : C ===== 459 : C 3.9 - Recuperation des noms des caracteristiques 460 : C ===== 461 : NBROBL=0 462 : NBRFAC=0 463 : IVECT=0 464 : NOMID=0 465 : NOTYPE=0 466 : C= 3.9.1 - Elements COQUES : epaisseur 467 : IF (MFR.EQ.3.OR.MFR.EQ.9) THEN 468 : NBROBL=1 469 : SEGINI,NOMID 470 : LESOBL(1)='EPAI' 471 : NBTYPE=1 472 : SEGINI,NOTYPE 473 : TYPE(1)='REAL*8' 474 : C= 3.9.2 - Elements BARREs et CERCEs : section 475 : ELSE IF (MFR.EQ.27) THEN 476 : NBROBL=1 477 : SEGINI,NOMID 478 : LESOBL(1)='SECT' 479 : NBTYPE=1 480 : SEGINI,NOTYPE 481 : TYPE(1)='REAL*8' 482 : C= 3.9.3 - Elements BAEX : section, excentrements et orientation 483 : ELSE IF (MFR.EQ.49) THEN 484 : NBROBL=6 485 : SEGINI,NOMID 486 : LESOBL(1)='SECT' 487 : LESOBL(2)='EXCZ' 488 : LESOBL(3)='EXCY' 489 : LESOBL(4)='VX ' 490 : LESOBL(5)='VY ' 491 : LESOBL(6)='VZ ' 492 : NBTYPE=1 493 : SEGINI,NOTYPE 494 : TYPE(1)='REAL*8' 495 : C= 3.9.4 - Elements POUTREs 496 : ELSE IF (MFR.EQ.7) THEN 497 : IF (CMATE.NE.'SECTION') THEN 498 : NBROBL=1 499 : SEGINI,NOMID 500 : LESOBL(1)='SECT' 501 : NBTYPE=1 502 : SEGINI,NOTYPE 503 : TYPE(1)='REAL*8' 504 : ENDIF 505 : C= 3.9.5 - Elements TUYAUx 506 : ELSE IF (MFR.EQ.13) THEN 507 : NBROBL=2 508 : NBRFAC=2 509 : SEGINI,NOMID 510 : LESOBL(1)='EPAI' 511 : LESOBL(2)='RAYO' 512 : LESFAC(1)='RACO' 513 : LESFAC(2)='VECT' 514 : IVECT=1 515 : NBTYPE=4 516 : SEGINI,NOTYPE 517 : TYPE(1)='REAL*8' 518 : TYPE(2)='REAL*8' 519 : TYPE(3)='REAL*8' 520 : TYPE(4)='POINTEURPOINT ' 521 : ENDIF 522 : MOCARA=NOMID 523 : NCARA=NBROBL 524 : NCARF=NBRFAC 525 : NCARR=NCARA+NCARF 526 : C= 3.9.6 - Verification de leur presence dans IPCHE1 527 : IF (MOCARA.NE.0) THEN 528 : MOTYPE=NOTYPE 529 : IF (IPCHE1.NE.0) THEN 529 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1, 530 : . INFOS,3,IVACAR) 531 : SEGSUP,NOTYPE 532 : IF (IERR.NE.0) GOTO 250 533 : IF (IVECT.EQ.1) THEN 534 : MPTVAL=IVACAR 535 : IF (IVAL(NCARR).EQ.0) THEN 536 : IVECT=2 537 : NOMID=MOCARA 538 : SEGACT,NOMID 539 : NBRFAC=NBRFAC+2 540 : SEGADJ,NOMID 541 : LESFAC(NBRFAC-2)='VX ' 542 : LESFAC(NBRFAC-1)='VY ' 543 : LESFAC(NBRFAC) ='VZ ' 544 : MOCARA=NOMID 545 : NBTYPE=1 546 : SEGINI,NOTYPE 547 : TYPE(1)='REAL*8' 548 : MOTYPE=NOTYPE 548 : CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1, 549 : . INFOS,3,IVACAR) 550 : SEGSUP,NOTYPE 551 : IF (IERR.NE.0) GOTO 250 552 : NCARA=NBROBL 553 : NCARF=NBRFAC 554 : NCARR=NCARA+NCARF 555 : ENDIF 556 : ENDIF 557 : ELSE 558 : MOTERR(1:4)='CARA' 559 : MOTERR(5:8)='CARA' 560 : MOTERR(9:12)=NOMTP(MELE) 561 : MOTERR(13:20)='EPTH' 561 : CALL ERREUR(145) 562 : SEGSUP,NOTYPE 563 : GOTO 250 564 : ENDIF 565 : IF (ISupC.EQ.1) THEN 565 : CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE) 566 : IF (IERR.NE.0) THEN 567 : ISupC=0 568 : GOTO 250 569 : ENDIF 570 : ENDIF 571 : ENDIF 572 : C ====== 573 : C 3.10 - Recuperation des noms des composantes de deformations 574 : C ====== 575 : if(lnomid(5).ne.0) then 576 : nomid=lnomid(5) 577 : segact nomid 578 : moepth=nomid 579 : lsupde=.false. 580 : nstr=lesobl(/2) 581 : else 581 : CALL IDDEFO(IMODEL,IFOUR,MOEPTH,NSTR,NFAC) 582 : lsupde=.true. 583 : endif 584 : C*OF Pas de verif. que NSTR=NEPTH ? 585 : C ====== 586 : C 3.11 - Initialisation du MCHAML des contraintes de Von Mises (MCHAML) 587 : C associe au modele elementaire iSou (de maillage IPMAIL) 588 : C Remplissage des donnees associees a MCHAML dans MCHELM(global) 589 : C ====== 590 : C= 3.11.1 - Initialisation de MCHAML 591 : N2=NEPTH 592 : SEGINI,MCHAML 593 : C= 3.11.2 - Remplissage de MCHEML(iSou) 594 : CONCHE(iSou)=CONM 595 : IMACHE(iSou)=IPMAIL 596 : ICHAML(iSou)=MCHAML 597 : INFCHE(iSou,1)=0 598 : INFCHE(iSou,2)=0 599 : INFCHE(iSou,3)=NIFOUR 600 : INFCHE(iSou,4)=IPMINT 601 : INFCHE(iSou,5)=0 602 : INFCHE(iSou,6)=5 603 : C= 3.11.3 - Initialisation des N2 MELVAL associes a MCHAML 604 : C= Fin du remplissage de MCHAML 605 : N1PTEL=NBGS 606 : N1EL=NBELEM 607 : IF (MELE.EQ.30.OR.MELE.EQ.43) THEN 608 : N1PTEL=1 609 : N1EL=1 610 : ENDIF 611 : N2PTEL=0 612 : N2EL=0 613 : NS=1 614 : NCOSOU=N2 615 : SEGINI,MPTVAL 616 : IVAETH=MPTVAL 617 : NOMID=MOEPTH 618 : SEGACT,NOMID 619 : DO i=1,N2 620 : NOMCHE(i)=LESOBL(i) 621 : TYPCHE(i)='REAL*8' 622 : SEGINI,MELVAL 623 : IELVAL(i)=MELVAL 624 : IVAL(i)=MELVAL 625 : ENDDO 626 : C ====== 627 : C 3.12 - Initialisation de quelques segments de travail 628 : C Recuperation des fonctions de forme et de leurs derivees au 629 : C centre de l'element pour le calcul des axes locaux 630 : C ====== 631 : IF (LOGMA) THEN 632 : IF (LOGMF) THEN 633 : IELE=NUMGEO(MELE) 633 : CALL RESHPT(1,NBNO,IELE,MELE,NPINT,IPT1,IRT1) 634 : IF (IERR.NE.0) GOTO 260 635 : MINTE2=IPT1 636 : SEGACT,MINTE2 637 : ENDIF 638 : SEGINI,MWRK2 639 : ENDIF 640 : NV1=NMATT 641 : SEGINI,MVELCH,MWRK3 642 : C ====== 643 : C 3.13 - Boucle sur les elements du sous-modele elementaire 644 : C ====== 645 : DO iElt=1,NBELEM 646 : C= 3.13.1 - Cas des elements MASSIFs - materiau a "TROPIE" 647 : C= Recuperation des coordonnees des noeuds de l element iElt 648 : C= Determination des axes locaux aux noeuds 649 : IF (LOGMA.AND.LOGMF) THEN 649 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,iElt,XE) 650 : NBSH=MINTE2.SHPTOT(/2) 650 : CALL RLOCAL(XE,MINTE2.SHPTOT,NBSH,NBNN,TXR) 651 : IF (nbsh.EQ.-1) THEN 651 : CALL ERREUR(525) 652 : GOTO 260 653 : ENDIF 654 : ENDIF 655 : C= 3.13.2 - Cas de la poutre TIMO et modele SECTION 656 : IF (CMATE.EQ.'SECTION') THEN 657 : MPTVAL=IVAMAT 658 : MELVAL=IVAL(1) 659 : IBMN=MIN(iElt,IELCHE(/2)) 660 : IPMODL=IELCHE(1,IBMN) 661 : MELVAL=IVAL(2) 662 : IBMN=MIN(iElt,IELCHE(/2)) 663 : IPMAT=IELCHE(1,IBMN) 663 : CALL FRIGTH(IPMODL,IPMAT,CRIGI,0,0) 664 : ENDIF 665 : C= 3.13.3 - Boucle sur les points de Gauss 666 : DO iGau=1,NBPGAU 667 : C= 3.13.3.1 - Remplissage du tableau des caracteristiques du materiau 668 : IF (CMATE.NE.'SECTION') THEN 669 : MPTVAL=IVAMAT 670 : DO i=1,NMATT 671 : MELVAL=IVAL(i) 672 : IBMN=MIN(iElt,VELCHE(/2)) 673 : IGMN=MIN(iGau,VELCHE(/1)) 674 : VALMAT(i)=VELCHE(IGMN,IBMN) 675 : ENDDO 676 : ENDIF 677 : C= 3.13.3.2 - Prise en compte des epaisseur et excentrement dans le cas 678 : C= des coques minces avec ou sans cisaillement transverse 679 : IF ((CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'. 680 : $ OR.CMATE.EQ.'UNIDIREC') .AND.(MFR.EQ.3.OR.MFR.EQ.9)) THEN 681 : MPTVAL=IVACAR 682 : MELVAL=IVAL(1) 683 : IF (MELVAL.NE.0) THEN 684 : IBMN=MIN(iElt,VELCHE(/2)) 685 : IGMN=MIN(iGau,VELCHE(/1)) 686 : EPAIST=VELCHE(IGMN,IBMN) 687 : ELSE 687 : CALL ERREUR(527) 688 : GOTO 260 689 : ENDIF 690 : ENDIF 691 : C= 3.13.3.3 - Recuperation des temperatures du point de Gauss iGau 692 : MPTVAL=IVATEM 693 : MELVAL=IVAL(1) 694 : IGMN=MIN(iGau,VELCHE(/1)) 695 : IBMN=MIN(iElt,VELCHE(/2)) 696 : TEMP=VELCHE(IGMN,IBMN) 697 : C write(6,*) 'EPTHP',ielt,igau,igmn,ibmn,temp 698 : IF (((MFR.EQ.3.OR.MFR.EQ.9).AND.(CMATE.EQ.'ISOTROPE'. 699 : $ OR.CMATE.EQ.'ORTHOTRO'.OR.CMATE.EQ.'UNIDIREC')). 700 : $ OR.(MFR.EQ.5.AND. 701 : $ (CMATE.EQ.'ISOTROPE'.OR.CMATE.EQ.'ORTHOTRO'))) THEN 702 : IF (NPINT.EQ.0) THEN 703 : THIF=TEMP 704 : TEMP=XZero 705 : MELVAL=IVAL(2) 706 : IGMN=MIN(iGau,VELCHE(/1)) 707 : IBMN=MIN(iElt,VELCHE(/2)) 708 : THM=VELCHE(IGMN,IBMN) 709 : MELVAL=IVAL(3) 710 : IGMN=MIN(iGau,VELCHE(/1)) 711 : IBMN=MIN(iElt,VELCHE(/2)) 712 : THSU=VELCHE(IGMN,IBMN) 713 : ENDIF 714 : E3=DZEGAU(iGau) 715 : ELSE 716 : IF (CMATE.EQ.'SECTION') TEMP=TEMP*CRIGI(1) 717 : ENDIF 718 : C= 3.13.3.4 - Cas ISOTROPE : calcul des deformations thermiques 719 : IF (CMATE.EQ.'ISOTROPE') THEN 719 : CALL EPTHIS(MFR,MELE,VALMAT,NEPTH,TEMP,THIF,THM,THSU, 720 : . E3,EPAIST,RES,NPINT,KERRE) 721 : C= 3.13.3.5 - Cas ORTHOTROPE : calcul des deformations thermiques 722 : ELSE IF (CMATE.EQ.'ORTHOTRO') THEN 723 : IF (NPINT.EQ.0) THEN 723 : CALL EPTHOR(MFR,MELE,VALMAT,NEPTH,TEMP,THIF,THM,THSU, 724 : . E3,EPAIST,TXR,XLOC,XGLOB,ROTS,RES,KERRE) 725 : ELSE 726 : KERRE=19 727 : ENDIF 728 : C= 3.13.3.6 - Cas ANISOTROPE : calcul des deformations thermiques 729 : ELSE IF (CMATE.EQ.'ANISOTRO') THEN 730 : IF (NPINT.EQ.0) THEN 730 : CALL EPTHAN(MFR,MELE,VALMAT,NEPTH,TEMP,TXR,XLOC,XGLOB, 731 : . ROTS,RES,KERRE) 732 : ELSE 733 : KERRE=19 734 : ENDIF 735 : C= 3.13.3.7 - Cas UNIDIRECTIONNEL : calcul des deformations thermiques 736 : ELSE IF (CMATE.EQ.'UNIDIREC') THEN 737 : IF (NPINT.EQ.0) THEN 737 : CALL EPTHUN(MFR,MELE,VALMAT,NEPTH,TEMP,THIF,THM,THSU, 738 : . EPAIST,TXR,XLOC,XGLOB,ROTS,RES,KERRE) 739 : ELSE 740 : KERRE=19 741 : ENDIF 742 : C= 3.13.3.8 - Cas HOMOGENEISE et SECTION : calcul des deformations ther. 743 : ELSE IF (CMATE.EQ.'HOMOGENE'.OR.CMATE.EQ.'SECTION') THEN 744 : IF (NPINT.EQ.0) THEN 744 : CALL EPTHHS(MELE,VALMAT,NEPTH,TEMP,RES,KERRE) 745 : ELSE 746 : KERRE=19 747 : ENDIF 748 : C= 3.13.3.9 - Cas non prevus et traitement des ERREURS 749 : ELSE 750 : KERRE=19 751 : ENDIF 752 : IF (KERRE.EQ.19) THEN 752 : CALL ERREUR(19) 753 : GOTO 260 754 : ELSE IF (KERRE.EQ.86) THEN 755 : MOTERR(1:4)=NOMTP(MELE) 756 : MOTERR(5:12)='EPTH' 756 : CALL ERREUR(86) 757 : GOTO 260 758 : ENDIF 759 : C= 3.13.3.10 - Stockage des deformations dans les MELVAL 760 : MPTVAL=IVAETH 761 : DO i=1,NEPTH 762 : MELVAL=IVAL(i) 763 : VELCHE(iGau,iElt)=RES(i) 764 : ENDDO 765 : ENDDO 766 : ENDDO 767 : C ====== 768 : C 3.14 - Desactivation/suppression de segments associes a iSou 769 : C Sortie prematuree en cas d'ERREUR (iOK=0) 770 : C ====== 771 : IF (IERR.EQ.0) iOK=1 772 : 260 SEGSUP,MVELCH,MWRK3 773 : IF (MOEPTH.NE.0) THEN 774 : NOMID=MOEPTH 775 : if(lsupde)SEGSUP,NOMID 776 : ENDIF 777 : IF (LOGMA) THEN 778 : SEGSUP,MWRK2 779 : IF (LOGMF) SEGDES,MINTE2 780 : ENDIF 781 : 250 IF (MOCARA.NE.0) THEN 782 : NOMID=MOCARA 783 : SEGSUP,NOMID 784 : IF (ISupC.EQ.1) THEN 784 : CALL DTMVAL(IVACAR,3) 785 : ELSE 785 : CALL DTMVAL(IVACAR,1) 786 : ENDIF 787 : ENDIF 788 : 240 IF (MOMATR.NE.0) THEN 789 : NOMID=MOMATR 790 : if(lsupma)SEGSUP,NOMID 791 : IF (ISupC.EQ.1) THEN 791 : CALL DTMVAL(IVAMAT,3) 792 : ELSE 792 : CALL DTMVAL(IVAMAT,1) 793 : ENDIF 794 : ENDIF 795 : 230 IF (MOTEMP.NE.0) THEN 796 : NOMID=MOTEMP 797 : if(lsupte)SEGSUP,NOMID 798 : ENDIF 799 : IF (ISupT.EQ.1) THEN 799 : CALL DTMVAL(IVATEM,3) 800 : ELSE 800 : CALL DTMVAL(IVATEM,1) 801 : ENDIF 802 : SEGDES,MELEME 803 : 220 CONTINUE 804 : if (IPMINT.NE.0) SEGDES,MINTE 805 : 210 CONTINUE 806 : SEGDES,IMODEL 807 : IF (iOK.EQ.0) THEN 807 : CALL DTMVAL(IVAETH,3) 808 : IF (MCHAML.NE.0) SEGSUP,MCHAML 809 : SEGSUP,MCHELM 810 : GOTO 300 811 : ENDIF 811 : CALL DTMVAL(IVAETH,1) 812 : SEGDES,MCHAML 813 : ENDDO 814 : 815 : C 4 - MENAGE : DESACTIVATION/DESTRUCTION DE SEGMENTS 816 : C ==================================================== 817 : IRET=1 818 : SEGDES,MCHELM 819 : 300 SEGDES,MMODEL 820 : NOTYPE=MOTYTE 821 : SEGSUP,NOTYPE 822 : 823 : RETURN 824 : END 825 : 826 : 827 : 828 : 829 : 830 :
© Cast3M 2003 - All rights reserved.
Disclaimer