sdlen_dege.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	sdlen_dege (volg, lat, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, ixs, idege, nel)

Function/Subroutine Documentation

sdlen_dege()

subroutine sdlen_dege	(		volg,
			lat,
			x1,
			x2,
			x3,
			x4,
			x5,
			x6,
			x7,
			x8,
			y1,
			y2,
			y3,
			y4,
			y5,
			y6,
			y7,
			y8,
			z1,
			z2,
			z3,
			z4,
			z5,
			z6,
			z7,
			z8,
		integer, dimension(nixs,*)	ixs,
		integer, dimension(*)	idege,
		integer, intent(in)	nel )

Definition at line 36 of file sdlen_dege.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   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: NEL
      INTEGER IXS(NIXS,*), IDEGE(*)
      my_real
     .   volg(*),lat(*),
     .   x1(*), x2(*), x3(*), x4(*), x5(*), x6(*), x7(*), x8(*),
     .   y1(*), y2(*), y3(*), y4(*), y5(*), y6(*), y7(*), y8(*),  
     .   z1(*), z2(*), z3(*), z4(*), z5(*), z6(*), z7(*), z8(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
C----------DELTAX crrection for degenerated element
      INTEGER I,IT
      my_real
     .   aream(mvsiz), atax,fac,v_g
C-----------------------------------------------
      CALL degenes8(
     1   ixs,     idege,   nel)
C
      DO i=1,nel
C-------due to the fact that AREA_Max*L is far from V for Dege---
       IF(idege(i) > 0) THEN
        aream(i) =em20
C----tetra 4  ,pyrami     
        IF (idege(i)>2) THEN
         fac=one_over_9
        ELSEIF (idege(i)>1) THEN
         fac=fourth
        ELSE
         fac=one
        END IF
          it = 0
        CALL idege8(x1(i),x2(i),x3(i),x4(i),y1(i),y2(i),y3(i),y4(i),
     .             z1(i),z2(i),z3(i),z4(i),aream(i),fac,it)
        CALL idege8(x5(i),x6(i),x7(i),x8(i),y5(i),y6(i),y7(i),y8(i),
     .             z5(i),z6(i),z7(i),z8(i),aream(i),fac,it)
        CALL idege8(x1(i),x2(i),x6(i),x5(i),y1(i),y2(i),y6(i),y5(i),
     .             z1(i),z2(i),z6(i),z5(i),aream(i),fac,it)
        CALL idege8(x2(i),x3(i),x7(i),x6(i),y2(i),y3(i),y7(i),y6(i),
     .             z2(i),z3(i),z7(i),z6(i),aream(i),fac,it)
        CALL idege8(x3(i),x4(i),x8(i),x7(i),y3(i),y4(i),y8(i),y7(i),
     .             z3(i),z4(i),z8(i),z7(i),aream(i),fac,it)
        CALL idege8(x4(i),x1(i),x5(i),x8(i),y4(i),y1(i),y5(i),y8(i),
     .             z4(i),z1(i),z5(i),z8(i),aream(i),fac,it)
C----tetra 4       
        IF (it ==0  ) aream(i)=fac*aream(i)
        IF (idege(i)>3 ) THEN
           aream(i)=aream(i)*fac
         CALL deges4v(v_g,
     .   x1(i), x2(i), x3(i), x4(i), x5(i), x6(i), x7(i), x8(i),
     .   y1(i), y2(i), y3(i), y4(i), y5(i), y6(i), y7(i), y8(i),
     .   z1(i), z2(i), z3(i), z4(i), z5(i), z6(i), z7(i), z8(i))
          ELSE
           v_g=volg(i)
          END IF
        lat(i) = four*v_g/sqrt(aream(i))
 
       ENDIF
      ENDDO
C      
      RETURN