C FLUMA1    SOURCE    PV        09/03/12    21:22:49     6325           

C=======================================================================
C=                            F L U M A 1                              =
C=                            -----------                              =
C=                                                                     =
C=  Fonction :                                                         =
C=  ----------                                                         =
C=   Calcul des flux nodaux equivalents dans le cas UNDIMENSIONNEL     =
C=                                                                     =
C=  Parametres :  (E)=Entree  (S)=Sortie                               =
C=  ------------                                                       =
C=   IPFLOD   (E)   Pointeur sur le segment MELVAL des FLUX NODAUX     =
C=   IPGEOM   (E)   Pointeur sur un objet MAILLAGE elementaire         =
C=   IPINTE   (E)   Pointeur sur un segment MINTE contenant les        =
C=                  caracteristiques d'integration                     =
C=   NUMPOI   (E)   Indique la direction du flux dans le repere global =
C=                  = -1 lorsque le flux est normal a la face          =
C=                  = 1  pour la syntaxe 3 (flux d un vecteur)         =
C=   IPFLEQ   (S)   Pointeur sur un segment MELVAL contenant les       =
C=                  flux nodaux equivalents                            =
C=======================================================================

      SUBROUTINE FLUMA1 (IPFLOD,IPGEOM,IPINTE,NUMPOI,IPFLEQ)

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

-INC CCOPTIO
-INC CCREEL
-INC SMCHAML
-INC SMELEME
-INC SMINTE
-INC SMCOORD

      SEGMENT MMAT1
        REAL*8 XE(3,NBPTEL),SHP(6,NBPTEL)
      ENDSEGMENT

C= Quelques constantes (2.Pi et 4.Pi)
      PARAMETER (X2Pi=6.283185307179586476925286766559D0)
      PARAMETER (X4Pi=12.566370614359172953850573533118D0)

C ON RECUPERE LES VALEURS NODALES DU FLUX
      IF (NUMPOI.NE.1) THEN
        MELVA1=IPFLOD
        SEGACT,MELVA1
        NBPTE1=MELVA1.VELCHE(/1)
        NEL1=MELVA1.VELCHE(/2)
      ELSE
        MCHAM1=IPFLOD
        SEGACT,MCHAM1
        MELVA1=MCHAM1.IELVAL(1)
        MELVA2=MCHAM1.IELVAL(2)
        SEGACT,MELVA1,MELVA2
        NBPTE1=MELVA1.VELCHE(/1)
        NEL1=MELVA1.VELCHE(/2)
        SEGDES,MCHAM1
      ENDIF

* ON RECUPERE LES CARACTERISTIQUES D'INTEGRATION DES FACES
      MINTE=IPINTE
      SEGACT,MINTE
      NBPGAU=POIGAU(/1)

* ON RECUPERE UN DES MAILLAGES ELEMENTAIRES DE L'ENVELOPPE
      MELEME=IPGEOM
      SEGACT,MELEME
      NBPTEL=NUM(/1)
      NEL=NUM(/2)

C*OF  IF ((NBPGAU.NE.1).OR.(NBPTEL.NE.1)) THEN
C*OF    WRITE(6,*) 'ERREUR FATALE : FLUMA1'
C*OF    RETURN
C*OF  ENDIF

* MELVAL QUI CONTIENDRA LES FLUX NODAUX EQUIVALENTS
      N1PTEL=NBPTEL
      N1EL=NEL
      N2PTEL=0
      N2EL=0
      SEGINI,MELVAL
      IPFLEQ=MELVAL
      SEGINI,MMAT1

C= ON RECUPERE LES COORDONNEES DU VECTEUR DIRECTION
C= ERREUR SI LA DONNEE DE LA DIRECTION DU FLUX EST NULLE
      XDIR=1.
      IF ((NUMPOI.NE.-1).AND.(NUMPOI.NE.1)) THEN
        CALL EXCOO1(NUMPOI,XDIR,YDIR,ZDIR,DENS)
        DNORME=ABS(XDIR)
        IF (DNORME.LT.XPETIT) THEN
          CALL ERREUR(417)
          RETURN
        ENDIF
        XDIR=XDIR/DNORME
      ENDIF

C= BOUCLE SUR LES ELEMENTS
      DO IEL=1,NEL

*  ON CHERCHE LES COORDONNEES DES ELEMENTS DANS LE REPERE GLOBAL
        CALL DOXE(XCOOR,IDIM,NBPTEL,NUM,IEL,XE)

C= Cas des elements AXISymetriques et SPHEriques
        IF (IFOUR.GE.12.AND.IFOUR.LE.14) THEN
          Volu=X2Pi*XE(1,1)
        ELSE IF (IFOUR.EQ.15) THEN
          RR=XE(1,1)
          Volu=X4Pi*RR*RR
        ELSE
          Volu=1.
        ENDIF
        IEMIN=MIN(IEL,NEL1)
C  on oriente la vraie normale suivant la pseudo
        IF (NUMPOI.EQ.1) THEN
          S1=MELVA2.VELCHE(1,IEMIN)
          XDIR=S1/ABS(S1)
        ENDIF
        VELCHE(1,IEL)=VELCHE(1,IEL)+Volu*XDIR*MELVA1.VELCHE(1,IEMIN)
      ENDDO

      SEGSUP,MMAT1
      SEGDES,MELEME,MELVA1,MINTE
      SEGDES,MELVAL
      IF (NUMPOI.EQ.1) SEGDES,MELVA2

      RETURN
      END