precheck_LIB_shell.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
! Copyright (c) 2019 FrontISTR Commons
! This software is released under the MIT License, see LICENSE.txt
!-------------------------------------------------------------------------------
module m_precheck_lib_shell
contains
  !***********************************************************************
  !  SHELL Element:
  !  PRE_731( XX,YY,ZZ,thick,vol,almax,almin )
  !  PRE_741( XX,YY,ZZ,thick,vol,almax,almin )
  !----------------------------------------------------------------------*
  subroutine pre_731( XX,YY,ZZ,thick,vol,almax,almin )
    !----------------------------------------------------------------------*
    !**
    !**  Precheck for 3nodes SHELL
    !**
    use hecmw
    implicit none
    ! I/F VARIABLES
    real(kind=kreal) xx(*),yy(*),zz(*),thick,vol,almax,almin
    ! LOCAL VARIABLES
    real(kind=kreal) v1x,v1y,v1z
    real(kind=kreal) v2x,v2y,v2z
    real(kind=kreal) v3x,v3y,v3z
    real(kind=kreal) area,a1,a2,a3
    area = 0.0
    vol = 0.0
    !** FACE 1-2-3
    v1x=xx(2)-xx(1)
    v1y=yy(2)-yy(1)
    v1z=zz(2)-zz(1)
    v2x=xx(3)-xx(1)
    v2y=yy(3)-yy(1)
    v2z=zz(3)-zz(1)
    v3x= v1y*v2z-v1z*v2y
    v3y=-v1x*v2z+v1z*v2x
    v3z= v1x*v2y-v1y*v2x
    area=sqrt( v3x*v3x + v3y*v3y + v3z*v3z )*0.5
    vol = area * thick
    a1 = sqrt( (xx(2)-xx(1))**2+(yy(2)-yy(1))**2+(zz(2)-zz(1))**2 )
    a2 = sqrt( (xx(3)-xx(2))**2+(yy(3)-yy(2))**2+(zz(3)-zz(2))**2 )
    a3 = sqrt( (xx(1)-xx(3))**2+(yy(1)-yy(3))**2+(zz(1)-zz(3))**2 )
    almax = dmax1( a1,a2,a3 )
    almin = dmin1( a1,a2,a3 )
 
  end subroutine pre_731
  !----------------------------------------------------------------------*
  subroutine pre_741( XX,YY,ZZ,thick,vol,almax,almin )
    !----------------------------------------------------------------------*
    !**
    !**  Precheck for 3nodes SHELL
    !**
    use hecmw
    use quadrature
    implicit none
    ! I/F VARIABLES
    real(kind=kreal) xx(*),yy(*),zz(*),thick,vol,almax,almin
    ! LOCAL VARIABLES
    integer(kind=kint) NN
    integer(kind=kint) NG
    parameter(nn=8,ng=2)
    real(kind=kreal) h(nn),hr(nn),hs(nn),ht(nn)
    real(kind=kreal) ri,si,ti,rp,sp,tp,rm,sm,tm
    real(kind=kreal) xj11,xj21,xj31,xj12,xj22,xj32,xj13,xj23,xj33,det,wg
    integer(kind=kint) IG1,IG2,LX,LY,LZ,I
    real(kind=kreal) vx,vy,vz,xcod,ycod,zcod
    real(kind=kreal) ax,ay,az,rx,ry,rz,hx,hy,hz,val
    real(kind=kreal) phx,phy,phz
    real(kind=kreal) g1x,g1y,g1z
    real(kind=kreal) g2x,g2y,g2z
    real(kind=kreal) g3x,g3y,g3z
    real(kind=kreal) xsum,coefx,coefy,coefz
    real(kind=kreal) area,a1,a2,a3,a4
    !
    area = 0.0
    vol  = 0.0
    ! INTEGRATION OVER SURFACE
    do ig2=1,ng
      si=gauss1d2(1,ig2)
      do ig1=1,ng
        ri=gauss1d2(1,ig1)
        h(1)=0.25*(1.0-ri)*(1.0-si)
        h(2)=0.25*(1.0+ri)*(1.0-si)
        h(3)=0.25*(1.0+ri)*(1.0+si)
        h(4)=0.25*(1.0-ri)*(1.0+si)
        hr(1)=-.25*(1.0-si)
        hr(2)= .25*(1.0-si)
        hr(3)= .25*(1.0+si)
        hr(4)=-.25*(1.0+si)
        hs(1)=-.25*(1.0-ri)
        hs(2)=-.25*(1.0+ri)
        hs(3)= .25*(1.0+ri)
        hs(4)= .25*(1.0-ri)
        g1x=0.0
        g1y=0.0
        g1z=0.0
        g2x=0.0
        g2y=0.0
        g2z=0.0
        do i=1,nn
          g1x=g1x+hr(i)*xx(i)
          g1y=g1y+hr(i)*yy(i)
          g1z=g1z+hr(i)*zz(i)
          g2x=g2x+hs(i)*xx(i)
          g2y=g2y+hs(i)*yy(i)
          g2z=g2z+hs(i)*zz(i)
        enddo
        g3x=g1y*g2z-g1z*g2y
        g3y=g1z*g2x-g1x*g2z
        g3z=g1x*g2y-g1y*g2x
        xsum=dsqrt(g3x**2+g3y**2+g3z**2)
        g3x=g3x/xsum
        g3y=g3y/xsum
        g3z=g3z/xsum
        !JACOBI MATRIX
        xj11=g1x
        xj12=g1y
        xj13=g1z
        xj21=g2x
        xj22=g2y
        xj23=g2z
        xj31=g3x
        xj32=g3y
        xj33=g3z
        !DETERMINANT OF JACOBIAN
        det=xj11*xj22*xj33                                                 &
          +xj12*xj23*xj31                                                 &
          +xj13*xj21*xj32                                                 &
          -xj13*xj22*xj31                                                 &
          -xj12*xj21*xj33                                                 &
          -xj11*xj23*xj32
        wg=weight1d2(ig1)*weight1d2(ig2)*det
        do i = 1, nn
          area = area + h(i)*wg
        enddo
      enddo
    enddo
 
    vol = area*thick
    a1 = sqrt( (xx(2)-xx(1))**2+(yy(2)-yy(1))**2+(zz(2)-zz(1))**2 )
    a2 = sqrt( (xx(3)-xx(2))**2+(yy(3)-yy(2))**2+(zz(3)-zz(2))**2 )
    a3 = sqrt( (xx(4)-xx(3))**2+(yy(4)-yy(3))**2+(zz(4)-zz(3))**2 )
    a4 = sqrt( (xx(1)-xx(4))**2+(yy(1)-yy(4))**2+(zz(1)-zz(4))**2 )
    almax = dmax1( a1,a2,a3,a4 )
    almin = dmin1( a1,a2,a3,a4 )
 
  end subroutine pre_741
end module m_precheck_lib_shell