Télécharger theta.eso

Retour à la liste

Numérotation des lignes :

  1. C THETA SOURCE PV 20/09/12 21:15:35 10711
  2.  
  3. C=======================================================================
  4. C= T H E T A =
  5. C= --------- =
  6. C= =
  7. C= OPERATEUR CAST3M "THETA" : =
  8. C= -------------------------- =
  9. C= SIG1 = 'THETA' MODL1 | CHP1 | CARA1 ; =
  10. C= | CHEL1 | =
  11. C= =
  12. C= Cet operateur sert a calculer les contraintes dues a un champ de =
  13. C= temperatures (contraintes dites thermiques). =
  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= SIG1 (MCHAML) Contraintes d'origine thermique =
  27. C=======================================================================
  28.  
  29. SUBROUTINE THETA
  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 SMELEME
  39. -INC SMCOORD
  40.  
  41. segact mcoord
  42. C 1 - LECTURE DES ARGUMENTS DE L'OPERATEUR
  43. C ==========================================
  44. C 1.1 - Lecture OBLIGATOIRE du modele (IPMODL)
  45. C =====
  46. MOTERR(1:8)='MODELE'
  47. CALL MESLIR(-137)
  48. CALL LIROBJ('MMODEL ',IPMODL,1,IRET)
  49. CALL ACTOBJ('MMODEL ',IPMODL,1)
  50. IF (IERR.NE.0) RETURN
  51. C =====
  52. C 1.2 - Lecture OBLIGATOIRE du champ de caracteristiques (IPCHA1)
  53. C =====
  54. IPCHA1=0
  55. CALL LIROBJ('MCHAML ',IPCHA1,1,IRET)
  56. CALL ACTOBJ('MCHAML ',IPCHA1,1)
  57. IF (IERR.NE.0) RETURN
  58. call reduaf(ipcha1,ipmodl,ipch,0,ir,ker)
  59. if (ir.ne.1) call erreur(ker)
  60. IF (IERR.NE.0) RETURN
  61. ipcha1=ipch
  62. C =====
  63. C 1.3 - Lecture OBLIGATOIRE du champ de temperatures donne par :
  64. C 1) un CHPOINT (IPCHPO) converti en MCHAML (IPCHE2)
  65. C ou 2) un MCHAML (IPCHA2) qui est duplique en IPCHE2
  66. C =====
  67. C= 1.3.1 - Syntaxe 1 : lecture d'un CHPOINT
  68. CALL LIROBJ('CHPOINT ',IPCHPO,0,IRET)
  69. IF (IERR.NE.0) RETURN
  70. IF (IRET.NE.0) THEN
  71. CALL ACTOBJ('CHPOINT ',IPCHPO,1)
  72. IPCHE1=IPCHA1
  73. CALL CHAME1(0,IPMODL,IPCHPO,' ',IPCHE2,1)
  74. IF (IERR.NE.0) RETURN
  75. ELSE
  76. C= 1.3.2 - Syntaxe 2 : lecture d'un MCHAML
  77. C= Mise en ordre des MCHAML lus
  78. C= 1 -> IPCHE1 = Caracteristiques, 2 -> IPCHE2 = Temperatures
  79. IPCHA2=0
  80. CALL LIROBJ('MCHAML ',IPCHA2,1,IRET)
  81. CALL ACTOBJ('MCHAML ',IPCHA2,1)
  82. IF (IERR.NE.0) RETURN
  83. call reduaf(ipcha2,ipmodl,ipch,0,ir,ker)
  84. if (ir.ne.1) call erreur(ker)
  85. IF (IERR.NE.0) RETURN
  86. ipcha2=ipch
  87. IPCHE1=0
  88. IPCHE2=0
  89. CALL RNGCHA(IPCHA1,IPCHA2,'CARACTERISTIQUES','TEMPERATURES',
  90. . IPCHE1,IPCHE2)
  91. C= 1.3.3 - ERREUR si les sous-types ne sont pas corrects
  92. IF (IPCHE1.EQ.0.OR.IPCHE2.EQ.0) THEN
  93. CALL ERREUR(554)
  94. RETURN
  95. ENDIF
  96. C= 1.3.4 - Copie du MCHAML de temperatures pour la linearisation
  97. CALL ECROBJ('MCHAML ',IPCHE2)
  98. CALL COPIER
  99. CALL LIROBJ('MCHAML ',IPCHE2,1,IRET)
  100. IF (IERR.NE.0) RETURN
  101. ENDIF
  102.  
  103. C 2 - LINEARISATION DES TEMPERATURES POUR LES NOEUDS MILIEUX
  104. C ============================================================
  105. CALL LINEAT(IPCHE2)
  106.  
  107. C 3 - CALCUL DU MCHAML DE CONTRAINTES THERMIQUES
  108. C ================================================
  109. CALL THETAP(IPMODL,IPCHE1,IPCHE2,IPSTRS,IRET)
  110.  
  111. C 4 - ECRITURE DU MCHAML RESULTAT
  112. C =================================
  113. IF (IRET.EQ.1) THEN
  114. CALL ACTOBJ('MCHAML ',IPSTRS,1)
  115. CALL ECROBJ('MCHAML ',IPSTRS)
  116. ENDIF
  117.  
  118. END
  119.  
  120.  
  121.  

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