s8ederipr3.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	s8ederipr3 (offg, voldp, ngl, wi, aj1, aj2, aj3, aj4, aj5, aj6, aj7, aj8, aj9, aji1, aji2, aji3, aji4, aji5, aji6, aji7, aji8, aji9, nnega, index, ipt, nel)

Function/Subroutine Documentation

s8ederipr3()

subroutine s8ederipr3	(		offg,
		double precision, dimension(*)	voldp,
		integer, dimension(*)	ngl,
			wi,
			aj1,
			aj2,
			aj3,
			aj4,
			aj5,
			aj6,
			aj7,
			aj8,
			aj9,
			aji1,
			aji2,
			aji3,
			aji4,
			aji5,
			aji6,
			aji7,
			aji8,
			aji9,
		integer	nnega,
		integer, dimension(*)	index,
		integer	ipt,
		integer, intent(in)	nel )

Definition at line 31 of file s8ederipr3.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(*),wi,
     .   aj1(*),aj2(*),aj3(*),
     .   aj4(*),aj5(*),aj6(*),
     .   aj7(*),aj8(*),aj9(*),
     .   aji1(*), aji2(*), aji3(*),
     .   aji4(*), aji5(*), aji6(*),
     .   aji7(*), aji8(*), aji9(*)
      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
     .   vol(mvsiz),det(mvsiz) ,dett(mvsiz) ,  
     .   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)
      DOUBLE PRECISION 
     .   DETDP
C-----------------------------------------------
C
      DO i=1,nel
       jac_59_68(i)=aj5(i)*aj9(i)-aj6(i)*aj8(i)
       jac_67_49(i)=aj6(i)*aj7(i)-aj4(i)*aj9(i)
       jac_38_29(i)=(-aj2(i)*aj9(i)+aj3(i)*aj8(i))
       jac_19_37(i)=( aj1(i)*aj9(i)-aj3(i)*aj7(i))
       jac_27_18(i)=(-aj1(i)*aj8(i)+aj2(i)*aj7(i))
       jac_26_35(i)=( aj2(i)*aj6(i)-aj3(i)*aj5(i))
       jac_34_16(i)=(-aj1(i)*aj6(i)+aj3(i)*aj4(i))
       jac_15_24(i)=( aj1(i)*aj5(i)-aj2(i)*aj4(i))
       jac_48_57(i)=aj4(i)*aj8(i)-aj5(i)*aj7(i)
      ENDDO
C
      DO i=1,nel
      detdp=one_over_512*(aj1(i)*jac_59_68(i)+aj2(i)*jac_67_49(i)+aj3(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) THEN
           vol(i)=one
           voldp(i)= one
         END IF
        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
            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
           ELSEIF (imconv==1.AND.abs(offg(i))/=two) THEN
c#include "lockon.inc"
c            WRITE(ISTDO,2000) NGL(I)
c            WRITE(IOUT ,2000) NGL(I)
c#include "lockoff.inc"
c            IDEL7NOK = 1   
           ENDIF 
          ENDIF
        ENDDO
      END IF
C
C
      DO i=1,nel
       dett(i)=one_over_512/det(i)
       aji1(i)=dett(i)*jac_59_68(i)
       aji4(i)=dett(i)*jac_67_49(i)
       aji7(i)=dett(i)*jac_48_57(i)
       aji2(i)=dett(i)*jac_38_29(i)
       aji5(i)=dett(i)*jac_19_37(i)
       aji8(i)=dett(i)*jac_27_18(i)
       aji3(i)=dett(i)*jac_26_35(i)
       aji6(i)=dett(i)*jac_34_16(i)
       aji9(i)=dett(i)*jac_15_24(i)
      ENDDO
C
      RETURN
 2000 FORMAT(/' ZERO OR NEGATIVE SUB-VOLUME : DELETE 3D-ELEMENT NB',
     .          i10/)
 2001 FORMAT(/' ZERO OR NEGATIVE SOLID SUB-VOLUME : ELEMENT NB:',
     .          i10/)