C CUCBKP    SOURCE    CHAT      07/10/22    21:15:38     5921
          SUBROUTINE CUCBKP(IFACE,BKSIP,XNOE,B,AJAC)
       implicit real*8(A-H,O-Z)
       implicit integer(I-N)

*
*     ------------------------------------------------------------------
*      CALCUL DE LA MATRICE B AU POINT D INTEGRATION DONNNE
*
*                                                    H. BUNG     06-98
*     ------------------------------------------------------------------
*
*  ENTREES :
*     XNOE(24) : COORDONNEES DES NOEUDS
*     IPINT      : NO DU POINT D INTEGRATION
*     MOT        : NOM DE L ELEMENT FINI
*  SORTIE
*     B(NBLIB,NBN) : MATRICE B
*     AJAC         : JACOBIEN
*
*      IMPLICIT NONE
*
*      REAL *8 XNOE(24),BKSIP(3,4)
*      REAL *8 B(3,4),AJAC
*      INTEGER IFACE
       dimension XNOE(24),BKSIP(3,4),B(3,4)

*
*----   VARIABLES LOCALES
*
*      REAL *8 DJ(3,3),UJ(3,3)
*      INTEGER  LRET,I,J,K,NBN,IDECALAGE
       dimension DJ(3,3),UJ(3,3)
*
      NBN = 4
      IF(IFACE.EQ.1)THEN
         IDECALAGE=0
      ENDIF
      IF(IFACE.EQ.2)THEN
         IDECALAGE=12
      ENDIF
      IF(IFACE.NE.1.AND.IFACE.NE.2) THEN
         WRITE(6,*)'******** FACE NON DEFINIE DANS CUB_CALB_KP *******'
         call erreur(5)
         STOP
      ENDIF
*
*---   DJ = BKSIP * TRANSPOSE(XNOE)
*
      DO I=1,3
         DO J=1,3
            DJ(I,J) = 0.
         END DO
      END DO
      DO I=1,3
         DO J=1,3
            DO K=1,NBN
               DJ(J,I)=DJ(J,I)+BKSIP(J,K)*XNOE(IDECALAGE+(K-1)*3+I)
            END DO
         END DO
      END DO
*
*-----   UJ(J,I)  MATRICE INVERSE DE DJ(J,I)
*
      CALL INV33(DJ,UJ,AJAC,LRET)
C TEST SI ELEMENT TROP DEFORME: CROISEMENT

      AJAC=ABS(AJAC)
*
*-----   MATRICE ( B ) = UJ * BKSIP
*
      DO I=1,3
         DO J=1,NBN
            B(I,J)=0.
         END DO
      END DO
      DO K=1,3
         DO J=1,3
            DO I=1,NBN
               B(J,I)=B(J,I)+UJ(J,K)*BKSIP(K,I)
            END DO
         END DO
      END DO
*
      END


