pdamp3.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines
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)

Function/Subroutine Documentation

pdamp3()

subroutine pdamp3	(	intent(in)	pm,
		intent(in)	geo,
		intent(in)	off,
		integer, intent(in)	imat,
		integer, intent(in)	ipid,
		integer, intent(in)	nel,
		integer, dimension(nel), intent(in)	ngl,
		intent(in)	exx,
		intent(in)	exy,
		intent(in)	exz,
		intent(in)	kxx,
		intent(in)	kyy,
		intent(in)	kzz,
		intent(in)	al,
		intent(inout)	fa1,
		intent(inout)	fa2,
		intent(inout)	fa3,
		intent(inout)	ma1,
		intent(inout)	ma2,
		intent(inout)	ma3,
		integer, intent(in)	impl_s,
		integer, intent(in)	idyna,
		intent(in)	dt1 )

Definition at line 28 of file pdamp3.F.

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