Télécharger capa.eso

Retour à la liste

Numérotation des lignes :

  1. C CAPA SOURCE CB215821 18/09/10 21:15:12 9912
  2.  
  3. C=======================================================================
  4. C= C A P A =
  5. C= ------- =
  6. C= =
  7. C= OPERATEUR DE CALCUL DE LA MATRICE DE CAPACITE (CALORIFIQUE) : =
  8. C= ------------------------------------------------------------- =
  9. C= CAP1 = 'CAPACITE' MODL1 CARA1 ( TAB1 ) ; =
  10. C= =
  11. C= ARGUMENTS : =
  12. C= ----------- =
  13. C= MODL1 (MMODEL) Modele (global) associe a la structure =
  14. C= CARA1 (MCHAML) Caracteristiques thermiques du(des) materiau(x)=
  15. C= Sous-type 'CARACTERISTIQUES' =
  16. C= TAB1 (TABLE) Table contenant les grandeurs liees a un chan- =
  17. C= gement de phase eventuel (facultatif) =
  18. C= Sous-type 'THERMIQUE' =
  19. C= =
  20. C= RESULTAT : =
  21. C= ---------- =
  22. C= CAP1 (RIGIDITE) Matrice de capacite calorifique =
  23. C= =
  24. C= Denis ROBERT, le 15 fevrier 1988. =
  25. C= Zakaria HABIBI, modification le 30 juin 2008(partie thermohydrique)=
  26. C=======================================================================
  27.  
  28. SUBROUTINE CAPA
  29.  
  30. IMPLICIT INTEGER(I-N)
  31. IMPLICIT REAL*8 (A-H,O-Z)
  32.  
  33. -INC CCOPTIO
  34.  
  35. -INC SMCHAML
  36. -INC SMMODEL
  37. -INC SMRIGID
  38.  
  39. CHARACTER*9 MO1
  40. LOGICAL L0,L1
  41.  
  42. C 1 - LECTURE DES ARGUMENTS DE L'OPERATEUR
  43. C ==========================================
  44. C 1.1 - Lecture OBLIGATOIRE du modele (IPMODE)
  45. C =====
  46. MOTERR(1:8)=' MODELE '
  47. CALL MESLIR(-137)
  48. CALL LIROBJ('MMODEL',IPMODE,1,IRet)
  49. IF (IERR.NE.0) RETURN
  50. C =====
  51. C 1.2 - Lecture OBLIGATOIRE du champ de caracteristiques (IPCHEL)
  52. C =====
  53. CALL MESLIR(-135)
  54. CALL LIROBJ('MCHAML',IPIN,1,IRet)
  55. IF (IERR.NE.0) RETURN
  56. CALL REDUAF(IPIN,IPMODE,IPCHEL,0,IR,KER)
  57. IF(IR .NE. 1) CALL ERREUR(KER)
  58. IF(IERR .NE. 0) RETURN
  59. C =====
  60. C 1.3 - Lecture FACULTATIVE de la table des donnees liees a un
  61. C changement de phase (ITABL)
  62. C =====
  63. ITABL=0
  64. CALL MESLIR(-136)
  65. CALL LIROBJ('TABLE',ITABL,0,IRet)
  66. IF (IERR.NE.0) RETURN
  67.  
  68. C 2 - VERIFICATIONS DES DONNEES DE L'OPERATEUR
  69. C ==============================================
  70. C 2.1 - Verification du sous-type du MCHAML de caracteristiques
  71. C =====
  72. MCHELM=IPCHEL
  73. SEGACT,MCHELM
  74. IF (TITCHE(1:8).NE.'CARACTER') THEN
  75. SEGDES,MCHELM
  76. MOTERR='CARACTERISTIQUES'
  77. CALL ERREUR(291)
  78. RETURN
  79. ENDIF
  80. SEGDES,MCHELM
  81. C =====
  82. C 2.2 - Verification du sous-type de la TABLE
  83. C (l'indice 'SOUSTYPE' doit valoir 'THERMIQUE')
  84. C =====
  85. IF (ITABL.NE.0) THEN
  86. CALL ACCTAB(ITABL,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  87. & 'MOT',I1,X1,MO1,L1,IP1)
  88. IF (IERR.NE.0) RETURN
  89. IF (MO1.NE.'THERMIQUE') THEN
  90. CALL ERREUR(314)
  91. RETURN
  92. ENDIF
  93. ENDIF
  94.  
  95. C 3 - CONSTRUCTION DE LA MATRICE DE CAPACITE
  96. C ============================================
  97. C 3.1 - Initialisation de la matrice :
  98. C =====
  99. NRIGEL = 0
  100. SEGINI,MRIGID
  101. MTYMAT = 'RIGIDITE'
  102. ICHOLE = 0
  103. IMGEO1 = 0
  104. IMGEO2 = 0
  105. C* IFORIG = IFOMOD
  106. IFORIG = IFOUR
  107. ISUPEQ = 0
  108. IPRIGI = MRIGID
  109. C =====
  110. C 3.2 - Remplissage de la matrice pour chaque modele concerne
  111. C =====
  112. MMODEL=IPMODE
  113. SEGACT,MMODEL
  114. NB1 = KMODEL(/1)
  115. N1 = 1
  116.  
  117. DO 10 IA = 1, NB1
  118. IMODEL = KMODEL(IA)
  119. SEGACT,IMODEL
  120. C ITHER = 0
  121. ITHHY = 0
  122. C IDIFF = 0
  123. C IELEC = 0
  124. IF (FORMOD(1).EQ.'THERMIQUE') THEN
  125. do iyu=1,matmod(/2)
  126. if( matmod(iyu).eq.'CONVECTION' ) GOTO 1
  127. if( matmod(iyu).eq.'RAYONNEMENT') GOTO 1
  128. enddo
  129. C ITHER = 1
  130. ISUPC = 6
  131. ELSE IF (FORMOD(1).EQ.'THERMOHYDRIQUE') THEN
  132. ITHHY = 1
  133. ISUPC = 6
  134. ELSE IF (FORMOD(1).EQ.'DIFFUSION') THEN
  135. C IDIFF = 1
  136. ISUPC = 6
  137. C* ELSE IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN
  138. C* IELEC = 1
  139. C* ISUPC = 4
  140. ELSE
  141. SEGDES,IMODEL
  142. GOTO 10
  143. ENDIF
  144.  
  145. IF (NB1.GT.1) THEN
  146. SEGINI,MMODE1
  147. IPMOD1 = MMODE1
  148. MMODE1.KMODEL(1) = IMODEL
  149. ELSE
  150. IPMOD1 = IPMODE
  151. ENDIF
  152.  
  153. CALL REDUAF(IPCHEL,IPMOD1,IPCHE1,0,IRET,KERRE)
  154. IF (IRET.NE.1) THEN
  155. CALL ERREUR(KERRE)
  156. GOTO 9999
  157. ENDIF
  158.  
  159. C Verification du lieu support du MCHAML de caracteristiques
  160. ISUPC1 = 0
  161. CALL QUESUP(IPMOD1,IPCHE1,ISUPC,0,ISUPC1,IRET)
  162. IF (ISUPC1.GT.1) GOTO 9999
  163. C Reactivation du modele elementaire (desactive dans REDUAF)
  164. SEGACT,IMODEL
  165. IF (ITHHY.NE.0) THEN
  166. CALL THCAPA1(IMODEL,IPCHE1,ISUPC1, IPRIGI)
  167. C ELSE IF (IDIFF.NE.0.OR.IELEC.NE.0) THEN
  168. C CALL CAPAED(IMODEL,IPCHE1,ISUPC1, IPRIGI)
  169. ELSE
  170. CALL CAPA1(IMODEL,IPCHE1,ISUPC1, ITABL,IPRIGI)
  171. ENDIF
  172.  
  173.  
  174. 1 CONTINUE
  175. SEGDES,IMODEL
  176. IF (IERR.NE.0) GOTO 9999
  177.  
  178. IF (NB1.GT.1) THEN
  179. SEGDES,MMODE1
  180. ENDIF
  181. 10 CONTINUE
  182.  
  183. NRIGEL = IRIGEL(/2)
  184. IF (NRIGEL.EQ.0) THEN
  185. CALL ERREUR(19)
  186. ENDIF
  187. 9999 CONTINUE
  188. IF (IERR.NE.0) THEN
  189. SEGSUP,MRIGID
  190. ELSE
  191. SEGDES,MRIGID
  192. CALL ECROBJ('RIGIDITE',IPRIGI)
  193. ENDIF
  194.  
  195. SEGDES,MMODEL
  196. C
  197. RETURN
  198. END
  199.  
  200.  
  201.  
  202.  
  203.  

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