C FPELTU    SOURCE    OF166741  25/02/21    21:16:37     12166          
C_______________________________________________________________________
C
C        CALCUL DES FORCES DE PRESSION POUR LES ELEMENTS TUYAU
C
C  ENTREES:
C  ________
C
C     IPTVPR  Pointeur sur un MELVAL contenant les pressions appliquees
C     IVACAR  Pointeur sur un MCHAML de CARACTERISTIQUES
C     IPMAIL  Pointeur sur un MELEME
C     ISOUS   Entier indiquant la zone elementaire traitee
C             (info necessaire dans l'affichage des erreurs 128 et 138)
C
C  SORTIES:
C  ________
C
C     IVAFOR  Pointeur sur un MPTVAL de forces aux noeuds
C_______________________________________________________________________
C
      SUBROUTINE FPELTU(IPTVPR,IVACAR,IPMAIL,ISOUS,IVAFOR)

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

-INC PPARAM
-INC CCOPTIO
-INC CCREEL

-INC SMCOORD
-INC SMELEME
-INC SMCHAML

-INC TMPTVAL

      DIMENSION XFORC(12),WORK(12),VECT(3)
      DIMENSION XE(3,2),P(3,3),XX(2),YY(2),ZZ(2)

      MELEME=IPMAIL
      NBELEM=NUM(/2)

C= BOUCLE SUR LES ELEMENTS
      DO 103 IB=1,NBELEM
C
        CALL DOXE(XCOOR,3,2,NUM,IB,XE)
        DO 105 J=1,2
          XX(J)=XE(1,J)
          YY(J)=XE(2,J)
          ZZ(J)=XE(3,J)
 105    CONTINUE
C
        XLON2=(XX(2)-XX(1))**2+(YY(2)-YY(1))**2+(ZZ(2)-ZZ(1))**2

        IF (XLON2.LE.0.D0) THEN
          INTERR(1)=ISOUS
          INTERR(2)=IB
          CALL ERREUR(128)
          RETURN
        ENDIF

        CALL ZERO(XFORC,1,12)
C
C       ON CHERCHE LES CARACTERISTIQUES
C
        MPTVAL=IVACAR
        NBCAR=IVAL(/1)
C
        MELVAL=IVAL(1)
        IBMN=MIN(IB,VELCHE(/2))
        EPAI=VELCHE(1,IBMN)
C
        MELVAL=IVAL(2)
        REXT=VELCHE(1,IBMN)
C
        IF (IPTVPR.EQ.0) THEN
          MELVAL=IVAL(3)
        ELSE
          MELVAL=IPTVPR
        ENDIF
        PRES=VELCHE(1,IBMN)
C
        IF (IVAL((NBCAR-3)).NE.0) THEN
          MELVAL=IVAL((NBCAR-3))
          RACO=VELCHE(1,IBMN)
        ELSE
          RACO=0.
        ENDIF
C
        IF (IVAL((NBCAR-2)).NE.0) THEN
          MELVAL=IVAL((NBCAR-2))
          VECT(1)=VELCHE(1,IBMN)
        ELSE
          VECT(1)=0.
        ENDIF
C
        IF (IVAL((NBCAR-1)).NE.0) THEN
          MELVAL=IVAL((NBCAR-1))
          VECT(2)=VELCHE(1,IBMN)
        ELSE
          VECT(2)=0.
        ENDIF
C
        IF (IVAL((NBCAR  )).NE.0) THEN
          MELVAL=IVAL((NBCAR  ))
          VECT(3)=VELCHE(1,IBMN)
        ELSE
          VECT(3)=0.
        ENDIF
C
        RINT=REXT-EPAI
        FL=XPI*PRES*RINT**2
        IF (RACO.NE.0.D0) THEN
          FL=FL/SQRT(1.D0-0.25D0*XLON2/RACO**2)
        ENDIF
        CALL ZERO(WORK,1,12)
        WORK(1)=-FL
        WORK(7)=FL
C
        CALL POUPAS(XX,YY,ZZ,VECT,P,KERRE)

        IF (KERRE.NE.0) THEN
          INTERR(1)=ISOUS
          INTERR(2)=IB
          CALL ERREUR(138)
          RETURN
        ENDIF

        CALL POUVEC(WORK,XFORC,P,2)
C
C       REMPLISSAGE DU SEGMENT CONTENANT LES FORCES
C
        MPTVAL=IVAFOR
        IE=0
        DO     IGAU=1,2
          DO     ICOMP=1,6
            MELVAL=IVAL(ICOMP)
            IGMN=MIN(IGAU,VELCHE(/1))
            IBMN=MIN(IB  ,VELCHE(/2))
            IE=IE+1
            VELCHE(IGMN,IBMN)=XFORC(IE)
          enddo
        enddo
C
 103  CONTINUE

      RETURN
      END