Télécharger la plaquette Cast3M


fr en

Télécharger capac2.eso

Retour à la liste

Numérotation des lignes : 

capac2

  1. C CAPAC2    SOURCE    OF166741  25/02/21    21:15:22     12166          
  2.  
  3. C=======================================================================
  4. C=                            C A P A C 2                              =
  5. C=                            -----------                              =
  6. C=                                                                     =
  7. C=  Fonction :                                                         =
  8. C=  ----------                                                         =
  9. C=   Calcul de la matrice de CAPACITE CALORIFIQUE pour les elements    =
  10. C=   finis COQUEs de type COQ4, COQ6 et COQ8                           =
  11. C=                                                                     =
  12. C=  Parametres :  (E)=Entree  (S)=Sortie                               =
  13. C=  ------------                                                       =
  14. C=   NEF      (E)    Numero de l'ELEMENT FINI dans NOMTP (cf. CCHAMP)  =
  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 resultat              (ACTIF) =
  19. C=                                                                     =
  20. C=  P. DOWLATYARI, aout 1990.                                          =
  21. C=======================================================================
  22.  
  23.       SUBROUTINE CAPAC2 (NEF,IPMAIL,IPINT1,IPINT2,IVAMAT,NVAMAT,
  24.      &                   IVAPHA,NVAPHA, IPMATR,NLIGR,INFOR)
  25.  
  26.       IMPLICIT INTEGER(I-N)
  27.       IMPLICIT REAL*8 (A-H,O-Z)
  28.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC CCREEL
  32. -INC CCHAMP
  33.  
  34. -INC SMCHAML
  35. -INC SMCOORD
  36. -INC SMELEME
  37. -INC SMINTE
  38. -INC SMRIGID
  39.  
  40. -INC TMPTVAL
  41.  
  42.       SEGMENT MMAT1
  43.         REAL*8 XE(3,NBNN),CAPSS(NBNN,NBNN),CAPV(NLIGR,NLIGR)
  44.         REAL*8 TXR(3,3,NBNN),EXC(NBNN),FORME(NBNN)
  45.         REAL*8 VACOMP(NBPGAU),EP(NBPGAU)
  46.         REAL*8 VACOMG(NVAMAT)
  47.       ENDSEGMENT
  48.  
  49.       CHARACTER*16 MOFOR
  50.  
  51.       DIMENSION XJ(3,3)
  52.  
  53. C= Coefficients d'integration dans l'epaisseur (Degay 04/95)
  54.       PARAMETER (X1s15=0.066666666666666666666666666667D0)
  55.       PARAMETER (X2s15=0.133333333333333333333333333333D0)
  56.       PARAMETER (X8s15=0.533333333333333333333333333333D0)
  57.       PARAMETER (Xm1s30=-0.033333333333333333333333333333D0)
  58.       DATA Coef11,Coef12,Coef13 /  X2s15 , X1s15 , Xm1s30 /
  59.       DATA Coef21,Coef22,Coef23 /  X1s15 , X8s15 ,  X1s15 /
  60.       DATA Coef31,Coef32,Coef33 / Xm1s30 , X1s15 ,  X2s15 /
  61.  
  62. C  1 - INITIALISATIONS ET VERIFICATIONS
  63. C ======================================
  64.       MELEME = IPMAIL
  65. c*      SEGACT,MELEME
  66.       NBNN   = NUM(/1)
  67.       NBELEM = NUM(/2)
  68.       NBNN2 = 2*NBNN
  69.       NBNN3 = 3*NBNN
  70. C =====
  71.       MINTE1 = IPINT1
  72.       SEGACT,MINTE1
  73.       NBPGAU = MINTE1.POIGAU(/1)
  74. C =====
  75.       MINTE2 = IPINT2
  76.       SEGACT,MINTE2
  77. C =====
  78.       MPTVAL = IVAMAT
  79. c*      SEGACT,MPTVAL
  80. c*C- Verification sur la constance du champ d'epaisseur :
  81. c*C- epaisseur toujours placee en derniere position du mptval
  82. c*      IPMELV = IVAL(NVAMAT)
  83. c*      CALL QUELCH(IPMELV,IOK)
  84. c*      IF (IOK.NE.0) THEN
  85. c*        CALL ERREUR(566)
  86. c*        GOTO 9990
  87. c*      ENDIF
  88. C =====
  89. c*      IF (IVAPHA.NE.0) THEN
  90. c*        MPTVAL = IVAPHA
  91. c*        SEGACT,MPTVAL
  92. c*      ENDIF
  93. C =====
  94.       xMATRI = IPMATR
  95. c*      SEGACT,XMATRI*MOD
  96. c*      NLIGRP = NBNN3 = NLIGR
  97. c*      NLIGRD = NBNN3 = NLIGR
  98. C =====
  99.       SEGINI,MMAT1
  100.  
  101.       E3 = XZERO
  102.  
  103. C  2 - BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IPMAIL
  104. C ============================================================
  105.       DO iElt = 1, NBELEM
  106. C =====
  107. C  2.1 - Recuperation des coordonnees GLOABLES des noeuds de l'element
  108. C =====
  109.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,iElt,XE)
  110. C =====
  111. C  2.2 - Calcul des axes locaux lies a l'element COQUE pour tous les
  112. C        noeuds de l'element fini
  113. C =====
  114.         CALL CQ8LOC(XE,NBNN,MINTE2.SHPTOT,TXR,iOK)
  115.         IF (iOK.EQ.0) THEN
  116.           CALL ERREUR(515)
  117.           GOTO 9990
  118.         ENDIF
  119. C =====
  120. C  2.3 - Recuperation des caracteristiques materielles pour tous les
  121. C        points de Gauss de l'element (avec calcul du terme Rho.Cp.Vol
  122. C        et prise en compte d'un eventuel changement de phase)
  123. C =====
  124.         DO iGau = 1, NBPGAU
  125. C          MPTVAL = IVAMAT
  126.           DO i = 1, NVAMAT
  127.             MELVAL = IVAL(i)
  128.             IGMN = MIN(iGau,VELCHE(/1))
  129.             IEMN = MIN(iElt,VELCHE(/2))
  130.             VACOMG(i) = VELCHE(IGMN,IEMN)
  131.           ENDDO
  132.           VALRHO = VACOMG(1)
  133.  
  134. C         CAS THERMIQUE on fait RHO.CP
  135.           IF (INFOR .EQ. 1) VACOMG(1) = VALRHO * VACOMG(2)
  136.  
  137.           VACOMP(iGau) = VACOMG(1)
  138.           EP(iGau)     = VACOMG(NVAMAT)
  139.         ENDDO
  140. C =====
  141. C  2.4 - Mise a zero de la matrice de CAPACITE de l'element iElt
  142. C =====
  143.         CALL ZERO(CAPV,NLIGR,NLIGR)
  144. C =====
  145. C  2.5 - Boucle sur les points de Gauss de l'element iElt
  146. C =====
  147.         DO iGau = 1, NBPGAU
  148. C =======
  149. C  2.5.1 - Calcul du jacobien associe a ce point de Gauss
  150. C =======
  151.           CALL CQ8JCE(iGau,NBNN,E3,XE,EP,EXC,TXR,MINTE1.SHPTOT,XJ,
  152.      &                DJAC,iOK)
  153. C =======
  154. C  2.5.2 - Erreur si le jacobien est nul en ce point de Gauss
  155. C =======
  156.           IF (iOK.LT.0) THEN
  157.             INTERR(1) = iElt
  158.             CALL ERREUR(405)
  159.             GOTO 9990
  160.           ENDIF
  161. C =======
  162. C  2.5.3 - Calcul de la contribution du point de Gauss a la matrice
  163. C          CAPACITE elementaire pour cet element fini
  164. C =======
  165.           CAPA = DJAC * minte1.POIGAU(iGau) * VACOMP(iGau)
  166.           CALL ZERO(CAPSS,NBNN,NBNN)
  167.           DO i0 = 1, NBNN
  168.             FORME(i0) = MINTE1.SHPTOT(1,i0,iGau)
  169.           ENDDO
  170.           CALL NTNST(FORME,CAPA,NBNN,1,CAPSS)
  171. C =======
  172. C  2.5.4 - Ajout de termes specifiques dus a l'integration (analytique)
  173. C          suivant l'epaisseur de l'element de type COQUE
  174. C =======
  175.           DO j0=1,NBNN
  176.             j1=j0+NBNN
  177.             j2=j1+NBNN
  178.             DO i0=1,NBNN
  179.               i1=i0+NBNN
  180.               i2=i1+NBNN
  181.               Cte=CAPSS(i0,j0)
  182.               CAPV(i0,j0)=CAPV(i0,j0) + Cte*Coef11
  183.               CAPV(i1,j0)=CAPV(i1,j0) + Cte*Coef21
  184.               CAPV(i2,j0)=CAPV(i2,j0) + Cte*Coef31
  185.               CAPV(i0,j1)=CAPV(i0,j1) + Cte*Coef12
  186.               CAPV(i1,j1)=CAPV(i1,j1) + Cte*Coef22
  187.               CAPV(i2,j1)=CAPV(i2,j1) + Cte*Coef32
  188.               CAPV(i0,j2)=CAPV(i0,j2) + Cte*Coef13
  189.               CAPV(i1,j2)=CAPV(i1,j2) + Cte*Coef23
  190.               CAPV(i2,j2)=CAPV(i2,j2) + Cte*Coef33
  191.             ENDDO
  192.           ENDDO
  193.         ENDDO
  194. C =====
  195. C  2.6 - Stockage de la matrice de CAPACITE pour cet element fini
  196. C        (remplissage de XMATRI)
  197. C =====
  198.         CALL REMPMT(CAPV,NLIGR,RE(1,1,iElt))
  199.       ENDDO
  200.  
  201. C  3 - MENAGE : DESACTIVATION/DESTRUCTION DE SEGMENTS
  202. C ====================================================
  203.  9990 CONTINUE
  204.       SEGSUP,MMAT1
  205. c*      SEGDES,MELEME,MINTE,MINTE2,XMATRI
  206. c*      MPTVAL = IVAMAT
  207. c*      SEGDES,MPTVAL
  208. c*      IF (IVAPHA.NE.0) THEN
  209. c*        MPTVAL = IVAPHA
  210. c*        SEGDES,MPTVAL
  211. c*      ENDIF
  212.  
  213.       RETURN
  214.       END
  215.  
  216.  
  217.  

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