bsigini.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/.
!||====================================================================
!||    bsigini                ../starter/source/elements/beam/bsigini.F
!||--- called by ------------------------------------------------------
!||    pinit3                 ../starter/source/elements/beam/pinit3.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.F
!||    fretitl2               ../starter/source/starter/freform.F
!||--- uses       -----------------------------------------------------
!||    message_mod            ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE bsigini(ELBUF_STR,
     .                   IGTYP    ,NEL    ,NSIGBEAM  ,SIGBEAM   ,PTBEAM,
     .                   IXP      ,IGEO   )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_mod
      USE message_mod
      USE names_and_titles_mod , ONLY : nchartitle
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      "vect01_c.inc"
#include      "param_c.inc"
#include      "scr17_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER :: IGTYP,NEL,NSIGBEAM
      INTEGER :: PTBEAM(*),IXP(NIXP,*),IGEO(NPROPGI,*)
      my_real :: sigbeam(nsigbeam,*)
      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,II,JJ,IPT,IR,IS,PT,KK(3),ILAY,NPTI,PID,IPID
      CHARACTER(LEN=NCHARTITLE) :: TITR1
      TYPE(g_bufel_),POINTER :: GBUF
      TYPE(l_bufel_),POINTER :: LBUF
C----------------------------------------------------------------------- 
      gbuf => elbuf_str%GBUF
!---
!     initial stress
!---
      DO i=1,3
        kk(i) = nel*(i-1)
      ENDDO
!
      DO i=lft,llt
        ii = i+nft
        jj = ptbeam(ii)
        IF (jj > 0) THEN
!---
          npti = nint(sigbeam(2,jj))
!---
          gbuf%EINT(kk(1)+i) = sigbeam(4,jj)
          gbuf%EINT(kk(2)+i) = sigbeam(5,jj)
!
          gbuf%FOR(kk(1)+i) = sigbeam(6,jj)
          gbuf%FOR(kk(2)+i) = sigbeam(7,jj)
          gbuf%FOR(kk(3)+i) = sigbeam(8,jj)
!
          gbuf%MOM(kk(1)+i) = sigbeam(9,jj)
          gbuf%MOM(kk(2)+i) = sigbeam(10,jj)
          gbuf%MOM(kk(3)+i) = sigbeam(11,jj)
!---
          IF (igtyp == 3) THEN
            IF(gbuf%G_PLA > 0) gbuf%PLA(i) = sigbeam(12,jj)
! check NPT /= NPTI
            IF (npt /= npti  .and . npti /= 0) THEN
              ipid=ixp(5,i)
              pid=igeo(1,ixp(5,i))
              CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid),ltitr)
              CALL ancmsg(msgid=1233,anmode=aninfo,msgtype=msgerror,i1=pid,i2=ixp(nixp,i),c1=titr1)
            ENDIF
!
          ELSEIF (igtyp == 18) THEN
            pt = 11
! check NPT /= NPTI
            IF (npt /= npti  .AND. npti /= 0) THEN
              ipid=ixp(5,i)
              pid=igeo(1,ixp(5,i))            
              CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid),ltitr)
              CALL ancmsg(msgid=1233,anmode=aninfo,msgtype=msgerror,i1=pid,i2=ixp(nixp,i),c1=titr1)
            ENDIF
!
            DO ipt=1,npt
              ilay=1
              ir = 1
              is = 1
              lbuf => elbuf_str%BUFLY(ilay)%LBUF(ir,is,ipt)
              lbuf%SIG(kk(1)+i) = sigbeam(pt+1,jj)
              lbuf%SIG(kk(2)+i) = sigbeam(pt+2,jj)
              lbuf%SIG(kk(3)+i) = sigbeam(pt+3,jj)
              IF(elbuf_str%BUFLY(ilay)%L_PLA > 0) lbuf%PLA(i) = sigbeam(pt+4,jj)
              pt = pt + 4
            ENDDO ! DO IPT=1,NPT
          ENDIF ! IF (IGTYP == 5)
!---
        ENDIF ! IF (JJ > 0)
      ENDDO ! DO I=LFT,LLT
!---
      RETURN
      END