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 29 of file q4coor2.F.

      use element_mod , only : nixq
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     connectivities and material
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     NODE COORDINATES     |
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     LOCAL REFERENCE FRAME (ISOPARAMETRIC)
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     convected frame ORTHOGONALIZED
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