scderi3.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	scderi3 (nel, vol, jeul, veul, geo, vzl, vzq, ngl, ngeo, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, det)

Function/Subroutine Documentation

scderi3()

subroutine scderi3	(	integer	nel,
			vol,
		integer	jeul,
			veul,
			geo,
			vzl,
			vzq,
		integer, dimension(*)	ngl,
		integer, dimension(*)	ngeo,
			x1,
			x2,
			x3,
			x4,
			x5,
			x6,
			x7,
			x8,
			y1,
			y2,
			y3,
			y4,
			y5,
			y6,
			y7,
			y8,
			z1,
			z2,
			z3,
			z4,
			z5,
			z6,
			z7,
			z8,
			det )

Definition at line 32 of file scderi3.F.

 
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
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      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER :: NEL,JEUL,NGL(*),NGEO(*)
      my_real
     .   vol(*), veul(lveul,*),geo(npropg,*),
     .   vzl(*),vzq(*), det(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J
      my_real
     .   dett(mvsiz), 
     .   x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz), 
     .   x5(mvsiz), x6(mvsiz), x7(mvsiz), x8(mvsiz), 
     .   y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
     .   y5(mvsiz), y6(mvsiz), y7(mvsiz), y8(mvsiz),
     .   z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
     .   z5(mvsiz), z6(mvsiz), z7(mvsiz), z8(mvsiz),
     .   jac1(mvsiz), jac2(mvsiz), jac3(mvsiz), jac4(mvsiz),
     .   jac5(mvsiz), jac6(mvsiz), jac7(mvsiz), jac8(mvsiz),
     .   jac9(mvsiz),
     .   jaci1(mvsiz), jaci2(mvsiz), jaci3(mvsiz), jaci4(mvsiz), 
     .   jaci5(mvsiz), jaci6(mvsiz), jaci7(mvsiz), jaci8(mvsiz), 
     .   jaci9(mvsiz), 
     .   x17(mvsiz), x28(mvsiz), x35(mvsiz), x46(mvsiz),
     .   y17(mvsiz), y28(mvsiz), y35(mvsiz), y46(mvsiz), 
     .   z17(mvsiz), z28(mvsiz), z35(mvsiz), z46(mvsiz),
     .   jac_59_68(mvsiz), jac_67_49(mvsiz), jac_48_57(mvsiz),
     .   x_17_46(mvsiz),y_17_46(mvsiz),z_17_46(mvsiz),
     .   x_28_35(mvsiz),y_28_35(mvsiz),z_28_35(mvsiz)
      my_real
     .   h1x,h2x,h1y,h2y,h1z,h2z
C=======================================================================
      DO i=1,nel
        x17(i)=x7(i)-x1(i)
        x28(i)=x8(i)-x2(i)
        x35(i)=x5(i)-x3(i)
        x46(i)=x6(i)-x4(i)
        y17(i)=y7(i)-y1(i)
        y28(i)=y8(i)-y2(i)
        y35(i)=y5(i)-y3(i)
        y46(i)=y6(i)-y4(i)
        z17(i)=z7(i)-z1(i)
        z28(i)=z8(i)-z2(i)
        z35(i)=z5(i)-z3(i)
        z46(i)=z6(i)-z4(i)
      ENDDO
C
C Jacobian matrix
      DO i=1,nel
C  -------ri.xi-----------
        jac3(i)=x17(i)+x28(i)-x35(i)-x46(i)
        jac1(i)=y17(i)+y28(i)-y35(i)-y46(i)
        jac2(i)=z17(i)+z28(i)-z35(i)-z46(i)
        x_17_46(i)=x17(i)+x46(i)
        y_17_46(i)=y17(i)+y46(i)
        z_17_46(i)=z17(i)+z46(i)
        x_28_35(i)=x28(i)+x35(i)
        y_28_35(i)=y28(i)+y35(i)
        z_28_35(i)=z28(i)+z35(i)
      ENDDO
C
      DO i=1,nel
C  -------si.xi-----------
        jac6(i)=x_17_46(i)+x_28_35(i)
        jac4(i)=y_17_46(i)+y_28_35(i)
        jac5(i)=z_17_46(i)+z_28_35(i)
C  -------ti.xi-----------
        jac9(i)=x_17_46(i)-x_28_35(i)
        jac7(i)=y_17_46(i)-y_28_35(i)
        jac8(i)=z_17_46(i)-z_28_35(i)
      ENDDO
C
      DO i=1,nel
        jac_59_68(i)=jac5(i)*jac9(i)-jac6(i)*jac8(i)
        jac_67_49(i)=jac6(i)*jac7(i)-jac4(i)*jac9(i)
        jac_48_57(i)=jac4(i)*jac8(i)-jac5(i)*jac7(i)
      ENDDO
C
      DO i=1,nel
        det(i)=one_over_64*(jac1(i)*jac_59_68(i)+jac2(i)*jac_67_49(i)+jac3(i)*jac_48_57(i))
        vol(i)=det(i)
      ENDDO
C
      DO i=1,nel
        IF(det(i)>zero) cycle
        CALL ancmsg(msgid=245,
     .              msgtype=msgerror,
     .              anmode=aninfo,
     .              i1=ngl(i))
      ENDDO
C
      DO i=1,nel
        h1x = x1(i)+x2(i)-x3(i)-x4(i)-x5(i)-x6(i)+x7(i)+x8(i)
        h1y = y1(i)+y2(i)-y3(i)-y4(i)-y5(i)-y6(i)+y7(i)+y8(i)
        h1z = z1(i)+z2(i)-z3(i)-z4(i)-z5(i)-z6(i)+z7(i)+z8(i)
        h2x = x1(i)-x2(i)-x3(i)+x4(i)-x5(i)+x6(i)+x7(i)-x8(i)
        h2y = y1(i)-y2(i)-y3(i)+y4(i)-y5(i)+y6(i)+y7(i)-y8(i)
        h2z = z1(i)-z2(i)-z3(i)+z4(i)-z5(i)+z6(i)+z7(i)-z8(i)
        vzl(i) =  one_over_64*jac5(i)*(jac9(i)*h1y+jac1(i)*h2x-jac3(i)*h2y-jac7(i)*h1x)
     .          + one_over_64*jac4(i)*(jac3(i)*h2z+jac8(i)*h1x-jac9(i)*h1z-jac2(i)*h2x)
     .          + one_over_64*jac6(i)*(jac7(i)*h1z+jac2(i)*h2y-jac1(i)*h2z-jac8(i)*h1y)
        vzq(i) =  one_over_64*jac5(i)*(h1y*h2x-h2y*h1x)
      ENDDO
C--------------------------
      IF (jeul == 0) RETURN
C
      DO i=1,nel
        dett(i)=one_over_64/det(i)
      ENDDO
C
C Jacobian matrix inverse
      DO i=1,nel
        jaci1(i)=dett(i)*jac_59_68(i)
        jaci4(i)=dett(i)*jac_67_49(i)
        jaci7(i)=dett(i)*jac_48_57(i)
        jaci2(i)=dett(i)*(-jac2(i)*jac9(i)+jac3(i)*jac8(i))
        jaci5(i)=dett(i)*( jac1(i)*jac9(i)-jac3(i)*jac7(i))
        jaci8(i)=dett(i)*(-jac1(i)*jac8(i)+jac2(i)*jac7(i))
        jaci3(i)=dett(i)*( jac2(i)*jac6(i)-jac3(i)*jac5(i))
        jaci6(i)=dett(i)*(-jac1(i)*jac6(i)+jac3(i)*jac4(i))
        jaci9(i)=dett(i)*( jac1(i)*jac5(i)-jac2(i)*jac4(i))
      ENDDO
C
      DO i=1,nel
        veul(3,i) = jaci1(i)-jaci2(i)+jaci3(i)
        veul(4,i) = jaci1(i)-jaci2(i)-jaci3(i)
        veul(7,i) = jaci4(i)-jaci5(i)+jaci6(i)
        veul(8,i) = jaci4(i)-jaci5(i)-jaci6(i)
        veul(11,i)= jaci7(i)-jaci8(i)+jaci9(i)
        veul(12,i)= jaci7(i)-jaci8(i)-jaci9(i)
      ENDDO
C
      DO i=1,nel
        veul(1,i) =-jaci1(i)-jaci2(i)-jaci3(i)
        veul(2,i) =-jaci1(i)-jaci2(i)+jaci3(i)
        veul(5,i) =-jaci4(i)-jaci5(i)-jaci6(i)
        veul(6,i) =-jaci4(i)-jaci5(i)+jaci6(i)
        veul(9,i) =-jaci7(i)-jaci8(i)-jaci9(i)
        veul(10,i)=-jaci7(i)-jaci8(i)+jaci9(i)
      ENDDO
C
      IF (geo(12,ngeo(i)) == 15) THEN
          DO i=1,nel
            vol(i)=vol(i)*geo(1,ngeo(i))      
          ENDDO
      ENDIF
c-----------
      RETURN