Télécharger capa.eso

Retour à la liste

Numérotation des lignes :

capa
  1. C CAPA SOURCE FANDEUR 22/01/03 21:15:04 11237
  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. IFORIG = IFOUR
  113. ISUPEQ = 0
  114. IPRIGI = MRIGID
  115. C =====
  116. C 3.2 - Remplissage de la matrice pour chaque modele concerne
  117. C =====
  118. MMODEL=IPMODE
  119. SEGACT,MMODEL
  120. NB1 = KMODEL(/1)
  121. N1 = 1
  122.  
  123. DO 10 IA = 1, NB1
  124. IMODEL = KMODEL(IA)
  125. SEGACT,IMODEL
  126. C ITHER = 0
  127. ITHHY = 0
  128. C IDIFF = 0
  129. C IELEC = 0
  130. IF (FORMOD(1).EQ.'THERMIQUE') THEN
  131. do iyu=1,matmod(/2)
  132. if( matmod(iyu).eq.'CONVECTION' ) GOTO 1
  133. if( matmod(iyu).eq.'RAYONNEMENT') GOTO 1
  134. enddo
  135. C ITHER = 1
  136. ISUPC = 6
  137. ELSE IF (FORMOD(1).EQ.'THERMOHYDRIQUE') THEN
  138. ITHHY = 1
  139. ISUPC = 6
  140. ELSE IF (FORMOD(1).EQ.'DIFFUSION') THEN
  141. C IDIFF = 1
  142. ISUPC = 6
  143. C* ELSE IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN
  144. C* IELEC = 1
  145. C* ISUPC = 4
  146. ELSE
  147. C SEGDES,IMODEL
  148. GOTO 10
  149. ENDIF
  150.  
  151. IF (NB1.GT.1) THEN
  152. SEGINI,MMODE1
  153. IPMOD1 = MMODE1
  154. MMODE1.KMODEL(1) = IMODEL
  155. ELSE
  156. IPMOD1 = IPMODE
  157. ENDIF
  158.  
  159. CALL ACTOBJ('MCHAML ',IPCHEL,1)
  160. CALL REDUAF(IPCHEL,IPMOD1,IPCHE1,0,IRET,KERRE)
  161. IF (IRET.NE.1) THEN
  162. CALL ERREUR(KERRE)
  163. GOTO 9999
  164. ENDIF
  165.  
  166. C Verification du lieu support du MCHAML de caracteristiques
  167. ISUPC1 = 0
  168. CALL QUESUP(IPMOD1,IPCHE1,ISUPC,0,ISUPC1,IRET)
  169. IF (ISUPC1.GT.1) GOTO 9999
  170. C Reactivation du modele elementaire (desactive dans REDUAF)
  171. C SEGACT,IMODEL
  172. IF (ITHHY.NE.0) THEN
  173. CALL THCAPA1(IMODEL,IPCHE1,ISUPC1, IPRIGI)
  174. C ELSE IF (IDIFF.NE.0.OR.IELEC.NE.0) THEN
  175. C CALL CAPAED(IMODEL,IPCHE1,ISUPC1, IPRIGI)
  176. ELSE
  177. CALL CAPA1(IMODEL,IPCHE1,ISUPC1, ITABL,IPRIGI)
  178. ENDIF
  179.  
  180.  
  181. 1 CONTINUE
  182. C SEGDES,IMODEL
  183. IF (IERR.NE.0) GOTO 9999
  184.  
  185. C IF (NB1.GT.1) THEN
  186. C SEGDES,MMODE1
  187. C ENDIF
  188. 10 CONTINUE
  189.  
  190. NRIGEL = IRIGEL(/2)
  191. IF (NRIGEL.EQ.0) THEN
  192. CALL ERREUR(19)
  193. ENDIF
  194. 9999 CONTINUE
  195. IF (IERR.NE.0) THEN
  196. SEGSUP,MRIGID
  197. ELSE
  198. SEGDES,MRIGID
  199. CALL ECROBJ('RIGIDITE',IPRIGI)
  200. ENDIF
  201.  
  202. END
  203.  
  204.  
  205.  
  206.  
  207.  

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