C RLOSHB    SOURCE    PV090527  26/05/20    21:15:05     12553          
      SUBROUTINE RLOSHB(XCOQ,XCENT,PPP,XL,XV24,XV13,XJ)
      implicit real*8(a-h,o-z)
      implicit integer (i-n)

*
*     ------------------------------------------------------------------
*
*          REPERE LOCAL DE LA COQUE BELYTCHKO
*          ===> MATRICE DE PASSAGE PPP
*                                               H. BUNG      02-93
*     ------------------------------------------------------------------
*
*     XCOQ     : COORDONNEES DES 4 NOEUDS COQUES(REPERE GLOBAL)
*     PPP      : MATRICE DE PASSAGE GLOBAL -> LOCAL
*     XCENT    : COORDONNEES DANS LE REPERE GLOBAL DU CENTRE DE L ELEMENT
*     XL       : COORDONNEES DES 4 NOEUDS COQUES DANS LE
*                  LE REPERE LOCAL (XCENT, E1, E2, E3)
*
*      IMPLICIT NONE
*
*---   VARIABLES GLOBALES
*      REAL *8 XCOQ(3,*),XCENT(*),PPP(3,*),XL(3,*),XV13(3),XV24(3),XJ
      dimension XCOQ(3,*),XCENT(*),PPP(3,*),XL(3,*),XV13(3),XV24(3)
*
*---   VARIABLES LOCALES
*      INTEGER NBN
      PARAMETER(NBN=4)
*
*      REAL *8 XMEAN(3,4),SS(3),AUX,TMP
*      INTEGER IP,II
      dimension XMEAN(3,4),SS(3)
*
*
*----     DEFINITION DES 4 POINTS  MILIEUX DES COTES
      II=NBN
      DO IP=1,NBN
          XMEAN(1,IP) = 0.5D0*(XCOQ(1,II)+XCOQ(1,IP))
          XMEAN(2,IP) = 0.5D0*(XCOQ(2,II)+XCOQ(2,IP))
          XMEAN(3,IP) = 0.5D0*(XCOQ(3,II)+XCOQ(3,IP))
          II=IP
      END DO
*
      XCENT(1) = 0.5D0*(XMEAN(1,1)+XMEAN(1,3))
      XCENT(2) = 0.5D0*(XMEAN(2,1)+XMEAN(2,3))
      XCENT(3) = 0.5D0*(XMEAN(3,1)+XMEAN(3,3))
C
C XV13 EST DANS LA DIRECTION DE E2
C
      XV13(1)  = 0.5D0*(XMEAN(1,3)-XMEAN(1,1))
      XV13(2)  = 0.5D0*(XMEAN(2,3)-XMEAN(2,1))
      XV13(3)  = 0.5D0*(XMEAN(3,3)-XMEAN(3,1))
C
C XV24 = E1
C
      XV24(1)  = 0.5D0*(XMEAN(1,4)-XMEAN(1,2))
      XV24(2)  = 0.5D0*(XMEAN(2,4)-XMEAN(2,2))
      XV24(3)  = 0.5D0*(XMEAN(3,4)-XMEAN(3,2))
*
*-----      REPERE LOCAL
*
C
C LE VECTEUR UNITAIRE E1 (PPP(;,1))= XV24 / ||XV24||
C
      TMP=SQRT(XV24(1)*XV24(1)+XV24(2)*XV24(2)+XV24(3)*XV24(3))
      PPP(1,1)=XV24(1)/TMP
      PPP(2,1)=XV24(2)/TMP
      PPP(3,1)=XV24(3)/TMP
C
C LE VECTEUR UNITAIRE E3 (PPP(;,3)) = XV24 ^ XV13
C
      SS(1) = XV24(2)*XV13(3) - XV24(3)*XV13(2)
      SS(2) = XV24(3)*XV13(1) - XV24(1)*XV13(3)
      SS(3) = XV24(1)*XV13(2) - XV24(2)*XV13(1)
      XJ = SQRT (SS(1)*SS(1)+SS(2)*SS(2)+SS(3)*SS(3))
      IF(XJ.GT.0) THEN
        AUX=1/XJ
        PPP(1,3) = SS(1) * AUX
        PPP(2,3) = SS(2) * AUX
        PPP(3,3) = SS(3) * AUX
      ELSE
        call erreur(345)
        PPP(1,3) = 1.          
        PPP(2,3) = 1.          
        PPP(3,3) = 1.             
***     STOP 'RLOSHB_3'
      ENDIF
C
C LE VECTEUR UNITAIRE  E2 = E3 ^ E1
C
      PPP(1,2) = PPP(2,3)*PPP(3,1) - PPP(3,3)*PPP(2,1)
      PPP(2,2) = PPP(3,3)*PPP(1,1) - PPP(1,3)*PPP(3,1)
      PPP(3,2) = PPP(1,3)*PPP(2,1) - PPP(2,3)*PPP(1,1)
C
C DANS XMEAN, ON MET XCOQ DANS LE REPERE GLOBAL TRANSLATE AU POINT XCENT
C
      DO IP=1,NBN
        XMEAN(1,IP) = XCOQ(1,IP)-XCENT(1)
        XMEAN(2,IP) = XCOQ(2,IP)-XCENT(2)
        XMEAN(3,IP) = XCOQ(3,IP)-XCENT(3)
      END DO
C
C XL : COORD DES 4 NOEUDS COQUE DANS LE REPERE LOCAL (XCENT,E1,E2,E3)
C
      DO IP=1,NBN
        XL(1,IP) =  PPP(1,1)*XMEAN(1,IP) + PPP(2,1)*XMEAN(2,IP)
     &           +  PPP(3,1)*XMEAN(3,IP)
        XL(2,IP) =  PPP(1,2)*XMEAN(1,IP) + PPP(2,2)*XMEAN(2,IP)
     &           +  PPP(3,2)*XMEAN(3,IP)
        XL(3,IP) =  PPP(1,3)*XMEAN(1,IP) + PPP(2,3)*XMEAN(2,IP)
     &           +  PPP(3,3)*XMEAN(3,IP)
      END DO
*
      END