sdefo3.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/.
!||====================================================================
!||    sdefo3        ../engine/source/elements/solid/solide/sdefo3.F
!||--- called by ------------------------------------------------------
!||    sforc3        ../engine/source/elements/solid/solide/sforc3.f
!||    szforc3       ../engine/source/elements/solid/solidez/szforc3.F
!||--- uses       -----------------------------------------------------
!||    aleanim_mod   ../common_source/modules/aleanim_mod.f
!||====================================================================
      SUBROUTINE sdefo3(FANI_CELL,
     1   PX1,     PX2,     PX3,     PX4,
     2   PY1,     PY2,     PY3,     PY4,
     3   PZ1,     PZ2,     PZ3,     PZ4,
     4   PX5,     PX6,     PX7,     PX8,
     5   PY5,     PY6,     PY7,     PY8,
     6   PZ5,     PZ6,     PZ7,     PZ8,
     7   VX1,     VX2,     VX3,     VX4,
     8   VX5,     VX6,     VX7,     VX8,
     9   VY1,     VY2,     VY3,     VY4,
     A   VY5,     VY6,     VY7,     VY8,
     B   VZ1,     VZ2,     VZ3,     VZ4,
     C   VZ5,     VZ6,     VZ7,     VZ8,
     D   DXX,     DXY,     DXZ,     DYX,
     E   DYY,     DYZ,     DZX,     DZY,
     F   DZZ,     D4,      D5,      D6,
     G   WXX,     WYY,     WZZ,     VXR,
     H   VYR,     VZR,     NEL,
     I   NFT,     ISMSTR,  JEUL,    JHBE,
     J   JCVT,    ISROT)
C-----------------------------------------------
C   D e s c r i p t i o n
C-----------------------------------------------
C This subroutine is computing deformation tensors
C   E = GRAD U
C   D = 1/2 * (E + t(E))
C   W = 1/2 * (E - t(E))
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE aleanim_mod, only : fani_cell_
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "com08_c.inc"
#include      "impl1_c.inc"
#include      "scr14_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(fani_cell_), intent(inout) :: FANI_CELL
      INTEGER, INTENT(IN) :: NEL
      INTEGER, INTENT(IN) :: NFT
      INTEGER, INTENT(IN) :: ISMSTR
      INTEGER, INTENT(IN) :: JEUL
      INTEGER, INTENT(IN) :: JHBE
      INTEGER, INTENT(IN) :: JCVT
      INTEGER, INTENT(IN) :: ISROT
      my_real
     .   VX1(*), VX2(*), VX3(*), VX4(*), VX5(*), VX6(*), VX7(*), VX8(*),
     .   VY1(*), VY2(*), VY3(*), VY4(*), VY5(*), VY6(*), VY7(*), VY8(*),
     .   VZ1(*), VZ2(*), VZ3(*), VZ4(*), VZ5(*), VZ6(*), VZ7(*), VZ8(*),
     .   PX1(*), PX2(*), PX3(*), PX4(*),
     .   PY1(*), PY2(*), PY3(*), PY4(*),
     .   PZ1(*), PZ2(*), PZ3(*), PZ4(*), 
     .   PX5(*), PX6(*), PX7(*), PX8(*),
     .   PY5(*), PY6(*), PY7(*), PY8(*),
     .   PZ5(*), PZ6(*), PZ7(*), PZ8(*),
     .   DXX(*), DXY(*), DXZ(*),
     .   dyx(*), dyy(*), dyz(*),
     .   dzx(*), dzy(*), dzz(*), d4(*), d5(*), d6(*),
     .   wxx(*), wyy(*), wzz(*), vxr(*),vyr(*),vzr(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER  I
      my_real
     .   vx17, vy17, vz17,
     .   vx28, vy28, vz28,
     .   vx35, vy35, vz35,
     .   vx46, vy46, vz46, dt1d2, dt1d
      my_real 
     .   pxx2,pyy2,pzz2,aaa,bbb,fac,
     .   exx,exy,exz,eyx,eyy,eyz,ezx,ezy,ezz
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------
      IF(integ8*jeul==0)THEN
       DO i=1,nel
        vx17=vx1(i)-vx7(i)
        vx28=vx2(i)-vx8(i)
        vx35=vx3(i)-vx5(i)
        vx46=vx4(i)-vx6(i)
        vy17=vy1(i)-vy7(i)
        vy28=vy2(i)-vy8(i)
        vy35=vy3(i)-vy5(i)
        vy46=vy4(i)-vy6(i)
        vz17=vz1(i)-vz7(i)
        vz28=vz2(i)-vz8(i)
        vz35=vz3(i)-vz5(i)
        vz46=vz4(i)-vz6(i)
 
        dxx(i)=px1(i)*vx17+px2(i)*vx28+px3(i)*vx35+px4(i)*vx46
        dyy(i)=py1(i)*vy17+py2(i)*vy28+py3(i)*vy35+py4(i)*vy46
        dzz(i)=pz1(i)*vz17+pz2(i)*vz28+pz3(i)*vz35+pz4(i)*vz46
        dxy(i)=py1(i)*vx17+py2(i)*vx28+py3(i)*vx35+py4(i)*vx46
        dxz(i)=pz1(i)*vx17+pz2(i)*vx28+pz3(i)*vx35+pz4(i)*vx46
        dyx(i)=px1(i)*vy17+px2(i)*vy28+px3(i)*vy35+px4(i)*vy46
        dyz(i)=pz1(i)*vy17+pz2(i)*vy28+pz3(i)*vy35+pz4(i)*vy46
        dzx(i)=px1(i)*vz17+px2(i)*vz28+px3(i)*vz35+px4(i)*vz46
        dzy(i)=py1(i)*vz17+py2(i)*vz28+py3(i)*vz35+py4(i)*vz46
       ENDDO
 
      ELSE
       DO i=1,nel
        dxx(i)=px1(i)*vx1(i)+px2(i)*vx2(i)+px3(i)*vx3(i)+px4(i)*vx4(i)+px5(i)*vx5(i)+px6(i)*vx6(i)+px7(i)*vx7(i)+px8(i)*vx8(i)
        dyy(i)=py1(i)*vy1(i)+py2(i)*vy2(i)+py3(i)*vy3(i)+py4(i)*vy4(i)+py5(i)*vy5(i)+py6(i)*vy6(i)+py7(i)*vy7(i)+py8(i)*vy8(i)
        dzz(i)=pz1(i)*vz1(i)+pz2(i)*vz2(i)+pz3(i)*vz3(i)+pz4(i)*vz4(i)+pz5(i)*vz5(i)+pz6(i)*vz6(i)+pz7(i)*vz7(i)+pz8(i)*vz8(i)
        dxy(i)=py1(i)*vx1(i)+py2(i)*vx2(i)+py3(i)*vx3(i)+py4(i)*vx4(i)+py5(i)*vx5(i)+py6(i)*vx6(i)+py7(i)*vx7(i)+py8(i)*vx8(i)
        dxz(i)=pz1(i)*vx1(i)+pz2(i)*vx2(i)+pz3(i)*vx3(i)+pz4(i)*vx4(i)+pz5(i)*vx5(i)+pz6(i)*vx6(i)+pz7(i)*vx7(i)+pz8(i)*vx8(i)
        dyx(i)=px1(i)*vy1(i)+px2(i)*vy2(i)+px3(i)*vy3(i)+px4(i)*vy4(i)+px5(i)*vy5(i)+px6(i)*vy6(i)+px7(i)*vy7(i)+px8(i)*vy8(i)
        dyz(i)=pz1(i)*vy1(i)+pz2(i)*vy2(i)+pz3(i)*vy3(i)+pz4(i)*vy4(i)+pz5(i)*vy5(i)+pz6(i)*vy6(i)+pz7(i)*vy7(i)+pz8(i)*vy8(i)
        dzx(i)=px1(i)*vz1(i)+px2(i)*vz2(i)+px3(i)*vz3(i)+px4(i)*vz4(i)+px5(i)*vz5(i)+px6(i)*vz6(i)+px7(i)*vz7(i)+px8(i)*vz8(i)
        dzy(i)=py1(i)*vz1(i)+py2(i)*vz2(i)+py3(i)*vz3(i)+py4(i)*vz4(i)+py5(i)*vz5(i)+py6(i)*vz6(i)+py7(i)*vz7(i)+py8(i)*vz8(i)
       ENDDO
      ENDIF
 
      dt1d2=half*dt1
      IF(iscau>0 .OR. imp_lr>0)dt1d2=dt1
 
      IF(jcvt /= 0)THEN
        IF(ismstr == 11)THEN
          DO i=1,nel
            d4(i)=dxy(i)+dyx(i)
            d5(i)=dyz(i)+dzy(i)
            d6(i)=dxz(i)+dzx(i)
            wzz(i)=dt1d2*(dyx(i)-dxy(i))
            wyy(i)=dt1d2*(dxz(i)-dzx(i))
            wxx(i)=dt1d2*(dzy(i)-dyz(i))
          ENDDO
        ELSE
          DO i=1,nel
            wxx(i)=zero
            wyy(i)=zero
            wzz(i)=zero
          ENDDO
          IF (impl_s == 0 .OR. (idyna > 0 .AND. ismdisp == 0)) THEN
            DO i=1,nel
             exx=dxx(i)
             eyy=dyy(i)
             ezz=dzz(i)
             exy=dxy(i)
             eyx=dyx(i)
             exz=dxz(i)
             ezx=dzx(i)
             eyz=dyz(i)
             ezy=dzy(i)
             dxx(i)=dxx(i)-dt1d2*(exx*exx+eyx*eyx+ezx*ezx)
             dyy(i)=dyy(i)-dt1d2*(eyy*eyy+ezy*ezy+exy*exy)
             dzz(i)=dzz(i)-dt1d2*(ezz*ezz+exz*exz+eyz*eyz)
             aaa=dt1d2*(exx*exy+eyx*eyy+ezx*ezy)
             dxy(i)=dxy(i)-aaa
             dyx(i)=dyx(i)-aaa
             d4(i)=dxy(i)+dyx(i)
             aaa=dt1d2*(eyy*eyz+ezy*ezz+exy*exz)
             dyz(i)=dyz(i)-aaa
             dzy(i)=dzy(i)-aaa
             d5(i)=dyz(i)+dzy(i)
             aaa=dt1d2*(ezz*ezx+exz*exx+eyz*eyx)
             dxz(i)=dxz(i)-aaa
             dzx(i)=dzx(i)-aaa
             d6(i)=dxz(i)+dzx(i)
            ENDDO
          ELSEIF (ismdisp>0.AND.iscau==0) THEN
          !---------implicit static---------             
            DO i=1,nel
             d4(i) = dxy(i)+dyx(i)
             d5(i) = dyz(i)+dzy(i)
             d6(i) = dxz(i)+dzx(i)
            ENDDO
          ELSE
            dt1d=two*dt1d2
            DO i=1,nel
             d4(i)=dxy(i)+dyx(i)-dt1d*(dxx(i)*dxy(i)+dyx(i)*dyy(i)+dzx(i)*dzy(i))
             d5(i)=dyz(i)+dzy(i)-dt1d*(dyy(i)*dyz(i)+dzy(i)*dzz(i)+dxy(i)*dxz(i))
             d6(i)=dxz(i)+dzx(i)-dt1d*(dzz(i)*dzx(i)+dxz(i)*dxx(i)+dyz(i)*dyx(i))
             dxx(i)=dxx(i)-dt1d2*(dxx(i)*dxx(i)+dyx(i)*dyx(i)+dzx(i)*dzx(i))
             dyy(i)=dyy(i)-dt1d2*(dyy(i)*dyy(i)+dzy(i)*dzy(i)+dxy(i)*dxy(i))
             dzz(i)=dzz(i)-dt1d2*(dzz(i)*dzz(i)+dxz(i)*dxz(i)+dyz(i)*dyz(i))
            ENDDO
          ENDIF ! IF (IMPL_S==0.OR.IDYNA>0)
        END IF !(ISMSTR == 11) THEN
 
      ELSEIF (jhbe>=2) THEN
        DO i=1,nel
          exx=dxx(i)
          eyy=dyy(i)
          ezz=dzz(i)
          exy=dxy(i)
          eyx=dyx(i)
          exz=dxz(i)
          ezx=dzx(i)
          eyz=dyz(i)
          ezy=dzy(i)
 
          dxx(i) = dxx(i)-dt1d2*(exx*exx+eyx*eyx+ezx*ezx)
          dyy(i) = dyy(i)-dt1d2*(eyy*eyy+ezy*ezy+exy*exy)
          dzz(i) = dzz(i)-dt1d2*(ezz*ezz+exz*exz+eyz*eyz)
          aaa = dt1d2*(exx*exy+eyx*eyy+ezx*ezy)
          dxy(i) = dxy(i) -aaa
          dyx(i) = dyx(i) -aaa
          d4(i) = dxy(i)+dyx(i)
          aaa = dt1d2*(eyy*eyz+ezy*ezz+exy*exz)
          dyz(i) = dyz(i) -aaa
          dzy(i) = dzy(i) -aaa
          d5(i) = dyz(i)+dzy(i)
          aaa = dt1d2*(ezz*ezx+exz*exx+eyz*eyx)
          dxz(i) = dxz(i) -aaa
          dzx(i) = dzx(i) -aaa
          d6(i) = dxz(i)+dzx(i)
 
          pxx2 = px1(i)*px1(i)+px2(i)*px2(i)+px3(i)*px3(i)+px4(i)*px4(i)
          pyy2 = py1(i)*py1(i)+py2(i)*py2(i)+py3(i)*py3(i)+py4(i)*py4(i)
          pzz2 = pz1(i)*pz1(i)+pz2(i)*pz2(i)+pz3(i)*pz3(i)+pz4(i)*pz4(i)
          wzz(i) = dt1*(pyy2*dyx(i)-pxx2*dxy(i))/(pxx2+pyy2)
          wxx(i) = dt1*(pzz2*dzy(i)-pyy2*dyz(i))/(pyy2+pzz2)
          wyy(i) = dt1*(pxx2*dxz(i)-pzz2*dzx(i))/(pzz2+pxx2)
        ENDDO
 
      ELSE
        DO i=1,nel
         d4(i) = dxy(i)+dyx(i)
         d5(i) = dyz(i)+dzy(i)
         d6(i) = dxz(i)+dzx(i)
         dxx(i) = dxx(i)
         dyy(i) = dyy(i)
         dzz(i) = dzz(i)
         wzz(i) = dt1d2*(dyx(i)-dxy(i))
         wyy(i) = dt1d2*(dxz(i)-dzx(i))
         wxx(i) = dt1d2*(dzy(i)-dyz(i))
        ENDDO
 
      ENDIF
 
      IF(isrot/=0)THEN
        DO i=1,nel
          dxy(i)=dxy(i) + vzr(i)
          dyx(i)=dyx(i) - vzr(i)
          dyz(i)=dyz(i) + vxr(i)
          dzy(i)=dzy(i) - vxr(i)
          dzx(i)=dzx(i) + vyr(i)
          dxz(i)=dxz(i) - vyr(i)
        ENDDO
        aaa = zero
        bbb = dt1 - aaa*dt1
        DO i=1,nel
          wxx(i) = aaa*wxx(i) + bbb*vxr(i)
          wyy(i) = aaa*wyy(i) + bbb*vyr(i)
          wzz(i) = aaa*wzz(i) + bbb*vzr(i)
        ENDDO
      ENDIF
      
      !VORTICITY OUTPUT /ANIM/ELEM/VORTX,VORTY,VORTZ
      IF(dt1/=zero)THEN
        fac = four/dt1
        IF(fani_cell%IS_VORT_X_REQUESTED)THEN
          DO i=1,nel
            fani_cell%VORT_X(i+nft) = fac*wxx(i)
          ENDDO
        ENDIF
        IF(fani_cell%IS_VORT_Y_REQUESTED)THEN
          DO i=1,nel
            fani_cell%VORT_Y(i+nft) = fac*wyy(i)
          ENDDO
        ENDIF
        IF(fani_cell%IS_VORT_Z_REQUESTED)THEN
          DO i=1,nel
            fani_cell%VORT_Z(i+nft) = fac*wzz(i)
          ENDDO
        ENDIF
      ENDIF
      
C-----------
      RETURN
      END