Télécharger capa7.eso

Retour à la liste

Numérotation des lignes :

  1. C CAPA7 SOURCE FANDEUR 13/01/16 21:15:02 7666
  2.  
  3. C=======================================================================
  4. C= C A P A 7 =
  5. C= --------- =
  6. C= =
  7. C= Fonction : =
  8. C= ---------- =
  9. C= Creation d'un champ par element (MCHAML) contenant les valeurs de =
  10. C= la capacite calorifique equivalente en cas de changement de phase =
  11. C= =
  12. C= Parametres : (E)=Entree (S)=Sortie =
  13. C= ------------ =
  14. C= ITAPHA (E) Table =
  15. C= IPOGEO (E) Maillage ELEMENTAIRE (MELEME) (ACTIF) =
  16. C= ICOQ (E) Non nul si element COQUE, =0 sinon =
  17. C= IPINTE (E) Segment SMINTE de l'element fini (ACTIF) =
  18. C= ICHPHA (S) MCHAML de capacite due au changement de phase =
  19. C=======================================================================
  20.  
  21. SUBROUTINE CAPA7 (ITAPHA,IPOGEO,ICOQ,IPINTE, ICHPHA)
  22.  
  23. IMPLICIT INTEGER(I-N)
  24. IMPLICIT REAL*8 (A-H,O-Z)
  25.  
  26. -INC CCOPTIO
  27.  
  28. -INC SMCHAML
  29. -INC SMCHPOI
  30. -INC SMCOORD
  31. -INC SMELEME
  32. -INC SMINTE
  33.  
  34. SEGMENT MTRI
  35. INTEGER NPAKET(NX)
  36. REAL*8 TEMPER(NX,2)
  37. INTEGER IPCHPT(2)
  38. ENDSEGMENT
  39.  
  40. LOGICAL L0
  41.  
  42. PARAMETER ( Epsi = 1.D-5,
  43. & XZero = 0.D0, XUn = 1.D0, X1s2 = 0.5D0 ,
  44. & X1s3 = 0.333333333333333333333333333333333333D0 )
  45.  
  46. CHARACTER*4 LNOCO(3)
  47. DATA LNOCO / 'TSUP','TINF','T ' /
  48.  
  49. ICHPHA = 0
  50.  
  51. C ===
  52. C 1 - Recuperation/Verification sur les donnees du changement de phase
  53. C ===
  54. C CLAT Chaleur latente du changement de phase (FLOTTANT)
  55. C TPHA1 Temperature 1 du changement de phase (FLOTTANT)
  56. C TPHA2 Temperature 2 du changement de phase (FLOTTANT)
  57. C IPCHP1 Champ de temperatures au pas (CHPOINT)
  58. C IPCHP2 Champ de temperatures au pas N + 1 (CHPOINT)
  59. I0 = 0
  60. X0 = XZero
  61. IP0 = 0
  62. L0 = .FALSE.
  63. CALL ACCTAB(ITAPHA,'MOT ',I0,X0 ,'CHALEUR LATENTE',L0,IP0,
  64. & 'FLOTTANT',I0,CLAT,' ' ,L0,IP0)
  65. CALL ACCTAB(ITAPHA,'MOT ',I0,X0 ,'TPHASE 1',L0,IP0,
  66. & 'FLOTTANT',I0,TPHA1,' ' ,L0,IP0)
  67. CALL ACCTAB(ITAPHA,'MOT ',I0,X0 ,'TPHASE 2',L0,IP0,
  68. & 'FLOTTANT',I0,TPHA2,' ' ,L0,IP0)
  69. CALL ACCTAB(ITAPHA,'MOT ',I0,X0,'CHAMP THERMIQUE 1',L0,IP0,
  70. & 'CHPOINT ',I0,X0,' ' ,L0,IPCHP1)
  71. CALL ACCTAB(ITAPHA,'MOT ',I0,X0,'CHAMP THERMIQUE 2',L0,IP0,
  72. & 'CHPOINT ',I0,X0,' ' ,L0,IPCHP2)
  73. IF (IERR.NE.0) RETURN
  74. TF1 = MIN(TPHA1,TPHA2)
  75. TF2 = MAX(TPHA1,TPHA2)
  76. DTF21 = TF2 - TF1
  77. IF (DTF21.LT.Epsi) THEN
  78. CALL ERREUR(511)
  79. RETURN
  80. ENDIF
  81. DHDTF = SIGN(XUn,(TPHA2-TPHA1)) * CLAT / DTF21
  82. C ===
  83. C 2 - Informations sur le maillage considere (IPOGEO)
  84. C ===
  85. IPT1 = IPOGEO
  86. c* SEGACT,IPT1
  87. NBNN1 = IPT1.NUM(/1)
  88. NBELE1 = IPT1.NUM(/2)
  89. C ===
  90. C 3 - Informations sur le support d'integration (MINTE)
  91. C ===
  92. MINTE = IPINTE
  93. c* SEGACT,MINTE
  94. NBPGAU = POIGAU(/1)
  95. C ===
  96. C 4 - Initialisation et remplissage du segment de travail MTRI
  97. C ===
  98. NX = XCOOR(/1)/(IDIM+1)
  99. SEGINI,MTRI
  100. C- NPAKET(Noeud) = 1 si Noeud est dans le maillage IPOGEO
  101. DO iElt = 1, NBELE1
  102. DO iNoe = 1, NBNN1
  103. MTRI.NPAKET(IPT1.NUM(iNoe,iElt)) = 1
  104. ENDDO
  105. ENDDO
  106. MTRI.IPCHPT(1) = IPCHP1
  107. MTRI.IPCHPT(2) = IPCHP2
  108. C- Recherche de la temperature nodale en debut et fin de pas
  109. C- pour chaque noeud du maillage IPOGEO.
  110. C- Dans le cas des elements COQUEs, la temperature nodale est la
  111. C- moyenne des temperatures T, TSUP et TINF.
  112. C- Si le noeud du maillage IPOGEO n'est pas dans le support des
  113. C- champs de temperatures, sa temperature est arbitrairement nulle.
  114. DO icht = 1, 2
  115. MCHPOI = MTRI.IPCHPT(icht)
  116. SEGACT,MCHPOI
  117. NSOUPO = IPCHP(/1)
  118. DO iSoupo = 1, NSOUPO
  119. MSOUPO = IPCHP(iSoupo)
  120. SEGACT,MSOUPO
  121. CALL PLACE(NOCOMP,NOCOMP(/1),indT,LNOCO(3))
  122. IF (indT.EQ.0) GOTO 10
  123. C- Verification sur les composantes du CHPOINT pour les coques
  124. IF (ICOQ.NE.0) THEN
  125. CALL PLACE(NOCOMP,NOCOMP(/1),indTI,LNOCO(2))
  126. CALL PLACE(NOCOMP,NOCOMP(/1),indTS,LNOCO(1))
  127. IF (indTI.EQ.0 .OR. indTS.EQ.0) THEN
  128. MOTERR(1:4) = LNOCO(1)
  129. IF (indTI.EQ.0) MOTERR(1:4) = LNOCO(2)
  130. CALL ERREUR(181)
  131. GOTO 999
  132. ENDIF
  133. ENDIF
  134. MELEME = IGEOC
  135. SEGACT,MELEME
  136. MPOVAL = IPOVAL
  137. SEGACT,MPOVAL
  138. DO iElt = 1, NUM(/2)
  139. j = NUM(1,iElt)
  140. IF (MTRI.NPAKET(j).NE.0) THEN
  141. MTRI.TEMPER(j,icht) = VPOCHA(iElt,indT)
  142. IF (ICOQ.NE.0) THEN
  143. MTRI.TEMPER(j,icht) = X1s3 *
  144. & ( MTRI.TEMPER(j,icht) + VPOCHA(iELT,indTI)
  145. & + VPOCHA(iELT,indTS) )
  146. ENDIF
  147. ENDIF
  148. ENDDO
  149. SEGDES,MPOVAL
  150. SEGDES,MELEME
  151. 10 CONTINUE
  152. SEGDES,MSOUPO
  153. ENDDO
  154. SEGDES,MCHPOI
  155. ENDDO
  156.  
  157. C ===
  158. C 5 - Determination du MCHAML de capacite calorifique du changement
  159. C de phase (terme de chaleur latente)
  160. C ===
  161. N2 = 1
  162. SEGINI,MCHAML
  163. NOMCHE(1) = 'C '
  164. TYPCHE(1) = 'REAL*8'
  165. N1PTEL = NBPGAU
  166. N1EL = NBELE1
  167. N2PTEL = 0
  168. N2EL = 0
  169. SEGINI,MELVAL
  170. IELVAL(1) = MELVAL
  171. C- Remplissage du segment MELVAL pour chaque point de Gauss (iGau) de
  172. C- chacun des elements (iElt) du maillage
  173. DO iElt = 1, NBELE1
  174. DO iGau = 1, NBPGAU
  175. C- Calcul des temperatures T1 et T2 au point de Gauss (iGau)
  176. T1 = XZero
  177. T2 = XZero
  178. DO iNoe = 1, NBNN1
  179. j = IPT1.NUM(iNoe,iElt)
  180. T1 = T1 + MTRI.TEMPER(j,1)*SHPTOT(1,iNoe,iGau)
  181. T2 = T2 + MTRI.TEMPER(j,2)*SHPTOT(1,iNoe,iGau)
  182. ENDDO
  183. C- Calcul du terme de capactite calorifique du au changement de phase
  184. C- (s'il y a lieu)
  185. IF (.NOT.(((T1.LE.TF1).AND.(T2.LE.TF1)).OR.
  186. & ((T1.GE.TF2).AND.(T2.GE.TF2)))) THEN
  187. IF (T1.NE.T2) THEN
  188. DT21 = T2 - T1
  189. DTEFF = X1s2 * (DTF21+DT21-ABS(TF2-T2)-ABS(T1-TF1))
  190. VELCHE(iGau,iElt) = DHDTF * DTEFF / ABS(DT21)
  191. ELSE
  192. VELCHE(iGau,iElt) = DHDTF
  193. ENDIF
  194. c* ELSE
  195. c* VELCHE(iGau,iElt) = XZero
  196. ENDIF
  197. ENDDO
  198. ENDDO
  199. SEGDES,MELVAL,MCHAML
  200. ICHPHA = MCHAML
  201.  
  202. C ===
  203. C 6 - MENAGE : Desactivation des segments utilises et crees
  204. C ===
  205. 999 CONTINUE
  206. SEGSUP,MTRI
  207. c* SEGDES,IPT1
  208. c* SEGDES,MINTE
  209.  
  210. RETURN
  211. END
  212.  
  213.  
  214.  
  215.  

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