qrcoor2.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	qrcoor2 (x, ixq, ngl, mxt, pid, ix1, ix2, ix3, ix4, y1, y2, y3, y4, z1, z2, z3, z4, sy, sz, ty, tz, e1y, e1z, e2y, e2z)

Function/Subroutine Documentation

qrcoor2()

subroutine qrcoor2	(		x,
		integer, dimension(nixq,*)	ixq,
		integer, dimension(*)	ngl,
		integer, dimension(*)	mxt,
		integer, dimension(*)	pid,
		integer, dimension(*)	ix1,
		integer, dimension(*)	ix2,
		integer, dimension(*)	ix3,
		integer, dimension(*)	ix4,
			y1,
			y2,
			y3,
			y4,
			z1,
			z2,
			z3,
			z4,
			sy,
			sz,
			ty,
			tz,
			e1y,
			e1z,
			e2y,
			e2z )

Definition at line 28 of file qrcoor2.F.

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   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "vect01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IXQ(NIXQ,*), NGL(*), MXT(*), PID(*)
      INTEGER IX1(*), IX2(*), IX3(*), IX4(*)
C     REAL
      my_real
     .   x(3,*),e1y(*),e1z(*),e2y(*),e2z(*)
      my_real
     .   y1(*), y2(*), y3(*), y4(*),
     .   z1(*), z2(*), z3(*), z4(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
C     REAL
      my_real
     .   sy(mvsiz) ,sz(mvsiz) ,
     .   ty(mvsiz) ,tz(mvsiz), suma,cs,ct
C--------------------------------------------------
C     CONNECTIVITES ET MATERIEL
C--------------------------------------------------
      DO i=lft,llt
        mxt(i)=ixq(1,i)
        ix1(i)=ixq(2,i)
        ix2(i)=ixq(3,i)
        ix3(i)=ixq(4,i)
        ix4(i)=ixq(5,i)
        pid(i)=ixq(6,i)
        ngl(i)=ixq(nixq,i)
      END DO
C
C----------------------------
C     COORDONNEES NOEUDS    |
C----------------------------
      DO i=lft,llt
        y1(i)=x(2,ix1(i))
        z1(i)=x(3,ix1(i))
        y2(i)=x(2,ix2(i))
        z2(i)=x(3,ix2(i))
        y3(i)=x(2,ix3(i))
        z3(i)=x(3,ix3(i))
        y4(i)=x(2,ix4(i))
        z4(i)=x(3,ix4(i))
      END DO
C---------------------------------------
C     REPERE LOCAL (ISOPARAMETRIQUE)
C---------------------------------------
      DO i=lft,llt
        sy(i)=half*(y2(i)+y3(i)-y1(i)-y4(i))
        sz(i)=half*(z2(i)+z3(i)-z1(i)-z4(i))
        ty(i)=half*(y3(i)+y4(i)-y1(i)-y2(i))
        tz(i)=half*(z3(i)+z4(i)-z1(i)-z2(i))
      END DO
C-----------
C     REPERE CONVECTE ORTHOGONALISE 
C     full integ: Same than the shell 
C-----------
      DO i=lft,llt
        ct = ty(i)*ty(i)+tz(i)*tz(i)
        cs = sy(i)*sy(i)+sz(i)*sz(i)
        IF(cs /= zero) THEN
          suma = sqrt(ct/max(em20,cs))
          e1y(i) = sy(i)*suma + tz(i)
          e1z(i) = sz(i)*suma - ty(i)
        ELSEIF(ct /= zero)THEN
          suma = sqrt(cs/max(em20,ct))
          e1y(i) = sy(i) + tz(i)*suma
          e1z(i) = sz(i) - ty(i)*suma
        END IF 
        suma=sqrt(e1y(i)**2+e1z(i)**2)
        suma=one/max(suma,em20)
        e1y(i)=e1y(i)*suma
        e1z(i)=e1z(i)*suma
        e2y(i)=-e1z(i)
        e2z(i)= e1y(i)
      ENDDO
C-----------
      RETURN