failini.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/.
!||====================================================================
!||    failini               ../starter/source/elements/solid/solide/failini.F
!||--- called by ------------------------------------------------------
!||    s10init3              ../starter/source/elements/solid/solide10/s10init3.f
!||    s16init3              ../starter/source/elements/thickshell/solide16/s16init3.F
!||    s20init3              ../starter/source/elements/solid/solide20/s20init3.F
!||    s4init3               ../starter/source/elements/solid/solide4/s4init3.F
!||    s6cinit3              ../starter/source/elements/thickshell/solide6c/s6cinit3.F
!||    s6zinit3              ../starter/source/elements/solid/solide6z/s6zinit3.F90
!||    s8cinit3              ../starter/source/elements/thickshell/solide8c/s8cinit3.F
!||    s8zinit3              ../starter/source/elements/solid/solide8z/s8zinit3.F
!||    scinit3               ../starter/source/elements/thickshell/solidec/scinit3.F
!||    sinit3                ../starter/source/elements/solid/solide/sinit3.F
!||    suinit3               ../starter/source/elements/elbuf_init/suinit3.F
!||--- calls      -----------------------------------------------------
!||    biquad_coefficients   ../starter/source/materials/fail/biquad/biquad_coefficients.F
!||--- uses       -----------------------------------------------------
!||====================================================================
      SUBROUTINE failini(
     .   ELBUF_STR,NPTR,NPTS,NPTT,NLAY,IPM,SIGSP,NSIGI,FAIL_INI,
     .   SIGI,NSIGS,IX,NIX,PT,RNOISE,PERTURB,MAT_PARAM)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_mod            
      USE matparam_def_mod
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       "vect01_c.inc"
#include       "com01_c.inc" 
#include       "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NPTR,NPTS,NPTT,IPM(NPROPMI,*),NSIGI,NLAY,
     .   FAIL_INI(*),IX(NIX,*),NSIGS,NIX,PT(*),PERTURB(NPERTURB)
      my_real
     .   sigsp(nsigi,*),sigi(nsigs,*),rnoise(nperturb,*)
      TYPE(elbuf_struct_), TARGET :: ELBUF_STR
      TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,L, II, JJ,IUS,
     .        JPS,IL,IR,IS,IT,NV,NVAR_RUPT,NVMAX,NFAIL,
     .        imat,irup
      my_real,
     .  DIMENSION(:), POINTER  :: uvarf,dfmax
      TYPE(buf_fail_),POINTER :: FBUF
      my_real
     .  c1,c2,c3,c4,c5,x_1(2),x_2(3)
C-----------------------------------------------
      IF (isigi /= 0 .AND. nvsolid4 /= 0) THEN
C                     
        DO i=lft,llt 
c
         ii=nft+i
         jj=pt(ii)
         IF(jj==0)cycle
c         
         DO il=1,nlay 
           nfail =  elbuf_str%BUFLY(il)%NFAIL
           DO ius=1,nfail
            jps = nvsolid1  + nvsolid2 + 4 + nusolid + nvsolid3 
            nvmax = nvsolid4 /(nptr*npts*nptt*nlay*5)
            DO ir = 1,nptr
             DO is = 1,npts
              DO it = 1,nptt
                fbuf  => elbuf_str%BUFLY(il)%FAIL(ir,is,it) 
                uvarf => fbuf%FLOC(ius)%VAR     
                dfmax => fbuf%FLOC(ius)%DAMMX   
                nvar_rupt = fbuf%FLOC(ius)%NVAR
                dfmax(i)= sigsp(jps+1+(ius-1)*nlay*nptr*npts*nptt*nvmax+
     .                    (il-1)*nvmax*nptr*npts*nptt,jj)
                jps = jps + 1
                DO nv=1,nvar_rupt 
                  uvarf((nv-1)*llt+i)=
     .               sigsp(jps+1+(ius-1)*nlay*nptr*npts*nptt*nvmax+
     .                          (il-1)*nvmax*nptr*npts*nptt,jj) 
                  jps = jps + 1
               ENDDO
              ENDDO
             ENDDO
            ENDDO 
           ENDDO
         ENDDO
        ENDDO
      ENDIF 
c-----------------------------
      IF( nperturb /= 0 ) THEN 
       DO j=1,nperturb
         IF(perturb(j) == 2)THEN
           DO i=lft,llt 
             IF (rnoise(j,i+nft) /= zero) THEN
               DO il=1,nlay   
                 nfail =  elbuf_str%BUFLY(il)%NFAIL
                 imat  =  elbuf_str%BUFLY(il)%IMAT
                 DO ius=1,nfail                                  
                   irup = mat_param(imat)%FAIL(ius)%IRUPT
                   IF (irup == 30) THEN           ! /FAIL/BIQUAD
                     mat_param(imat)%FAIL(ius)%UPARAM(8) = 1
                     c1 = zero
                     c2 = zero
                     c3 = mat_param(imat)%FAIL(ius)%UPARAM(9) * rnoise(j,i+nft)
                     c4 = zero
                     c5 = zero
                     l = int(mat_param(imat)%FAIL(ius)%UPARAM(10))
c
                     CALL biquad_coefficients(c1 ,c2 ,c3  ,c4  ,c5  ,l  ,
     .                                        x_1,x_2,zero,zero,zero,zero)
c
                     DO it = 1,nptt 
                       DO is = 1,npts
                         DO ir = 1,nptr 
                  fbuf  => elbuf_str%BUFLY(il)%FAIL(ir,is,it)
                  uvarf => fbuf%FLOC(ius)%VAR
                  uvarf((3-1)*llt+i) = c2
                  uvarf((4-1)*llt+i) = x_1(1)
                  uvarf((5-1)*llt+i) = x_1(2)
                  uvarf((6-1)*llt+i) = x_2(1)
                  uvarf((7-1)*llt+i) = x_2(2)
                  uvarf((8-1)*llt+i) = x_2(3)
                         ENDDO
                       ENDDO
                     ENDDO
                   ENDIF
                 ENDDO
               ENDDO
             ENDIF
           ENDDO
         ENDIF
       ENDDO
      ENDIF
c-----------
      RETURN
      END