C CONDU     SOURCE    CB215821  24/04/12    21:15:27     11897          

      SUBROUTINE CONDU

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


-INC PPARAM
-INC CCOPTIO
-INC SMCHAML
-INC SMMODEL
      POINTEUR MODTHR.MMODEL,MODRAY.MMODEL,MODCNV.MMODEL,MODTHM.MMODEL
      POINTEUR MOELEC.MMODEL,MODIFF.MMODEL
-INC SMRIGID
-INC SMCOORD

      CHARACTER*(LOCOMP) MOCOMP

      segact mcoord
      IPRIGI = 0
      IPMODR = 0
      IPMODC = 0

C =========================================
C  1- LECTURE DES ARGUMENTS DE L'OPERATEUR
C =========================================
C  1.1 - Lecture OBLIGATOIRE du modele (MODORI)
C =====
      MOTERR(1:8)=' MODELE '
      CALL MESLIR(-137)
      CALL LIROBJ('MMODEL  ',MODORI,1,IRet)
      CALL ACTOBJ('MMODEL  ',MODORI,1)
      IF (IERR.NE.0) RETURN
C =====
C  1.2 - Lecture OBLIGATOIRE du champ de caracteristiques (MCHORI)
C =====
      CALL MESLIR(-135)
      CALL LIROBJ('MCHAML  ',IPIN,1,IRet)
      CALL ACTOBJ('MCHAML  ',IPIN,1)
      IF (IERR.NE.0) RETURN
      CALL REDUAF(IPIN,MODORI,MCHORI,0,IR,KER)
      IF(IR   .NE. 1) CALL ERREUR(KER)
      IF(IERR .NE. 0) RETURN

C =========================================
C  2- QUELQUES VERIFICATIONS DES ARGUMENTS
C =========================================
C  2.1 - Verification du type du champ (MCHORI)
C =====
      MCHELM = MCHORI
      SEGACT,MCHELM
      IF (TITCHE(1:8).NE.'CARACTER') THEN
        MOTERR(1:16) = 'CARACTERISTIQUES'
        CALL ERREUR(291)
        RETURN
      ENDIF
C =====
C  2.2 - Verification du contenu du modele (MODORI)
C        Separation des formulations DIFFUSION & ELECTROSTATIQUE
C                et des formulations THERMIQUE & THERMOHYDRIQUE
C =====
      MMODEL = MODORI
      SEGACT,MMODEL
      NSOUS = KMODEL(/1)
      N1 = NSOUS
      SEGINI,MOELEC,MODTHM,MODRAY,MODCNV,MODTHR,MODIFF
      IELEC = 0
      ITHEM = 0
      IRAYE = 0
      ICONV = 0
      ITHER = 0
      IDIFF = 0

      DO isous = 1, NSOUS
        IMODEL = KMODEL(isous)
        SEGACT,IMODEL
        IF      (FORMOD(1).EQ.'ELECTROSTATIQUE ') THEN
          IELEC = IELEC + 1
          MOELEC.KMODEL(IELEC) = IMODEL
        ELSE IF (FORMOD(1).EQ.'THERMOHYDRIQUE  ') THEN
          ITHEM = ITHEM + 1
          MODTHM.KMODEL(ITHEM) = IMODEL
        ELSE IF (FORMOD(1).EQ.'DIFFUSION       ') THEN
          IDIFF = IDIFF + 1
          MODIFF.KMODEL(IDIFF) = IMODEL
        ELSE IF (FORMOD(1).EQ.'THERMIQUE       ') then
          NMAT = MATMOD(/2)
          CALL PLACE(MATMOD,NMAT,ipl,'RAYONNEMENT')
          IF (ipl.NE.0) THEN
            IRAYE = IRAYE + 1
            MODRAY.KMODEL(IRAYE) = IMODEL
          ELSE
            CALL PLACE(MATMOD,NMAT,ipl,'CONVECTION')
            IF (ipl.NE.0) THEN
              ICONV = ICONV + 1
              MODCNV.KMODEL(ICONV) = IMODEL
            ELSE
              ITHER = ITHER + 1
              MODTHR.KMODEL(ITHER) = IMODEL
            ENDIF
          ENDIF
        ELSE
          N1 = N1 - 1
        ENDIF
      ENDDO
C  Verification que le modele MODORI contient au moins un sous-modele
C  dont la formulation est traitee ici !
      IF (N1.LE.0) THEN
        MOTERR(1:8) = 'MMODEL  '
        INTERR(1) = MODORI
        CALL ERREUR(356)
        GOTO 9991
      ENDIF

      IF (IELEC.GT.0) THEN
C =======================================================
C  3-    CONSTRUCTION DE LA MATRICE DE CONDUCTIVITE
C     POUR LA FORMULATION ELECTROSTATIQUE
C =======================================================
C  Modele contenant uniquement des formulations DIFFUSION et ELECTROSTATIQUE
        N1 = IELEC
        SEGADJ,MOELEC
        IPMODR = MOELEC
C  Calcul de la matrice : tout est fait dans RIGI1
        ipch = 0
        imat = 1
        noer=0
        CALL RIGI1(IPMODR,MCHORI,ipch,imat,IPRIGI,IRET,noer)
        IF (IRET.NE.1) GOTO 9991
        MRIGID = IPRIGI
      ENDIF

      NSOUS = ITHEM + IRAYE + ICONV + ITHER + IDIFF
      IF (NSOUS.GT.0) THEN
C ================================================================
C  4-    CONSTRUCTION DE LA MATRICE DE CONDUCTIVITE
C     POUR LES FORMULATIONS THERMIQUE, DIFFUSION ET THERMOHYDRIQUE
C ================================================================
C  4.1 - Initialisation de la matrice si necessaire
C =====
        IF (IPRIGI.EQ.0) THEN
          NRIGEL = 0
          SEGINI,MRIGID
          MTYMAT = 'RIGIDITE'
          ICHOLE = 0
          IMGEO1 = 0
          IMGEO2 = 0
          IFORIG = IFOUR
          ISUPEQ = 0
          IPRIGI = MRIGID
        ELSE
          MRIGID = IPRIGI
          SEGACT,MRIGID*MOD
        ENDIF
C =====
C  4.2 - Modele avec uniquement les formulations THERMIQUE, DIFFUSION et THERMOHYDRIQUE
C =====
        N1 = NSOUS
        SEGINI,MMODEL
        isous = 0
        IF (ITHEM.GT.0) THEN
          DO i = 1, ITHEM
            isous = isous + 1
            KMODEL(isous) = MODTHM.KMODEL(i)
          ENDDO
        ENDIF
        IF (IRAYE.GT.0) THEN
          DO i = 1, IRAYE
            isous = isous + 1
            KMODEL(isous) = MODRAY.KMODEL(i)
          ENDDO
        ENDIF
        IF (ICONV.GT.0) THEN
          DO i = 1, ICONV
            isous = isous + 1
            KMODEL(isous) = MODCNV.KMODEL(i)
          ENDDO
        ENDIF
        IF (ITHER.GT.0) THEN
          DO i = 1, ITHER
            isous = isous + 1
            KMODEL(isous) = MODTHR.KMODEL(i)
          ENDDO
        ENDIF
        IF (IDIFF.GT.0) THEN
          DO i = 1, IDIFF
            isous = isous + 1
            KMODEL(isous) = MODIFF.KMODEL(i)
          ENDDO
        ENDIF
        IPMODC = MMODEL

C =====
C  4.3 - Reduction du champ au modele precedemment reduit
C =====
        MCHELM = MCHORI
        CALL REDUAF(MCHORI,IPMODC,IPCHEC,0,IRET,KERRE)
        IF (IRET.NE.1) THEN
          CALL ERREUR(KERRE)
          GOTO 9990
        ENDIF
        ISUPCH = 0
        CALL QUESUP(IPMODC,IPCHEC,6,0,ISUPCH,IRET)
        IF (ISUPCH.GT.1) GOTO 9990
C NB : La verification du support est effectuee ici pour l'instant,
C      car tous les formulations considerees ici s'appuient sur le
C      meme support (IRET = 1, 2 ou 6).

C =====
C  4.4 - Remplissage de la matrice pour chaque modele concerne
C =====
c Formulation thermohydrique
        IF (ITHEM.GT.0) THEN
          DO i = 1, ITHEM
            IMODEL = MODTHM.KMODEL(i)
            SEGACT,IMODEL
            CALL THCOND(IMODEL,IPCHEC,ISUPCH, IPRIGI)
            IF (IERR.NE.0) GOTO 9990
          ENDDO
        ENDIF

c Formulation rayonnement
        IF (IRAYE.GT.0) THEN
          MCHELM = IPCHEC
          DO i = 1, IRAYE
            IMODEL = MODRAY.KMODEL(i)
            SEGACT,IMODEL
* on accepte le sous-modele de rayonnement que si le mchaml
* correspondant contient une composante H !
            SEGACT,MCHELM
            imaray = IMACHE(/1)
            MOCOMP ='H'
            DO j = 1, imaray
              IF (imache(j).eq.IMAMOD .AND. conche(j).eq.CONMOD) then
                mchaml = ichaml(j)
                SEGACT,mchaml
                CALL PLACE(nomche,nomche(/2),ipl,MOCOMP)
                IF (ipl.NE.0) then
                  CALL TCONVE(IMODEL,IPCHEC,ISUPCH, IPRIGI)
                  IF (IERR.NE.0) GOTO 9990
                  GOTO 4420
                ENDIF
              ENDIF
            ENDDO
 4420       CONTINUE
          ENDDO
        ENDIF

c Formulation convection
        IF (ICONV.GT.0) THEN
          DO i = 1, ICONV
            IMODEL = MODCNV.KMODEL(i)
            SEGACT,IMODEL
            CALL TCONVE(IMODEL,IPCHEC,ISUPCH, IPRIGI)
            IF (IERR.NE.0) GOTO 9990
          ENDDO
        ENDIF
        
c Formulation conduction
        IF (ITHER.GT.0) THEN
          DO i = 1, ITHER
            IMODEL = MODTHR.KMODEL(i)
            SEGACT,IMODEL
            CALL TCONDU(IMODEL,IPCHEC,ISUPCH, IPRIGI)
            IF (IERR.NE.0) GOTO 9990
          ENDDO
        ENDIF
        
c Formulation diffusion
        IF (IDIFF.GT.0) THEN
          DO i = 1, IDIFF
            IMODEL = MODIFF.KMODEL(i)
            SEGACT,IMODEL
            CALL TCONDU(IMODEL,IPCHEC,ISUPCH, IPRIGI)
            IF (IERR.NE.0) GOTO 9990
          ENDDO
        ENDIF
      ENDIF

      NRIGEL = IRIGEL(/2)
      IF (NRIGEL.EQ.0) THEN
        CALL ERREUR(19)
      ENDIF

 9990 CONTINUE
      IF (IERR.NE.0) THEN
        SEGSUP,MRIGID
      ELSE
        SEGDES,MRIGID
        CALL ECROBJ('RIGIDITE',IPRIGI)
      ENDIF
 9991 CONTINUE
C      SEGSUP,MOELEC,MODTHR,MODTHM,MODRAY,MODCNV,MODIFF

      END