s4coor3.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/.
!||====================================================================
!||    s4coor3   ../engine/source/elements/solid/solide4/s4coor3.F
!||--- called by ------------------------------------------------------
!||    s4forc3   ../engine/source/elements/solid/solide4/s4forc3.f
!||====================================================================
      SUBROUTINE s4coor3(
     1   X,       IXS,     V,       W,
     2   X1,      X2,      X3,      X4,
     3   Y1,      Y2,      Y3,      Y4,
     4   Z1,      Z2,      Z3,      Z4,
     5   VX1,     VX2,     VX3,     VX4,
     6   VY1,     VY2,     VY3,     VY4,
     7   VZ1,     VZ2,     VZ3,     VZ4,
     8   VDX1,    VDX2,    VDX3,    VDX4,
     9   VDY1,    VDY2,    VDY3,    VDY4,
     A   VDZ1,    VDZ2,    VDZ3,    VDZ4,
     B   VDX,     VDY,     VDZ,     VD2,
     C   VIS,     OFFG,    OFF,     SAV,
     D   RHO,     RHOO,    NC1,     NC2,
     E   NC3,     NC4,     NGL,     MXT,
     F   NGEO,    F11,     F21,     F31,
     G   F12,     F22,     F32,     F13,
     H   F23,     F33,     F14,     F24,
     I   F34,     XD1,     XD2,     XD3,
     J   XD4,     YD1,     YD2,     YD3,
     K   YD4,     ZD1,     ZD2,     ZD3,
     L   ZD4,     XDP,     NEL,     JALE,
     M   ISMSTR,  JEUL,    JLAG)
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      "scr05_c.inc"
#include      "scr18_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: JALE
      INTEGER, INTENT(IN) :: ISMSTR
      INTEGER, INTENT(IN) :: JEUL
      INTEGER, INTENT(IN) :: JLAG
      INTEGER, INTENT(IN) ::  NEL
      INTEGER, INTENT(IN) ::  IXS(NIXS,*)
      my_real
     .   X(3,*),V(3,*),W(3,*), VIS(MVSIZ),
     .   X1(MVSIZ), X2(MVSIZ), X3(MVSIZ), X4(MVSIZ), 
     .   Y1(MVSIZ), Y2(MVSIZ), Y3(MVSIZ), Y4(MVSIZ), 
     .   Z1(MVSIZ), Z2(MVSIZ), Z3(MVSIZ), Z4(MVSIZ), 
     .  VX1(MVSIZ), VX2(MVSIZ), VX3(MVSIZ), VX4(MVSIZ), 
     .  VY1(MVSIZ), VY2(MVSIZ), VY3(MVSIZ), VY4(MVSIZ), 
     .  VZ1(MVSIZ), VZ2(MVSIZ), VZ3(MVSIZ), VZ4(MVSIZ), 
     .  VDX1(MVSIZ),VDX2(MVSIZ),VDX3(MVSIZ),VDX4(MVSIZ),
     .  VDY1(MVSIZ),VDY2(MVSIZ),VDY3(MVSIZ),VDY4(MVSIZ),
     .  VDZ1(MVSIZ),VDZ2(MVSIZ),VDZ3(MVSIZ),VDZ4(MVSIZ),
     .  VDX(MVSIZ), VDY(MVSIZ), VDZ(MVSIZ),VD2(MVSIZ),
     .  OFFG(NEL),OFF(MVSIZ),RHO(NEL),
     .  F11(MVSIZ),F21(MVSIZ),F31(MVSIZ),F12(MVSIZ),F22(MVSIZ),F32(MVSIZ),
     .  F13(MVSIZ),F23(MVSIZ),F33(MVSIZ),F14(MVSIZ),F24(MVSIZ),F34(MVSIZ),
     .  RHOO(MVSIZ)
      INTEGER NC1(MVSIZ), NC2(MVSIZ), NC3(MVSIZ), NC4(MVSIZ),
     .        mxt(mvsiz), ngl(mvsiz),ngeo(mvsiz)
      
      DOUBLE PRECISION 
     .   xdp(3,*), sav(nel,9),
     .   xd1(mvsiz), xd2(mvsiz), xd3(mvsiz), xd4(mvsiz),
     .   yd1(mvsiz), yd2(mvsiz), yd3(mvsiz), yd4(mvsiz),
     .   zd1(mvsiz), zd2(mvsiz), zd3(mvsiz), zd4(mvsiz)
           
      my_real
     .   off_l
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I
C-----------------------------------------------
#include "vectorize.inc"
      DO I=1,nel
        vis(i)=zero
        ngeo(i)=ixs(10,i)
        ngl(i)=ixs(11,i)
        mxt(i)=ixs(1,i)
        nc1(i)=ixs(2,i)
        nc2(i)=ixs(4,i)
        nc3(i)=ixs(7,i)
        nc4(i)=ixs(6,i)
        rhoo(i)=rho(i)
      ENDDO
#include "vectorize.inc"
      DO i=1,nel
        x1(i) =x(1,nc1(i))
        y1(i) =x(2,nc1(i))
        z1(i) =x(3,nc1(i))
        x2(i) =x(1,nc2(i))
        y2(i) =x(2,nc2(i))
        z2(i) =x(3,nc2(i))
        x3(i) =x(1,nc3(i))
        y3(i) =x(2,nc3(i))
        z3(i) =x(3,nc3(i))
        x4(i) =x(1,nc4(i))
        y4(i) =x(2,nc4(i))
        z4(i) =x(3,nc4(i))
        vx1(i)=v(1,nc1(i))
        vy1(i)=v(2,nc1(i))
        vz1(i)=v(3,nc1(i))
        vx2(i)=v(1,nc2(i))
        vy2(i)=v(2,nc2(i))
        vz2(i)=v(3,nc2(i))
        vx3(i)=v(1,nc3(i))
        vy3(i)=v(2,nc3(i))
        vz3(i)=v(3,nc3(i))
        vx4(i)=v(1,nc4(i))
        vy4(i)=v(2,nc4(i))
        vz4(i)=v(3,nc4(i))
      ENDDO
 
      off_l  = zero
C----------------------------
C     NODAL COORDINATES     |
C----------------------------
      IF((ismstr<=4.AND.jlag>0).OR.(ismstr==12.AND.idtmin(1)==3)) THEN
 
        IF(iresp == 1) THEN
#include "vectorize.inc"
          DO i=1,nel
            IF(abs(offg(i))>one)THEN
              xd1(i)=sav(i,1)
              yd1(i)=sav(i,2)
              zd1(i)=sav(i,3)
              xd2(i)=sav(i,4)
              yd2(i)=sav(i,5)
              zd2(i)=sav(i,6)
              xd3(i)=sav(i,7)
              yd3(i)=sav(i,8)
              zd3(i)=sav(i,9)
              xd4(i)=zero
              yd4(i)=zero
              zd4(i)=zero
              off(i) = abs(offg(i))-one
C             OFF_L  = MIN(OFF_L,OFFG(I))
            ELSE
              xd1(i)=xdp(1,nc1(i))
              yd1(i)=xdp(2,nc1(i))
              zd1(i)=xdp(3,nc1(i))
              xd2(i)=xdp(1,nc2(i))
              yd2(i)=xdp(2,nc2(i))
              zd2(i)=xdp(3,nc2(i))
              xd3(i)=xdp(1,nc3(i))
              yd3(i)=xdp(2,nc3(i))
              zd3(i)=xdp(3,nc3(i))
              xd4(i)=xdp(1,nc4(i))
              yd4(i)=xdp(2,nc4(i))
              zd4(i)=xdp(3,nc4(i))
              off(i) = abs(offg(i))
C             OFF_L  = MIN(OFF_L,OFFG(I))
            ENDIF
          ENDDO
          off_l = min(off_l,minval(offg(1:nel)))
        ELSE
#include "vectorize.inc"
          DO i=1,nel
            IF(abs(offg(i))>one)THEN
              xd1(i)=sav(i,1)
              yd1(i)=sav(i,2)
              zd1(i)=sav(i,3)
              xd2(i)=sav(i,4)
              yd2(i)=sav(i,5)
              zd2(i)=sav(i,6)
              xd3(i)=sav(i,7)
              yd3(i)=sav(i,8)
              zd3(i)=sav(i,9)
              xd4(i)=zero
              yd4(i)=zero
              zd4(i)=zero
              off(i) = abs(offg(i))-one
C             OFF_L  = MIN(OFF_L,OFFG(I))
            ELSE
              xd1(i)=x1(i)
              yd1(i)=y1(i)
              zd1(i)=z1(i)
              xd2(i)=x2(i)
              yd2(i)=y2(i)
              zd2(i)=z2(i)
              xd3(i)=x3(i)
              yd3(i)=y3(i)
              zd3(i)=z3(i)
              xd4(i)=x4(i)
              yd4(i)=y4(i)
              zd4(i)=z4(i)
              off(i) = abs(offg(i))
C             OFF_L  = MIN(OFF_L,OFFG(I))
            ENDIF
          ENDDO
          off_l = min(off_l,minval(offg(1:nel)))
        ENDIF
C
      ELSE
C
       IF(iresp==1)THEN 
#include "vectorize.inc"
         DO i=1,nel
           xd1(i)=xdp(1,nc1(i))  
           yd1(i)=xdp(2,nc1(i))  
           zd1(i)=xdp(3,nc1(i))  
           xd2(i)=xdp(1,nc2(i))  
           yd2(i)=xdp(2,nc2(i))  
           zd2(i)=xdp(3,nc2(i))  
           xd3(i)=xdp(1,nc3(i))  
           yd3(i)=xdp(2,nc3(i))  
           zd3(i)=xdp(3,nc3(i))  
           xd4(i)=xdp(1,nc4(i))  
           yd4(i)=xdp(2,nc4(i))  
           zd4(i)=xdp(3,nc4(i))  
           off(i) = abs(offg(i))
C          OFF_L  = MIN(OFF_L,OFFG(I))                 
         ENDDO
         off_l = min(off_l,minval(offg(1:nel)))
       ELSE  
#include "vectorize.inc"
         DO i=1,nel
           xd1(i)=x1(i) 
           yd1(i)=y1(i) 
           zd1(i)=z1(i) 
           xd2(i)=x2(i) 
           yd2(i)=y2(i) 
           zd2(i)=z2(i) 
           xd3(i)=x3(i) 
           yd3(i)=y3(i) 
           zd3(i)=z3(i) 
           xd4(i)=x4(i) 
           yd4(i)=y4(i) 
           zd4(i)=z4(i)   
           off(i) = abs(offg(i))
C          OFF_L  = MIN(OFF_L,OFFG(I))     
         ENDDO      
         off_l = min(off_l,minval(offg(1:nel)))
       ENDIF     
C
      ENDIF
C
      IF(off_l<zero)THEN
#include "vectorize.inc"
        DO i=1,nel
          IF(offg(i)<zero)THEN
            vx1(i)=zero
            vy1(i)=zero
            vz1(i)=zero
            vx2(i)=zero
            vy2(i)=zero
            vz2(i)=zero
            vx3(i)=zero
            vy3(i)=zero
            vz3(i)=zero
            vx4(i)=zero
            vy4(i)=zero
            vz4(i)=zero
          ENDIF
        ENDDO
      ENDIF
 
      f11(1:nel)=zero
      f21(1:nel)=zero
      f31(1:nel)=zero
      f12(1:nel)=zero
      f22(1:nel)=zero
      f32(1:nel)=zero
      f13(1:nel)=zero
      f23(1:nel)=zero
      f33(1:nel)=zero
      f14(1:nel)=zero
      f24(1:nel)=zero
      f34(1:nel)=zero
C
      IF (jlag/=0)THEN
       vd2(1:nel)=zero
       RETURN
C
      ELSEIF(jale/=0)THEN
#include "vectorize.inc"
        DO i=1,nel
          vdx1(i)=vx1(i)-w(1,nc1(i))
          vdy1(i)=vy1(i)-w(2,nc1(i))
          vdz1(i)=vz1(i)-w(3,nc1(i))
          vdx2(i)=vx2(i)-w(1,nc2(i))
          vdy2(i)=vy2(i)-w(2,nc2(i))
          vdz2(i)=vz2(i)-w(3,nc2(i))
          vdx3(i)=vx3(i)-w(1,nc3(i))
          vdy3(i)=vy3(i)-w(2,nc3(i))
          vdz3(i)=vz3(i)-w(3,nc3(i))
          vdx4(i)=vx4(i)-w(1,nc4(i))
          vdy4(i)=vy4(i)-w(2,nc4(i))
          vdz4(i)=vz4(i)-w(3,nc4(i))
        ENDDO
      ELSEIF(jeul/=0)THEN
#include "vectorize.inc"
        DO i=1,nel
          vdx1(i)=vx1(i)
          vdy1(i)=vy1(i)
          vdz1(i)=vz1(i)
          vdx2(i)=vx2(i)
          vdy2(i)=vy2(i)
          vdz2(i)=vz2(i)
          vdx3(i)=vx3(i)
          vdy3(i)=vy3(i)
          vdz3(i)=vz3(i)
          vdx4(i)=vx4(i)
          vdy4(i)=vy4(i)
          vdz4(i)=vz4(i)
        ENDDO
      ENDIF
#include "vectorize.inc"
      DO i=1,nel
        vdx(i)=fourth*(vdx1(i)+vdx2(i)+vdx3(i)+vdx4(i))
        vdy(i)=fourth*(vdy1(i)+vdy2(i)+vdy3(i)+vdy4(i))
        vdz(i)=fourth*(vdz1(i)+vdz2(i)+vdz3(i)+vdz4(i))
        vd2(i)=nine*(vdx(i)**2+vdy(i)**2+vdz(i)**2)
      ENDDO
C
      RETURN
      END