Télécharger capac3.eso

Retour à la liste

Numérotation des lignes :

  1. C CAPAC3 SOURCE CB215821 17/01/16 21:15:10 9279
  2.  
  3. C=======================================================================
  4. C= C A P A C 3 =
  5. C= ----------- =
  6. C= =
  7. C= Fonction : =
  8. C= ---------- =
  9. C= Calcul de la matrice de CAPACITE CALORIFIQUE pour des elements de =
  10. C= COQUE TRIANGLE (COQ3) a integration semi-analytique =
  11. C= =
  12. C= Parametres : (E)=Entree (S)=Sortie =
  13. C= ------------ =
  14. C= NEF (E) Numero de l'ELEMENT FINI dans NOMTP =
  15. C= IPMAIL (E) Numero du segment IMODEL dans le segment MMODEL =
  16. C= CLAT (E) Chaleur latente du changement de phase =
  17. C= IPRIGI (E/S) Matrice de CAPACITE (RIGIDITE) resultat (ACTIF) =
  18. C=======================================================================
  19.  
  20. SUBROUTINE CAPAC3 (NEF,IPMAIL,IPINTE,IVAMAT,NVAMAT,IVAPHA,NVAPHA,
  21. & IPMATR,NLIGR,INFOR)
  22.  
  23. IMPLICIT INTEGER(I-N)
  24. IMPLICIT REAL*8 (A-H,O-Z)
  25.  
  26. -INC CCOPTIO
  27. -INC CCREEL
  28. -INC CCHAMP
  29.  
  30. -INC SMCHAML
  31. -INC SMCOORD
  32. -INC SMELEME
  33. -INC SMINTE
  34. -INC SMRIGID
  35.  
  36. CHARACTER*16 MOFOR
  37.  
  38. SEGMENT MMAT1
  39. REAL*8 XE(3,NBNN),FORME(NBNN)
  40. REAL*8 CAPSS(NBNN,NBNN),CAPV(NLIGR,NLIGR)
  41. ENDSEGMENT
  42.  
  43. SEGMENT MPTVAL
  44. INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU)
  45. CHARACTER*16 TYVAL(NCOSOU)
  46. ENDSEGMENT
  47.  
  48. C= Quelques constantes numeriques
  49. PARAMETER (X1s15=0.066666666666666666666666666667D0)
  50. PARAMETER (X2s15=0.133333333333333333333333333333D0)
  51. PARAMETER (X8s15=0.533333333333333333333333333333D0)
  52. PARAMETER (X1s30=0.033333333333333333333333333333D0)
  53.  
  54. SEGMENT SVACOM
  55. REAL*8 VACOMP(NVAMAT)
  56. ENDSEGMENT
  57.  
  58. SEGINI,SVACOM
  59.  
  60. C 1 - INITIALISATIONS ET VERIFICATIONS
  61. C ======================================
  62. MELEME = IPMAIL
  63. c* SEGACT,MELEME
  64. NBNN = NUM(/1)
  65. NBELEM = NUM(/2)
  66. NBNN2 = 2*NBNN
  67. c* NBNN3 = 3*NBNN
  68. C =====
  69. MINTE = IPINTE
  70. c* SEGACT,MINTE
  71. NBPGAU = POIGAU(/1)
  72. C =====
  73. MPTVAL = IVAMAT
  74. c* SEGACT,MPTVAL
  75. C- Test sur la constance du champ d'epaisseur : supprime
  76. c* IPMELV = IVAL(3)
  77. c* CALL QUELCH(IPMELV,IOK)
  78. c* IF (IOK.NE.0) THEN
  79. c* CALL ERREUR(566)
  80. c* GOTO 9990
  81. c* ENDIF
  82. C =====
  83. c* IF (IVAPHA.NE.0) THEN
  84. c* MPTVAL = IVAPHA
  85. c* SEGACT,MPTVAL
  86. c* ENDIF
  87. C =====
  88. XMATRI = IPMATR
  89. c* SEGACT,XMATRI*MOD
  90. c* NLIGRP = NBNN3 = NLIGR
  91. c* NLIGRD = NBNN3 = NLIGR
  92. C =====
  93. SEGINI,MMAT1
  94.  
  95. C 2 - BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IPMAIL
  96. C ============================================================
  97. DO iElt = 1, NBELEM
  98. C =====
  99. C 2.1 - Recuperation des coordonnees GLOABLES des noeuds de l'element
  100. C =====
  101. CALL ZERO(CAPV,NLIGR,NLIGR)
  102. C =====
  103. C 2.2 - Recuperation des coordonnees GLOABLES des noeuds de l'element
  104. C =====
  105. CALL DOXE(XCOOR,IDIM,NBNN,NUM,iElt,XE)
  106. C =====
  107. C 2.3 - Boucle sur les points de Gauss de l'element iElt
  108. C =====
  109. DO iGau = 1, NBPGAU
  110.  
  111. C- Calcul du volume associe a ce point de Gauss (jacobien)
  112. S1=XZero
  113. S2=XZero
  114. S3=XZero
  115. S4=XZero
  116. S5=XZero
  117. S6=XZero
  118. DO iNoe = 1, NBNN
  119. S1=S1+SHPTOT(2,iNoe,iGau)*XE(2,iNoe)
  120. S2=S2+SHPTOT(3,iNoe,iGau)*XE(3,iNoe)
  121. S3=S3+SHPTOT(3,iNoe,iGau)*XE(2,iNoe)
  122. S4=S4+SHPTOT(2,iNoe,iGau)*XE(3,iNoe)
  123. S5=S5+SHPTOT(3,iNoe,iGau)*XE(1,iNoe)
  124. S6=S6+SHPTOT(2,iNoe,iGau)*XE(1,iNoe)
  125. ENDDO
  126. SurfX=S1*S2-S3*S4
  127. SurfY=S4*S5-S2*S6
  128. SurfZ=S6*S3-S5*S1
  129. DJAC = ABS(SurfX*SurfX+SurfY*SurfY+SurfZ*SurfZ)
  130. C- Verification que le volume n'est pas nul en ce point de Gauss
  131. IF (DJAC.LT.XPETIT) THEN
  132. INTERR(1) = iElt
  133. CALL ERREUR(259)
  134. GOTO 9990
  135. ENDIF
  136. DJAC = SQRT(DJAC)
  137.  
  138. C MPTVAL = IVAMAT
  139. DO i = 1, NVAMAT
  140. MELVAL = IVAL(i)
  141. IGMN = MIN(iGau,VELCHE(/1))
  142. IEMN = MIN(iElt,VELCHE(/2))
  143. VACOMP(i) = VELCHE(IGMN,IEMN)
  144. ENDDO
  145. VALRHO = VACOMP(1)
  146.  
  147. C CAS THERMIQUE on fait RHO.CP
  148. IF (INFOR .EQ. 1) VACOMP(1) = VALRHO * VACOMP(2)
  149.  
  150. CAPA = DJAC * POIGAU(iGau) * VACOMP(1)
  151. C- Calcul de la contribution du point de Gauss a la matrice
  152. C- CAPACITE elementaire pour cet element fini
  153. CALL ZERO(CAPSS,NBNN,NBNN)
  154. do iou=1,nbnn
  155. forme(iou)=shptot(1,iou,igau)
  156. enddo
  157. CALL NTNST(FORME,CAPA,NBNN,1,CAPSS)
  158.  
  159. C- Ajout de termes specifiques dus a l'integration (analytique)
  160. C- suivant l'epaisseur de l'element de type COQUE
  161. C =======
  162. C- Erreur si l'epaisseur est est nulle
  163. EP = VACOMP(NVAMAT)
  164. c* IF (EP.LE.XPetit) THEN
  165. c* CALL ERREUR(517)
  166. c* GOTO 9990
  167. c* ENDIF
  168. C1 = X2s15*EP
  169. C2 = X1s15*EP
  170. C3 = -X1s30*EP
  171. C4 = X8s15*EP
  172. C5 = C2
  173. C6 = C1
  174. DO j=1,NBNN
  175. j1 = j + NBNN
  176. j2 = j + NBNN2
  177. DO i=1,NBNN
  178. i1 = i + NBNN
  179. i2 = i + NBNN2
  180. Cte = CAPSS(i,j)
  181. CAPV( i, j) = CAPV( i, j) + C1*Cte
  182. CAPV(i1, j) = CAPV(i1, j) + C2*Cte
  183. CAPV(i2, j) = CAPV(i2, j) + C3*Cte
  184. CAPV(i1,j1) = CAPV(i1,j1) + C4*Cte
  185. CAPV(i2,j1) = CAPV(i2,j1) + C5*Cte
  186. CAPV(i2,j2) = CAPV(i2,j2) + C6*Cte
  187. ENDDO
  188. ENDDO
  189. ENDDO
  190. C =====
  191. C 2.4 - Stockage de la matrice de CAPACITE pour cet element fini
  192. C (remplissage de XMATRI)
  193. C =====
  194. CALL REMPMT(CAPV,NLIGR,RE(1,1,iElt))
  195. ENDDO
  196.  
  197. C 3 - MENAGE : DESACTIVATION/DESTRUCTION DE SEGMENTS
  198. C ====================================================
  199. 9990 CONTINUE
  200. SEGSUP,MMAT1,SVACOM
  201. c* SEGDES,MELEME,MINTE,XMATRI
  202. c* MPTVAL = IVAMAT
  203. c* SEGDES,MPTVAL
  204. c* IF (IVAPHA.NE.0) THEN
  205. c* MPTVAL = IVAPHA
  206. c* SEGDES,MPTVAL
  207. c* ENDIF
  208.  
  209. RETURN
  210. END
  211.  
  212.  
  213.  
  214.  
  215.  

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