Télécharger capac1.eso

Retour à la liste

Numérotation des lignes :

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

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