m1lawp.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/.
!||====================================================================
!||    m1lawp       ../engine/source/materials/mat/mat001/m1lawp.F
!||--- called by ------------------------------------------------------
!||    main_beam3   ../engine/source/elements/beam/main_beam3.F
!||====================================================================
      SUBROUTINE m1lawp(
     1              PM      ,FOR     ,MOM     ,GEO     ,
     2              OFF     ,EXX     ,EXY     ,EXZ     ,KXX,
     3              KYY     ,KZZ     ,AL      ,F1      ,F2 ,
     4              F3      ,M1      ,M2      ,M3      ,NEL,
     5              MAT     ,PID     )
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
      END