C CONDU     SOURCE    FANDEUR   12/07/05    21:15:09     7420           

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

-INC CCOPTIO
-INC SMCHAML
-INC SMMODEL
      POINTEUR MODTHR.MMODEL,MODRAY.MMODEL,MODCNV.MMODEL,MODTHM.MMODEL
      POINTEUR MODIEL.MMODEL
-INC SMRIGID

      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)
      IF (IERR.NE.0) RETURN
C =====
C  1.2 - Lecture OBLIGATOIRE du champ de caracteristiques (MCHORI)
C =====
      CALL MESLIR(-135)
      CALL LIROBJ('MCHAML',MCHORI,1,IRet)
      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
        SEGDES,MCHELM
        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,MODIEL,MODTHM,MODRAY,MODCNV,MODTHR
      IDIEL = 0
      ITHEM = 0
      IRAYE = 0
      ICONV = 0
      ITHER = 0
      DO isous = 1, NSOUS
        IMODEL = KMODEL(isous)
        SEGACT,IMODEL
        IF      (FORMOD(1).EQ.'DIFFUSION       ' .OR.
     &           FORMOD(1).EQ.'ELECTROSTATIQUE ') THEN
          IDIEL = IDIEL + 1
          MODIEL.KMODEL(IDIEL) = IMODEL
        ELSE IF (FORMOD(1).EQ.'THERMOHYDRIQUE  ') THEN
          ITHEM = ITHEM + 1
          MODTHM.KMODEL(ITHEM) = 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 (IDIEL.GT.0) THEN
C =======================================================
C  3-    CONSTRUCTION DE LA MATRICE DE CONDUCTIVITE
C     POUR LES FORMULATIONS DIFFUSION ET ELECTROSTATIQUE
C =======================================================
C  Modele contenant uniquement des formulations DIFFUSION et ELECTROSTATIQUE
        N1 = IDIEL
        SEGADJ,MODIEL
        IPMODR = MODIEL
C  Calcul de la matrice : tout est fait dans RIGI1
        ipch = 0
        imat = 1
        CALL RIGI1(IPMODR,MCHORI,ipch,imat,IPRIGI,IRET)
        IF (IRET.NE.1) GOTO 9991
        MRIGID = IPRIGI
      ENDIF

      NSOUS = ITHEM + IRAYE + ICONV + ITHER
      IF (NSOUS.GT.0) THEN
C ======================================================
C  4-    CONSTRUCTION DE LA MATRICE DE CONDUCTIVITE
C     POUR LES FORMULATIONS THERMIQUE 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
C*        IFORIG = IFOMOD
          IFORIG = IFOUR
          ISUPEQ = 0
          IPRIGI = MRIGID
        ELSE
          MRIGID = IPRIGI
          SEGACT,MRIGID*MOD
        ENDIF
C =====
C  4.2 - Modele avec uniquement des formulations THERMIQUE 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
        IPMODC = MMODEL
C =====
C  4.3 - Reduction du champ au modele precedemment reduit
C =====
        MCHELM = MCHORI
        CALL REDUAF(MCHORI,IPMODC,IPCHEC,0,IRET,KERRE)
        SEGDES,MCHELM
        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)
            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,'H        ')
                IF (ipl.NE.0) then
                  CALL TCONVE(IMODEL,IPCHEC,ISUPCH, IPRIGI)
                  IF (IERR.NE.0) GOTO 9990
                  GOTO 4420
                ENDIF
                SEGDES,mchaml
              ENDIF
            ENDDO
 4420       CONTINUE
          ENDDO
          SEGDES,MCHELM
        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
        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
      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
      IF (IPMODC.NE.0) THEN
        MMODEL = IPMODC
        SEGSUP,MMODEL
      ENDIF
 9991 CONTINUE
      MMODEL = MODORI
      DO isous = 1, NSOUS
        IMODEL = KMODEL(isous)
        SEGDES,IMODEL
      ENDDO
      SEGDES,MMODEL
      SEGSUP,MODIEL,MODTHR,MODTHM,MODRAY,MODCNV

      RETURN
      END