Sources Esope | Cast3M

capanu
C CAPANU    SOURCE    CB215821  18/09/13    21:15:07     9917           
 
C=======================================================================
C=                            C A P A N U                              =
C=                            -----------                              =
C=                                                                     =
C=  Fonction :                                                         =
C=  ----------                                                         =
C=  Calcul de la matrice de CAPACITE CALORIFIQUE pour EF MASSIF        =
C=                                                                     =
C=  Parametres :  (E)=Entree  (S)=Sortie                               =
C=  ------------                                                       =
C=   NEF      (E)   Numero de l'ELEMENT FINI dans NOMTP (cf. CCHAMP)   =
C=   IPMAIL   (E)   Numero du segment MELEME dans le segment MMODEL    =
C=   IPMODL   (E)   Pointeur sur un segment IMODEL             (ACTIF) =
C=   IPCHA1   (E)   Pointeur sur un segment MCHELM de CARACTERISTIQUES =
C=   IPRIGI  (E/S)  Pointeur sur l'objet RIGIDITE (CAPACITE)   (ACTIF) =
C=                                                                     =
C=  Variables locales :                                                =
C=  -------------------                                                =
C=   NBNN            Nombre de NOEUDS dans l'element considere         =
C=   NbElem          Nombre d'ELEMENTS dans le maillage elementaire    =
C=   NBPGAU          Nombre de points de Gauss de l'element fini       =
C=   CAP(NBNN,NBNN)  Matrice de CAPACITE ELEMENTAIRE                   =
C=   XE(3,NBNN)      Coordonnees GLOBALES des noeuds de l'ELEMENT      =
C=   SHP(6,NBNN)     Tableau de TRAVAIL                                =
C=   FORME(NBNN)     Fonctions de FORME                                =
C=   VACOMP          Valeurs des composantes recherchees               =
C=                                                                     =
C=  Denis ROBERT, le 15 fevrier 1988.                                  =
C=======================================================================
 
      SUBROUTINE CAPANU (NEF,IPMAIL,IPINTE,IVAMAT,NVAMAT,IVAPHA,NVAPHA,
     &                   IPMATR,NLIGR,INFOR)
 
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC CCREEL
 
-INC SMCHAML
-INC SMCOORD
-INC SMELEME
-INC SMINTE
-INC SMRIGID
 
      CHARACTER*16 MOFOR
 
      SEGMENT MPTVAL
        INTEGER IPOS(NS),NSOF(NS),IVAL(NCOSOU)
        CHARACTER*16 TYVAL(NCOSOU)
      ENDSEGMENT
 
      SEGMENT MMAT1
        REAL*8 CAP(NLIGR,NLIGR),XE(3,NBNN)
        REAL*8 SHP(6,NBNN),FORME(NBNN)
      ENDSEGMENT
 
      SEGMENT SVACOM
        REAL*8 VACOMP(NVAMAT)
      ENDSEGMENT
 
      SEGINI,SVACOM
 
C  1 - INITIALISATIONS ET VERIFICATIONS
C ======================================
      MINTE = IPINTE
C*      SEGACT,MINTE
      NBPGAU = POIGAU(/1)
C =====
      MELEME = IPMAIL
C*      SEGACT,MELEME
      NBNN   = NUM(/1)
      NBELEM = NUM(/2)
C =====
      MPTVAL = IVAMAT
c*      SEGACT,MPTVAL
      IF (IVAPHA.NE.0) THEN
        MPTVAL = IVAPHA
c*        SEGACT,MPTVAL
      ENDIF
C =====
      XMATRI = IPMATR
C*      SEGACT,XMATRI*MOD
C =====
      SEGINI,MMAT1
 
C  2 - BOUCLE SUR LES ELEMENTS DU MAILLAGE ELEMENTAIRE IPMAIL
C ============================================================
      DO iElt = 1, NBELEM
C =====
C  2.1 - Mise a zero de la matrice de CAPACITE de l'element iElt
C =====
        CALL ZERO(CAP,NLIGR,NLIGR)
C =====
C  2.2 - Recuperation des coordonnees GLOBALES des noeuds de l'element
C =====
        CALL DOXE(XCOOR,IDIM,NBNN,NUM,iElt,XE)
C =====
C  2.3 - Boucle sur les points de Gauss de l'element iElt
C =====
        iFois=0
        DO iGau = 1, NBPGAU
C =======
C  2.3.1 - Calcul du jacobien, des fonctions de forme et de leurs
C          derivees au point de Gauss iGau
C =======
          CALL CAPA4(0,iGau,NBNN,XE,SHPTOT,SHP,FORME,DJAC)
C          IF (IERR.NE.0) GOTO 9990
          IF (DJAC.LT.XZero) iFois=iFois+1
          DJAC = ABS(DJAC)
C =======
C  2.3.2 - Erreur si le jacobien est nul en ce point de Gauss
C =======
          IF (DJAC.LT.XPetit) THEN
            INTERR(1) = iElt
            CALL ERREUR(259)
            GOTO 9990
          ENDIF
C =======
C  2.3.3 - Calcul du terme Rho.Cp.Vol en ce point de Gauss avec prise
C          en compte d'un eventuel changement de phase et de la section
C          dans le cas d'un element BARRe (erreur si celle-ci est nulle)
C =======
 
C          MPTVAL = IVAMAT
          DO i = 1, NVAMAT
            MELVAL = IVAL(i)
            IGMN = MIN(iGau,VELCHE(/1))
            IEMN = MIN(iElt,VELCHE(/2))
            VACOMP(i) = VELCHE(IGMN,IEMN)
          ENDDO
          VALRHO = VACOMP(1)
 
C         CAS THERMIQUE on fait RHO.CP
          IF (INFOR .EQ. 1) VACOMP(1) = VALRHO * VACOMP(2)
 
          CAPA = DJAC * POIGAU(iGau) * VACOMP(1)
C =======
C  2.3.4 - Calcul de la contribution du point de Gauss a la matrice
C          CAPACITE elementaire pour cet element fini
C =======
          CALL NTNST(FORME,CAPA,NLIGR,1,CAP)
        ENDDO
C =====
C  2.4 - Erreur si, en un point de Gauss, le jacobien change de signe
C =====
        IF (iFois.NE.0.AND.iFois.NE.NBPGAU) THEN
          INTERR(1) = iElt
          CALL ERREUR(195)
          GOTO 9990
        ENDIF
C =====
C  2.5 - Stockage de la matrice de CAPACITE pour cet element fini
C        (remplissage de XMATRI)
C =====
        CALL REMPMT(CAP,NLIGR,RE(1,1,iElt))
C
      ENDDO
 
C  3 - MENAGE : DESACTIVATION/DESTRUCTION DE SEGMENTS
C ====================================================
 9990 CONTINUE
      SEGSUP,MMAT1,SVACOM
 
      RETURN
      END