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