c3deri3.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	c3deri3 (jft, jlt, px1, py1, py2, smstr, offg, ismstr, alpe, aldt, ux1, ux2, ux3, uy1, uy2, uy3, nel, area, x21g, y21g, z21g, x31g, y31g, z31g, x2, y2, x3, y3, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z)

Function/Subroutine Documentation

c3deri3()

subroutine c3deri3	(	integer	jft,
		integer	jlt,
			px1,
			py1,
			py2,
		double precision, dimension(*)	smstr,
			offg,
		integer	ismstr,
			alpe,
			aldt,
			ux1,
			ux2,
			ux3,
			uy1,
			uy2,
			uy3,
		integer	nel,
			area,
			x21g,
			y21g,
			z21g,
			x31g,
			y31g,
			z31g,
			x2,
			y2,
			x3,
			y3,
			e1x,
			e1y,
			e1z,
			e2x,
			e2y,
			e2z,
			e3x,
			e3y,
			e3z )

Definition at line 29 of file c3deri3.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 JFT, JLT,ISMSTR,NEL
      my_real
     .   px1(*),py1(*),py2(*),offg(*),alpe(mvsiz),area(mvsiz),
     .   e1x(mvsiz), e1y(mvsiz), e1z(mvsiz),
     .   e2x(mvsiz), e2y(mvsiz), e2z(mvsiz),
     .   e3x(mvsiz), e3y(mvsiz), e3z(mvsiz),
     .   ux1(mvsiz),ux2(mvsiz),ux3(mvsiz),uy1(mvsiz),
     .   x2(mvsiz),y2(mvsiz),x3(mvsiz),y3(mvsiz),
     .   x21g(mvsiz), y21g(mvsiz), z21g(mvsiz),
     .   x31g(mvsiz), y31g(mvsiz), z31g(mvsiz),
     .   uy2(mvsiz),uy3(mvsiz),aldt(mvsiz)
      DOUBLE PRECISION SMSTR(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, II(3)
      my_real al1, al2, al3, almax
C=======================================================================
      DO i=jft,jlt
        x2(i)=e1x(i)*x21g(i)+e1y(i)*y21g(i)+e1z(i)*z21g(i)
        y2(i)=e2x(i)*x21g(i)+e2y(i)*y21g(i)+e2z(i)*z21g(i)
        x3(i)=e1x(i)*x31g(i)+e1y(i)*y31g(i)+e1z(i)*z31g(i)
        y3(i)=e2x(i)*x31g(i)+e2y(i)*y31g(i)+e2z(i)*z31g(i)
      ENDDO
C
      DO i=1,3
        ii(i) = nel*(i-1)
      ENDDO
C
      IF (ismstr == 11) THEN
        DO i=jft,jlt
          IF (abs(offg(i)) == one) offg(i)=sign(two,offg(i))
        ENDDO
        DO i=jft,jlt
          ux1(i) = zero
          uy1(i) = zero
          ux2(i) = zero
          uy2(i) = zero
          ux3(i) = zero
          uy3(i) = zero
          IF(abs(offg(i)) == two)THEN
            ux2(i) = x2(i)-smstr(ii(1)+i)
            ux3(i) = x3(i)-smstr(ii(2)+i)
            uy3(i) = y3(i)-smstr(ii(3)+i)
            x2(i)  = smstr(ii(1)+i)
            x3(i)  = smstr(ii(2)+i)
            y3(i)  = smstr(ii(3)+i)
            area(i) = half*x2(i)*y3(i)
          ELSE
            smstr(ii(1)+i)=x2(i)
            smstr(ii(2)+i)=x3(i)
            smstr(ii(3)+i)=y3(i)
          ENDIF
        ENDDO
      ELSEIF (ismstr == 1.OR.ismstr == 2) THEN
        DO i=jft,jlt
          IF(offg(i) == two)THEN
            x2(i)=smstr(ii(1)+i)
            x3(i)=smstr(ii(2)+i)
            y3(i)=smstr(ii(3)+i)
            area(i) = half*x2(i)*y3(i)
          ELSE
            smstr(ii(1)+i)=x2(i)
            smstr(ii(2)+i)=x3(i)
            smstr(ii(3)+i)=y3(i)
          ENDIF
        ENDDO
      ENDIF
      IF (ismstr == 1) THEN
        DO i=jft,jlt
          IF (offg(i) == one) offg(i)=two
        ENDDO
      ENDIF
C
      DO i=jft,jlt
        y3(i) = sign(max(em15,abs(y3(i))),y3(i))
        px1(i)=-half*y3(i)
        py1(i)= half*(x3(i)-x2(i))
        py2(i)=-half*x3(i)      
      ENDDO
C
      DO i=jft,jlt
        al1 = x2(i) * x2(i)      
        al2 = (x3(i)-x2(i)) * (x3(i)-x2(i)) + y3(i) * y3(i)
        al3 = x3(i) * x3(i) + y3(i) * y3(i)
        almax = max(al1,al2,al3)
        aldt(i)= two*area(i) / sqrt(almax)
        alpe(i)=one
      ENDDO
C---------------------------------------------------------
      RETURN
C