C CHAMAS    SOURCE    FANDEUR   13/01/16    21:15:05     7666           

C=======================================================================
C=                            C H A M A S                              =
C=                            -----------                              =
C=                                                                     =
C=  Fonction :                                                         =
C=  ----------                                                         =
C=   Calcul des flux equivalents a des sources volumiques dans le cas  =
C=   des elements MASSIFs (1D, 2D, 3D).                                =
C=                                                                     =
C=  Parametres :  (E)=Entree  (S)=Sortie                               =
C=  ------------                                                       =
C=   IPMODE  (E)   Pointeur sur le segment MMODEL de la structure      =
C=   IPCHSO  (E)   Pointeur sur le MCHAML aux noeuds de sources        =
C=   IPCHEB  (E)   Pointeur sur le segment MCHAML de CARACTERISTIQUES  =
C=                 (inutilise dans ce sous-programme)
C=   NOMDUA  (E)   Nom de la composante du champ de flux equivalents   =
C=   IPCHAL  (S)   Pointeur sur le champ des flux equivalents          =
C=                                                                     =
C=  Denis ROBERT, le 01/02/88.                                         =
C=======================================================================

      SUBROUTINE CHAMAS (IPMODE,IPCHSO,IPCHEB,NOMDUA, IPCHAL)

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

-INC CCOPTIO
-INC SMCHAML
-INC SMMODEL

      SEGMENT INFO
        INTEGER INFELL(JG)
      ENDSEGMENT

      CHARACTER*(*) NOMDUA

      IPCHAL=0

C  1 - QUELQUES VERIFICATIONS SUR LES DONNEES
C ============================================
      MMODEL=IPMODE
      SEGACT,MMODEL
      NSOU=KMODEL(/1)
C =====
C  Verification de l'existence de sources pour tout le modele
      MCHEL1=IPCHSO
      SEGACT,MCHEL1
      IF (MCHEL1.IMACHE(/1).NE.NSOU) THEN
        CALL ERREUR(21)
        GOTO 120
      ENDIF

C  2 - CREATION DU MCHAML GLOBAL (RESULTAT)
C ==========================================
      L1=18
      N1=NSOU
      N3=6
      SEGINI,MCHELM
C*    IFOCHE=IFOMOD
      IFOCHE=IFOUR
      TITCHE='SOURCES.VOLUMIQUES'

C  3 - BOUCLE SUR LES ZONES ELEMENTAIRES DU MODELE (ISOU)
C ========================================================
      ITHER = 0
      ITHHY = 0
C
      DO ISOU = 1, NSOU
C =====
C  3.1 - Activation du modele elementaire ISOU
C =====
        IMODEL=KMODEL(ISOU)
        SEGACT,IMODEL
        NEF = NEFMOD
C* On suppose que l'on a une FORMULATION unique (cf. chaleu.eso)
        IF (ISOU.EQ.1) THEN
          NFOR = FORMOD(/2)
          CALL PLACE(FORMOD,NFOR,ITHER,'THERMIQUE')
          IF (ITHER.EQ.0) THEN
            CALL PLACE(FORMOD,NFOR,ITHHY,'THERMOHYDRIQUE')
          ENDIF
        ENDIF
C =====
C  3.2 - Recherche dans le MCHAML des sources (IPCHSO) du maillage
C        (IMAMOD) associe au modele elementaire iSou, puis recuperation
C        du MCHAML elementaire de sources associe (IPSONO)
C =====
        DO i = 1, NSOU
          IF (MCHEL1.IMACHE(i).EQ.IMAMOD) GOTO 10
        ENDDO
        CALL ERREUR(21)
        SEGSUP,MCHELM
        GOTO 100
 10     CONTINUE
        MCHAM1 = MCHEL1.ICHAML(i)
        SEGACT,MCHAM1
        IPSONO=MCHAM1.IELVAL(1)
        SEGDES,MCHAM1
C =====
C  3.4 - Initialisation du MCHAML des flux de chaleur nodaux equivalents
C        (MCHAML) associe au modele elementaire iSou (maillage IMAMOD)
C        Remplissage des donnees associees a MCHAML dans MCHELM (global)
C =====
        N2=1
        SEGINI,MCHAML
        NOMCHE(1)=NOMDUA
        TYPCHE(1)='REAL*8'
        IMACHE(ISOU)=IMAMOD
        ICHAML(ISOU)=MCHAML
        INFCHE(ISOU,3)=NIFOUR
        INFCHE(ISOU,6)=1
C =====
C  3.5 - Recuperation d'informations sur l'element fini du modele
C        elementaire iSou (NEF)
C =====
        IF (ITHER.NE.0 .OR. ITHHY.NE.0) THEN
          CALL TSHAPE(NEF,'GAUSS',IPINTE)
        ELSE
          IF (INFMOD(/1).LT.5) THEN
            CALL ELQUOI(NEF,0,5,IPINF,IMODEL)
            IF (IERR.NE.0) GOTO 100
            INFO=IPINF
            IPINTE=INFELL(11)
            SEGSUP,INFO
          ELSE
            IPINTE=INFMOD(5)
          ENDIF
        ENDIF
C =====
C  3.6 - Calcul des flux nodaux equivalents (segment MELVAL) 
C =====
        IPGEO=IMAMOD
        IF (IDIM.EQ.3) THEN
          CALL CHAMA3(IPSONO,IPGEO,IPINTE,IPCHEQ)
        ELSE IF (IDIM.EQ.2) THEN
          CALL CHAMA2(IPSONO,IPGEO,IPINTE,IPCHEQ)
        ELSE IF (IDIM.EQ.1) THEN
          CALL CHAMA1(IPSONO,IPGEO,IPINTE,IPCHEQ)
        ENDIF
        IF (IERR.NE.0) THEN
          SEGSUP,MCHELM
          GOTO 100
        ENDIF
        IELVAL(1)=IPCHEQ
        SEGDES,MCHAML
   58 continue
      ENDDO

C  4 - MENAGE : DESACTIVATION DE SEGMENTS
C ========================================
      IPCHAL=MCHELM
      SEGDES,MCHELM
 100  DO i = 1, NSOU
        IMODEL=KMODEL(i)
        SEGDES,IMODEL
      ENDDO
 120  SEGDES,MMODEL,MCHEL1

      RETURN
      END