OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
cfailini.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 cfailini (elbuf_str, mat_param, nptt, nlay, sigsh, nsigsh, ptsh, rnoise, perturb, aldt, thk)
subroutine cfailini4 (elbuf_str, nptr, npts, nptt, nlay, sigsh, nsigsh, ptsh, rnoise, perturb, mat_param, aldt, thk)

Function/Subroutine Documentation

◆ cfailini()

subroutine cfailini ( type(elbuf_struct_), target elbuf_str,
type (matparam_struct_), dimension(nummat), intent(inout) mat_param,
integer nptt,
integer nlay,
sigsh,
integer nsigsh,
integer, dimension(*) ptsh,
rnoise,
integer, dimension(nperturb) perturb,
aldt,
thk )

Definition at line 33 of file cfailini.F.

36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE elbufdef_mod
40 USE matparam_def_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "param_c.inc"
49#include "vect01_c.inc"
50#include "com01_c.inc"
51#include "com04_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER NPTT,NLAY,NSIGSH,PERTURB(NPERTURB),PTSH(*)
56 my_real
57 . sigsh(nsigsh,*),rnoise(nperturb,*),aldt(*),thk(*)
58 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
59 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63 INTEGER I,J,IIP,JPT, IFL,II, JJ, IPT, IPP,IUS,IPSU,
64 . IFLAGINI,JPS,IL,IT,NV,NVAR_RUPT,NVMAX,
65 . NFAIL,N,IMAT,L,IRUP
66 my_real, DIMENSION(:), POINTER :: uvarf,dfmax
67 TYPE(BUF_LAY_) ,POINTER :: BUFLY
68 TYPE(BUF_FAIL_),POINTER :: FBUF
69 my_real :: c1,c2,c3,c4,c5,x_1(2),x_2(3)
70C=======================================================================
71c UVAR INITIALIZATION
72c------------------------
73 DO il=1,nlay
74 bufly => elbuf_str%BUFLY(il)
75 nfail = bufly%NFAIL
76 DO ifl=1,nfail
77 irup = bufly%FAIL(1,1,1)%FLOC(ifl)%ILAWF
78c
79 IF (irup == 23) THEN ! /fail/tab
80 DO it = 1,nptt
81 fbuf => bufly%FAIL(1,1,it)
82 uvarf => fbuf%FLOC(ifl)%VAR
83 DO i = lft,llt
84 uvarf(llt +i) = thk(i) ! UVAR(2)
85 uvarf(llt*4+i) = aldt(i) ! UVAR(5)
86 uvarf(llt*5+i) = one ! UVAR(6) = IPOS
87 uvarf(llt*6+i) = one ! UVAR(7) = IPOS
88 uvarf(llt*7+i) = one ! UVAR(8) = IPOS
89 ENDDO
90 ENDDO
91 END IF
92c
93 END DO
94 END DO ! NLAY
95c------------------------
96 IF( nvshell1 /= 0 ) THEN
97 IF (isigi /= 0) THEN
98C
99 DO i=lft,llt
100 ii = i+nft
101 jj=ptsh(ii)
102 IF(jj == 0)cycle
103 DO il=1,nlay
104 nfail = elbuf_str%BUFLY(il)%NFAIL
105 DO ius=1,nfail
106 jps = nvshell + nushell + 3 + nortshel
107 nvmax = nvshell1 /(nptt*nlay*5)
108 DO it = 1,nptt
109 fbuf => elbuf_str%BUFLY(il)%FAIL(1,1,it)
110 uvarf => fbuf%FLOC(ius)%VAR
111 dfmax => fbuf%FLOC(ius)%DAMMX
112 nvar_rupt = fbuf%FLOC(ius)%NVAR
113 dfmax(i)= sigsh(jps+1+(ius-1)*nlay*nptt*nvmax+
114 . (il-1)*nvmax*nptt,jj)
115 jps = jps + 1
116 DO nv=1,nvar_rupt
117 uvarf((nv-1)*llt+i)=
118 . sigsh(jps+1+(ius-1)*nlay*nptt*nvmax+(il-1)*nvmax*nptt,jj)
119 jps = jps + 1
120 ENDDO
121 ENDDO
122 ENDDO
123 ENDDO
124 ENDDO
125 ENDIF
126 ENDIF
127c
128 IF( nperturb /= 0 ) THEN
129 DO j=1,nperturb
130 IF(perturb(j) == 2)THEN
131 DO i=lft,llt
132 IF (rnoise(j,i+nft) /= zero) THEN
133 DO il=1,nlay
134 nfail = elbuf_str%BUFLY(il)%NFAIL
135 imat = elbuf_str%BUFLY(il)%IMAT
136 DO ius=1,nfail
137 irup = mat_param(imat)%FAIL(ius)%IRUPT
138 IF (irup == 30) THEN ! /FAIL/BIQUAD
139 mat_param(imat)%FAIL(ius)%UPARAM(8) = 1 ! flag PERTURB
140 c1 = zero
141 c2 = zero
142 c3 = mat_param(imat)%FAIL(ius)%UPARAM(9) * rnoise(j,i+nft)
143 c4 = zero
144 c5 = zero
145 l = int(mat_param(imat)%FAIL(ius)%UPARAM(10))
146c
147 CALL biquad_coefficients(c1,c2,c3,c4,c5,l,x_1,x_2,zero,zero,zero,zero)
148c
149 DO it = 1,nptt
150 fbuf => elbuf_str%BUFLY(il)%FAIL(1,1,it)
151 uvarf => fbuf%FLOC(ius)%VAR
152 uvarf((3-1)*llt+i) = c2
153 uvarf((4-1)*llt+i) = x_1(1)
154 uvarf((5-1)*llt+i) = x_1(2)
155 uvarf((6-1)*llt+i) = x_2(1)
156 uvarf((7-1)*llt+i) = x_2(2)
157 uvarf((8-1)*llt+i) = x_2(3)
158 ENDDO
159 ENDIF
160 ENDDO
161 ENDDO
162 ENDIF
163 ENDDO
164 ENDIF
165 ENDDO
166 ENDIF
167c-----------
168 RETURN
biquad_coefficients
subroutine biquad_coefficients(c1, c2, c3, c4, c5, l, x_1, x_2, e1, e2, e3, e4)
Definition biquad_coefficients.F:35
my_real
#define my_real
Definition cppsort.cpp:32

◆ cfailini4()

subroutine cfailini4 ( type(elbuf_struct_), target elbuf_str,
integer nptr,
integer npts,
integer nptt,
integer nlay,
sigsh,
integer nsigsh,
integer, dimension(*) ptsh,
rnoise,
integer, dimension(nperturb) perturb,
type (matparam_struct_), dimension(nummat), intent(inout) mat_param,
aldt,
thk )

Definition at line 178 of file cfailini.F.

182C-----------------------------------------------
183C M o d u l e s
184C-----------------------------------------------
185 USE elbufdef_mod
186 USE matparam_def_mod
187C-----------------------------------------------
188C I m p l i c i t T y p e s
189C-----------------------------------------------
190#include "implicit_f.inc"
191C-----------------------------------------------
192C C o m m o n B l o c k s
193C-----------------------------------------------
194#include "param_c.inc"
195#include "vect01_c.inc"
196#include "com01_c.inc"
197#include "com04_c.inc"
198C-----------------------------------------------
199C D u m m y A r g u m e n t s
200C-----------------------------------------------
201 INTEGER NPTR,NPTS,NPTT,NSIGSH,NLAY,
202 . PTSH(*),PERTURB(NPERTURB)
203 my_real
204 . sigsh(nsigsh,*),rnoise(nperturb,*),aldt(*),thk(*)
205 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
206 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
207C-----------------------------------------------
208C L o c a l V a r i a b l e s
209C-----------------------------------------------
210 INTEGER I,J,IIP,JPT,IFL, II, JJ, IPT, IPP,IUS,IPSU,
211 . IFLAGINI,JPS,IL,IR,IS,IT,NV,NVAR_RUPT,NVMAX,NFAIL,N,
212 . IMAT,L,IRUP
213 my_real ,DIMENSION(:), POINTER :: uvarf,dfmax
214 my_real :: c1,c2,c3,c4,c5,x_1(2),x_2(3)
215 TYPE(BUF_LAY_) ,POINTER :: BUFLY
216 TYPE(BUF_FAIL_),POINTER :: FBUF
217C=======================================================================
218c UVAR INITIALIZATION
219c------------------------
220 DO il=1,nlay
221 bufly => elbuf_str%BUFLY(il)
222 nfail = bufly%NFAIL
223 DO ifl=1,nfail
224 irup = bufly%FAIL(1,1,1)%FLOC(ifl)%ILAWF
225c
226 IF (irup == 23) THEN ! /fail/tab
227 DO it = 1,nptt
228 DO is = 1,npts
229 DO ir = 1,nptr
230 fbuf => bufly%FAIL(ir,is,it)
231 uvarf => fbuf%FLOC(ifl)%VAR
232 DO i = lft,llt
233 uvarf(llt +i) = thk(i) ! UVAR(2)
234 uvarf(llt*4+i) = aldt(i) ! UVAR(5)
235 uvarf(llt*5+i) = one ! UVAR(6) = IPOS
236 uvarf(llt*6+i) = one ! UVAR(7) = IPOS
237 uvarf(llt*7+i) = one ! UVAR(8) = IPOS
238 ENDDO
239 ENDDO
240 ENDDO
241 ENDDO
242 END IF
243c
244 END DO
245 END DO ! NLAY
246c------------------------
247 IF( nvshell1 /= 0 ) THEN
248 IF (isigi /= 0) THEN
249 DO i=lft,llt
250 ii = i+nft
251 jj = ptsh(ii)
252 IF(jj == 0)cycle
253 DO il=1,nlay
254 nfail = elbuf_str%BUFLY(il)%NFAIL
255 DO ius=1,nfail
256 jps = nvshell + nushell + 3 + nortshel
257 nvmax = nvshell1 /(max(1,nptr)*max(1,npts)*max(1,nptt)*
258 . max(1,nlay)*5)
259 DO it = 1,nptt
260 DO is = 1,npts
261 DO ir = 1,nptr
262 fbuf => elbuf_str%BUFLY(il)%FAIL(ir,is,it)
263 uvarf => fbuf%FLOC(ius)%VAR
264 dfmax => fbuf%FLOC(ius)%DAMMX
265 nvar_rupt = fbuf%FLOC(ius)%NVAR
266 dfmax(i)=sigsh(jps+1+(ius-1)*nlay*nptr*npts*nptt*nvmax+
267 . (il-1)*nvmax*nptr*npts*nptt,jj)
268 jps = jps + 1
269 DO nv=1,nvar_rupt
270 uvarf((nv-1)*llt+i)=
271 . sigsh(jps+1+(ius-1)*nlay*nptr*npts*nptt*nvmax+
272 . (il-1)*nvmax*nptr*npts*nptt,jj)
273 jps = jps + 1
274 ENDDO
275 ENDDO
276 ENDDO
277 ENDDO
278 ENDDO
279 ENDDO
280 ENDDO
281 ENDIF
282 ENDIF
283c------------------------
284 IF( nperturb /= 0 ) THEN
285 DO j=1,nperturb
286 IF(perturb(j) == 2)THEN
287 DO i=lft,llt
288 IF (rnoise(j,i+nft) /= zero) THEN
289 DO il=1,nlay
290 nfail = elbuf_str%BUFLY(il)%NFAIL
291 imat = elbuf_str%BUFLY(il)%IMAT
292 DO ius=1,nfail
293 irup = mat_param(imat)%FAIL(ius)%IRUPT
294 IF (irup == 30) THEN
295 mat_param(imat)%FAIL(ius)%UPARAM(8) = 1
296 c1 = zero
297 c2 = zero
298 c3 = mat_param(imat)%FAIL(ius)%UPARAM(9) * rnoise(j,i+nft)
299 c4 = zero
300 c5 = zero
301 l = int(mat_param(imat)%FAIL(ius)%UPARAM(10))
302c
303 CALL biquad_coefficients(c1,c2,c3,c4,c5,l,x_1,x_2,zero,zero,zero,zero)
304 DO it = 1,nptt
305 DO is = 1,npts
306 DO ir = 1,nptr
307 fbuf => elbuf_str%BUFLY(il)%FAIL(ir,is,it)
308 uvarf => fbuf%FLOC(ius)%VAR
309 uvarf((3-1)*llt+i) = c2
310 uvarf((4-1)*llt+i) = x_1(1)
311 uvarf((5-1)*llt+i) = x_1(2)
312 uvarf((6-1)*llt+i) = x_2(1)
313 uvarf((7-1)*llt+i) = x_2(2)
314 uvarf((8-1)*llt+i) = x_2(3)
315 ENDDO
316 ENDDO
317 ENDDO
318 ENDIF
319 ENDDO
320 ENDDO
321 ENDIF
322 ENDDO
323 ENDIF
324 ENDDO
325 ENDIF
326c-----------
327 RETURN
max
#define max(a, b)
Definition macros.h:21