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

Function/Subroutine Documentation

q4rcoor2()

subroutine q4rcoor2	(		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,
			yavg,
			y234,
			y124,
			sy,
			sz,
			ty,
			tz,
			e1y,
			e1z,
			e2y,
			e2z )

Definition at line 28 of file q4coor2.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(*)
      my_real
     .   x(3,*),e1y(*),e1z(*),e2y(*),e2z(*)
      my_real
     .   y1(*), y2(*), y3(*), y4(*),
     .   z1(*), z2(*), z3(*), z4(*),yavg(*),y234(*),y124(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
      my_real
     .   sy(mvsiz) ,sz(mvsiz) ,
     .   ty(mvsiz) ,tz(mvsiz), suma,ct,cs
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
      DO i=lft,llt
         yavg(i) = fourth*(y1(i)+y2(i)+y3(i)+y4(i))
         y234(i)=y2(i)+y3(i)+y4(i)
         y124(i)=y1(i)+y2(i)+y4(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