C EPTH SOURCE PV 20/09/12 21:15:12 10711 C======================================================================= C= E P T H = C= ------- = C= = C= OPERATEUR CAST3M "EPTH" : = C= ------------------------- = C= EPT1 = 'EPTH' MODL1 | CHP1 | CARA1 ; = C= | CHEL1 | = C= = C= Cet operateur sert a calculer les deformations dues a un champ = C= de temperatures. = C= = C= ARGUMENTS : = C= ----------- = C= MODL1 (MMODEL) Modele (global) associe a la structure = C= CHP1 (CHPOINT) Temperatures aux NOEUDS = C= CHEL1 (MCHAML) Temperatures donnees par ELEMENT = C= Sous-type 'TEMPERATURES' = C= CARA1 (MCHAML) Caracteristiques des materiaux = C= Sous-type 'CARACTERISTIQUES' = C= = C= RESULTAT : = C= ---------- = C= EPT1 (CHPOINT/MCHAML) Deformations d'origine thermique = C======================================================================= SUBROUTINE EPTH IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMCHAML -INC SMCOORD segact mcoord IPMODL=0 IPIN =0 IPCHA1=0 IPCHA2=0 IPCHE1=0 IPCHE2=0 IPEPTH=0 IRET =0 C 1 - LECTURE DES ARGUMENTS DE L'OPERATEUR C ========================================== C 1.1 - Lecture OBLIGATOIRE du modele (IPMODL) C ===== MOTERR(1:8)='MODELE' CALL MESLIR(-137) CALL LIROBJ('MMODEL ',IPMODL,1,IRet) IF (IERR.NE.0) RETURN CALL ACTOBJ('MMODEL ',IPMODL,1) C ===== C 1.2 - Lecture OBLIGATOIRE du champ de caracteristiques (IPCHA1) C ===== IPCHA1=0 CALL LIROBJ('MCHAML ',IPIN,1,IRet) IF (IERR.NE.0) RETURN CALL ACTOBJ('MCHAML ',IPIN,1) * AM 29/08/14 ON REDUIT SUR LE MODELE CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IRE,KER) IF(IRE.NE.1) CALL ERREUR(KER) IF (IERR.NE.0) RETURN C ===== C 1.3 - Lecture OBLIGATOIRE du champ de temperatures donne par : C 1) un CHPOINT (IPCHPO) converti en MCHAML (IPCHE2) C ou 2) un MCHAML (IPCHA2) qui est duplique en IPCHE2 C ===== CALL LIROBJ('CHPOINT',IPCHPO,0,IRet) IF (IERR.NE.0) RETURN IF (IRet.NE.0) THEN CALL ACTOBJ('CHPOINT ',IPCHPO,1) IPCHE1=IPCHA1 CALL CHAME1(0,IPMODL,IPCHPO,' ',IPCHE2,1) IF (IERR.NE.0) GOTO 10 ELSE C= 1.3.1 - Mise en ordre des MCHAML lus C 1 -> IPCHE1 = Caracteristiques, 2 -> IPCHE2 = Temperatures CALL LIROBJ('MCHAML ', IPIN,1,IRet) IF (IERR.NE.0) RETURN CALL ACTOBJ('MCHAML ',IPIN,1) C CB 05/12/16 ON REDUIT SUR LE MODELE CALL REDUAF(IPIN,IPMODL,IPCHA2,0,IRE,KER) IF(IRE.NE.1) CALL ERREUR(KER) IF (IERR.NE.0) RETURN CALL RNGCHA(IPCHA1,IPCHA2,'CARACTERISTIQUES','TEMPERATURES', . IPCHE1,IPCHE2) C= 1.3.2 - ERREUR si les sous-types ne sont pas corrects IF (IPCHE1.EQ.0.OR.IPCHE2.EQ.0) THEN CALL ERREUR(554) RETURN ENDIF C= 1.3.3 - Copie du MCHAML de temperatures pour la linearisation IPIN=IPCHE2 CALL COPIE8(IPIN,IPCHE2) IF (IERR.NE.0) GOTO 10 ENDIF C 2 - LINEARISATION DES TEMPERATURES POUR LES NOEUDS MILIEUX C ============================================================ CALL LINEAT(IPCHE2) C 3 - CALCUL DU MCHAML DE DEFORMATIONS THERMIQUES C ================================================= CALL EPTHP(IPMODL,IPCHE1,IPCHE2,IPEPTH,IRET) C 4 - ECRITURE DU MCHAML RESULTAT C ================================= IF (IRET.EQ.1) THEN CALL ACTOBJ('MCHAML ',IPEPTH,1) CALL ECROBJ('MCHAML ',IPEPTH) ENDIF 10 CONTINUE END