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

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