Sources Esope | Cast3M

tq4loc
C TQ4LOC    SOURCE    CHAT      05/01/13    03:44:00     5004
      SUBROUTINE TQ4LOC (XE,BPSS,IRR)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC CCREEL
************************************************************************
*
*                             T Q 4 L O C
*                             -----------
*
* FONCTION:
* ---------
*
*     Calcul le repre local d'un {l{ment COQ4.
*
* PARAMETRES:   (E)=ENTREE   (S)=SORTIE   (+ = CONTENU DANS UN COMMUN)
* -----------
*
*     XE      (E)  Coordonn{es des 4 noeuds.
*     BPSS    (S)  Matrice de passage.
*     IRR     (S)  =1 SUCCES ,=0 ECHEC
      REAL*8 XE(3,*),BPSS(3,*)
*
* VARIABLES:
* ----------
*
*     QSI1   = vecteur norm{ de la m{diane allant de 4-1 vers 2-3.
*     ETA1   = vecteur norm{ de la m{diane allant de 1-2 vers 3-4.
*     X1, Y1 = vecteurs du rep}re local, dans le plan moyen de
*              l'{l{ment.
*     Z1     = vecteur du rep}re local, normal au plan moyen de
*              l'{l{ment.
*
      REAL*8 QSI1(3),ETA1(3),X1(3),Y1(3),Z1(3)
      REAL*8 U1(3),V1(3)
*
* MODE DE FONCTIONNEMENT:
* -----------------------
*
*     Pour le calcul du rep}re local et de la matrice de passage, on
*     fait une estimation du plan moyen.
*
* AUTEUR, DATE DE CREATION:
* -------------------------
*
*     PASCAL MANIGOT     09 JUILLET 1991
*
* LANGAGE:
* --------
*
*     FORTRAN77
*
************************************************************************
*
*
*     Calcul du rep}re local
*     ----------------------
*
*              Y
*         4    |          3
*          *---|---------*
*          |   |         |
*          |   |         |
*          |   |         |
*          |   +------------X
*          |             |
*          *-------------*
*         1               2
*
*
      IRR=1
*     Calcul des m{dianes:
      QSI1(1) = XE(1,2)+XE(1,3) - XE(1,1)-XE(1,4)
      QSI1(2) = XE(2,2)+XE(2,3) - XE(2,1)-XE(2,4)
      QSI1(3) = XE(3,2)+XE(3,3) - XE(3,1)-XE(3,4)
      XNORM=SQRT(QSI1(1)**2+QSI1(2)**2+QSI1(3)**2)
      IF(XNORM.GE.XPETIT)THEN
        CALL NORMER (QSI1)
      ELSE
         IRR=0
         RETURN
      ENDIF
      ETA1(1) = XE(1,3)+XE(1,4) - XE(1,1)-XE(1,2)
      ETA1(2) = XE(2,3)+XE(2,4) - XE(2,1)-XE(2,2)
      ETA1(3) = XE(3,3)+XE(3,4) - XE(3,1)-XE(3,2)
      XNORM=SQRT(ETA1(1)**2+ETA1(2)**2+ETA1(3)**2)
      IF(XNORM.GE.XPETIT)THEN
        CALL NORMER (QSI1)
      ELSE
         IRR=0
         RETURN
      ENDIF
      CALL NORMER (ETA1)
*
*     Normale = Normale aux 2 m{dianes.
      Z1(1)= QSI1(2)*ETA1(3) - QSI1(3)*ETA1(2)
      Z1(2)= QSI1(3)*ETA1(1) - QSI1(1)*ETA1(3)
      Z1(3)= QSI1(1)*ETA1(2) - QSI1(2)*ETA1(1)
      CALL NORMER (Z1)
*
*     Axes dans le Plan = bissectrices des bissectrices des m{dianes
*                       = m{dianes pour un {l{ment rectangulaire
      U1(1) = QSI1(1) - ETA1(1)
      U1(2) = QSI1(2) - ETA1(2)
      U1(3) = QSI1(3) - ETA1(3)
      CALL NORMER (U1)
      V1(1) = QSI1(1) + ETA1(1)
      V1(2) = QSI1(2) + ETA1(2)
      V1(3) = QSI1(3) + ETA1(3)
      CALL NORMER (V1)
*
      X1(1) = U1(1) + V1(1)
      X1(2) = U1(2) + V1(2)
      X1(3) = U1(3) + V1(3)
      CALL NORMER (X1)
*
      Y1(1)=X1(3)*Z1(2)-X1(2)*Z1(3)
      Y1(2)=X1(1)*Z1(3)-X1(3)*Z1(1)
      Y1(3)=X1(2)*Z1(1)-X1(1)*Z1(2)
      CALL NORMER (Y1)
*
*     Matrice de passage
*     ------------------
*
      DO 15 I=1,3
        BPSS(I,1)=X1(I)
        BPSS(I,2)=Y1(I)
        BPSS(I,3)=Z1(I)
  15  CONTINUE
*
      RETURN
      END