C CAPABA    SOURCE    PV090527  26/04/30    21:15:11     12529          

C=======================================================================
C=                            C A P A N U                              =
C=                            -----------                              =
C=                                                                     =
C=  Fonction :                                                         =
C=  ----------                                                         =
C=  Calcul de la matrice de CAPACITE CALORIFIQUE d'un element BARRe    =
C=                                                                     =
C=  Parametres :  (E)=Entree  (S)=Sortie                               =
C=  ------------                                                       =
C=   IMAIL    (E)   Numero du segment IMODEL dans le segment MMODEL    =
C=   IPCHA1   (E)   Pointeur sur un segment MCHEL1 de CARACTERISTIQUES =
C=   CLAT     (E)   Chaleur latente du changement de phase             =
C=   TPHA1    (E)   Temperature 1 de changement de phase               =
C=   TPHA2    (E)   Temperature 2 de changement de phase               =
C=   IPVAL1   (E)   CHAMELEM de temperatures au pas N                  =
C=   IPVAL2   (E)   CHAMELEM de temperatures au pas N + 1              =
C=   IPRIGI  (E/S)  Pointeur sur l'objet RIGIDITE (CAPACITE)   (ACTIF) =
C=                                                                     =
C=  Denis ROBERT, le 15 fevrier 1988.                                  =
C=======================================================================

      SUBROUTINE CAPABA (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 CCHAMP

-INC SMCOORD
-INC SMINTE
-INC SMRIGID
-INC SMELEME
-INC SMCHAML

-INC TMPTVAL

      SEGMENT MMAT1
        REAL*8 CAP(NLIGR,NLIGR),XE(3,NBNN)
        REAL*8 SHP(6,NBNN),FORME(NBNN)
        REAL*8 VACOMP(NVAMAT)
      ENDSEGMENT

      CHARACTER*16 MOFOR
      INTEGER      INFOR

C*      IF (NEF.NE.46) CALL ERREUR(5)
      IF (IFOMOD.NE.-1 .AND. IFOMOD.NE.2.and.ifomod.ne.0) THEN
        CALL ERREUR(251)
        RETURN
      ENDIF
      IFIN = IDIM+1

C  1 - INITIALISATIONS ET VERIFICATIONS
C ======================================
      MELEME = IPMAIL
c*      SEGACT,MELEME
      NBNN   = NUM(/1)
      NBELEM = NUM(/2)
C =====
      MINTE = IPINTE
c*      SEGACT,MINTE
      NBPGAU = POIGAU(/1)
C =====
c*      MPTVAL = IVAMAT
c*      SEGACT,MPTVAL
c*      IF (IVAPHA.NE.0) THEN
c*        MPTVAL = IVAPHA
c*        SEGACT,MPTVAL
c*      ENDIF
C =====
      XMATRI = IPMATR
c*      SEGACT,XMATRI*MOD
c*      NLIGRP = NLIGR
c*      NLIGRD = NLIGR
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- Calcul du jacobien, des fonctions de forme et de leurs derivees
C- au point de Gauss iGau
          DO j = 1, NBNN
            FORME(j) = SHPTOT(1,j,iGau)
            DO i = 1, IFIN
              SHP(i,j) = SHPTOT(i,j,iGau)
            ENDDO
          ENDDO
          CALL TCONV4(XE,SHP,IDIM,NBNN,DJAC)
          IF (IERR.NE.0) GOTO 9990
          IF (DJAC.LT.XZero) iFois=iFois+1
          DJAC = ABS(DJAC)
C- Erreur si le jacobien est nul en ce point de Gauss
          IF (DJAC.LT.XPetit) THEN
            INTERR(1) = iElt
            CALL ERREUR(259)
            GOTO 9990
          ENDIF

C- Calcul du terme Rho.Cp.Vol.Se en ce point de Gauss pour la THERMIQUE
          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)

C- Erreur si la section d'un element BARRe est nulle
          SE = VACOMP(NVAMAT)
          IF (SE.LE.XPetit) THEN
            CALL ERREUR(517)
            GOTO 9990
          ENDIF
          CAPA = SE * DJAC * POIGAU(iGau) * VACOMP(1)
C- Calcul de la contribution du point de Gauss a la matrice CAPACITE
C- elementaire pour cet element fini
          CALL NTNST(FORME,CAPA,NBNN,1,CAP)

C =======
        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))
      ENDDO

C  3 - MENAGE : DESACTIVATION/DESTRUCTION DE SEGMENTS
C ====================================================
 9990 CONTINUE
      SEGSUP,MMAT1
c*      SEGDES,MELEME,MINTE,XMATRI
c*      MPTVAL = IVAMAT
c*      SEGDES,MPTVAL
c*      IF (IVAPHA.NE.0) THEN
c*        MPTVAL = IVAPHA
c*        SEGDES,MPTVAL
c*      ENDIF

      RETURN
      END