fail_windshield_init.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	fail_windshield_init (elbuf_str, mat_param, fail_brokmann, nel, nft, ity, igrsh4n, igrsh3n, aldt, thk, ngl)

Function/Subroutine Documentation

fail_windshield_init()

subroutine fail_windshield_init	(	type (elbuf_struct_)	elbuf_str,
		type (matparam_struct_), dimension(nummat), intent(inout)	mat_param,
		type (fail_brokmann_), intent(in)	fail_brokmann,
		integer	nel,
		integer	nft,
		integer	ity,
		type (group_), dimension(ngrshel)	igrsh4n,
		type (group_), dimension(ngrsh3n)	igrsh3n,
		intent(in)	aldt,
		intent(in)	thk,
		integer, dimension(nel), intent(in)	ngl )

Definition at line 37 of file fail_windshield_init.F.

!-----------------------------------------------
!   M o d u l e s
!-----------------------------------------------
      USE elbufdef_mod            
      USE matparam_def_mod
      USE groupdef_mod
      USE crack_depth_init_mod
      USE brokmann_crack_init_mod
      use brokmann_random_def_mod
!-----------------------------------------------
!   I m p l i c i t   T y p e s
!-----------------------------------------------
#include      "implicit_f.inc"
!-----------------------------------------------
!   C o m m o n   B l o c k s
!-----------------------------------------------
#include       "param_c.inc"
#include       "com04_c.inc" 
!-----------------------------------------------
!   d u m m y   a r g u m e n t s
!-----------------------------------------------
      INTEGER NEL,NFT,ITY
      INTEGER, DIMENSION(NEL) ,INTENT(IN) :: NGL
      my_real, DIMENSION(NEL) ,INTENT(IN) :: aldt
      my_real, DIMENSION(NEL) ,INTENT(IN) :: thk
      TYPE (ELBUF_STRUCT_) :: ELBUF_STR
      TYPE (GROUP_)  , DIMENSION(NGRSHEL) :: IGRSH4N
      TYPE (GROUP_)  , DIMENSION(NGRSH3N) :: IGRSH3N
      TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
      TYPE (FAIL_BROKMANN_) ,INTENT(IN) :: FAIL_BROKMANN
!-----------------------------------------------
!   L o c a l   V a r i a b l e s
!-----------------------------------------------
      INTEGER I,II,KK,IEL,ID,IL,IR,IS,IT,NPTR,NPTS,NPTT,IFL,ITGLASS,ELNUM,
     .   IGR,IGRID,NUMEL,IMAT,IRUPT,NFAIL,NUPARAM,NUVAR,NINDX,IVAR,NUM
      INTEGER TAGSH(MAX(NUMELC,NUMELTG)),TAGEL(NEL),INDX(NEL)
      EXTERNAL  ngr2usrn
      INTEGER   NGR2USRN
!-----------------------------------------------------------------------
!     Initialization of failure UVAR table => edge element flag for /FAIL/ALTER
!=======================================================================
      DO il=1, elbuf_str%NLAY
        nfail = elbuf_str%BUFLY(il)%NFAIL
        nptr  = elbuf_str%NPTR
        npts  = elbuf_str%NPTS
        nptt  = elbuf_str%BUFLY(il)%NPTT
        imat  = elbuf_str%BUFLY(il)%IMAT
        DO ir=1,nptr
        DO is=1,npts
        DO it=1,nptt
          DO ifl = 1,nfail
            irupt = mat_param(imat)%FAIL(ifl)%IRUPT
            IF (irupt == 28) THEN   ! windshield failure model
              nuparam = mat_param(imat)%FAIL(ifl)%NUPARAM
              nuvar   = mat_param(imat)%FAIL(ifl)%NUVAR
              itglass = nint(mat_param(imat)%FAIL(ifl)%UPARAM(22))
!
              ivar = nel*(10-1)     ! edge element flag = UVAR(10)
              igr  = 0
              IF (ity == 3) THEN
                kk = ngrnod + ngrbric + ngrquad
                igrid = mat_param(imat)%FAIL(ifl)%UPARAM(12)
                mat_param(imat)%FAIL(ifl)%UPARAM(11) = one / sqrt(pi)  ! GEORED for underintegrated 4N shells
                IF (igrid > 0) igr = ngr2usrn(igrid,igrsh4n,ngrshel,num)
                tagsh(1:numelc)  = 0
              ELSEIF (ity == 7) THEN
                igrid = mat_param(imat)%FAIL(ifl)%UPARAM(13)
                IF (igrid > 0) igr = ngr2usrn(igrid,igrsh3n,ngrsh3n,num)
                tagsh(1:numeltg) = 0
              ENDIF
c
              IF (igr > 0) THEN
                tagel(1:nel) = 0
                IF (ity == 3) THEN
                  numel = igrsh4n(igr)%NENTITY
                  DO iel=1,numel
                    ii = igrsh4n(igr)%ENTITY(iel)
                    tagsh(ii) = 1
                  ENDDO
                ELSEIF (ity == 7) THEN
                  numel = igrsh3n(igr)%NENTITY
                  DO iel=1,numel
                    ii = igrsh3n(igr)%ENTITY(iel)
                    tagsh(ii) = 1
                  ENDDO
                ENDIF ! IF (ITY == 3)
                nindx = 0
                DO i=1,nel
                  IF (tagsh(i+nft) == 1) THEN
                    nindx = nindx + 1
                    indx(nindx) = i
                  ENDIF
                ENDDO
                DO ii = 1,nindx
                  i = indx(ii)            
                  elbuf_str%BUFLY(il)%FAIL(ir,is,it)%FLOC(ifl)%VAR(ivar + i) = 1
                ENDDO
              ENDIF                
!
            END IF               
          END DO    !  IFL = 1,NFAIL              
        END DO      !  IT=1,NPTT
        END DO      !  IT=1,NPTS
        END DO      !  IT=1,NPTR
      END DO        !  IL=1,NLAY
!-----------------------------------------------------------------------------
!     crack depth initialization depending on element and Gauss point position
!-----------------------------------------------------------------------------
      DO il=1, elbuf_str%NLAY
        nfail = elbuf_str%BUFLY(il)%NFAIL
        nptr  = elbuf_str%NPTR
        npts  = elbuf_str%NPTS
        nptt  = elbuf_str%BUFLY(il)%NPTT
        imat  = elbuf_str%BUFLY(il)%IMAT
        DO ir=1,nptr
        DO is=1,npts
        DO it=1,nptt
          DO ifl = 1,nfail
            irupt = mat_param(imat)%FAIL(ifl)%IRUPT
            IF (irupt == 28) THEN   ! windshield failure model
              nuparam = mat_param(imat)%FAIL(ifl)%NUPARAM
              nuvar   = mat_param(imat)%FAIL(ifl)%NUVAR
              itglass = nint(mat_param(imat)%FAIL(ifl)%UPARAM(22))
!
              !  Ch.Alter criterion - crack depth initialization 
!
              CALL crack_depth_init(nel   ,it  ,nptt ,nuparam ,nuvar,
     .                              mat_param(imat)%FAIL(ifl)%UPARAM,
     .                              elbuf_str%BUFLY(il)%FAIL(ir,is,it)%FLOC(ifl)%VAR,
     .                              elbuf_str%BUFLY(il)%FAIL(ir,is,it)%FLOC(ifl)%DAMMX,
     .                              elbuf_str%GBUF%DMG  )
!
              !  Ch.Brokmann criterion - random crack initialization
!
              IF (itglass == 1 .and. (it == 1 .or. it == nptt)) THEN
                DO ii = 1,fail_brokmann%NFAIL
                  IF (fail_brokmann%BROKMANN(ii)%IMAT == imat) THEN
                    ! tag elements of current group in brokmann element list
                    nindx = 0
                    indx(1:nel) = 0
                    do kk = 1,fail_brokmann%brokmann(ii)%nelem
                      id = fail_brokmann%brokmann(ii)%brokmann_elem(kk)%id
                      do iel=1,nel
                        if (id == ngl(iel)) then
                          nindx = nindx + 1
                          indx(nindx) = kk
                        end if
                      end do
                    end do
!
                    if (nindx > 0) then 
                      CALL brokmann_crack_init(nel  ,it   ,nptt ,nuparam ,nuvar,
     .                     mat_param(imat)%FAIL(ifl)%UPARAM    ,fail_brokmann%BROKMANN(ii),
     .                     elbuf_str%BUFLY(il)%FAIL(ir,is,it)%FLOC(ifl)%VAR,
     .                     indx    ,thk      ,aldt      ,ngl   )
                    end if 
!
                  END IF
                END DO
              END IF        ! END Brokmann criterion initialization
!
            END IF  !  windshield failure
          END DO    !  IFL = 1,NFAIL              
        END DO      !  IT=1,NPTT
        END DO      !  IT=1,NPTS
        END DO      !  IT=1,NPTR
      END DO        !  IL=1,NLAY
!-----------
      RETURN