cderi3.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	cderi3 (jft, jlt, smstr, offg, sti, stir, area, px1, px2, py1, py2, x2, x3, x4, y2, y3, y4, z2, x1g, x2g, x3g, x4g, y1g, y2g, y3g, y4g, z1g, z2g, z3g, z4g, e1x, e1y, e1z, e2x, e2y, e2z, e3x, e3y, e3z, vhx, vhy, a_i, ux1, ux2, ux3, ux4, uy1, uy2, uy3, uy4, nel, ismstr)

Function/Subroutine Documentation

cderi3()

subroutine cderi3	(	integer	jft,
		integer	jlt,
		double precision, dimension(*)	smstr,
			offg,
			sti,
			stir,
			area,
			px1,
			px2,
			py1,
			py2,
			x2,
			x3,
			x4,
			y2,
			y3,
			y4,
			z2,
			x1g,
			x2g,
			x3g,
			x4g,
			y1g,
			y2g,
			y3g,
			y4g,
			z1g,
			z2g,
			z3g,
			z4g,
			e1x,
			e1y,
			e1z,
			e2x,
			e2y,
			e2z,
			e3x,
			e3y,
			e3z,
			vhx,
			vhy,
			a_i,
			ux1,
			ux2,
			ux3,
			ux4,
			uy1,
			uy2,
			uy3,
			uy4,
		integer	nel,
		integer, intent(in)	ismstr )

Definition at line 29 of file cderi3.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) :: ISMSTR
      INTEGER JFT, JLT,NEL
      my_real
     .   px1(*), px2(*), py1(*), py2(*), 
     .   offg(*),sti(*), stir(*)
      my_real
     .   x2(mvsiz), x3(mvsiz), x4(mvsiz),area(mvsiz),
     .   y2(mvsiz), y3(mvsiz), y4(mvsiz), z2(mvsiz),
     .   x1g(mvsiz), x2g(mvsiz), x3g(mvsiz), x4g(mvsiz),
     .   y1g(mvsiz), y2g(mvsiz), y3g(mvsiz), y4g(mvsiz),
     .   z1g(mvsiz), z2g(mvsiz), z3g(mvsiz), z4g(mvsiz),
     .   e1x(mvsiz), e1y(mvsiz), e1z(mvsiz),
     .   e2x(mvsiz), e2y(mvsiz), e2z(mvsiz),
     .   e3x(mvsiz), e3y(mvsiz), e3z(mvsiz),
     .   vhx(mvsiz), vhy(mvsiz), a_i(mvsiz),
     .   ux1(mvsiz),ux2(mvsiz),ux3(mvsiz),ux4(mvsiz),
     .   uy1(mvsiz),uy2(mvsiz),uy3(mvsiz),uy4(mvsiz)
      double precision
     .  smstr(*)
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,II(6)
C     REAL
      my_real
     .     x21ga, y21ga, z21ga, x31ga, y31ga, z31ga,
     .     x41ga, y41ga, z41ga
C-----------------------------------------------
      DO i=1,6
        ii(i) = nel*(i-1)
      ENDDO
C
      DO i=jft,jlt                                    
        sti(i) = zero                                 
        stir(i)= zero                                 
        x21ga=x2g(i)-x1g(i)                           
        y21ga=y2g(i)-y1g(i)                           
        z21ga=z2g(i)-z1g(i)                           
        x31ga=x3g(i)-x1g(i)                           
        y31ga=y3g(i)-y1g(i)                           
        z31ga=z3g(i)-z1g(i)                           
        x41ga=x4g(i)-x1g(i)                           
        y41ga=y4g(i)-y1g(i)                           
        z41ga=z4g(i)-z1g(i)                           
C
        x2(i)=e1x(i)*x21ga+e1y(i)*y21ga+e1z(i)*z21ga  
        y2(i)=e2x(i)*x21ga+e2y(i)*y21ga+e2z(i)*z21ga  
        y3(i)=e2x(i)*x31ga+e2y(i)*y31ga+e2z(i)*z31ga  
        x3(i)=e1x(i)*x31ga+e1y(i)*y31ga+e1z(i)*z31ga  
        x4(i)=e1x(i)*x41ga+e1y(i)*y41ga+e1z(i)*z41ga  
        y4(i)=e2x(i)*x41ga+e2y(i)*y41ga+e2z(i)*z41ga  
        z2(i)=e3x(i)*x21ga+e3y(i)*y21ga+e3z(i)*z21ga 
      ENDDO                                           
C
      IF (ismstr == 11) THEN
        DO i=jft,jlt
          IF(abs(offg(i)) == one)offg(i)=sign(two,offg(i))
          ux1(i) = zero
          uy1(i) = zero
          ux2(i) = zero
          uy2(i) = zero
          ux3(i) = zero
          uy3(i) = zero
          ux4(i) = zero
          uy4(i) = zero
          IF(abs(offg(i)) == two)THEN
            ux2(i) = x2(i)-smstr(ii(1)+i)
            uy2(i) = y2(i)-smstr(ii(2)+i)
            ux3(i) = x3(i)-smstr(ii(3)+i)
            uy3(i) = y3(i)-smstr(ii(4)+i)
            ux4(i) = x4(i)-smstr(ii(5)+i)
            uy4(i) = y4(i)-smstr(ii(6)+i)
            x2(i)  = smstr(ii(1)+i)
            y2(i)  = smstr(ii(2)+i)
            x3(i)  = smstr(ii(3)+i)
            y3(i)  = smstr(ii(4)+i)
            x4(i)  = smstr(ii(5)+i)
            y4(i)  = smstr(ii(6)+i)
            z2(i)  = zero
          ELSE
            smstr(ii(1)+i)=x2(i)
            smstr(ii(2)+i)=y2(i)
            smstr(ii(3)+i)=x3(i)
            smstr(ii(4)+i)=y3(i)
            smstr(ii(5)+i)=x4(i)
            smstr(ii(6)+i)=y4(i)
          ENDIF
        ENDDO
      ELSEIF(ismstr == 1.OR.ismstr == 2)THEN
        DO i=jft,jlt
          IF(abs(offg(i)) == two)THEN
            x2(i)=smstr(ii(1)+i)
            y2(i)=smstr(ii(2)+i)
            x3(i)=smstr(ii(3)+i)
            y3(i)=smstr(ii(4)+i)
            x4(i)=smstr(ii(5)+i)
            y4(i)=smstr(ii(6)+i)
            z2(i)=zero
          ELSE
            smstr(ii(1)+i)=x2(i)
            smstr(ii(2)+i)=y2(i)
            smstr(ii(3)+i)=x3(i)
            smstr(ii(4)+i)=y3(i)
            smstr(ii(5)+i)=x4(i)
            smstr(ii(6)+i)=y4(i)
          ENDIF
        ENDDO
        IF (ismstr == 1) THEN
          DO i=jft,jlt
            IF (offg(i) == one) offg(i)=two
          ENDDO
        ENDIF
      ENDIF
C
      DO 40 i=jft,jlt
      px1(i)= half*(y2(i)-y4(i))
      py1(i)= half*(x4(i)-x2(i))
      px2(i)= half* y3(i)
      py2(i)=-half* x3(i)     
   40 CONTINUE
C
      DO  i=jft,jlt
        area(i)= max(two*(py2(i)*px1(i)-py1(i)*px2(i)),em20)
        a_i(i) = one / area(i)
      ENDDO
C
C     CALCULATION FOR HOURGLASS VECTORS
C
      DO i=jft,jlt
        vhx(i)=(-x2(i)+x3(i)-x4(i))/area(i)
        vhy(i)=(-y2(i)+y3(i)-y4(i))/area(i)
      ENDDO
C-----------
      RETURN