OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ruptint2.F File Reference
#include "implicit_f.inc"
#include "com08_c.inc"
#include "units_c.inc"
#include "scr14_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine ruptint2 (nsl, isl, nuvar, uvar, userbuf, prop, ifuns, ifunn, ifunt, imod, ifiltr, idbg, npf, tf, noint, itab, pdama2, isym, h3d_data)

Function/Subroutine Documentation

◆ ruptint2()

subroutine ruptint2 ( integer nsl,
integer isl,
integer nuvar,
uvar,
type(uintbuf) userbuf,
prop,
integer ifuns,
integer ifunn,
integer ifunt,
integer imod,
integer ifiltr,
integer idbg,
integer, dimension(*) npf,
tf,
integer noint,
integer, dimension(*) itab,
pdama2,
integer isym,
type (h3d_database) h3d_data )

Definition at line 33 of file ruptint2.F.

38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE uintbuf_mod
42 USE h3d_mod
43C----------+---------+---+---+--------------------------------------------
44C VAR | SIZE |TYP| RW| DEFINITION
45C----------+---------+---+---+--------------------------------------------
46C NSL | 1 | I | R | NUMBER OF SECONDARY NODES
47C NUVAR | 1 | I | R | NUMBER OF USER VARIABLES
48C PROP | 6 | F | R | PROPERTY BUFFER
49C UVAR |NUVAR | F |R/W| USER SECONDARY NODE VARIABLES
50C USERBUF | | F |R/W| SECONDARY NODE DATA STRUCTURE
51C=======================================================================
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "com08_c.inc"
59#include "units_c.inc"
60#include "scr14_c.inc"
61C----------------------------------------------------------
62C D u m m y A r g u m e n t s a n d F u n c t i o n
63C----------------------------------------------------------
64 INTEGER NPF(*),ITAB(*)
65 INTEGER NSL,ISL,NUVAR,IMOD,IFUNN,IFUNT,IFUNS,IDBG,IFILTR,
66 . NOINT,ISYM
67 my_real
68 . prop(*),uvar(*), tf(*),pdama2(2,*)
69 type(UINTBUF) :: USERBUF
70 TYPE (H3D_DATABASE) :: H3D_DATA
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER IERROR,IRUPT,IRUPT0,ISECND
75 my_real
76 . dtim,sign,sigt,sign1,sigt1,area,dfsign,dfsigt,dsig,
77 . signmax,sigtmax,dnmax,dtmax,facn,fact,
78 . scal_f,scal_d,scal_sr,ssr,alpha,deri,dis_n,dis_t,dis_na,signa
79C-----------------------------------------------
80C E x t e r n a l F u n c t i o n s
81C-----------------------------------------------
82 my_real finter
83C=======================================================================
84C MODULE COMPONENTS
85C-----------------------------------------------
86 isecnd = userbuf%ISECND
87 area = userbuf%AREA
88 dis_n = userbuf%DXN
89 dis_t = userbuf%DXT
90 sign = userbuf%SIGN
91 sigt = userbuf%SIGT
92 dtim = userbuf%DT
93 irupt = nint(userbuf%RUPT)
94 irupt0= irupt
95 dis_na = abs(dis_n)
96 signa = abs(sign)
97C-----------------------------------------------
98 ssr = one
99 facn = one
100 fact = one
101C-----
102 scal_f = prop(1)
103 scal_d = prop(2)
104 scal_sr = prop(3)
105 alpha = prop(4)
106 dnmax = prop(5)
107 dtmax = prop(6)
108C-------
109c IF (IRUPT == 0) THEN
110c UVAR(1) = SIGN
111c UVAR(2) = SIGT
112c ENDIF
113c
114C--- Force filtering
115c
116 sign1 = uvar(1)
117 sigt1 = uvar(2)
118 IF (ifiltr == 1) THEN
119 sign = alpha*sign + (one-alpha)*sign1
120 sigt = alpha*sigt + (one-alpha)*sigt1
121 ENDIF
122C
123 dfsign = (sign - sign1) / dtim
124 dfsigt = (sigt - sigt1) / dtim
125 dsig = sqrt(dfsign**2 + dfsigt**2)
126 IF (ifuns > 0) ssr = finter(ifuns,dsig/scal_sr,npf,tf,deri)
127c
128C--- Rupture Criteria
129c
130 signmax = ssr*scal_f * finter(ifunn,dis_na/scal_d,npf,tf,deri)
131 sigtmax = ssr*scal_f * finter(ifunt,dis_t /scal_d,npf,tf,deri)
132C
133 IF (sigt > zero) fact = min(one, abs(sigtmax / sigt))
134C
135 IF (isym == 0 .OR. irupt /= 0) THEN
136 IF (abs(sign) > zero) facn = min(one, abs(signmax / sign))
137 IF (imod == 2) THEN
138 IF (dis_na > dnmax .OR. dis_t > dtmax) THEN
139 irupt = 1
140 facn = zero
141 fact = zero
142 ENDIF
143 IF (anim_n(15)==1 .OR. h3d_data%N_SCAL_DAMA2 == 1)
144 . pdama2(1,isecnd)=min(hundred*dis_na/dnmax,hundred)
145 IF (anim_n(16)==1 .OR. h3d_data%N_SCAL_DAMA2 == 1)
146 . pdama2(2,isecnd)=min(hundred*dis_t/dtmax,hundred)
147 ELSEIF (imod == 1) THEN
148 dis_na = dis_na / dnmax
149 dis_t = dis_t / dtmax
150 IF (sqrt(dis_n*dis_n + dis_t*dis_t) > one) THEN
151 irupt = 1
152 facn = zero
153 fact = zero
154 ENDIF
155 IF (anim_n(15)==1 .OR. h3d_data%N_SCAL_DAMA2 == 1)
156 . pdama2(1,isecnd)=min(hundred*dis_na,hundred)
157 IF (anim_n(16)==1 .OR. h3d_data%N_SCAL_DAMA2 == 1)
158 . pdama2(2,isecnd)=min(hundred*dis_t,hundred)
159 ENDIF
160C
161 ELSE ! ISYM == 1 .AND. IRUPT == 0)
162 IF (sign > zero) facn = min(one, abs(signmax / sign))
163 IF (imod == 2) THEN
164 IF (dis_n > zero .AND. dis_na > dnmax .OR. dis_t > dtmax) THEN
165 irupt = 1
166 facn = zero
167 fact = zero
168 ENDIF
169 IF (anim_n(15)==1 .OR. h3d_data%N_SCAL_DAMA2 == 1)
170 . pdama2(1,isecnd)=min(hundred*dis_na/dnmax,hundred)
171 IF (anim_n(16)==1 .OR. h3d_data%N_SCAL_DAMA2 == 1)
172 . pdama2(2,isecnd)=min(hundred*dis_t/dtmax,hundred)
173 ENDIF
174 ENDIF ! ISYM
175C-----
176 IF (irupt == 1) THEN
177 facn = zero
178 fact = zero
179 ELSEIF (facn < one .OR. fact < one) THEN
180 irupt = -1
181 ENDIF
182C-----
183 if (idbg > 0) then
184 IF (irupt /= 0) THEN
185 IF (irupt == 1) THEN
186 WRITE(iout,*)'RUPTURE TOTALE'
187 ELSEIF (irupt == -1) THEN
188 WRITE(iout,*)'RUPTURE PARTIELLE'
189 ENDIF
190 WRITE(iout,*)'Time =',tt, ' SECONDARY =',isl,itab(isecnd)
191 if (idbg == 2) WRITE(iout,*)'AREA =',area
192 WRITE(iout,*)'Dist N =',dis_n, ' Dist T =',dis_t
193 WRITE(iout,*)'DNmax =',dnmax, ' DTmax =',dtmax
194 WRITE(iout,*)'Sig N =',sign, ' sig T =',sigt
195 WRITE(iout,*)'SIGNMAX =',signmax,' SIGTMAX =',sigtmax
196 WRITE(iout,*)'Facn,t =',facn,fact
197 WRITE(iout,*)'------------------------------------- '
198 ENDIF
199 endif
200C
201 IF (irupt0 == 0 .AND. irupt /= 0) THEN
202 WRITE(iout,'(A,I9,A,E16.9,A,I9)')
203 . 'INTERFACE TYPE 2 N ',noint, ' TIME= ',tt,
204 . ' START RUPTURE SECONDARY NODE ',itab(isecnd)
205 WRITE(*,'(A,I9,A,E16.9,A,I9)')
206 . 'INTERFACE TYPE 2 N ',noint, ' TIME= ',tt,
207 . ' START RUPTURE SECONDARY NODE ',itab(isecnd)
208 ENDIF
209 IF (irupt0 /= 1 .AND. irupt == 1) THEN
210 WRITE(iout,'(a,i9,a,e16.9,a,i9)')
211 . 'INTERFACE type 2 n ',NOINT, ' time= ',TT,
212 . ' total rupture secondary node ',ITAB(ISECND)
213 ENDIF
214C-----------
215 UVAR(1) = SIGN
216 UVAR(2) = SIGT
217 USERBUF%FACN = FACN
218 USERBUF%FACT = FACT
219 USERBUF%RUPT = IRUPT
220C-------------------------------
221 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
alpha
#define alpha
Definition eval.h:35
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20
h3d_mod
Definition h3d_mod.F:308
uintbuf_mod
Definition uintbuf_mod.F:29