C KAM101    SOURCE    CHAT      05/01/13    00:51:04     5004
      SUBROUTINE KAM101(NELA,NEL,NP,IES,LE,AM,XCOOR,IPADL,IKAS,
     & IAXI,NES,NPG,FN,GR,HR,PG,PGSQ,RPG)
C************************************************************************
C   CALCUL DE LA MATRICE M ( P*DIV(U) )  --> AM(NP,IES,NEL)
C
C   IKAS=1  V NORMALE IMPOSEE
C   IKAS=-1 V TANGENTE IMPOSEE
C
C************************************************************************
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)

C***
      DIMENSION LE(NP,NEL),IPADL(*)
      DIMENSION AM(NELA,IES),XCOOR(*),P3(3,3)
      DIMENSION XYZ(3,9)
      DIMENSION FN(NP,NPG),GR(NES,NP,NPG),HR(IES,NP,NPG)
      DIMENSION PG(NPG),PGSQ(NPG),RPG(NPG)
C***

      IF(NP.LE.2.AND.IES.EQ.3)THEN
      WRITE(6,*)' Operateur VNSIMP ou VTSIMP (kam101) :'
      WRITE(6,*)' On ne sait pas traiter ce type d element'
      RETURN
      ENDIF

C     write(6,*)' IPADL'
C     write(6,1001)(IPADL(II),ii=1,100)

      DO 2 K=1,NEL
      DO 3 I=1,NP
      NU=LE(I,K)

      XYZ(1,I)=XCOOR((NU-1)*(IES+1)    +1)
      XYZ(2,I)=XCOOR((NU-1)*(IES+1)    +2)
      IF(IES.EQ.3)XYZ(3,I)=XCOOR((NU-1)*(IES+1)    +3)
 3    CONTINUE
C     write(6,*)' XYZ='
C     write(6,1002) XYZ



      IF(IES.EQ.2)THEN

      TX=XYZ(1,2)-XYZ(1,1)
      TY=XYZ(2,2)-XYZ(2,1)
      TT=TX*TX+TY*TY
      TT=SQRT(TT)
C      TX=TX/TT
C      TY=TY/TT
      AX=-TY
      AY=TX
      IF(IKAS.EQ.-1)THEN
      AX=TX
      AY=TY
      ENDIF
      DO 21 J=1,NP
      NU=IPADL(LE(J,K))
      AM(NU,1)=AM(NU,1)+AX
      AM(NU,2)=AM(NU,2)+AY
C      write(6,*)' le,nu=',LE(J,K),NU,' Ax,Ay=',AX,AY
C      write(6,1002)AM(NU,1),AM(NU,2)

 21   CONTINUE

      ELSEIF(IES.EQ.3)THEN
      IIAXI=0
      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IES,NP,NPG,IIAXI,AIRE)
      CALL CALJQB(XYZ,P3,IES,NP)
      DO 31 J=1,NP
      NU=IPADL(LE(J,K))
      AM(NU,1)=AM(NU,1)+P3(3,1)*AIRE
      AM(NU,2)=AM(NU,2)+P3(3,2)*AIRE
      AM(NU,3)=AM(NU,3)+P3(3,3)*AIRE
C      write(6,*)' le,nu=',LE(J,K),NU,' Aire=',AIRE
C      write(6,1002)AM(NU,1),AM(NU,2),AM(NU,3)
 31   CONTINUE
C     write(6,*)' P3= AORE=',AIRE
C     write(6,1002)P3
      ENDIF
 2    CONTINUE
C     write(6,*)' Sub kam101 FIN : AM='
C     DO 2101 k=1,nela
C     DO 2101 k=1,10
C     write(6,*)' k=',k
C     write(6,1002)(AM(k,i),i=1,ies)
C2101 CONTINUE

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

