Télécharger capa.eso

Retour à la liste

Numérotation des lignes :

  1. C CAPA SOURCE PV 20/03/30 21:15:38 10567
  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.  
  34. -INC PPARAM
  35. -INC CCOPTIO
  36.  
  37. -INC SMCHAML
  38. -INC SMMODEL
  39. -INC SMRIGID
  40. -INC SMCOORD
  41.  
  42. CHARACTER*9 MO1
  43. LOGICAL L0,L1
  44. *
  45. segact mcoord
  46. *
  47. C 1 - LECTURE DES ARGUMENTS DE L'OPERATEUR
  48. C ==========================================
  49. C 1.1 - Lecture OBLIGATOIRE du modele (IPMODE)
  50. C =====
  51. MOTERR(1:8)=' MODELE '
  52. CALL MESLIR(-137)
  53. CALL LIROBJ('MMODEL ',IPMODE,1,IRet)
  54. CALL ACTOBJ('MMODEL ',IPMODE,1)
  55. IF (IERR.NE.0) RETURN
  56. C =====
  57. C 1.2 - Lecture OBLIGATOIRE du champ de caracteristiques (IPCHEL)
  58. C =====
  59. CALL MESLIR(-135)
  60. CALL LIROBJ('MCHAML ',IPIN,1,IRet)
  61. CALL ACTOBJ('MCHAML ',IPIN,1)
  62. IF (IERR.NE.0) RETURN
  63. CALL REDUAF(IPIN,IPMODE,IPCHEL,0,IR,KER)
  64. IF(IR .NE. 1) CALL ERREUR(KER)
  65. IF(IERR .NE. 0) RETURN
  66. C =====
  67. C 1.3 - Lecture FACULTATIVE de la table des donnees liees a un
  68. C changement de phase (ITABL)
  69. C =====
  70. ITABL=0
  71. CALL MESLIR(-136)
  72. CALL LIROBJ('TABLE',ITABL,0,IRet)
  73. IF (IERR.NE.0) RETURN
  74.  
  75. C 2 - VERIFICATIONS DES DONNEES DE L'OPERATEUR
  76. C ==============================================
  77. C 2.1 - Verification du sous-type du MCHAML de caracteristiques
  78. C =====
  79. MCHELM=IPCHEL
  80. SEGACT,MCHELM
  81. IF (TITCHE(1:8).NE.'CARACTER') THEN
  82. C SEGDES,MCHELM
  83. MOTERR='CARACTERISTIQUES'
  84. CALL ERREUR(291)
  85. RETURN
  86. ENDIF
  87. C SEGDES,MCHELM
  88. C =====
  89. C 2.2 - Verification du sous-type de la TABLE
  90. C (l'indice 'SOUSTYPE' doit valoir 'THERMIQUE')
  91. C =====
  92. IF (ITABL.NE.0) THEN
  93. CALL ACCTAB(ITABL,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
  94. & 'MOT',I1,X1,MO1,L1,IP1)
  95. IF (IERR.NE.0) RETURN
  96. IF (MO1.NE.'THERMIQUE') THEN
  97. CALL ERREUR(314)
  98. RETURN
  99. ENDIF
  100. ENDIF
  101.  
  102. C 3 - CONSTRUCTION DE LA MATRICE DE CAPACITE
  103. C ============================================
  104. C 3.1 - Initialisation de la matrice :
  105. C =====
  106. NRIGEL = 0
  107. SEGINI,MRIGID
  108. MTYMAT = 'RIGIDITE'
  109. ICHOLE = 0
  110. IMGEO1 = 0
  111. IMGEO2 = 0
  112. C* IFORIG = IFOMOD
  113. IFORIG = IFOUR
  114. ISUPEQ = 0
  115. IPRIGI = MRIGID
  116. C =====
  117. C 3.2 - Remplissage de la matrice pour chaque modele concerne
  118. C =====
  119. MMODEL=IPMODE
  120. SEGACT,MMODEL
  121. NB1 = KMODEL(/1)
  122. N1 = 1
  123.  
  124. DO 10 IA = 1, NB1
  125. IMODEL = KMODEL(IA)
  126. SEGACT,IMODEL
  127. C ITHER = 0
  128. ITHHY = 0
  129. C IDIFF = 0
  130. C IELEC = 0
  131. IF (FORMOD(1).EQ.'THERMIQUE') THEN
  132. do iyu=1,matmod(/2)
  133. if( matmod(iyu).eq.'CONVECTION' ) GOTO 1
  134. if( matmod(iyu).eq.'RAYONNEMENT') GOTO 1
  135. enddo
  136. C ITHER = 1
  137. ISUPC = 6
  138. ELSE IF (FORMOD(1).EQ.'THERMOHYDRIQUE') THEN
  139. ITHHY = 1
  140. ISUPC = 6
  141. ELSE IF (FORMOD(1).EQ.'DIFFUSION') THEN
  142. C IDIFF = 1
  143. ISUPC = 6
  144. C* ELSE IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN
  145. C* IELEC = 1
  146. C* ISUPC = 4
  147. ELSE
  148. C SEGDES,IMODEL
  149. GOTO 10
  150. ENDIF
  151.  
  152. IF (NB1.GT.1) THEN
  153. SEGINI,MMODE1
  154. IPMOD1 = MMODE1
  155. MMODE1.KMODEL(1) = IMODEL
  156. ELSE
  157. IPMOD1 = IPMODE
  158. ENDIF
  159.  
  160. CALL ACTOBJ('MCHAML ',IPCHEL,1)
  161. CALL REDUAF(IPCHEL,IPMOD1,IPCHE1,0,IRET,KERRE)
  162. IF (IRET.NE.1) THEN
  163. CALL ERREUR(KERRE)
  164. GOTO 9999
  165. ENDIF
  166.  
  167. C Verification du lieu support du MCHAML de caracteristiques
  168. ISUPC1 = 0
  169. CALL QUESUP(IPMOD1,IPCHE1,ISUPC,0,ISUPC1,IRET)
  170. IF (ISUPC1.GT.1) GOTO 9999
  171. C Reactivation du modele elementaire (desactive dans REDUAF)
  172. C SEGACT,IMODEL
  173. IF (ITHHY.NE.0) THEN
  174. CALL THCAPA1(IMODEL,IPCHE1,ISUPC1, IPRIGI)
  175. C ELSE IF (IDIFF.NE.0.OR.IELEC.NE.0) THEN
  176. C CALL CAPAED(IMODEL,IPCHE1,ISUPC1, IPRIGI)
  177. ELSE
  178. CALL CAPA1(IMODEL,IPCHE1,ISUPC1, ITABL,IPRIGI)
  179. ENDIF
  180.  
  181.  
  182. 1 CONTINUE
  183. C SEGDES,IMODEL
  184. IF (IERR.NE.0) GOTO 9999
  185.  
  186. C IF (NB1.GT.1) THEN
  187. C SEGDES,MMODE1
  188. C ENDIF
  189. 10 CONTINUE
  190.  
  191. NRIGEL = IRIGEL(/2)
  192. IF (NRIGEL.EQ.0) THEN
  193. CALL ERREUR(19)
  194. ENDIF
  195. 9999 CONTINUE
  196. IF (IERR.NE.0) THEN
  197. SEGSUP,MRIGID
  198. ELSE
  199. SEGDES,MRIGID
  200. CALL ECROBJ('RIGIDITE',IPRIGI)
  201. ENDIF
  202.  
  203. END
  204.  
  205.  
  206.  
  207.  

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