sboltini.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/.
!||====================================================================
!||    sboltini   ../starter/source/loads/bolt/sboltini.F
!||--- called by ------------------------------------------------------
!||    s10init3   ../starter/source/elements/solid/solide10/s10init3.F
!||    s4init3    ../starter/source/elements/solid/solide4/s4init3.F
!||    s8zinit3   ../starter/source/elements/solid/solide8z/s8zinit3.F
!||    sinit3     ../starter/source/elements/solid/solide/sinit3.F
!||====================================================================
      SUBROUTINE sboltini(E1X  ,E1Y  ,E1Z  ,E2X  ,E2Y  ,E2Z  ,E3X  ,E3Y  ,E3Z  ,
     .                    BPRELD     ,NEL  ,IX   ,NIX  ,VPRELOAD, IFLAG_BPRELOAD)  
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      "boltpr_c.inc"
#include      "vect01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER   NIX , NEL
      INTEGER   IX(NIX,*), IFLAG_BPRELOAD(*)
      my_real
     .   vpreload(7,*),bpreld(nel,nbpreld),
     .   e1x(*),e1y(*),e1z(*),e2x(*),e2y(*),e2z(*),e3x(*),e3y(*),e3z(*)  
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,IFLAGINI,J,II,JJ
      my_real
     .  nx,ny,nz,tstart,tend,load,sens,
     .  l11,l22,l33,l12,l23,l13,t11,t22,t33,t12,t23,t13,
     .  s11,s12,s13,s21,s22,s23,s31,s32,s33,
     .  ee1x,ee1y,ee1z,ee2x,ee2y,ee2z,ee3x,ee3y,ee3z
C=======================================================================
      IF (jcvt /= 0)THEN
       DO i=lft,llt
         iflagini = 0
         ii=nft+i
         jj=iflag_bpreload(ii)
         IF (jj == 0)GOTO 200
         iflagini = 1
C-----------
         IF (iflagini == 1)THEN
           tstart = vpreload(1,ii)
           tend   = vpreload(2,ii)
           load   = vpreload(3,ii)
           nx = vpreload(4,ii)
           ny = vpreload(5,ii)
           nz = vpreload(6,ii)
           sens = vpreload(7,ii)
           l11 = load*nx*nx
           l22 = load*ny*ny
           l33 = load*nz*nz
           l12 = load*nx*ny
           l23 = load*ny*nz
           l13 = load*nz*nx
           ee1x = e1x(i)
           ee1y = e1y(i)
           ee1z = e1z(i)
           ee2x = e2x(i)
           ee2y = e2y(i)
           ee2z = e2z(i)
           ee3x = e3x(i)
           ee3y = e3y(i)
           ee3z = e3z(i)
           s11 = l11*ee1x+l12*ee1y+l13*ee1z
           s12 = l11*ee2x+l12*ee2y+l13*ee2z
           s13 = l11*ee3x+l12*ee3y+l13*ee3z
           s21 = l12*ee1x+l22*ee1y+l23*ee1z
           s22 = l12*ee2x+l22*ee2y+l23*ee2z
           s23 = l12*ee3x+l22*ee3y+l23*ee3z
           s31 = l13*ee1x+l23*ee1y+l33*ee1z
           s32 = l13*ee2x+l23*ee2y+l33*ee2z
           s33 = l13*ee3x+l23*ee3y+l33*ee3z
           t11 = ee1x*s11+ee1y*s21+ee1z*s31
           t22 = ee2x*s12+ee2y*s22+ee2z*s32
           t33 = ee3x*s13+ee3y*s23+ee3z*s33
           t12 = ee1x*s12+ee1y*s22+ee1z*s32
           t23 = ee2x*s13+ee2y*s23+ee2z*s33
           t13 = ee1x*s13+ee1y*s23+ee1z*s33
           bpreld(i,1)=tstart
           bpreld(i,2)=tend
           bpreld(i,3)=zero
           bpreld(i,4)=t11  
           bpreld(i,5)=t22  
           bpreld(i,6)=t33
           bpreld(i,7)=t12
           bpreld(i,8)=t23
           bpreld(i,9)=t13
           bpreld(i,10)=sens
          
          !write (957,'(3I5,1X,10E10.3)')II,I,N,BPRELD(I,1:10)
         ENDIF
  200    CONTINUE
       ENDDO
      ELSE
       DO i=lft,llt
        iflagini = 0
        ii=nft+i
        jj=iflag_bpreload(ii)
        IF (jj == 0)GOTO 300
        iflagini = 1
C-----------
        IF (iflagini == 1)THEN
          tstart = vpreload(1,ii)
          tend   = vpreload(2,ii)
          load   = vpreload(3,ii)
          nx = vpreload(4,ii)
          ny = vpreload(5,ii)
          nz = vpreload(6,ii)
          sens = vpreload(7,ii)
          l11 = load*nx*nx
          l22 = load*ny*ny
          l33 = load*nz*nz
          l12 = load*nx*ny
          l23 = load*ny*nz
          l13 = load*nz*nx
          bpreld(i,1)=tstart
          bpreld(i,2)=tend
          bpreld(i,3)=zero
          bpreld(i,4)=l11  
          bpreld(i,5)=l22  
          bpreld(i,6)=l33
          bpreld(i,7)=l12
          bpreld(i,8)=l23
          bpreld(i,9)=l13
          bpreld(i,10)=sens
          
          !write (917,'(3I5,1X,10E10.3)')II,I,N,BPRELD(I,1:10)
        ENDIF
  300   CONTINUE
       ENDDO
      ENDIF
C-----------
      RETURN
      END