qrdefo2.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com08_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	qrdefo2 (v, y1, y2, y3, y4, z1, z2, z3, z4, vy1, vy2, vy3, vy4, vz1, vz2, vz3, vz4, py1, py2, pz1, pz2, wyz, dyz, dzy, eyy, ezz, ett, eyz, eyt, ezt, rx, ry, rz, sx, sy, sz, tx, ty, tz, voln, aire, airem, nc1, nc2, nc3, nc4, r22, r23, r32, r33, nel, jcvt)

Function/Subroutine Documentation

qrdefo2()

subroutine qrdefo2	(		v,
			y1,
			y2,
			y3,
			y4,
			z1,
			z2,
			z3,
			z4,
			vy1,
			vy2,
			vy3,
			vy4,
			vz1,
			vz2,
			vz3,
			vz4,
			py1,
			py2,
			pz1,
			pz2,
			wyz,
			dyz,
			dzy,
			eyy,
			ezz,
			ett,
			eyz,
			eyt,
			ezt,
			rx,
			ry,
			rz,
			sx,
			sy,
			sz,
			tx,
			ty,
			tz,
			voln,
			aire,
			airem,
		integer, dimension(*)	nc1,
		integer, dimension(*)	nc2,
		integer, dimension(*)	nc3,
		integer, dimension(*)	nc4,
			r22,
			r23,
			r32,
			r33,
		integer, intent(in)	nel,
		integer, intent(in)	jcvt )

Definition at line 28 of file qrdefo2.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   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: NEL
      INTEGER, INTENT(IN) :: JCVT
C     REAL
      my_real
     .   v(3,*),
     .   y1(*),y2(*),y3(*),y4(*),z1(*),z2(*),z3(*),z4(*),
     .   vy1(*),vy2(*),vy3(*),vy4(*),vz1(*),vz2(*),vz3(*),vz4(*),
     .   py1(*), py2(*), pz1(*), pz2(*),
     .   wyz(*), dyz(*), dzy(*),
     .   eyy(*),ezz(*), ett(*), eyz(*), eyt(*), ezt(*),
     .   rx(*),ry(*), rz(*), sx(*), sy(*), sz(*), tx(*), ty(*), tz(*),
     .   voln(*),aire(*),airem(*),
     .   r22(*),r23(*),r32(*),r33(*)
C
      INTEGER NC1(*), NC2(*), NC3(*), NC4(*)
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "com08_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
C     REAL
      my_real
     .   vy13(mvsiz), vy24(mvsiz), vz13(mvsiz),vz24(mvsiz),
     .   ym1(mvsiz), ym2(mvsiz), ym3(mvsiz), ym4(mvsiz),
     .   zm1(mvsiz), zm2(mvsiz), zm3(mvsiz), zm4(mvsiz),
     .   yavg(mvsiz),a1(mvsiz) , a2(mvsiz), zavg(mvsiz),
     .   vyg(mvsiz),vy,vz,y,z
C-----------------------------------------------
C
C     JCVT/=0 Lagrangian case only
      DO i=1,nel
        vy1(i)=v(2,nc1(i))
        vz1(i)=v(3,nc1(i))
        vy2(i)=v(2,nc2(i))
        vz2(i)=v(3,nc2(i))
        vy3(i)=v(2,nc3(i))
        vz3(i)=v(3,nc3(i))
        vy4(i)=v(2,nc4(i))
        vz4(i)=v(3,nc4(i))
      END DO
C
      DO i=1,nel
        vy=r22(i)*vy1(i)+r32(i)*vz1(i)
        vz=r23(i)*vy1(i)+r33(i)*vz1(i)
        vy1(i)=vy
        vz1(i)=vz
        vy=r22(i)*vy2(i)+r32(i)*vz2(i)
        vz=r23(i)*vy2(i)+r33(i)*vz2(i)
        vy2(i)=vy
        vz2(i)=vz
        vy=r22(i)*vy3(i)+r32(i)*vz3(i)
        vz=r23(i)*vy3(i)+r33(i)*vz3(i)
        vy3(i)=vy
        vz3(i)=vz
        vy=r22(i)*vy4(i)+r32(i)*vz4(i)
        vz=r23(i)*vy4(i)+r33(i)*vz4(i)
        vy4(i)=vy
        vz4(i)=vz
      END DO
C
      DO i=1,nel
        py1(i)=half*(z2(i)-z4(i))
        py2(i)=half*(z3(i)-z1(i))
        pz1(i)=half*(y4(i)-y2(i))
        pz2(i)=half*(y1(i)-y3(i))   
      END DO
C
      DO i=1,nel
        a1(i) =y2(i)*(z3(i)-z4(i))+y3(i)*(z4(i)-z2(i))+
     &       y4(i)*(z2(i)-z3(i))
        a2(i) =y2(i)*(z4(i)-z1(i))+y4(i)*(z1(i)-z2(i))+
     &       y1(i)*(z2(i)-z4(i))
        airem(i)=(a1(i)+a2(i))*half
C AUTRE FORMULE AIREM(I)=2.*(PZ2(I)*PY1(I)-PZ1(I)*PY2(I))
      END DO
C
      IF(n2d==1)THEN
        DO i=1,nel
          y =y1(i)+y2(i)+y3(i)+y4(i)
          z =z1(i)+z2(i)+z3(i)+z4(i)
          yavg(i) =r22(i)*y+r23(i)*z
        END DO
      END IF
C
      DO i=1,nel
        vy13(i)=vy1(i)-vy3(i)
        vy24(i)=vy2(i)-vy4(i)
        vz13(i)=vz1(i)-vz3(i)
        vz24(i)=vz2(i)-vz4(i)
      END DO
C
      DO i=1,nel
        IF(airem(i)>zero) THEN
          eyy(i)=(py1(i)*vy13(i)+py2(i)*vy24(i))/airem(i)
          ezz(i)=(pz1(i)*vz13(i)+pz2(i)*vz24(i))/airem(i)
          ett(i)=zero
          dzy(i)=(py1(i)*vz13(i)+py2(i)*vz24(i))/airem(i)
          dyz(i)=(pz1(i)*vy13(i)+pz2(i)*vy24(i))/airem(i)
          eyt(i)=zero
          ezt(i)=zero
        ELSE
          eyy(i)=zero
          ezz(i)=zero
          ett(i)=zero
          dzy(i)=zero
          dyz(i)=zero
          eyt(i)=zero
          ezt(i)=zero
        END IF
      END DO
C
      IF(n2d==1) THEN
        DO i=1,nel
          IF (yavg(i)>zero)THEN
            vy=vy1(i)+vy2(i)+vy3(i)+vy4(i)
            vz=vz1(i)+vz2(i)+vz3(i)+vz4(i)
            vyg(i) =r22(i)*vy+r23(i)*vz
            ett(i)=vyg(i)/yavg(i)
          END IF
        END DO
      ENDIF
C
C     correction due to rotation of the skew:
      DO i=1,nel
        eyz(i)  = dyz(i)+dzy(i)
     .     -dt1*(eyy(i)*dyz(i)+dzy(i)*ezz(i))
        eyy(i)  = eyy(i)
     .     -0.5*dt1*(eyy(i)*eyy(i)+dzy(i)*dzy(i))
        ezz(i)  = ezz(i)
     .     -0.5*dt1*(ezz(i)*ezz(i)+dyz(i)*dyz(i))
        ett(i)  = ett(i)
C   pas de rotation => pas de terme    .     -0.5*DT1*ETT(I)*ETT(I)
        wyz(i)= zero
      ENDDO
C---------------------------------------
C     REPERE LOCAL POUR MATERIAUX NON ISOTROPES
C---------------------------------------
      DO 90 i=1,nel
      rx(i)=one
      ry(i)=zero
      rz(i)=zero
      sx(i)=zero    
      sy(i)=-pz1(i)-pz2(i)
      sz(i)=+py1(i)+py2(i)
      tx(i)=zero
      ty(i)=+pz1(i)-pz2(i)
      tz(i)=-py1(i)+py2(i)
   90 CONTINUE
C
      RETURN