pcoori.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "vect01_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	pcoori (x, ncp, mxt, mxg, nc1, nc2, nc3, deltax, x1, x2, x3, y1, y2, y3, z1, z2, z3, ibeam_vector, rbeam_vector, ivect, vect)

Function/Subroutine Documentation

pcoori()

subroutine pcoori	(		x,
		integer, dimension(nixp,*)	ncp,
		integer, dimension(mvsiz)	mxt,
		integer, dimension(mvsiz)	mxg,
		integer, dimension(mvsiz)	nc1,
		integer, dimension(mvsiz)	nc2,
		integer, dimension(mvsiz)	nc3,
			deltax,
			x1,
			x2,
			x3,
			y1,
			y2,
			y3,
			z1,
			z2,
			z3,
		integer, dimension(mvsiz), intent(in)	ibeam_vector,
		dimension(3,mvsiz), intent(in)	rbeam_vector,
		integer, dimension(mvsiz), intent(out)	ivect,
		dimension(3,mvsiz), intent(out)	vect )

Definition at line 33 of file pcoori.F.

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   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NCP(NIXP,*),NC1(MVSIZ), NC2(MVSIZ), NC3(MVSIZ),
     .        MXT(MVSIZ), MXG(MVSIZ)
      INTEGER , INTENT (IN)  :: IBEAM_VECTOR(MVSIZ)
      INTEGER , INTENT (OUT) :: IVECT(MVSIZ)
      my_real x1(mvsiz), x2(mvsiz), x3(mvsiz),
     .        y1(mvsiz), y2(mvsiz), y3(mvsiz),
     .        z1(mvsiz), z2(mvsiz), z3(mvsiz),x(3,*),deltax(mvsiz)
      my_real , INTENT (IN)  :: rbeam_vector(3,mvsiz)
      my_real , INTENT (OUT) :: vect(3,mvsiz)
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "vect01_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
      my_real xp1, xp2, xp3, xnor1, xp4, xp5, xp6,
     .        xnor2, xnorm, det1, det2, det3, det, xx,yy,zz,tol
C=======================================================================
C     CONNECTIVITES ET MATERIEL                   |
C--------------------------------------------------
      tol=two*em06
      DO i=lft,llt
        mxt(i)=ncp(1,i)
        nc1(i)=ncp(2,i)
        nc2(i)=ncp(3,i)
        nc3(i)=ncp(4,i)
        mxg(i)=ncp(5,i)
        ivect(i)=ibeam_vector(i)
        vect(1:3,i)=rbeam_vector(1:3,i)        
      END DO
C
C----------------------------
C     COORDINATES         |
C----------------------------
      DO i=lft,llt
        x1(i)=x(1,nc1(i))
        y1(i)=x(2,nc1(i))
        z1(i)=x(3,nc1(i))
        x2(i)=x(1,nc2(i))
        y2(i)=x(2,nc2(i))
        z2(i)=x(3,nc2(i))
        x3(i)=x(1,nc3(i))
        y3(i)=x(2,nc3(i))
        z3(i)=x(3,nc3(i))
      ENDDO
c
      DO i=lft,llt
        xx = (x1(i)-x2(i))*(x1(i)-x2(i)) 
        yy = (y1(i)-y2(i))*(y1(i)-y2(i)) 
        zz = (z1(i)-z2(i))*(z1(i)-z2(i)) 
        deltax(i) = sqrt(xx+yy+zz)
      ENDDO
C------------------------------
C     CONSISTENCY
C------------------------------     
      DO i=lft,llt
        xp1=x2(i)-x1(i)
        xp2=y2(i)-y1(i)
        xp3=z2(i)-z1(i)
        xnor1=sqrt(xp1*xp1+xp2*xp2+xp3*xp3)
        IF(xnor1<=em20) THEN
          CALL ancmsg(msgid=222,
     .                msgtype=msgerror,
     .                anmode=aninfo,
     .                i1=ncp(6,i))
        ENDIF
C
        IF (ivect(i)>0) THEN
C         DIRECTION DEFINED BY VECTOR : CHECK THAT VECTOR NOT COLINEAR WITH N1N2       
          xp4=vect(1,i)
          xp5=vect(2,i)
          xp6=vect(3,i)
          det1=xp1*xp5-xp2*xp4
          det2=xp2*xp6-xp3*xp5
          det3=xp3*xp4-xp1*xp6
          det= sqrt(det1**2+det2**2+det3**2)
          IF (det<tol) THEN
C           IVECT swithed to -1 - Y or Z global axis will be used instead of the vector            
            ivect(i) = -1
            CALL ancmsg(msgid=3090,
     .                  msgtype=msgwarning,
     .                  anmode=aninfo_blind_1,
     .                  i1=ncp(6,i),
     .                  prmod=msg_cumu)
          ENDIF              
        ELSE  
C         DIRECTION DEFINED WITH N3 : CHECK THAT N1N2 and N1N3 ARE NOT COLINEAR
          IF (nc3(i)==nc2(i)) cycle
          xp4=x3(i)-x1(i)
          xp5=y3(i)-y1(i)
          xp6=z3(i)-z1(i)
          xnor2=sqrt(xp4*xp4+xp5*xp5+xp6*xp6)
          IF(xnor2<em20) THEN
            CALL ancmsg(msgid=223,
     .                msgtype=msgerror,
     .                anmode=aninfo_blind_1,
     .                i1=ncp(6,i))
          ELSE
            det1=xp1*xp5-xp2*xp4
            det2=xp2*xp6-xp3*xp5
            det3=xp3*xp4-xp1*xp6
            det= sqrt(det1**2+det2**2+det3**2)
            IF (det<tol) THEN
              CALL ancmsg(msgid=3051,
     .                   msgtype=msgwarning,
     .                   anmode=aninfo_blind_1,
     .                   i1=ncp(6,i),
     .                   prmod=msg_cumu)
              nc3(i)=nc2(i)
            ENDIF
          ENDIF
        ENDIF   
      ENDDO
      CALL ancmsg(msgid=3051,
     .                  msgtype=msgwarning,
     .                  anmode=aninfo_blind_1,
     .                  prmod=msg_print)
      CALL ancmsg(msgid=3090,
     .                  msgtype=msgwarning,
     .                  anmode=aninfo_blind_1,
     .                  prmod=msg_print)
c-----------
      RETURN