r26def3.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/.
!||====================================================================
!||    r26def3            ../engine/source/elements/spring/r26def3.F
!||--- called by ------------------------------------------------------
!||    rforc3             ../engine/source/elements/spring/rforc3.F
!||--- calls      -----------------------------------------------------
!||    r26sig             ../engine/source/elements/spring/r26sig.F
!||--- uses       -----------------------------------------------------
!||    python_funct_mod   ../common_source/modules/python_mod.F90
!||====================================================================
      SUBROUTINE r26def3(python,
     1   F,       E,       DL,      AL0,
     2   DV0,     FEP,     DPL2,    IPOS,
     3   GEO,     IGEO,    NPF,     TF,
     4   V,       OFF,     ANIM,    FR_WAVE,
     5   AL0_ERR, X1DP,    X2DP,    NGL,
     6   MGN,     EX,      EY,      EZ,
     7   XK,      XM,      XC,      AK,
     8   NEL,     NFT,     IAD,     CRIT)
        use python_funct_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      "scr14_c.inc"
#include      "param_c.inc"
#include      "com08_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      type(python_), intent(inout) :: python
      INTEGER, INTENT(IN) :: NFT
      INTEGER, INTENT(INOUT) :: IAD
      INTEGER, INTENT(IN) :: NEL
      INTEGER NPF(*),IGEO(NPROPGI,*),NGL(*),MGN(*)
C     REAL
      my_real
     .   GEO(NPROPG,*), F(*), AL0(*), E(*), DL(*), TF(*), OFF(*),
     .   dv0(*), dpl2(*), fep(*),anim(*),ipos(*),fr_wave(*),v(3,*),
     .   al0_err(*),ex(mvsiz), ey(mvsiz), ez(mvsiz),xk(mvsiz),
     .   xm(mvsiz),xc(mvsiz),ak(mvsiz)
      DOUBLE PRECISION X1DP(3,*),X2DP(3,*)
      my_real, DIMENSION(NEL), INTENT(INOUT) :: 
     .   crit
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER  I, J, ILENG,NINDX, PID
      INTEGER NC1(MVSIZ), NC2(MVSIZ),INDX(MVSIZ)
C     REAL
      my_real
     .   dlold(mvsiz),dmn(mvsiz),dmx(mvsiz),xl0(mvsiz),
     .   dv(mvsiz),alpha(mvsiz)
      my_real
     .    dt11, bid, sum
      DOUBLE PRECISION EXDP(MVSIZ),EYDP(MVSIZ),EZDP(MVSIZ),ALDP(MVSIZ),
     .                 al0dp(mvsiz)
C-----------------------------------------------
      dt11 = dt1
      IF (dt11 == zero) dt11 = ep30
c      
      DO i=1,nel
        pid = mgn(i) 
        xm(i)   =geo(1,pid)
        xk(i)   =geo(2,pid)
        xc(i)   =zero
        alpha(i)=geo(4,pid)
        dmn(i)  =geo(15,pid)
        dmx(i)  =geo(16,pid)
        ak(i) = one
      ENDDO
C
      DO i=1,nel
        exdp(i)=x2dp(1,i)-x1dp(1,i)
        eydp(i)=x2dp(2,i)-x1dp(2,i)
        ezdp(i)=x2dp(3,i)-x1dp(3,i)
        dlold(i)=dl(i)
        aldp(i)=sqrt(exdp(i)*exdp(i)+eydp(i)*eydp(i)+ezdp(i)*ezdp(i))
      ENDDO
C
      IF (tt == zero) THEN
        DO i=1,nel
          al0(i)=aldp(i)                   ! cast double vers My_real
          al0_err(i)=aldp(i)-al0(i)        ! difference entre double et My_real
        ENDDO
      ENDIF
C
      DO i=1,nel
        al0dp(i) = al0(i)                  ! cast My_real en double
        al0dp(i) = al0dp(i) + al0_err(i)   ! AL_DP doit etre recalcule ainsi afin de garantir la coherence absolue entre AL0_DP et AL_DP   
      ENDDO
C
      DO i=1,nel
        sum  = max(aldp(i),em15)
        exdp(i)= exdp(i)/sum
        eydp(i)= eydp(i)/sum
        ezdp(i)= ezdp(i)/sum
        ex(i)=exdp(i)
        ey(i)=eydp(i)
        ez(i)=ezdp(i)
      ENDDO
C
      DO i=1,nel
        dl(i) = aldp(i) - al0dp(i)
      ENDDO
C
      DO i=1,nel
        ileng = nint(geo(93,mgn(i)))
        IF (ileng /= 0) THEN
          xl0(i)= al0dp(i)
        ELSE
          xl0(i)=one
        ENDIF
      ENDDO
C
C-----
      CALL r26sig(python,
     1   f,          xk,         dl,         dlold,
     2   e,          off,        xl0,        tf,
     3   npf,        anim,       anim_fe(11),fr_wave,
     4   dmn,        dmx,        igeo,       geo,
     5   mgn,        dv0,        alpha,      nel,
     6   nft,        iad)
C-----
      nindx = 0
      DO i=1,nel
        IF (off(i) == one) THEN
          crit(i) = max(dl(i)/(dmx(i)*xl0(i)),dl(i)/(dmn(i)*xl0(i)))
          crit(i) = min(crit(i),one)
          crit(i) = max(crit(i),zero)
          IF (dl(i) > dmx(i)*xl0(i) .OR. dl(i) < dmn(i)*xl0(i)) THEN
            crit(i) = one
            off(i)=zero
            nindx = nindx + 1
            indx(nindx) = i
            idel7nok = 1
          ENDIF
        ENDIF
      ENDDO
      DO j=1,nindx
        i = indx(j)
#include "lockon.inc"
        WRITE(iout, 1000) ngl(i)
        WRITE(istdo,1100) ngl(i),tt
#include "lockoff.inc"
      ENDDO
      DO i=1,nel
        xm(i)=xm(i)*xl0(i)
        xk(i)=xk(i)/xl0(i)
        xc(i)=xc(i)/xl0(i)
      ENDDO
C-----------
 1000 FORMAT(1x,'-- RUPTURE OF SPRING ELEMENT NUMBER ',i10)
 1100 FORMAT(1x,'-- RUPTURE OF SPRING ELEMENT :',i10,' AT TIME :',g11.4)
C-----------
      RETURN
      END SUBROUTINE r26def3