Télécharger epth.eso

Retour à la liste

Numérotation des lignes :

  1. C EPTH SOURCE PV 20/04/03 21:15:25 10571
  2.  
  3. C=======================================================================
  4. C= E P T H =
  5. C= ------- =
  6. C= =
  7. C= OPERATEUR CAST3M "EPTH" : =
  8. C= ------------------------- =
  9. C= EPT1 = 'EPTH' MODL1 | CHP1 | CARA1 ; =
  10. C= | CHEL1 | =
  11. C= =
  12. C= Cet operateur sert a calculer les deformations dues a un champ =
  13. C= de temperatures. =
  14. C= =
  15. C= ARGUMENTS : =
  16. C= ----------- =
  17. C= MODL1 (MMODEL) Modele (global) associe a la structure =
  18. C= CHP1 (CHPOINT) Temperatures aux NOEUDS =
  19. C= CHEL1 (MCHAML) Temperatures donnees par ELEMENT =
  20. C= Sous-type 'TEMPERATURES' =
  21. C= CARA1 (MCHAML) Caracteristiques des materiaux =
  22. C= Sous-type 'CARACTERISTIQUES' =
  23. C= =
  24. C= RESULTAT : =
  25. C= ---------- =
  26. C= EPT1 (CHPOINT/MCHAML) Deformations d'origine thermique =
  27. C=======================================================================
  28.  
  29. SUBROUTINE EPTH
  30.  
  31. IMPLICIT INTEGER(I-N)
  32. IMPLICIT REAL*8 (A-H,O-Z)
  33.  
  34.  
  35. -INC PPARAM
  36. -INC CCOPTIO
  37. -INC SMCHAML
  38. -INC SMCOORD
  39.  
  40. segact mcoord
  41. IPMODL=0
  42. IPIN =0
  43. IPCHA1=0
  44. IPCHA2=0
  45. IPCHE1=0
  46. IPCHE2=0
  47. IPEPTH=0
  48. IRET =0
  49.  
  50. C 1 - LECTURE DES ARGUMENTS DE L'OPERATEUR
  51. C ==========================================
  52. C 1.1 - Lecture OBLIGATOIRE du modele (IPMODL)
  53. C =====
  54. MOTERR(1:8)='MODELE'
  55. CALL MESLIR(-137)
  56. CALL LIROBJ('MMODEL ',IPMODL,1,IRet)
  57. IF (IERR.NE.0) RETURN
  58. CALL ACTOBJ('MMODEL ',IPMODL,1)
  59. C =====
  60. C 1.2 - Lecture OBLIGATOIRE du champ de caracteristiques (IPCHA1)
  61. C =====
  62. IPCHA1=0
  63. CALL LIROBJ('MCHAML ',IPIN,1,IRet)
  64. IF (IERR.NE.0) RETURN
  65. CALL ACTOBJ('MCHAML ',IPIN,1)
  66.  
  67. * AM 29/08/14 ON REDUIT SUR LE MODELE
  68. CALL REDUAF(IPIN,IPMODL,IPCHA1,0,IRE,KER)
  69. IF(IRE.NE.1) CALL ERREUR(KER)
  70. IF (IERR.NE.0) RETURN
  71.  
  72. C =====
  73. C 1.3 - Lecture OBLIGATOIRE du champ de temperatures donne par :
  74. C 1) un CHPOINT (IPCHPO) converti en MCHAML (IPCHE2)
  75. C ou 2) un MCHAML (IPCHA2) qui est duplique en IPCHE2
  76. C =====
  77. CALL LIROBJ('CHPOINT',IPCHPO,0,IRet)
  78. IF (IERR.NE.0) RETURN
  79. IF (IRet.NE.0) THEN
  80. CALL ACTOBJ('CHPOINT ',IPCHPO,1)
  81. IPCHE1=IPCHA1
  82. CALL CHAME1(0,IPMODL,IPCHPO,' ',IPCHE2,1)
  83. IF (IERR.NE.0) GOTO 10
  84.  
  85. ELSE
  86. C= 1.3.1 - Mise en ordre des MCHAML lus
  87. C 1 -> IPCHE1 = Caracteristiques, 2 -> IPCHE2 = Temperatures
  88. CALL LIROBJ('MCHAML ', IPIN,1,IRet)
  89. IF (IERR.NE.0) RETURN
  90. CALL ACTOBJ('MCHAML ',IPIN,1)
  91.  
  92. C CB 05/12/16 ON REDUIT SUR LE MODELE
  93. CALL REDUAF(IPIN,IPMODL,IPCHA2,0,IRE,KER)
  94. IF(IRE.NE.1) CALL ERREUR(KER)
  95. IF (IERR.NE.0) RETURN
  96.  
  97. CALL RNGCHA(IPCHA1,IPCHA2,'CARACTERISTIQUES','TEMPERATURES',
  98. . IPCHE1,IPCHE2)
  99. C= 1.3.2 - ERREUR si les sous-types ne sont pas corrects
  100. IF (IPCHE1.EQ.0.OR.IPCHE2.EQ.0) THEN
  101. CALL ERREUR(554)
  102. RETURN
  103. ENDIF
  104. C= 1.3.3 - Copie du MCHAML de temperatures pour la linearisation
  105. IPIN=IPCHE2
  106. CALL COPIE8(IPIN,IPCHE2)
  107. IF (IERR.NE.0) GOTO 10
  108. ENDIF
  109.  
  110. C 2 - LINEARISATION DES TEMPERATURES POUR LES NOEUDS MILIEUX
  111. C ============================================================
  112. CALL LINEAT(IPCHE2)
  113.  
  114. C 3 - CALCUL DU MCHAML DE DEFORMATIONS THERMIQUES
  115. C =================================================
  116. CALL EPTHP(IPMODL,IPCHE1,IPCHE2,IPEPTH,IRET)
  117.  
  118. C 4 - ECRITURE DU MCHAML RESULTAT
  119. C =================================
  120. IF (IRET.EQ.1) THEN
  121. CALL ACTOBJ('MCHAML ',IPEPTH,1)
  122. CALL ECROBJ('MCHAML ',IPEPTH)
  123. ENDIF
  124.  
  125. 10 CONTINUE
  126.  
  127. MCHELM=IPCHE2
  128. DO IA=1,IMACHE(/1)
  129. MCHAML=ICHAML(IA)
  130. DO IB=1,IELVAL(/1)
  131. MELVAL=IELVAL(IB)
  132. SEGSUP MELVAL
  133. ENDDO
  134. SEGSUP MCHAML
  135. ENDDO
  136. SEGSUP,MCHELM
  137.  
  138. END
  139.  
  140.  
  141.  
  142.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales