fxbsini.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/.
!||====================================================================
!||    fxbsini     ../starter/source/constraints/fxbody/fxbsini.F
!||--- called by ------------------------------------------------------
!||    initia      ../starter/source/elements/initia/initia.F
!||--- calls      -----------------------------------------------------
!||    fsigcini    ../starter/source/constraints/fxbody/fsigcini.F
!||    fsigpini    ../starter/source/constraints/fxbody/fsigpini.F
!||    fsigsini    ../starter/source/constraints/fxbody/fsigsini.F
!||    fsigtini    ../starter/source/constraints/fxbody/fsigtini.F
!||    fsigtrini   ../starter/source/constraints/fxbody/fsigtrini.F
!||====================================================================
      SUBROUTINE fxbsini(FXBELM, FXBSIG, NELS , NELC  , NELTG,
     .                   X     , IPARG , PM   , FXBMOD, NML  ,
     .                   NSN   , IXS   , IXC  , IXTG  , GEO  ,
     .                   FXBRPM, NFX   , IFILE, LVSIG , NSNI ,
     .                   NME   , IRCS  , IRCM0, NELT  , NELP ,
     .                   IXT   , IXP   ,IBEAM_VECTOR,RBEAM_VECTOR)
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      "units_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER FXBELM(*), NELS, NELC, NELTG, IPARG(NPARG,*), NML, 
     .        NSN, IXS(NIXS,*), IXC(NIXC,*), IXTG(NIXTG,*), NFX, IFILE,
     .        LVSIG, NSNI, NME, IRCS, IRCM0, NELT, NELP, IXT(NIXT,*),
     .        IXP(NIXP,*)
      INTEGER, INTENT (IN   ) :: IBEAM_VECTOR(NELP)
      my_real
     .        fxbsig(*), x(3,*), pm(npropm,*), fxbmod(*),
     .        geo(npropg,*), fxbrpm(*)
      my_real, INTENT (IN   ) :: rbeam_vector(3,nelp)     
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,II,IM,IADMOD,IADEL,IADSIG, IADM, IADS, IRCM, IAD, J
      my_real
     .        rini(3,3), vmod(nsn*6), vsig(lvsig), vv(6)
C=======================================================================
      ircm=ircm0
      ircm=ircm+nme*(nsn-nsni)
C      
      DO i=1,3
         DO ii=1,3
            rini(i,ii)=fxbrpm(1+(i-1)*3+ii)
         ENDDO
      ENDDO
C
      iadsig=1
      DO im=1,nml
        IF (ifile==0) THEN
           iadmod=nsn*6*(im-1)+1
           DO i=1,nsn*6
              vmod(i)=fxbmod(iadmod+i-1)
           ENDDO
        ELSEIF (ifile==1) THEN
           iadmod=nsni*6*(im-1)+1
           DO i=1,nsni*6
              vmod(i)=fxbmod(iadmod+i-1)
           ENDDO
           iadm=nsni*6
           DO i=1,nsn-nsni
              ircm=ircm+1
              READ(ifxm,rec=ircm) (vv(ii),ii=1,6)
              DO ii=1,6
                 vmod(iadm+ii)=vv(ii)
              ENDDO
              iadm=iadm+6
           ENDDO
        ENDIF
C   1. Solid elements
        iadel=1
        iads=1
        IF (nels>0) CALL fsigsini(
     .     fxbelm(iadel), iparg, x,          pm,   ixs, 
     .     geo,           vmod,  vsig(iads), rini, nels)
C   2. 4-nodes shell elements
        iadel=iadel+nels*13
        iads=iads+nels*7             
        IF (nelc>0) CALL fsigcini(
     .     fxbelm(iadel), iparg, x,          pm,   ixc, 
     .     geo,           vmod,  vsig(iads), rini, nelc)
C   3. Truss elements
        iadel=iadel+nelc*10
        iads=iads+nelc*10
        IF (nelt>0) CALL fsigtrini(
     .     fxbelm(iadel), iparg, x,         pm,   ixt,
     .     geo,           vmod,  vsig(iads),nelt)
C   4. Beam elements
        iadel=iadel+nelt*7
        iads=iads+nelt*2
        IF (nelp>0) CALL fsigpini(
     .     fxbelm(iadel), iparg, x,          pm,   ixp, 
     .     geo,           vmod,  vsig(iads), rini, nelp,
     .     ibeam_vector ,rbeam_vector)
C   5. 3-nodes shell elements
        iadel=iadel+nelp*9
        iads=iads+nelp*8             
        IF (neltg>0) CALL fsigtini(
     .     fxbelm(iadel), iparg, x,          pm,   ixtg, 
     .     geo,           vmod,  vsig(iads), rini, neltg)
        IF (ifile==0) THEN
           DO i=1,lvsig
              fxbsig(iadsig+i-1)=vsig(i)
           ENDDO
        ELSE
           iad=0
           DO i=1,lvsig/6
              ircs=ircs+1
              WRITE(ifxs,rec=ircs) (vsig(iad+j),j=1,6)
              iad=iad+6
           ENDDO
           ii=lvsig-(lvsig/6)*6
           IF (ii/=0) THEN
              ircs=ircs+1
              WRITE(ifxs,rec=ircs) (vsig(iad+j),j=1,ii),(zero,j=ii+1,6)
           ENDIF
        ENDIF
        iadsig=iadsig+nels*7+nelc*10+nelt*2+nelp*8+neltg*10
      ENDDO
C-----------
      RETURN
      END SUBROUTINE fxbsini