C YFRTI     SOURCE    MAGN      14/07/15    21:15:05     8096
      SUBROUTINE YFRTI(DRR,LE,NEL,K0,NPT,IES,NP,IAXI,IPADL,KIMPL,
     &                 COEF,NCOEF,IKK,
     &                 BETA,NBETA,IKB,
     &                 V0  ,NV0  ,IKV,
     &                 UN,F,F1)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C***********************************************************************
C
C                                                BETA
C     CALCUL LE TENSEUR DE PERTE DE CHARGE    K U           I KX       I
C                                                     K-->  I    KY    I
C                                                           I       KZ I
C
C     COEFF    :  K
C     BETA     :  BETA
C
C
C
C***********************************************************************
C
      DIMENSION LE(NP,*),IPADL(*),DRR(NP,NEL)
      DIMENSION UN(NPT,IES),F(NPT,IES),F1(NPT,IES)
      DIMENSION COEF(NCOEF,IES),BETA(NBETA,IES),V0(NV0,IES)
-INC CCREEL
C
      IF(IES.EQ.2) THEN
C
C                 *******
C                 * 2 D *
C                 *******
C
C     write(6,*)' NPT=',NPT,' IES=',IES,' IKK=',ikk,' IKB=',ikb,
C    & ' IKV=',ikv

      IF(KIMPL.EQ.0)THEN

      DO 502 K=1,NEL
      NK=K+K0
      KK=1+(1-IKK)*(NK-1)
      KB=1+(1-IKB)*(NK-1)

      DO 502 I=1,NP
      NF=IPADL(LE(I,K))
      KV=1+(1-IKV)*(NF-1)
      UXN=UN(NF,1)-V0(KV,1)
      UX=ABS(UXN)+XPETIT
      BX=(BETA(KB,1)-1.D0)*LOG(UX)
      ABX=ABS(BX)
      IF(ABX.LE.XPETIT)THEN
      UX=1.D0
      ELSE
      UX=EXP(BX)
      ENDIF
      UYN=UN(NF,2)-V0(KV,2)
      UY=ABS(UYN)+XPETIT
      BY=(BETA(KB,2)-1.D0)*LOG(UY)
      ABY=ABS(BY)
      IF(ABY.LE.XPETIT)THEN
      UY=1.D0
      ELSE
      UY=EXP(BY)
      ENDIF
      FF1=COEF(KK,1)*UX*UXN*DRR(I,K)*(-1.)
      FF2=COEF(KK,2)*UY*UYN*DRR(I,K)*(-1.)
      F(NF,1)=F(NF,1)+FF1
      F(NF,2)=F(NF,2)+FF2
 502  CONTINUE

      ELSE
      DO 402 K=1,NEL
      NK=K+K0
      KK=1+(1-IKK)*(NK-1)
      KB=1+(1-IKB)*(NK-1)

      DO 402 I=1,NP
      NF=IPADL(LE(I,K))
      KV=1+(1-IKV)*(NF-1)

      UXNE=-V0(KV,1)
      UXNI=UN(NF,1)
      UXN =UN(NF,1)-V0(KV,1)
      UX=ABS(UXN)+XPETIT
      BX=(BETA(KB,1)-1.D0)*LOG(UX)
      ABX=ABS(BX)
      IF(ABX.LE.XPETIT)THEN
      UX=1.D0
      ELSE
      UX=EXP(BX)
      ENDIF

      UYNE=-V0(KV,2)
      UYNI=UN(NF,2)
      UYN =UN(NF,2)-V0(KV,2)
      UY=ABS(UYN)+XPETIT
      BY=(BETA(KB,2)-1.D0)*LOG(UY)
      ABY=ABS(BY)
      IF(ABY.LE.XPETIT)THEN
      UY=1.D0
      ELSE
      UY=EXP(BY)
      ENDIF

      FFE1=COEF(KK,1)*UX*UXNE*DRR(I,K)
c      il semble qu'il y ait une erreur sur le terme
c      FFI1 mis en commentaire. On le remplace par
c      l'expression suivante.
c      FFI1=COEF(KK,1)*UX*UXNI*DRR(I,K)
      FFI1=COEF(KK,1)*UX*DRR(I,K)
      FFE2=COEF(KK,2)*UY*UYNE*DRR(I,K)
c      il semble qu'il y ait une erreur sur le terme
c      FFI2 mis en commentaire. On le remplace par
c      l'expression suivante.
c      FFI2=COEF(KK,2)*UY*UYNI*DRR(I,K)
      FFI2=COEF(KK,2)*UY*DRR(I,K)
      F(NF,1)=F(NF,1)+FFE1
      F(NF,2)=F(NF,2)+FFE2
      F1(NF,1)=F1(NF,1)+FFI1
      F1(NF,2)=F1(NF,2)+FFI2
 402  CONTINUE

      ENDIF

C
C                 *******
C                 * 3 D *
C                 *******
C
      ELSE

      IF(KIMPL.EQ.0)THEN

      DO 503 K=1,NEL
      NK=K+K0
      KK=1+(1-IKK)*(NK-1)
      KB=1+(1-IKB)*(NK-1)

      DO 503 I=1,NP
      NF=IPADL(LE(I,K))
      KV=1+(1-IKV)*(NF-1)
      UXN=UN(NF,1)-V0(KV,1)
      UX=ABS(UXN)+XPETIT
      BX=(BETA(KB,1)-1.D0)*LOG(UX)
      ABX=ABS(BX)
      IF(ABX.LE.XPETIT)THEN
      UX=1.D0
      ELSE
      UX=EXP(BX)
      ENDIF
      UYN=UN(NF,2)-V0(KV,2)
      UY=ABS(UYN)+XPETIT
      BY=(BETA(KB,2)-1.D0)*LOG(UY)
      ABY=ABS(BY)
      IF(ABY.LE.XPETIT)THEN
      UY=1.D0
      ELSE
      UY=EXP(BY)
      ENDIF
      UZN=UN(NF,3)-V0(KV,3)
      UZ=ABS(UZN)+XPETIT
      BZ=(BETA(KB,3)-1.D0)*LOG(UZ)
      ABZ=ABS(BZ)
      IF(ABZ.LE.XPETIT)THEN
      UZ=1.D0
      ELSE
      UZ=EXP(BZ)
      ENDIF
      FF1=COEF(KK,1)*UX*UXN*DRR(I,K)*(-1.)
      FF2=COEF(KK,2)*UY*UYN*DRR(I,K)*(-1.)
      FF3=COEF(KK,3)*UZ*UZN*DRR(I,K)*(-1.)
      F(NF,1)=F(NF,1)+FF1
      F(NF,2)=F(NF,2)+FF2
      F(NF,3)=F(NF,3)+FF3
 503  CONTINUE

      ELSE
      DO 403 K=1,NEL
      NK=K+K0
      KK=1+(1-IKK)*(NK-1)
      KB=1+(1-IKB)*(NK-1)

      DO 403 I=1,NP
      NF=IPADL(LE(I,K))

      KV=1+(1-IKV)*(NF-1)
      UXNE=-V0(KV,1)
      UXNI=UN(NF,1)
      UXN =UN(NF,1)-V0(KV,1)
      UX=ABS(UXN)+XPETIT
      BX=(BETA(KB,1)-1.D0)*LOG(UX)
      ABX=ABS(BX)
      IF(ABX.LE.XPETIT)THEN
      UX=1.D0
      ELSE
      UX=EXP(BX)
      ENDIF

      UYNE=-V0(KV,2)
      UYNI=UN(NF,2)
      UYN =UN(NF,2)-V0(KV,2)
      UY=ABS(UYN)+XPETIT
      BY=(BETA(KB,2)-1.D0)*LOG(UY)
      ABY=ABS(BY)
      IF(ABY.LE.XPETIT)THEN
      UY=1.D0
      ELSE
      UY=EXP(BY)
      ENDIF

      UZNE=-V0(KV,3)
      UZNI=UN(NF,3)
      UZN =UN(NF,3)-V0(KV,3)
      UZ=ABS(UZN)+XPETIT
      BZ=(BETA(KB,3)-1.D0)*LOG(UZ)
      ABZ=ABS(BZ)
      IF(ABZ.LE.XPETIT)THEN
      UZ=1.D0
      ELSE
      UZ=EXP(BZ)
      ENDIF

      FFE1=COEF(KK,1)*UX*UXNE*DRR(I,K)
c      il semble qu'il y ait une erreur sur le terme
c      FFI1 mis en commentaire. On le remplace par
c      l'expression suivante.
c      FFI1=COEF(KK,1)*UX*UXNI*DRR(I,K)
      FFI1=COEF(KK,1)*UX*DRR(I,K)
      FFE2=COEF(KK,2)*UY*UYNE*DRR(I,K)
c      il semble qu'il y ait une erreur sur le terme
c      FFI2 mis en commentaire. On le remplace par
c      l'expression suivante.
c      FFI2=COEF(KK,2)*UY*UYNI*DRR(I,K)
      FFI2=COEF(KK,2)*UY*DRR(I,K)
      FFE3=COEF(KK,3)*UZ*UZNE*DRR(I,K)
c      il semble qu'il y ait une erreur sur le terme
c      FFI3 mis en commentaire. On le remplace par
c      l'expression suivante.
c      FFI3=COEF(KK,3)*UZ*UZNI*DRR(I,K)
      FFI3=COEF(KK,3)*UZ*DRR(I,K)
      F(NF,1)=F(NF,1)+FFE1
      F(NF,2)=F(NF,2)+FFE2
      F(NF,3)=F(NF,3)+FFE3
      F1(NF,1)=F1(NF,1)+FFI1
      F1(NF,2)=F1(NF,2)+FFI2
      F1(NF,3)=F1(NF,3)+FFI3
 403  CONTINUE

      ENDIF

      ENDIF


      RETURN
 1001 FORMAT(20(1X,I5))
 1002 FORMAT(10(1X,1PE11.4))
      END