C ZCOLOC    SOURCE    AM        12/02/06    21:16:18     7281
      SUBROUTINE ZCOLOC(XE,SHPTOT,NBNO,MELE,IFOUR,IGAU,BPSS)
C=======================================================================
C    -CALCUL DE LA MATRICE DE PASSAGE BPSS
C=======================================================================
C  INPUT
C     XE     = COORDONNEES  DE L ELEMENT
C     SHPTOT = FONCTIONS DE FORME
C            = SHPTOT(1,...) = FONCTIONS DE FORME
C            = SHPTOT(2,...) = DERIVEE PAR RAPPORT A QSI
C            = SHPTOT(3,...) = DERIVEE PAR RAPPORT A ETA
C     NBNO   = NOMBRE DE NOEUDS DE L'ELEMENT
C     MELE   = NUMERO DE L'ELEMENT FINI
C     IFOUR
C  OUTPUT
C     BPSS   = MATRICE DE PASSAGE REPERE GLOBAL/REPERE LOCAL
C=======================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION XE(3,*),BPSS(3,3),SHPTOT(6,NBNO,*)
      DIMENSION S1(3),SN(3)
C
      NDIM = 2
      IF(IFOUR.GT.0) NDIM = 3
C
C----------     CALCUL DE LA MATRICE DE  PASSAGE
C
      DO 6 I=1,3
         S1(I)=0.0D0
         SN(I)=0.0D0
    6 CONTINUE
C
C-------------------TANGENTE AU POINT DE GAUSS IGAU SELON QSI
C
      DO 7 I=1,NBNO
         DO 77 J=1,NDIM
           S1(J) = S1(J) + ( SHPTOT(2,I,IGAU)*XE(J,I) )
   77    CONTINUE
    7  CONTINUE
C
C-------------------NORMALISATION DE S1
C
       XNORME = SQRT((S1(1)**2) + (S1(2)**2) + (S1(3)**2))
       DO I=1,NDIM
         S1(I) = S1(I) / XNORME
       ENDDO

*
*    CAS PARTICULIERS 2D,3D
*

       GO TO (200,300),NDIM-1
       GO TO 99
 200   CONTINUE

***************
*    CAS 2D   *
***************
C
C-------------------NORMALE (PAR ROTATION DE 90 DEGRES )
C
       SN(1) = -S1(2)
       SN(2) =  S1(1)
C
C-------------------STOCKAGE DE LA MATRICE DE PASSAGE
C
       DO 10 I=1,2
          BPSS(1,I) = S1(I)
          BPSS(2,I) = SN(I)
   10  CONTINUE
*
       GO TO 400
*

 300   CONTINUE

***************
*    CAS 3D   *  PAS ENCORE DISPONIBLE
***************
       GO TO 99


 400  CONTINUE

      RETURN

99    CONTINUE

      RETURN
      END