C CAPA      SOURCE    CHAT      12/06/07    21:15:05     7389           

C=======================================================================
C=                              C A P A                                =
C=                              -------                                =
C=                                                                     =
C=  OPERATEUR DE CALCUL DE LA MATRICE DE CAPACITE (CALORIFIQUE) :      =
C=  -------------------------------------------------------------      =
C=   CAP1  =  'CAPACITE'  MODL1  CARA1  ( TAB1 ) ;                     =
C=                                                                     =
C=  ARGUMENTS :                                                        =
C=  -----------                                                        =
C=   MODL1   (MMODEL)   Modele (global) associe a la structure         =
C=   CARA1   (MCHAML)   Caracteristiques thermiques du(des) materiau(x)=
C=                      Sous-type 'CARACTERISTIQUES'                   =
C=   TAB1    (TABLE)    Table contenant les grandeurs liees a un chan- =
C=                      gement de phase eventuel          (facultatif) =
C=                      Sous-type 'THERMIQUE'                          =
C=                                                                     =
C=  RESULTAT :                                                         =
C=  ----------                                                         =
C=   CAP1    (RIGIDITE) Matrice de capacite calorifique                =
C=                                                                     =
C=  Denis ROBERT, le 15 fevrier 1988.                                  =
C=  Zakaria HABIBI, modification le 30 juin 2008(partie thermohydrique)=
C=======================================================================

      SUBROUTINE CAPA

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

-INC CCOPTIO

-INC SMCHAML
-INC SMMODEL
-INC SMRIGID

      CHARACTER*9 MO1
      LOGICAL L0,L1

C  1 - LECTURE DES ARGUMENTS DE L'OPERATEUR
C ==========================================
C  1.1 - Lecture OBLIGATOIRE du modele (IPMODE)
C =====
      MOTERR(1:8)=' MODELE '
      CALL MESLIR(-137)
      CALL LIROBJ('MMODEL',IPMODE,1,IRet)
      IF (IERR.NE.0) RETURN
C =====
C  1.2 - Lecture OBLIGATOIRE du champ de caracteristiques (IPCHEL)
C =====
      CALL MESLIR(-135)
      CALL LIROBJ('MCHAML',IPCHEL,1,IRet)
      IF (IERR.NE.0) RETURN
C =====
C  1.3 - Lecture FACULTATIVE de la table des donnees liees a un
C        changement de phase (ITABL)
C =====
      ITABL=0
      CALL MESLIR(-136)
      CALL LIROBJ('TABLE',ITABL,0,IRet)
      IF (IERR.NE.0) RETURN

C  2 - VERIFICATIONS DES DONNEES DE L'OPERATEUR
C ==============================================
C  2.1 - Verification du sous-type du MCHAML de caracteristiques
C =====
      MCHELM=IPCHEL
      SEGACT,MCHELM
      IF (TITCHE(1:8).NE.'CARACTER') THEN
        SEGDES,MCHELM
        MOTERR='CARACTERISTIQUES'
        CALL ERREUR(291)
        RETURN
      ENDIF
      SEGDES,MCHELM
C =====
C  2.2 - Verification du sous-type de la TABLE
C        (l'indice 'SOUSTYPE' doit valoir 'THERMIQUE')
C =====
      IF (ITABL.NE.0) THEN
        CALL ACCTAB(ITABL,'MOT',I0,X0,'SOUSTYPE',L0,IP0,
     &              'MOT',I1,X1,MO1,L1,IP1)
        IF (IERR.NE.0) RETURN
        IF (MO1.NE.'THERMIQUE') THEN
          CALL ERREUR(314)
          RETURN
        ENDIF
      ENDIF

C  3 - CONSTRUCTION DE LA MATRICE DE CAPACITE
C ============================================
C  3.1 - Initialisation de la matrice :
C =====
      NRIGEL = 0
      SEGINI,MRIGID
      MTYMAT = 'RIGIDITE'
      ICHOLE = 0
      IMGEO1 = 0
      IMGEO2 = 0
C*    IFORIG = IFOMOD
      IFORIG = IFOUR
      ISUPEQ = 0
      IPRIGI = MRIGID
C =====
C  3.2 - Remplissage de la matrice pour chaque modele concerne
C =====
      MMODEL=IPMODE
      SEGACT,MMODEL
      NB1 = KMODEL(/1)
      IF (NB1.GT.1) THEN
        N1 = 1
        SEGINI,MMODE1
        IPMOD1 = MMODE1
      ELSE
        IPMOD1 = IPMODE
      ENDIF
      DO IA = 1, NB1
        IMODEL = KMODEL(IA)
        SEGACT,IMODEL
        ITHER = 0
        ITHHY = 0
        IDIFF = 0
        IELEC = 0
        IF (FORMOD(1).EQ.'THERMIQUE') THEN
          do iyu=1,matmod(/2)
            if( matmod(iyu).eq.'CONVECTION' ) go to 1
            if( matmod(iyu).eq.'RAYONNEMENT')  go to 1
          enddo
          ITHER = 1
          ISUPC = 6
        ELSE IF (FORMOD(1).EQ.'THERMOHYDRIQUE') THEN
          ITHHY = 1
          ISUPC = 6
        ELSE IF (FORMOD(1).EQ.'DIFFUSION') THEN
          IDIFF = 1
          ISUPC = 4
C*      ELSE IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN
C*        IELEC = 1
C*        ISUPC = 4
        ELSE
          MOTERR(1:8) = FORMOD(1)
          CALL ERREUR(193)
          SEGDES,IMODEL
          GOTO 9999
        ENDIF
        IF (NB1.GT.1) THEN
          SEGACT,MMODE1*MOD
          MMODE1.KMODEL(1) = IMODEL
        ENDIF
        CALL REDUAF(IPCHEL,IPMOD1,IPCHE1,0,IRET,KERRE)
        IF (IRET.NE.1) THEN
          CALL ERREUR(KERRE)
          GOTO 9999
        ENDIF
C Verification du lieu support du MCHAML de caracteristiques
        ISUPC1 = 0
        CALL QUESUP(IPMOD1,IPCHE1,ISUPC,0,ISUPC1,IRET)
        IF (ISUPC1.GT.1) GOTO 9999
C Reactivation du modele elementaire (desactive dans REDUAF)
        SEGACT,IMODEL
        IF (ITHHY.NE.0) THEN
          CALL THCAPA1(IMODEL,IPCHE1,ISUPC1, IPRIGI)
        ELSE IF (IDIFF.NE.0.OR.IELEC.NE.0) THEN
          CALL CAPAED(IMODEL,IPCHE1,ISUPC1, IPRIGI)
        ELSE
          CALL CAPA1(IMODEL,IPCHE1,ISUPC1, ITABL,IPRIGI)
        ENDIF
    1   CONTINUE
        SEGDES,IMODEL
        IF (IERR.NE.0) GOTO 9999
      ENDDO

      NRIGEL = IRIGEL(/2)
      IF (NRIGEL.EQ.0) THEN
        CALL ERREUR(19)
      ENDIF
 9999 CONTINUE
      IF (IERR.NE.0) THEN
        SEGSUP,MRIGID
      ELSE
        SEGDES,MRIGID
        CALL ECROBJ('RIGIDITE',IPRIGI)
      ENDIF

      SEGDES,MMODEL
      IF (NB1.GT.1) SEGSUP,MMODE1
C
      RETURN
      END