3points_to_frame.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    points_to_frame   ../starter/source/model/submodel/3points_to_frame.F
!||--- called by ------------------------------------------------------
!||    lectrans          ../starter/source/model/transformation/lectrans.F
!||    lectranssub       ../starter/source/model/submodel/lectranssub.F
!||--- uses       -----------------------------------------------------
!||    message_mod       ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE points_to_frame(X1, X2, X3 ,PP, IERROR)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      my_real
     .  x1(3),x2(3),x3(3),pp(3,3)
      INTEGER IERROR
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      my_real
     .  u(3),v(3),w(3),
     .  nn,pnor1,pnor2,pnorm1,det,det1,det2,det3
C-----------------------------------------------
      ierror = 0
C-----
      u(1) = x2(1) - x1(1)
      u(2) = x2(2) - x1(2)
      u(3) = x2(3) - x1(3)
      v(1) = x3(1) - x1(1)
      v(2) = x3(2) - x1(2)
      v(3) = x3(3) - x1(3)
      w(1) = u(2)*v(3)-u(3)*v(2)   ! W=UxV
      w(2) = u(3)*v(1)-u(1)*v(3)
      w(3) = u(1)*v(2)-u(2)*v(1)
      v(1) = w(2)*u(3)-w(3)*u(2)   ! V=WxU
      v(2) = w(3)*u(1)-w(1)*u(3)
      v(3) = w(1)*u(2)-w(2)*u(1)
C------------
C     TESTS DE CONSISTANCE
C------------
      pnor1=sqrt(u(1)*u(1)+u(2)*u(2)+u(3)*u(3))
      IF (pnor1 < em20) THEN
        ierror=1
C       CALL ANCMSG(MSGID=1866,
C     .             MSGTYPE=MSGERROR,
C     .             ANMODE=ANINFO_BLIND_1,
C     .             I1=ID,C1=TITR,
C     .             I2=N1,
C     .             I3=N2)
        RETURN
      END IF
C     CALCUL DE COLINEARITE DES VECTEURS N1N2 ET N1N3
      pnor2=sqrt(v(1)*v(1)+v(2)*v(2)+v(3)*v(3))
      IF (pnor2 > em20) THEN
        pnorm1=one/(pnor1*pnor2)
        det1=abs((u(2)*v(3)-u(3)*v(2))*pnorm1)
        det2=abs((u(3)*v(1)-u(1)*v(3))*pnorm1)
        det3=abs((u(1)*v(2)-u(2)*v(1))*pnorm1)
        det= max(det1,det2,det3)
      ELSE
        det=zero
      ENDIF
      IF (det < em5) THEN
        ierror=2
C       CALL ANCMSG(MSGID=1867,
C    .              MSGTYPE=MSGWARNING,
C    .              ANMODE=ANINFO_BLIND_1,
C    .              I1=ID,C1=TITR)
        IF(abs(u(2)) > em5) THEN
          v(1)=abs(u(1))+ten
        ELSE
          v(2)=ten
        ENDIF
      ENDIF
C------------
      w(1) = u(2)*v(3)-u(3)*v(2)   ! W=UxV
      w(2) = u(3)*v(1)-u(1)*v(3)
      w(3) = u(1)*v(2)-u(2)*v(1)
C------------
      nn = one/max(em20,sqrt(u(1)*u(1)+u(2)*u(2)+u(3)*u(3)))
      u(1) = u(1)*nn
      u(2) = u(2)*nn
      u(3) = u(3)*nn
      nn = one/max(em20,sqrt(v(1)*v(1)+v(2)*v(2)+v(3)*v(3)))
      v(1) = v(1)*nn
      v(2) = v(2)*nn
      v(3) = v(3)*nn
      nn = one/max(em20,sqrt(w(1)*w(1)+w(2)*w(2)+w(3)*w(3)))
      w(1) = w(1)*nn
      w(2) = w(2)*nn
      w(3) = w(3)*nn
C------------
      pp(1,1)=u(1)
      pp(2,1)=u(2)
      pp(3,1)=u(3)
      pp(1,2)=v(1)
      pp(2,2)=v(2)
      pp(3,2)=v(3)
      pp(1,3)=w(1)
      pp(2,3)=w(2)
      pp(3,3)=w(3)
C------------
      RETURN 
      END