buserini.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/.
!||====================================================================
!||    buserini               ../starter/source/elements/beam/buserini.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 buserini(ELBUF_STR,
     .                    IXP      ,SIGBEAM  ,NSIGBEAM ,PTBEAM ,IGEO  ,
     .                    NEL      )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_mod
      USE message_mod
      USE names_and_titles_mod , ONLY : nchartitle
      use element_mod , only : nixp
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      "com01_c.inc"
#include      "param_c.inc"
#include      "scr17_c.inc"
#include      "vect01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NEL,NSIGBEAM
      INTEGER IXP(NIXP,*),PTBEAM(*),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,NPTI,NU,NUVAR,NVARS,IPT,ILAY,IR,IS,PID,IPID,IGTYP
      CHARACTER(LEN=NCHARTITLE)::TITR1
      my_real, DIMENSION(:), POINTER :: uvar
C=======================================================================
!     INITIAL USER VARIABLES
      DO i=lft,llt
        ii = nft+i
        jj = ptbeam(ii)
        IF (jj > 0) THEN
          npti  = nint(sigbeam(nvbeam + 2,jj))
          igtyp = nint(sigbeam(nvbeam + 3,jj))
          nvars = nint(sigbeam(nvbeam + 4,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=1237,anmode=aninfo,msgtype=msgerror,i1=pid,i2=ixp(nixp,i),c1=titr1)
          ENDIF
 
          DO ipt=1,npt
            ilay=1
            ir = 1
            is = 1
            nuvar = elbuf_str%BUFLY(ilay)%NVAR_MAT
            uvar => elbuf_str%BUFLY(ilay)%MAT(ir,is,ipt)%VAR
            DO nu = 1,min(nvars,nuvar)
              uvar((nu-1)*nel + i) =  sigbeam(nvbeam + 4  + nu + (ipt -1)*nvars,jj)
            ENDDO
          ENDDO  !  DO ILAY=1,NPT
        ENDIF ! IF (JJ > 0)
      ENDDO ! DO I=JFT,JLT
C-----------
      RETURN
      END