Télécharger capaba.eso

Retour à la liste

Numérotation des lignes :

capaba
  1. C CAPABA SOURCE CB215821 17/01/16 21:15:07 9279
  2.  
  3. C=======================================================================
  4. C= C A P A N U =
  5. C= ----------- =
  6. C= =
  7. C= Fonction : =
  8. C= ---------- =
  9. C= Calcul de la matrice de CAPACITE CALORIFIQUE d'un element BARRe =
  10. C= =
  11. C= Parametres : (E)=Entree (S)=Sortie =
  12. C= ------------ =
  13. C= IMAIL (E) Numero du segment IMODEL dans le segment MMODEL =
  14. C= IPCHA1 (E) Pointeur sur un segment MCHEL1 de CARACTERISTIQUES =
  15. C= CLAT (E) Chaleur latente du changement de phase =
  16. C= TPHA1 (E) Temperature 1 de changement de phase =
  17. C= TPHA2 (E) Temperature 2 de changement de phase =
  18. C= IPVAL1 (E) CHAMELEM de temperatures au pas N =
  19. C= IPVAL2 (E) CHAMELEM de temperatures au pas N + 1 =
  20. C= IPRIGI (E/S) Pointeur sur l'objet RIGIDITE (CAPACITE) (ACTIF) =
  21. C= =
  22. C= Denis ROBERT, le 15 fevrier 1988. =
  23. C=======================================================================
  24.  
  25. SUBROUTINE CAPABA (NEF,IPMAIL,IPINTE,IVAMAT,NVAMAT,IVAPHA,NVAPHA,
  26. & IPMATR,NLIGR,INFOR)
  27.  
  28. IMPLICIT INTEGER(I-N)
  29. IMPLICIT REAL*8 (A-H,O-Z)
  30.  
  31.  
  32. -INC PPARAM
  33. -INC CCOPTIO
  34. -INC CCREEL
  35. -INC CCHAMP
  36.  
  37. -INC SMCOORD
  38. -INC SMINTE
  39. -INC SMRIGID
  40. -INC SMELEME
  41. -INC SMCHAML
  42.  
  43. CHARACTER*16 MOFOR
  44. INTEGER INFOR
  45.  
  46. SEGMENT MMAT1
  47. REAL*8 CAP(NLIGR,NLIGR),XE(3,NBNN)
  48. REAL*8 SHP(6,NBNN),FORME(NBNN)
  49. ENDSEGMENT
  50.  
  51. SEGMENT MPTVAL
  52. INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU)
  53. CHARACTER*16 TYVAL(NCOSOU)
  54. ENDSEGMENT
  55.  
  56. SEGMENT SVACOM
  57. REAL*8 VACOMP(NVAMAT)
  58. ENDSEGMENT
  59.  
  60. SEGINI,SVACOM
  61.  
  62. C* IF (NEF.NE.46) CALL ERREUR(5)
  63. IF (IFOMOD.NE.-1 .AND. IFOMOD.NE.2.and.ifomod.ne.0) THEN
  64. CALL ERREUR(251)
  65. RETURN
  66. ENDIF
  67. IFIN = IDIM+1
  68.  
  69. C 1 - INITIALISATIONS ET VERIFICATIONS
  70. C ======================================
  71. MELEME = IPMAIL
  72. c* SEGACT,MELEME
  73. NBNN = NUM(/1)
  74. NBELEM = NUM(/2)
  75. C =====
  76. MINTE = IPINTE
  77. c* SEGACT,MINTE
  78. NBPGAU = POIGAU(/1)
  79. C =====
  80. c* MPTVAL = IVAMAT
  81. c* SEGACT,MPTVAL
  82. c* IF (IVAPHA.NE.0) THEN
  83. c* MPTVAL = IVAPHA
  84. c* SEGACT,MPTVAL
  85. c* ENDIF
  86. C =====
  87. XMATRI = IPMATR
  88. c* SEGACT,XMATRI*MOD
  89. c* NLIGRP = NLIGR
  90. c* NLIGRD = NLIGR
  91. C =====
  92. SEGINI,MMAT1
  93.  
  94. C 2 - BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IPMAIL
  95. C ============================================================
  96. DO iElt = 1, NBELEM
  97. C =====
  98. C 2.1 - Mise a zero de la matrice de CAPACITE de l'element iElt
  99. C =====
  100. CALL ZERO(CAP,NLIGR,NLIGR)
  101. C =====
  102. C 2.2 - Recuperation des coordonnees GLOBALES des noeuds de l'element
  103. C =====
  104. CALL DOXE(XCOOR,IDIM,NBNN,NUM,iElt,XE)
  105. C =====
  106. C 2.3 - Boucle sur les points de Gauss de l'element iElt
  107. C =====
  108. iFois=0
  109. DO iGau = 1, NBPGAU
  110. C- Calcul du jacobien, des fonctions de forme et de leurs derivees
  111. C- au point de Gauss iGau
  112. DO j = 1, NBNN
  113. FORME(j) = SHPTOT(1,j,iGau)
  114. DO i = 1, IFIN
  115. SHP(i,j) = SHPTOT(i,j,iGau)
  116. ENDDO
  117. ENDDO
  118. CALL TCONV4(XE,SHP,IDIM,NBNN,DJAC)
  119. IF (IERR.NE.0) GOTO 9990
  120. IF (DJAC.LT.XZero) iFois=iFois+1
  121. DJAC = ABS(DJAC)
  122. C- Erreur si le jacobien est nul en ce point de Gauss
  123. IF (DJAC.LT.XPetit) THEN
  124. INTERR(1) = iElt
  125. CALL ERREUR(259)
  126. GOTO 9990
  127. ENDIF
  128.  
  129. C- Calcul du terme Rho.Cp.Vol.Se en ce point de Gauss pour la THERMIQUE
  130. MPTVAL = IVAMAT
  131. DO i = 1, NVAMAT
  132. MELVAL = IVAL(i)
  133. IGMN = MIN(iGau,VELCHE(/1))
  134. IEMN = MIN(iElt,VELCHE(/2))
  135. VACOMP(i) = VELCHE(IGMN,IEMN)
  136. ENDDO
  137. VALRHO = VACOMP(1)
  138.  
  139. C CAS THERMIQUE on fait RHO.CP
  140. IF (INFOR .EQ. 1) VACOMP(1) = VALRHO * VACOMP(2)
  141.  
  142. C- Erreur si la section d'un element BARRe est nulle
  143. SE = VACOMP(NVAMAT)
  144. IF (SE.LE.XPetit) THEN
  145. CALL ERREUR(517)
  146. GOTO 9990
  147. ENDIF
  148. CAPA = SE * DJAC * POIGAU(iGau) * VACOMP(1)
  149. C- Calcul de la contribution du point de Gauss a la matrice CAPACITE
  150. C- elementaire pour cet element fini
  151. CALL NTNST(FORME,CAPA,NBNN,1,CAP)
  152.  
  153. C =======
  154. ENDDO
  155. C =====
  156. C 2.4 - Erreur si, en un point de Gauss, le jacobien change de signe
  157. C =====
  158. IF (iFois.NE.0.AND.iFois.NE.NBPGAU) THEN
  159. INTERR(1) = iElt
  160. CALL ERREUR(195)
  161. GOTO 9990
  162. ENDIF
  163. C =====
  164. C 2.5 - Stockage de la matrice de CAPACITE pour cet element fini
  165. C (remplissage de XMATRI)
  166. C =====
  167. CALL REMPMT(CAP,NLIGR,RE(1,1,iElt))
  168. ENDDO
  169.  
  170. C 3 - MENAGE : DESACTIVATION/DESTRUCTION DE SEGMENTS
  171. C ====================================================
  172. 9990 CONTINUE
  173. SEGSUP,MMAT1,SVACOM
  174. c* SEGDES,MELEME,MINTE,XMATRI
  175. c* MPTVAL = IVAMAT
  176. c* SEGDES,MPTVAL
  177. c* IF (IVAPHA.NE.0) THEN
  178. c* MPTVAL = IVAPHA
  179. c* SEGDES,MPTVAL
  180. c* ENDIF
  181.  
  182. RETURN
  183. END
  184.  
  185.  
  186.  
  187.  
  188.  
  189.  

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