s8zderipr3.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    s8zderipr3    ../engine/source/elements/solid/solide8z/s8zderipr3.F
!||--- called by ------------------------------------------------------
!||    s8zforc3      ../engine/source/elements/solid/solide8z/s8zforc3.f
!||--- uses       -----------------------------------------------------
!||    message_mod   ../engine/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE s8zderipr3(
     1   OFFG,    VOLDP,   NGL,     KSI,
     2   ETA,     ZETA,    WI,      CJ1,
     3   CJ2,     CJ3,     CJ4,     CJ5,
     4   CJ6,     CJ7,     CJ8,     CJ9,
     5   HX,      HY,      HZ,      JAC1,
     6   JAC2,    JAC3,    JAC4,    JAC5,
     7   JAC6,    JACI1,   JACI2,   JACI3,
     8   JACI4,   JACI5,   JACI6,   JACI7,
     9   JACI8,   JACI9,   NNEGA,   INDEX,
     A   IPT,     NEL)
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/)
      END