m1lawp.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"
#include "com08_c.inc"
#include "impl1_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	m1lawp (pm, for, mom, geo, off, exx, exy, exz, kxx, kyy, kzz, al, f1, f2, f3, m1, m2, m3, nel, mat, pid)

Function/Subroutine Documentation

m1lawp()

subroutine m1lawp	(		pm,
			for,
			mom,
			geo,
			off,
			exx,
			exy,
			exz,
			kxx,
			kyy,
			kzz,
			al,
			f1,
			f2,
			f3,
			m1,
			m2,
			m3,
		integer	nel,
		integer, dimension(nel)	mat,
		integer, dimension(nel)	pid )

Definition at line 28 of file m1lawp.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      "com08_c.inc"
#include      "impl1_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NEL,MAT(NEL),PID(NEL)
C     REAL
      my_real
     .   pm(npropm,*), for(nel,3), mom(nel,3), geo(npropg,*),
     .   off(*),a1(nel),
     .   al(nel),exx(nel),
     .   exy(nel),exz(nel),kxx(nel),kyy(nel),kzz(nel),
     .   f1(nel), f2(nel), f3(nel), 
     .   m1(nel), m2(nel), m3(nel)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J
C     REAL
      my_real
     .   ym(nel),shf(nel),b1(nel),b2(nel),b3(nel),
     .   degmb(nel), degfx(nel), 
     .   sh(nel), yma2(nel), sh10(nel),
     .   sh20(nel), sh0(nel), sh1(nel), sh2(nel),
     .   dmpm(nel),dmpf(nel),rho(nel),g(nel)
C-----------------------------------------------
      IF (impl_s == 0 .OR. idyna > 0) THEN
        DO i=1,nel                    
          dmpm(i)=geo(16,pid(i))*al(i)  
          dmpf(i)=geo(17,pid(i))*al(i)  
        ENDDO 
      ELSE
        DO i=1,nel                    
          dmpm(i)=zero  
          dmpf(i)=zero  
        ENDDO 
      ENDIF                                 
C
      DO i=1,nel
        rho(i) =pm( 1,mat(i))
        g(i)   =pm(22,mat(i))
        ym(i)  =pm(20,mat(i)) !YM = E/l
        a1(i)  =geo(1,pid(i)) !A1 = A
        b1(i)  =geo(2,pid(i))
        b2(i)  =geo(18,pid(i))
        b3(i)  =geo(4,pid(i)) !B3 = Ix/l
        shf(i) =geo(37,pid(i))
      ENDDO
C-----------------------------
C
C     CISSAILLEMENT TRANSVERSAL CALCULE AVEC K1=12EI/L**2 K2=5/6GA
C
      DO i=1,nel
        sh(i)=five_over_6*g(i)*a1(i)
        yma2(i)=twelve*ym(i)/al(i)**2
        sh10(i)=yma2(i)*b1(i)
        sh20(i)=yma2(i)*b2(i)
        sh0(i)=(one-shf(i))*sh(i)
        sh1(i)=sh0(i)*sh10(i)/(sh(i)+sh10(i)) + shf(i)*sh10(i)
        sh2(i)=sh0(i)*sh20(i)/(sh(i)+sh20(i)) + shf(i)*sh20(i)
C
        for(i,1)=for(i,1)+ exx(i)*a1(i)*ym(i)
        for(i,2)=for(i,2)+ exy(i)*sh2(i)
        for(i,3)=for(i,3)+ exz(i)*sh1(i)
        mom(i,1)=mom(i,1)+ kxx(i)*g(i)*b3(i)
        mom(i,2)=mom(i,2)+ kyy(i)*ym(i)*b1(i)
        mom(i,3)=mom(i,3)+ kzz(i)*ym(i)*b2(i)
C
        for(i,1)=for(i,1)*off(i)
        for(i,2)=for(i,2)*off(i)
        for(i,3)=for(i,3)*off(i)
        mom(i,1)=mom(i,1)*off(i)
        mom(i,2)=mom(i,2)*off(i)
        mom(i,3)=mom(i,3)*off(i)
      ENDDO
C
      DO i=1,nel
        f1(i) =  for(i,1)
        f2(i) =  for(i,2) 
        f3(i) =  for(i,3)  
        m1(i) =  mom(i,1) 
        m2(i) =  mom(i,2) 
        m3(i) =  mom(i,3) 
      ENDDO               
C-----------------------------------------------
      RETURN