s8zderipr3.F File Reference

#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "units_c.inc"
#include "scr17_c.inc"
#include "impl1_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	s8zderipr3 (offg, voldp, ngl, ksi, eta, zeta, wi, cj1, cj2, cj3, cj4, cj5, cj6, cj7, cj8, cj9, hx, hy, hz, jac1, jac2, jac3, jac4, jac5, jac6, jaci1, jaci2, jaci3, jaci4, jaci5, jaci6, jaci7, jaci8, jaci9, nnega, index, ipt, nel)

Function/Subroutine Documentation

s8zderipr3()

subroutine s8zderipr3	(		offg,
		double precision, dimension(*)	voldp,
		integer, dimension(*)	ngl,
			ksi,
			eta,
			zeta,
			wi,
			cj1,
			cj2,
			cj3,
			cj4,
			cj5,
			cj6,
			cj7,
			cj8,
			cj9,
			hx,
			hy,
			hz,
			jac1,
			jac2,
			jac3,
			jac4,
			jac5,
			jac6,
			jaci1,
			jaci2,
			jaci3,
			jaci4,
			jaci5,
			jaci6,
			jaci7,
			jaci8,
			jaci9,
		integer	nnega,
		integer, dimension(*)	index,
		integer	ipt,
		integer, intent(in)	nel )

Definition at line 30 of file s8zderipr3.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"
#include      "comlock.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      "units_c.inc"
#include      "scr17_c.inc"
#include      "impl1_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: NEL
      INTEGER NNEGA,INDEX(*),IPT
C     REAL
      my_real
     .   offg(*),ksi,eta,zeta,wi,
     .   hx(mvsiz,4),  hy(mvsiz,4), hz(mvsiz,4),   
     .   cj1(*),cj2(*),cj3(*),
     .   cj4(*),cj5(*),cj6(*),
     .   cj7(*),cj8(*),cj9(*),
     .   jac1(*),jac2(*),jac3(*),
     .   jac4(*),jac5(*),jac6(*),
     .   jaci1(*),jaci2(*),jaci3(*),
     .   jaci4(*),jaci5(*),jaci6(*),
     .   jaci7(*),jaci8(*),jaci9(*)
      DOUBLE PRECISION 
     .   VOLDP(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER NGL(*), I, J ,ICOR
C     REAL
C                                                                     12
      my_real
     .   det(mvsiz) ,dett ,
     .   jac_59_68(mvsiz), jac_67_49(mvsiz), jac_48_57(mvsiz),
     .   jac_38_29(mvsiz), jac_19_37(mvsiz), jac_27_18(mvsiz),
     .   jac_26_35(mvsiz), jac_34_16(mvsiz), jac_15_24(mvsiz),
     .   jac7,jac8,jac9,vol(mvsiz)
      DOUBLE PRECISION 
     .   DETDP
C-----------------------------------------------
      DO i=1,nel
       jac1(i)=cj1(i)+hx(i,3)*eta+(hx(i,2)+hx(i,4)*eta)*zeta
       jac2(i)=cj2(i)+hy(i,3)*eta+(hy(i,2)+hy(i,4)*eta)*zeta
       jac3(i)=cj3(i)+hz(i,3)*eta+(hz(i,2)+hz(i,4)*eta)*zeta
C
       jac4(i)=cj4(i)+hx(i,1)*zeta+(hx(i,3)+hx(i,4)*zeta)*ksi
       jac5(i)=cj5(i)+hy(i,1)*zeta+(hy(i,3)+hy(i,4)*zeta)*ksi
       jac6(i)=cj6(i)+hz(i,1)*zeta+(hz(i,3)+hz(i,4)*zeta)*ksi
C
       jac7=cj7(i)+hx(i,2)*ksi+(hx(i,1)+hx(i,4)*ksi)*eta
       jac8=cj8(i)+hy(i,2)*ksi+(hy(i,1)+hy(i,4)*ksi)*eta
       jac9=cj9(i)+hz(i,2)*ksi+(hz(i,1)+hz(i,4)*ksi)*eta
C
C     JACOBIAN
C
       jac_59_68(i)=jac5(i)*jac9-jac6(i)*jac8
       jac_67_49(i)=jac6(i)*jac7-jac4(i)*jac9
       jac_38_29(i)=(-jac2(i)*jac9+jac3(i)*jac8)
       jac_19_37(i)=( jac1(i)*jac9-jac3(i)*jac7)
       jac_27_18(i)=(-jac1(i)*jac8+jac2(i)*jac7)
       jac_26_35(i)=( jac2(i)*jac6(i)-jac3(i)*jac5(i))
       jac_34_16(i)=(-jac1(i)*jac6(i)+jac3(i)*jac4(i))
       jac_15_24(i)=( jac1(i)*jac5(i)-jac2(i)*jac4(i))
       jac_48_57(i)=jac4(i)*jac8-jac5(i)*jac7
      ENDDO
C
      DO i=1,nel
      detdp=one_over_512*(jac1(i)*jac_59_68(i)+jac2(i)*jac_67_49(i)+jac3(i)*jac_48_57(i))
      det(i) = detdp
      voldp(i) = wi * detdp
      vol(i) = voldp(i)
      ENDDO
C
      icor = 0
      DO i=1,nel
        IF(offg(i)==zero)THEN
         det(i)=one
         IF (vol(i)<=zero) vol(i)=one
         IF (voldp(i)<=zero) voldp(i)=one
        ELSEIF (vol(i)<=zero ) THEN
          icor=1
        ENDIF
      ENDDO
      IF (icor>0.AND.inconv==1) THEN
       DO i=1,nel
       IF (offg(i) /= two.AND.offg(i) /= zero ) THEN
         nnega=nnega+1
        index(nnega)=i
        offg(i) = two
       END IF
       ENDDO
      END IF
C
      IF (icor>0.AND.impl_s>0) THEN
        DO i=1,nel
          IF(vol(i)<=zero)THEN
            vol(i)= em20
            voldp(i) = em20
            det(i)= em20
           IF (imp_chk>0) THEN
#include "lockon.inc"
            WRITE(iout ,2001) ngl(i)
#include "lockoff.inc"
            idel7nok = 1
            imp_ir = imp_ir + 1
           ENDIF 
          ENDIF
        ENDDO
      END IF
C
      DO i=1,nel
       dett=one_over_512/det(i)
       jaci1(i)=dett*jac_59_68(i)
       jaci4(i)=dett*jac_67_49(i)
       jaci7(i)=dett*jac_48_57(i)
       jaci2(i)=dett*jac_38_29(i)
       jaci5(i)=dett*jac_19_37(i)
       jaci8(i)=dett*jac_27_18(i)
       jaci3(i)=dett*jac_26_35(i)
       jaci6(i)=dett*jac_34_16(i)
       jaci9(i)=dett*jac_15_24(i)
      ENDDO
C
      RETURN
 2001 FORMAT(/' ZERO OR NEGATIVE SOLID SUB-VOLUME : ELEMENT NB:',
     .          i10/)