mmstifs.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/.
!||====================================================================
!||    mmstifs    ../engine/source/elements/solid/solide8z/mmstifs.F
!||--- called by ------------------------------------------------------
!||    q4ke2      ../engine/source/elements/solid_2d/quad4/q4ke2.f
!||    s10ke3     ../engine/source/elements/solid/solide10/s10ke3.F
!||    s20ke3     ../engine/source/elements/solid/solide20/s20ke3.F
!||    s4ke3      ../engine/source/elements/solid/solide4/s4ke3.F
!||    s6cke3     ../engine/source/elements/thickshell/solide6c/s6cke3.F
!||    s8cke3     ../engine/source/elements/thickshell/solide8c/s8cke3.F
!||    s8zke3     ../engine/source/elements/solid/solide8z/s8zke3.F
!||--- calls      -----------------------------------------------------
!||    gethkt3    ../engine/source/elements/solid/solide8z/gethkt3.F
!||    sktcons2   ../engine/source/elements/solid/solide8z/sktcons2.f
!||    sktvonm3   ../engine/source/elements/solid/solide8z/sktvonm3.F
!||====================================================================
      SUBROUTINE mmstifs(
     1   PM,      MAT,     HH,      VOL,
     2   ICSIG,   DD,      GG,      DG,
     3   G33,     DM,      GM,      DGM,
     4   IORTH,   SIG,     IR,      IS,
     5   IT,      NEL,     JHBE,    MTN)
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-----------------------------------------------
#include      "param_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) :: MTN
      INTEGER, INTENT(IN) :: JHBE
      INTEGER ICSIG,IORTH,IR,IS,IT,NEL
      INTEGER MAT(*)
C     REAL
      my_real
     .   pm(npropm,*),hh(2,*),dd(3,3,*),gg(*),vol(*),
     .   dg(3,3,*),g33(3,3,*),dm(3,3,*),gm(3,3,*),dgm(3,3,*),
     .   sig(nel,6)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,ICS,ICT,ICR,J,K
C     REAL
      my_real
     .   TT,TV,TT0,G(MVSIZ),QH(MVSIZ),EE,SFAC
C-----------------------------------------------
      sfac=one
      IF (ismdisp>0) sfac=em05
      IF (iorth>0) THEN
       IF (ikt==3) THEN
          DO i=1,nel
C           QH(I)=GM(1,1,I)
candr           write(*,*)' QH(I)=', QH(I)!.. contains H modulus ..
candr ... H module is wrong here, it is due to an 'unclean'
candr ... passing it from routine 'mmats'
candr ... setting it 'by hand' proves that everything else
candr ... is correct
candr     QH(I)=1949.29d0 ! .. H for tension-torsion test ..
 
c           G(I) = HH(2,I)
          ENDDO
         DO j = 1, 3
         DO k = 1, 3
          DO i=1,nel
           dgm(j,k,i)=zero
           gm(j,k,i)=zero
          ENDDO
         ENDDO
         ENDDO
         CALL gethkt3(
     1   1,       nel,     qh,      ir,
     2   is,      it,      mtn)
         CALL sktvonm3(1 ,nel ,dm  ,hh   ,sig  ,
     .                 dgm ,gm  ,qh  ,nel  )
       ELSEIF (ikt==4) THEN
          DO i=1,nel
           qh(i)= hh(1,i)
           g(i) = hh(2,i)
          ENDDO
        CALL sktcons2(
     1   1,       nel,     dm,      qh,
     2   g,       dgm,     gm,      ir,
     3   is,      it,      nel,     mtn)
       END IF
        DO j = 1, 3
        DO k = j, 3
         DO i=1,nel
          dd(j,k,i)=dm(j,k,i)*vol(i)
          g33(j,k,i)=gm(j,k,i)*vol(i)
          dd(k,j,i)=dd(j,k,i)
          g33(k,j,i)=g33(j,k,i)
         ENDDO
        ENDDO
        ENDDO
candr (DG is non-symmetric)
        DO j = 1, 3
        DO k = 1, 3
         DO i=1,nel
          dg(j,k,i)=dgm(j,k,i)*vol(i)
         ENDDO
        ENDDO
        ENDDO
 
      ELSE
      IF (jhbe==15) THEN
       DO i=1,nel
         tv=hh(1,i)*vol(i)
         gg(i)=hh(2,i)*vol(i)
         tt0=one/(tv+two*gg(i))
         tt=four*gg(i)*(tv+gg(i))*tt0
         tv=two*gg(i)*tv*tt0
         ee=gg(i)*(three*hh(1,i)+two*hh(2,i))/(hh(1,i)+hh(2,i))
         dd(1,1,i)=tt
         dd(2,2,i)=tt
         dd(3,3,i)=sfac*ee
         dd(1,2,i)=tv
         dd(1,3,i)=zero
         dd(2,1,i)=tv
         dd(2,3,i)=zero
         dd(3,1,i)=zero
         dd(3,2,i)=zero
       ENDDO
      ELSEIF (jhbe==14.AND.icsig>0) THEN
       ics=icsig/100
       ict=mod(icsig/10,10)
       icr=mod(icsig,10)
       DO i=1,nel
         tv=hh(1,i)*vol(i)
         gg(i)=hh(2,i)*vol(i)
         tt0=one/(tv+two*gg(i))
         tt=four*gg(i)*(tv+gg(i))*tt0
         tv=two*gg(i)*tv*tt0
         ee=gg(i)*(three*hh(1,i)+two*hh(2,i))/(hh(1,i)+hh(2,i))
         dd(1,1,i)=tt
         dd(2,2,i)=tv
         dd(3,3,i)=sfac*ee
       ENDDO
       IF (ics==1) THEN
        DO i=1,nel
         tt=dd(1,1,i)
         tv=dd(2,2,i)
         dd(1,1,i)=tt
         dd(2,2,i)=tt
         dd(1,2,i)=tv
         dd(1,3,i)=zero
         dd(2,1,i)=tv
         dd(2,3,i)=zero
         dd(3,1,i)=zero
         dd(3,2,i)=zero
        ENDDO
       ELSEIF (ict==1) THEN
        DO i=1,nel
         tt=dd(1,1,i)
         tv=dd(2,2,i)
         dd(1,1,i)=tt
         dd(2,2,i)=dd(3,3,i)
         dd(3,3,i)=tt
         dd(1,2,i)=zero
         dd(1,3,i)=tv
         dd(2,1,i)=zero
         dd(2,3,i)=zero
         dd(3,1,i)=tv
         dd(3,2,i)=zero
        ENDDO
       ELSEIF (icr==1) THEN
        DO i=1,nel
         tt=dd(1,1,i)
         tv=dd(2,2,i)
         dd(1,1,i)=dd(3,3,i)
         dd(2,2,i)=tt
         dd(3,3,i)=tt
         dd(1,2,i)=zero
         dd(1,3,i)=zero
         dd(2,1,i)=zero
         dd(2,3,i)=tv
         dd(3,1,i)=zero
         dd(3,2,i)=tv
        ENDDO
       ENDIF
      ELSE
       DO i=1,nel
         tv=hh(1,i)*vol(i)
         gg(i)=hh(2,i)*vol(i)
         tt=tv+two*gg(i)
         dd(1,1,i)=tt
         dd(2,2,i)=tt
         dd(3,3,i)=tt
         dd(1,2,i)=tv
         dd(1,3,i)=tv
         dd(2,1,i)=tv
         dd(2,3,i)=tv
         dd(3,1,i)=tv
         dd(3,2,i)=tv
       ENDDO
      ENDIF
      END IF !(IORTH>0) THEN
C
      RETURN
      END