C CAPA      SOURCE    CB215821  24/04/12    21:15:10     11897          

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 PPARAM
-INC CCOPTIO

-INC SMCHAML
-INC SMMODEL
-INC SMRIGID
-INC SMCOORD

      CHARACTER*9 MO1
      LOGICAL L0,L1
*
      segact mcoord
*
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)
      CALL ACTOBJ('MMODEL  ',IPMODE,1)
      IF (IERR.NE.0) RETURN
C =====
C  1.2 - Lecture OBLIGATOIRE du champ de caracteristiques (IPCHEL)
C =====
      CALL MESLIR(-135)
      CALL LIROBJ('MCHAML  ',IPIN,1,IRet)
      CALL ACTOBJ('MCHAML  ',IPIN,1)
      IF (IERR.NE.0) RETURN     
      CALL REDUAF(IPIN,IPMODE,IPCHEL,0,IR,KER)
      IF(IR   .NE. 1) CALL ERREUR(KER)
      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
C        SEGDES,MCHELM
        MOTERR='CARACTERISTIQUES'
        CALL ERREUR(291)
        RETURN
      ENDIF
C      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
      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)
      N1 = 1
      
      DO 10 IA = 1, NB1
        IMODEL = KMODEL(IA)
        SEGACT,IMODEL
C        ITHER = 0
        ITHHY = 0
C        IDIFF = 0
C        IELEC = 0
        IF (FORMOD(1).EQ.'THERMIQUE') THEN
          do iyu=1,matmod(/2)
            if( matmod(iyu).eq.'CONVECTION' )  GOTO 1
            if( matmod(iyu).eq.'RAYONNEMENT')  GOTO 1
          enddo
C          ITHER = 1
          ISUPC = 6
        ELSE IF (FORMOD(1).EQ.'THERMOHYDRIQUE') THEN
          ITHHY = 1
          ISUPC = 6
        ELSE IF (FORMOD(1).EQ.'DIFFUSION') THEN
C          IDIFF = 1
          ISUPC = 6
C*      ELSE IF (FORMOD(1).EQ.'ELECTROSTATIQUE') THEN
C*        IELEC = 1
C*        ISUPC = 4
        ELSE
C          SEGDES,IMODEL
          GOTO 10
        ENDIF

        IF (NB1.GT.1) THEN
          SEGINI,MMODE1
          IPMOD1 = MMODE1
          MMODE1.KMODEL(1) = IMODEL
        ELSE
          IPMOD1 = IPMODE
        ENDIF
        
        CALL ACTOBJ('MCHAML  ',IPCHEL,1)
        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)
C        SEGACT,IMODEL
        IF (ITHHY.NE.0) THEN
          CALL THCAPA1(IMODEL,IPCHE1,ISUPC1, IPRIGI)
C        ELSE IF (IDIFF.NE.0.OR.IELEC.NE.0) THEN
C          CALL CAPAED(IMODEL,IPCHE1,ISUPC1, IPRIGI)
        ELSE
          CALL CAPA1(IMODEL,IPCHE1,ISUPC1, ITABL,IPRIGI)
        ENDIF


    1   CONTINUE
C        SEGDES,IMODEL
        IF (IERR.NE.0) GOTO 9999
        
C        IF (NB1.GT.1) THEN
C          SEGDES,MMODE1
C        ENDIF
 10   CONTINUE

      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

      END