thermexpp.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/.
!||====================================================================
!||    thermexppi     ../engine/source/elements/beam/thermexpp.F
!||--- called by ------------------------------------------------------
!||    pforc3         ../engine/source/elements/beam/pforc3.F
!||--- uses       -----------------------------------------------------
!||    elbufdef_mod   ../common_source/modules/mat_elem/elbufdef_mod.F90
!||====================================================================
      SUBROUTINE thermexppi(ELBUF_STR,
     1                  NEL    ,NPT    ,MAT    , PID    ,
     2                  PM     ,GEO    , AL     ,ETH    ,
     2                  OFF    ,FOR    ,EINT       )
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_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      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NPT,NEL
      INTEGER MAT(MVSIZ),PID(MVSIZ)
C     REAL
      my_real
     .   pm(npropm,*), geo(npropg,*),for(nel,3), eint(nel,2),
     .   off(*), al(*),eth(nel)
C
      TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
 
      INTEGER I, MX, IPT, IPA, 
     .        IR,IS,ILAYER,II(3)
C     REAL
      my_real
     .  e, signxx,dfxx,apt
C
      TYPE(l_bufel_),POINTER :: LBUF  
      TYPE(BUF_LAY_) ,POINTER :: BUFLY
C=======================================================================
!   
   
C-------------------------------------
C     START OF LOOP OVER INTEGRATION POINTS
C--------------------------------------
C             
      ipa  = 400  
      DO i=1,3
        ii(i) = nel*(i-1)
      ENDDO 
      DO ipt= 1,npt
        ilayer=1
        ir = 1
        is = 1
        lbuf => elbuf_str%BUFLY(ilayer)%LBUF(ir,is,ipt)
        bufly => elbuf_str%BUFLY(ilayer)
c---    Total strain
C 
        IF (bufly%L_STRA > 0) THEN
          DO i= 1,nel
            lbuf%STRA(ii(1)+i) = lbuf%STRA(ii(1)+i) + eth(i)
          ENDDO
        ENDIF        
C
C--- Elastic constraints
C
        DO i =1 ,nel             
          mx = mat(i)                            
          e    = pm(20,mx)                         
          signxx =  -e*eth(i)  
C       FORCES AND MOMENTS
          apt = geo(ipa+ipt,pid(i)) 
          dfxx = apt*signxx
          for(i,1) = for(i,1) + dfxx     
C                                                    
          lbuf%SIG(ii(1)+i) = lbuf%SIG(ii(1)+i) + signxx
        ENDDO                                                       
C-------------------------------------
C       END OF LOOP OVER INTEGRATION POINTS
C-------------------------------------
       ENDDO   
C-----------
      RETURN
      END
!||====================================================================
!||    thermexppg   ../engine/source/elements/beam/thermexpp.F
!||--- called by ------------------------------------------------------
!||    pforc3       ../engine/source/elements/beam/pforc3.F
!||====================================================================
      SUBROUTINE thermexppg(
     .              NEL    ,MAT     ,PID   , PM, GEO ,
     .              OFF    ,ETH     ,FOR     ,EINT  )
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.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      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NEL,MAT(MVSIZ),PID(MVSIZ)
C     REAL
      my_real
     .   PM(NPROPM,*), FOR(NEL,3),  EINT(NEL,2), GEO(NPROPG,*),
     . OFF(*),ETH(NEL)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
C     REAL
      my_real
     .   YM,A1
C-----------------------------------------------
      DO i=1,nel
        ym  =pm(20,mat(i))
        a1  =geo(1,pid(i))
        for(i,1) = (for(i,1)  - eth(i)*a1*ym )*off(i)   
!!        EINT(I,1) = EINT(I,1) - FOR(I,1)*ETH(I)*AL(I)*HALF*OFF(I)
      ENDDO             
C-----------------------------------------------
      RETURN
      END