Télécharger capa.eso

Retour à la liste

Numérotation des lignes :

  1. C CAPA SOURCE CB215821 17/01/16 21:15:05 9279
  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 IA = 1, NB1
  118. IMODEL = KMODEL(IA)
  119. SEGACT,IMODEL
  120. C ITHER = 0
  121. ITHHY = 0
  122. C IDIFF = 0
  123. 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. MOTERR(1:8) = FORMOD(1)
  142. CALL ERREUR(193)
  143. SEGDES,IMODEL
  144. GOTO 9999
  145. ENDIF
  146.  
  147. IF (NB1.GT.1) THEN
  148. SEGINI,MMODE1
  149. IPMOD1 = MMODE1
  150. MMODE1.KMODEL(1) = IMODEL
  151. ELSE
  152. IPMOD1 = IPMODE
  153. ENDIF
  154.  
  155. CALL REDUAF(IPCHEL,IPMOD1,IPCHE1,0,IRET,KERRE)
  156. IF (IRET.NE.1) THEN
  157. CALL ERREUR(KERRE)
  158. GOTO 9999
  159. ENDIF
  160.  
  161. C Verification du lieu support du MCHAML de caracteristiques
  162. ISUPC1 = 0
  163. CALL QUESUP(IPMOD1,IPCHE1,ISUPC,0,ISUPC1,IRET)
  164. IF (ISUPC1.GT.1) GOTO 9999
  165. C Reactivation du modele elementaire (desactive dans REDUAF)
  166. SEGACT,IMODEL
  167. IF (ITHHY.NE.0) THEN
  168. CALL THCAPA1(IMODEL,IPCHE1,ISUPC1, IPRIGI)
  169. C ELSE IF (IDIFF.NE.0.OR.IELEC.NE.0) THEN
  170. C CALL CAPAED(IMODEL,IPCHE1,ISUPC1, IPRIGI)
  171. ELSE
  172. CALL CAPA1(IMODEL,IPCHE1,ISUPC1, ITABL,IPRIGI)
  173. ENDIF
  174.  
  175.  
  176. 1 CONTINUE
  177. SEGDES,IMODEL
  178. IF (IERR.NE.0) GOTO 9999
  179.  
  180. IF (NB1.GT.1) THEN
  181. SEGDES,MMODE1
  182. ENDIF
  183. ENDDO
  184.  
  185. NRIGEL = IRIGEL(/2)
  186. IF (NRIGEL.EQ.0) THEN
  187. CALL ERREUR(19)
  188. ENDIF
  189. 9999 CONTINUE
  190. IF (IERR.NE.0) THEN
  191. SEGSUP,MRIGID
  192. ELSE
  193. SEGDES,MRIGID
  194. CALL ECROBJ('RIGIDITE',IPRIGI)
  195. ENDIF
  196.  
  197. SEGDES,MMODEL
  198. C
  199. RETURN
  200. END
  201.  
  202.  
  203.  
  204.  

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