C BCO2      SOURCE    AM        19/04/30    21:15:00     10215          

      SUBROUTINE BCO2(IGAU,MFR,IFOU,NIFOU,XEL,BPSS,SHPTOT,SHP,
     .                BGENE,DJAC,IRRT,IDIM,NBNO,NST,LRE)
C=======================================================================
C
C     CALCUL DE LA MATRICE B = TETA * ( N , -N )
C     ET DU JACOBIEN EN IGAU
C          ROUTINE FORTRAN PUR
C          DERIVEE DE LA ROUTINE BJO4 PAR S. FELIX
C=======================================================================
C  INPUT
C     IGAU  = NUMERO DU POINT DE GAUSS
C     XEL   = COORDONNEES DES NOEUDS DE L'ELEMENT
C     BPSS  = MATRICE DE PASSAGE
C             BPSS(,) = AXE S1
C             BPSS(,) = AXE S2
C             BPSS(,) = AXE SN
C     SHPTOT= FONCTIONS DE FORME ET DERIVEES DANS L'ESPACE DE REFERENCE
C             SHPTOT(1, ) = FONCTION DE FORME
C             SHPTOT(2, ) = DERIVEES PAR RAPPORT A QSI
C             SHPTOT(3, ) = DERIVEES PAR RAPPORT A ETA
C  OUTPUT
C     SHP   = FONCTIONS DE FORME ET DERIVEES DANS L'ESPACE GEOMETRIQUE
C             SHP(1, ) = FONCTION DE FORME
C             SHP(2, ) = DERIVEES PAR RAPPORT A X LOCAL
C             SHP(3, ) = DERIVEES PAR RAPPORT A Y LOCAL
C     DJAC  = JACOBIEN AU POINT D'INTEGRATION IGAU
C     BGENE = MATRICE B AU POINT D'INTEGRATION IGAU
C     IRRT  = DIFFERENT DE ZERO SI ERREUR
C     NBNO  = NOMBRE DE NOEUDS
C     NST   = NOMBRE DE COMPOSANTES DE CONTRAINTES
C     LRE   = NOMBRE DE COLONNES DE LA MATRICE B
C
C  REMARQUE : ATTENTION : DANS LES CAS CONTRAINTES PLANES ET
C             AXISYMETRIQUE, LA MATRICE BPSS ( RESPECTIVEMENT BGENE )
C             N'A PLUS LA DIMENSION (3X3) ( RESPECTIVEMENT (3X18) ).
C             TROUVER LEURS DIMENSIONS CORRECTES ET MODIFIER LES
C             PARAMETRES LRE, NST, NBNO. CEUX CI CORRESPONDRONT A
C             CEUX DU CAS BIDIMENSIONNELS.
C
C=======================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      PARAMETER (XZero=0.,XUn=1.)
      DIMENSION XEL(3,*),BGENE(NST,*),SHP(6,*),SHPTOT(6,NBNO,*)
      DIMENSION BPSS(3,3)
C
      IRRT = 0
C
C     MATRICE JACOBIENNE
C
      DO 1 I=1,NBNO
       SHP(1,I) = SHPTOT(1,I,IGAU)
       SHP(2,I) = SHPTOT(2,I,IGAU)
    1 CONTINUE
C
C !!!!!! ATTENTION : IL FAUT CALCULER LE JACOBIEN AVEC NBNO=4 !!!!!!
C        IL NE FAUT SURTOUT PAS METTRE NBNO=4 CAR CA FAUSSE ALORS
C        LES RESULTATS ... NBNO DOIT ETRE EGAL A 4 CAR IL YA 4 NOEUDS
C

      NBNONN=NBNO/2
      CALL DEVOLU(XEL,SHP,MFR,NBNONN,IFOU,NIFOU,1,1.D0,RR,DJAC)
      DJac=XZero
      dJInv=XZero
      DO i=1,NBNONN
         DJac=DJac+SHP(2,i)*XEL(1,i)
      ENDDO
      IF (DJac.NE.XZero) dJInv=XUn/DJac
      DO i=1,NBNONN
            SHP(2,i)=SHP(2,i)*dJInv
      ENDDO
      IF (DJAC.LT.0.0D0) THEN
           IRRT = 1
      ELSE IF (DJAC.EQ.0.0D0) THEN
           IRRT = 2
      ELSE IF (DJAC.GT.0.0D0) THEN
           IRRT = 0
           DJAC = 0.5
      ENDIF

C
C     MATRICE B
C
      CALL ZERO(BGENE,NST,LRE)
      DO 2 I=1,IDIM
       DO 3 J=1,2
        DO 4 K=1,IDIM

**  AM  30/04/19
**       L=3*(J-1)+K
**       M=L+6
         L=IDIM*(J-1)+K
         M=L+2*IDIM
         BGENE(I,L)=BPSS(I,K)*SHP(1,J)
         BGENE(I,M)=-BGENE(I,L)
    4   CONTINUE
    3  CONTINUE
    2 CONTINUE
C

      RETURN
      END