C FLUX2     SOURCE    BP208322  13/07/30    21:15:08     7809           

C=======================================================================
C=                            F L U X 2                                =
C=                            ---------                                =
C=                                                                     =
C=  Fonction :                                                         =
C=  ----------                                                         =
C=   Calcul des flux nodaux equivalents aux conditions de flux imposes =
C=                                                                     =
C=  Parametres :  (E)=Entree  (S)=Sortie                               =
C=  ------------                                                       =
C=   IPMODE   (E)   Pointeur sur le segment MMODEL de la structure     =
C=   IPCHPO   (E)   Pointeur sur le CHPOINT (ou le MCHAML) de flux     =
C=                  imposes aux noeuds de la structure                 =
C=                  (champ variable ou constant)                       =
C=   NUMPOI   (E)   Vaut -1 si le flux impose est normal a la surface, =
C=                  sinon pointeur sur un POINT correspondant a la     =
C=                  direction du flux (par rapport au repere global)   =
C=   MOCOMP   (E)   Nom de la composante de flux                       =
C=   PEAU     (E)   Indique la peau consideree (elements COQUES)       =
C=   MLMOTX   (E)   Pointeur MLMOTS de la liste des composantes de     =
C=                  IPCHPO associees aux 3 directions x,y,z.           =
C=   IPFLUX   (S)   Pointeur sur le champ des flux nodaux equivalents  =
C=                                                                     =
C=  Variables locales :                                                =
C=  -------------------                                                =
C=   IMASSI   Tableau contenant les numeros dans NOMTP des elements    =
C=            thermiques de type MASSIF                                =
C=   LMASSI   Longueur du tableau IMASSI                               =
C=   ICOQUE   Tableau contenant les numeros dans NOMTP des elements    =
C=            thermiques de type COQUE                                 =
C=   LCOQUE   Longueur du tableau ICOQUE                               =
C=                                                                     =
C=  Remarque :  Le MODELE doit contenir exclusivement un seul type     =
C=  ----------  d'elements, soit MASSIFs, soit COQUEs.                 =
C=                                                                     =
C=  Denis ROBERT, le 29 janvier 1988.                                  =
C=======================================================================

      SUBROUTINE FLUX2 (IPMODE,IPCHPO,NUMPOI,MOCOMP,PEAU,MLMOTX, IPFLUX)

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

-INC CCOPTIO
-INC SMMODEL
-INC SMCHPOI
-INC SMCHAML
-INC SMELEME

      CHARACTER*(*) MOCOMP,PEAU

      PARAMETER (LMASSI=16,LCOQUE=5)
      INTEGER IMASSI(LMASSI),ICOQUE(LCOQUE)

      LOGICAL ltelq

C ----------
C  Elements         TRI3 TRI6 QUA4 QUA8 CUB8 CU20 PRI6 PR15 TET4 TE10
C  MASSIFs          PYR5 PY13 T1D2 T1D3 M1D2 M1D3
C ----------
      DATA IMASSI /    4,   6,   8,  10,  14,  15,  16,  17,  23,  24,
     .                25,  26, 191, 192, 193, 194 /
C -------------
C  Elts COQUEs      COQ2 COQ3 COQ8 COQ4 COQ6
C -------------
      DATA ICOQUE /   44,  27,  41,  49,  56 /

C  1 - VERIFICATIONS SUR LE MODELE
C =================================
C  ERREUR si l'objet MODELE ne contient pas uniquement un seul type
C  d'elements soit MASSIF, soit COQUE.
C  ERREUR si la PEAU n'est pas indiquee dans le cas d'elements COQUE.
C =====
      jMASSi=0
      jCOQue=0
      MMODEL=IPMODE
      SEGACT,MMODEL
      NSOU=KMODEL(/1)
      DO i=1,NSOU
        IMODEL=KMODEL(i)
        SEGACT,IMODEL
        CALL PLACE2(IMASSI,LMASSI,iOK,NEFMOD)
        IF (iOK.NE.0) THEN
          jMASSi=jMASSi+1
        ELSE
          CALL PLACE2(ICOQUE,LCOQUE,iOK,NEFMOD)
          IF (iOK.NE.0) jCOQue=jCOQue+1
        ENDIF
        SEGDES,IMODEL
      ENDDO
      SEGDES,MMODEL
      IF (jMASSi.NE.NSOU.AND.jCOQue.NE.NSOU) THEN
        CALL ERREUR(409)
        RETURN
      ENDIF
      IF (jCOQue.EQ.NSOU) THEN
        IF (PEAU.EQ.'    ') THEN
          CALL ERREUR(513)
          RETURN
        ENDIF
        MOCOMP(1:4)='Q'//PEAU(1:3)
      ENDIF

C  2 - PREPARATION DES DONNEES POUR LE CALCUL
C ============================================
C= Creation d'un objet MAILLAGE contenant une seule fois tous les points

C= 2.1 du CHAMELEM -IPCHPO
      if(IPCHPO.lt.0) then
      
        MCHELM=-1*IPCHPO
        segact,MCHELM
        N1=IMACHE(/1)
        if(N1.eq.0)then
          moterr(1:8)='CHAMELEM'
          interr(1)=MCHELM
          CALL ERREUR(356)
          RETURN
        endif
c       verif que l'on est sur les points de gauss pour la thermique
        ISUPPO=INFCHE(1,6)
        if(ISUPPO.ne.6) then
           call CHASUP(IPMODE,MCHELM,MCHEL2,IRET,6)
           if(IRET.NE.0) call erreur(IRET)
           MCHELM=MCHEL2
           segact,MCHELM
        endif
        MELEME=IMACHE(1)
        segact,MELEME
        call CHANGE(MELEME,1)
        segdes,MELEME
        IPGEOM = MELEME
        if(N1.gt.1) then
        do i=2,N1
          MELEME=IMACHE(2)
          segact,MELEME
          call CHANGE(MELEME,1)
          segdes,MELEME
          ltelq=.FALSE.
          CALL FUSE(IPGEOM,MELEME,IRET,ltelq)
          IF (IERR.NE.0) RETURN
          IPGEOM=IRET        
        enddo
        endif
        segdes,MCHELM
      
C= 2.2 du CHPOINT IPCHPO (fusion des maillages supports de tous les MSOUPO)
      else
     
        MCHPOI=IPCHPO
        SEGACT,MCHPOI
        NSOUPO=IPCHP(/1)
        IF (NSOUPO.EQ.0) THEN
          CALL ERREUR(156)
          RETURN
        ENDIF
        MSOUPO=IPCHP(1)
        SEGACT,MSOUPO
        IPGEOM=IGEOC
        SEGDES,MSOUPO
        DO i=2,NSOUPO
          MSOUPO=IPCHP(i)
          SEGACT,MSOUPO
          IGEO1=IGEOC
          SEGDES,MSOUPO
          ltelq=.FALSE.
          CALL FUSE(IPGEOM,IGEO1,IRET,ltelq)
          IF (IERR.NE.0) RETURN
          IPGEOM=IRET
        ENDDO
        SEGDES,MCHPOI
      
      endif

C  3 - CALCUL DES FLUX EQUIVALENTS
C =================================
C  3.1 - Cas des elements MASSIFS (1D,2D,3D)
C =====
      IF (jMASSi.EQ.NSOU) THEN
        CALL FLUMAS(IPMODE,IPGEOM,IPCHPO,NUMPOI,MOCOMP,MLMOTX, IPFLUX)
C =====
C  3.2 - Cas des elements de COQUE
C =====
C*    ELSE IF (jCOQue.EQ.NSOU) THEN
      ELSE
        CALL FLUCOQ(IPMODE,IPGEOM,IPCHPO,NUMPOI,MOCOMP,MLMOTX, IPFLUX)
      ENDIF

      RETURN
      END