C ASSKP2    SOURCE    CHAT      07/10/22    21:15:11     5921
      SUBROUTINE ASSKP2(IFACE,BKP,XN,tKP)
      IMPLICIT REAL*8(A-H,O-Z)
      IMPLICIT INTEGER (I-N)


C ASSEMBLAGE DE KP POUR LE SHB8
*      REAL *8 BKP(3,4),XN(3),tkp(24,24),XKP(24),YKP(24),ZKP(24),B(3,8)
*      REAL *8 KPTMP(24,24)
*      INTEGER I,J,IFACE
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

      DIMENSION BKP(3,4),XN(3),tkp(24,24),XKP(24),YKP(24),ZKP(24),B(3,8)
      dimension tkptmp(24,24)
      IF(IFACE.NE.1.AND.IFACE.NE.2) THEN
         WRITE(6,*)'******** FACE NON DEFINIE DANS ASSE_KP2 *******'
         CALL ERREUR(5)
         STOP
      ENDIF
      DO I=1,3
         DO J=1,8
            B(I,J)=0.
         ENDDO
      ENDDO
      IF(IFACE.EQ.1)THEN
CCCCCCCCCCCCCCC PRESSION SUR FACE INFERIEURE
         DO I=1,3
            DO J=1,4
               B(I,J)=BKP(I,J)
            ENDDO
         ENDDO
      ENDIF
      IF(IFACE.EQ.2)THEN
CCCCCCCCCCCCCCC PRESSION SUR FACE SUPERIEURE
         DO I=1,3
            DO J=5,8
               B(I,J)=BKP(I,J-4)
            ENDDO
         ENDDO
      ENDIF
      DO I=1,24
         XKP(I)=0.
         YKP(I)=0.
         ZKP(I)=0.
      ENDDO
      DO I=9,16
         XKP(I)=B(2,I-8)*XN(1)-B(1,I-8)*XN(2)
      ENDDO
      DO I=17,24
         XKP(I)=B(3,I-16)*XN(1)-B(1,I-16)*XN(3)
      ENDDO
      DO I=1,8
         YKP(I)=B(1,I)*XN(2)-B(2,I)*XN(1)
      ENDDO
      DO I=17,24
         YKP(I)=B(3,I-16)*XN(2)-B(2,I-16)*XN(3)
      ENDDO
      DO I=1,8
         ZKP(I)=B(1,I)*XN(3)-B(3,I)*XN(1)
      ENDDO
      DO I=9,16
         ZKP(I)=B(2,I-8)*XN(3)-B(3,I-8)*XN(2)
      ENDDO
      DO I=1,24
         DO J=1,24
            tkptmp(J,I)=0.
         ENDDO
      ENDDO
      DO I=1,24
         DO J=1,8
            tkptmp(J,I)=XKP(I)
         ENDDO
         DO J=9,16
            tkptmp(J,I)=YKP(I)
         ENDDO
         DO J=17,24
            tkptmp(J,I)=ZKP(I)
         ENDDO
      ENDDO
      DO I=1,24
         DO J=1,24
            tkp(I,J)=(tkptmp(I,J)+tkptmp(J,I))/2.
C            KP(I,J)=KPTMP(I,J)
         ENDDO
      ENDDO
      RETURN
      END


