failini.F File Reference

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

Go to the source code of this file.

Functions/Subroutines
subroutine	failini (elbuf_str, nptr, npts, nptt, nlay, ipm, sigsp, nsigi, fail_ini, sigi, nsigs, ix, nix, pt, rnoise, perturb, mat_param)

Function/Subroutine Documentation

failini()

subroutine failini	(	type(elbuf_struct_), target	elbuf_str,
		integer	nptr,
		integer	npts,
		integer	nptt,
		integer	nlay,
		integer, dimension(npropmi,*)	ipm,
			sigsp,
		integer	nsigi,
		integer, dimension(*)	fail_ini,
			sigi,
		integer	nsigs,
		integer, dimension(nix,*)	ix,
		integer	nix,
		integer, dimension(*)	pt,
			rnoise,
		integer, dimension(nperturb)	perturb,
		type (matparam_struct_), dimension(nummat), intent(inout)	mat_param )

Definition at line 41 of file failini.F.

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