3points_to_frame.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	points_to_frame (x1, x2, x3, pp, ierror)

Function/Subroutine Documentation

points_to_frame()

subroutine points_to_frame	(		x1,
			x2,
			x3,
			pp,
		integer	ierror )

Definition at line 31 of file 3points_to_frame.F.

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