pdamp3.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/.
!||====================================================================
!||    pdamp3   ../engine/source/elements/beam/pdamp3.F
!||--- called by ------------------------------------------------------
!||    pforc3   ../engine/source/elements/beam/pforc3.F
!||====================================================================
      SUBROUTINE pdamp3(
     .    PM      ,GEO     ,OFF     ,IMAT    ,IPID  ,
     .    NEL     ,NGL     ,EXX     ,EXY     ,EXZ   ,
     .    KXX     ,KYY     ,KZZ     ,AL      ,FA1   ,
     .    FA2     ,FA3     ,MA1     ,MA2     ,MA3   ,
     .    IMPL_S  ,IDYNA   ,DT1     )
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      "param_c.inc"
#include      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER ,INTENT(IN) :: NEL,IMAT,IPID,IMPL_S,IDYNA
      INTEGER ,DIMENSION(NEL) ,INTENT(IN) :: NGL
      my_real ,DIMENSION(NPROPG,NUMGEO) ,INTENT(IN):: GEO
      my_real ,DIMENSION(NPROPM,NUMMAT) ,INTENT(IN):: PM
      my_real ,DIMENSION(NEL) ,INTENT(IN)   :: OFF
      my_real ,DIMENSION(NEL) ,INTENT(IN)   :: al
      my_real ,DIMENSION(NEL) ,INTENT(IN)   :: exx,exy,exz,kxx,kyy,kzz
      my_real ,DIMENSION(NEL) ,INTENT(INOUT):: fa1,fa2,fa3,ma1,ma2,ma3
      my_real ,INTENT(IN)                   :: dt1
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER  I
      my_real :: rho,rhoe,rhog,young,g,dmm,iyy,izz,ixx,area,dtinv
      my_real ,DIMENSION(NEL) :: vol,dmpm,dmpf
c=======================================================================
      rho  = pm( 1,imat)
      young= pm(20,imat)
      g    = pm(22,imat)
      area = geo(1,ipid)
      ixx  = geo(4,ipid)
      iyy  = geo(2,ipid)
      izz  = geo(18,ipid)
      rhoe = sqrt(two*young*rho)  
      rhog = sqrt(two*g *rho)   
c
      vol(1:nel) = area*al(1:nel)
      dtinv = dt1/max(dt1**2,em20)  
c
      IF (impl_s == 0 .OR. idyna > 0) THEN
        DO i=1,nel                    
          dmpm(i)=dtinv*geo(16,ipid)*off(i)  
          dmpf(i)=dtinv*geo(17,ipid)*off(i)
        ENDDO
      ELSE
        DO i=1,nel                    
          dmpm(i)=zero  
          dmpf(i)=zero  
        ENDDO 
      ENDIF                                 
C-----------------------------
C     AMORTISSEMENT
C-----------------------------
      DO i=1,nel
        dmm = vol(i)*rhoe
        fa1(i) = fa1(i) + dmpm(i)*exx(i)*dmm
        fa2(i) = fa2(i) + dmpf(i)*exy(i)*dmm
        fa3(i) = fa3(i) + dmpf(i)*exz(i)*dmm
        ma1(i) = ma1(i) + dmpf(i)*kxx(i)*al(i)*ixx*rhog
        ma2(i) = ma2(i) + dmpf(i)*kyy(i)*al(i)*iyy*rhoe
        ma3(i) = ma3(i) + dmpf(i)*kzz(i)*al(i)*izz*rhoe
      ENDDO
C-----------
      RETURN
      END SUBROUTINE pdamp3