C ZTOIMP    SOURCE    CB215821  26/08/24    21:19:06     12622          
      SUBROUTINE ZTOIMP(NEL,K0,NP,IPADL,LE,
     & DRR,COTE,NC4,IKIMPL,
     & UN,F,NPTD,TAU,NTAU,IKA)

      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C************************************************************************
C
C     SYNTAXE :
C
C        TOIMP (TO)
C
C
C************************************************************************
      DIMENSION UN(NPTD,*),F(NPTD,*),TAU(NTAU,*),COTE(NC4,NEL)
      DIMENSION XT(3),XN(3)
      DIMENSION LE(NP,NEL),IPADL(*),DRR(NP,NEL)

-INC PPARAM
-INC CCOPTIO
-INC CCREEL
*-

C
C
      IF(IDIM.EQ.3)GO TO 300

C                     *********
C                     *   2D  *
C                     *********

      DO 1003 K=1,NEL
      NK=K0+K
      KA=1+(1-IKA)*(NK-1)
C
      XT(1)=COTE(5,NK)
      XT(2)=COTE(7,NK)
      XN(1)=COTE(6,NK)
      XN(2)=COTE(8,NK)
C
      DO 50 I=1,NP
      NF=IPADL(LE(I,K))
C     UX=UN(NF,1)
C     UY=UN(NF,2)
C     UM=UX*UX+UY*UY
C     UM=SQRT(UM)+XPETIT
C     XT(1)=UX/UM
C     XT(2)=UY/UM
      FF1=(TAU(KA,1)*XT(1)+TAU(KA,2)*XN(1))*DRR(I,K)
      F(NF,1)=F(NF,1)-FF1*IKIMPL
      FF2=(TAU(KA,1)*XT(2)+TAU(KA,2)*XN(2))*DRR(I,K)
      F(NF,2)=F(NF,2)-FF2*IKIMPL
 50   CONTINUE
 1003 CONTINUE

      RETURN

C                     *********
C                     *   3D  *
C                     *********
 300  CONTINUE


      DO 1004 K=1,NEL
      NK=K0+K
      KA=1+(1-IKA)*(NK-1)
      XT(1)=COTE(5,NK)
      XT(2)=COTE(6,NK)
      XT(3)=COTE(7,NK)
      XN(1)=COTE(7 ,NK)
      XN(2)=COTE(10,NK)
      XN(3)=COTE(13,NK)
      TO=TAU(KA,1)*TAU(KA,1)+TAU(KA,2)*TAU(KA,2)
      TO=SQRT(TO)
C
      DO 350  I=1,NP

      NF=IPADL(LE(I,K))
C     UX=UN(NF,1)
C     UY=UN(NF,2)
C     UZ=UN(NF,3)
C     UM=UX*UX+UY*UY+UZ*UZ
C     UM=SQRT(UM)+XPETIT
C     XT(1)=UX/UM
C     XT(2)=UY/UM
C     XT(3)=UZ/UM

      FF1=(TO*XT(1)+TAU(KA,3)*XN(1))*DRR(I,K)
      F(NF,1)=F(NF,1)-FF1
      FF2=(TO*XT(2)+TAU(KA,3)*XN(2))*DRR(I,K)
      F(NF,2)=F(NF,2)-FF2
      FF3=(TO*XT(3)+TAU(KA,3)*XN(3))*DRR(I,K)
      F(NF,3)=F(NF,3)-FF3

 350  CONTINUE
 1004 CONTINUE


      RETURN


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