OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
h3d_sol_skin_scalar.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine h3d_sol_skin_scalar (elbuf_tab, skin_scalar, iparg, ixs, x, pm, iparts, igeo, ixs10, ixs16, ixs20, is_written_skin, h3d_part, info1, keyword, nskin, iad_elem, fr_elem, weight, tag_skins6, npf, tf, mat_param)
subroutine idx_fld_sol (nel, nuparam, nfunc, ifunc, npf, tf, uparam, eps3, fld_idx, niparam, iparam, pla)
subroutine dam_fld_sol (nel, nuparam, nfunc, ifunc, npf, tf, uparam, eps3, dam, niparam, iparam, pla)

Function/Subroutine Documentation

◆ dam_fld_sol()

subroutine dam_fld_sol ( integer, intent(in) nel,
integer, intent(in) nuparam,
integer, intent(in) nfunc,
integer, dimension(nfunc) ifunc,
integer, dimension(*) npf,
tf,
dimension(nuparam) uparam,
intent(in) eps3,
intent(out) dam,
integer, intent(in) niparam,
integer, dimension(niparam), intent(in) iparam,
intent(in) pla )

Definition at line 351 of file h3d_sol_skin_scalar.F.

355C-----------------------------------------------
356c FLD failure model
357C-----------------------------------------------
358C I m p l i c i t T y p e s
359C-----------------------------------------------
360#include "implicit_f.inc"
361C-----------------------------------------------
362C G l o b a l P a r a m e t e r s
363C-----------------------------------------------
364C---------+---------+---+---+--------------------------------------------
365C VAR | SIZE |TYP| RW| DEFINITION
366C---------+---------+---+---+--------------------------------------------
367C NEL | 1 | I | R | SIZE OF THE ELEMENT GROUP NEL
368C NUPARAM | 1 | I | R | SIZE OF THE USER PARAMETER ARRAY
369C UPARAM | NUPARAM | F | R | USER MATERIAL PARAMETER ARRAY
370C---------+---------+---+---+--------------------------------------------
371C EPS3 | NEL*3 | F | R | IN PLANE STRAIN TENSOR
372C---------+---------+---+---+--------------------------------------------
373C OFF | NEL | F | R | DELETED ELEMENT FLAG (=1. ON, =0. OFF)
374C FOFF | NEL | I |R/W| DELETED INTEGRATION POINT FLAG (=1 ON, =0 OFF)
375C DAM | NEL | F |R/W| DAMAGE FACTOR
376C---------+---------+---+---+--------------------------------------------
377C---------+---------+---+---+--------------------------------------------
378C I N P U T A r g u m e n t s
379C-----------------------------------------------
380 INTEGER, INTENT(IN) :: NEL,NUPARAM,NFUNC,NIPARAM
381 INTEGER ,DIMENSION(NFUNC) :: IFUNC
382 INTEGER, DIMENSION(NIPARAM), INTENT(IN) :: IPARAM
383 my_real ,DIMENSION(3,NEL), INTENT(IN) :: eps3
384 my_real,DIMENSION(NUPARAM) :: uparam
385 my_real ,DIMENSION(NEL), INTENT(IN) :: pla
386C-----------------------------------------------
387C I N P U T O U T P U T A r g u m e n t s
388C-----------------------------------------------
389 my_real ,DIMENSION(NEL), INTENT(OUT) :: dam
390C-----------------------------------------------
391C VARIABLES FOR FUNCTION INTERPOLATION
392C-----------------------------------------------
393 INTEGER NPF(*)
394 my_real finter , finterfld ,tf(*)
395 EXTERNAL finter
396C Y = FINTER(IFUNC(J),X,NPF,TF,DYDX)
397C Y : y = f(x)
398C X : x
399C DYDX : f'(x) = dy/dx
400C IFUNC(J): FUNCTION INDEX
401C J : FIRST(J=1), SECOND(J=2) .. FUNCTION USED FOR THIS LAW
402C NPF,TF : FUNCTION PARAMETER
403C-----------------------------------------------
404C L o c a l V a r i a b l e s
405C-----------------------------------------------
406 INTEGER :: I,II,J,IENG,LENF,NINDX,IMARGIN
407 my_real :: rani,r1,r2,s1,s2,ss,q,dydx,e12,fact_margin,fact_loosemetal
408 my_real ,ALLOCATABLE, DIMENSION(:) :: xf
409 my_real ,DIMENSION(NEL) :: emaj,emin,em,beta
410C=======================================================================
411c
412 ! -> Real parameters
413 fact_margin = uparam(1)
414 rani = uparam(3)
415 fact_loosemetal = uparam(4)
416 ! -> Integer parameters
417 imargin = iparam(2)
418 ieng = iparam(3)
419c
420 !=================================================================
421 ! - MINOR AND MAJOR (TRUE) STRAIN DEFORMATION
422 !=================================================================
423 DO i = 1,nel
424 e12= eps3(3,i)
425 s1 = half*(eps3(1,i) + eps3(2,i))
426 s2 = half*(eps3(1,i) - eps3(2,i))
427 q = sqrt(s2**2 + e12**2)
428 emaj(i) = s1 + q
429 emin(i) = s1 - q
430 IF (emin(i) >= emaj(i)) THEN
431 ss = emin(i)
432 emin(i) = emaj(i)
433 emaj(i) = ss
434 ENDIF
435 beta(i) = emin(i)/max(emaj(i),em20)
436 ENDDO
437c
438 !=================================================================
439 ! FAILURE MAJOR STRAIN FROM INPUT CURVE AND DAMAGE RATIO
440 !=================================================================
441 ! -> Engineering strains input
442 IF (ieng == 1) THEN ! transform input fld curve to true strain
443 ii = npf(ifunc(1))
444 lenf = npf(ifunc(1)+ 1) - npf(ifunc(1))
445 ALLOCATE(xf(lenf))
446 DO i = 1,lenf
447 xf(i) = log(tf(ii + i-1) + one)
448 ENDDO
449c
450 DO i = 1,nel
451 em(i) = finterfld(emin(i),lenf,xf)
452 dam(i) = emaj(i) / em(i)
453c DFMAX(I) = MIN(ONE, DAM(I))
454 ENDDO
455 DEALLOCATE(xf)
456 ! -> True strains input
457 ELSE
458 ! -> Classical formulation
459 IF (ieng == 0) THEN
460 DO i = 1,nel
461 em(i) = finter(ifunc(1),emin(i),npf,tf,dydx)
462 dam(i) = emaj(i) / em(i)
463 ENDDO
464 ! -> Non-linear path formulation
465 ELSEIF (ieng == 2) THEN
466 DO i = 1,nel
467 em(i) = finter(ifunc(1),beta(i),npf,tf,dydx)
468 dam(i) = pla(i) / em(i)
469 ENDDO
470 ENDIF
471 ENDIF
472C------------------------
473 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21

◆ h3d_sol_skin_scalar()

subroutine h3d_sol_skin_scalar ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
skin_scalar,
integer, dimension(nparg,*) iparg,
integer, dimension(nixs,*) ixs,
x,
pm,
integer, dimension(*) iparts,
integer, dimension(npropgi,*) igeo,
integer, dimension(6,*) ixs10,
integer, dimension(8,*) ixs16,
integer, dimension(12,*) ixs20,
integer, dimension(*) is_written_skin,
integer, dimension(*) h3d_part,
integer info1,
character(len=ncharline100) keyword,
integer nskin,
integer, dimension(2,*) iad_elem,
integer, dimension(*) fr_elem,
integer, dimension(*) weight,
integer, dimension(*) tag_skins6,
integer, dimension(*) npf,
tf,
type (matparam_struct_), dimension(nummat), intent(in) mat_param )

Definition at line 38 of file h3d_sol_skin_scalar.F.

44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE initbuf_mod
48 USE mat_elem_mod
49 USE elbufdef_mod
50 USE names_and_titles_mod, ONLY: ncharline100
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 "com01_c.inc"
59#include "com04_c.inc"
60#include "param_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64C REAL
65 my_real
66 . skin_scalar(*),pm(npropm,*), x(3,*),tf(*)
67 INTEGER IPARG(NPARG,*),
68 . IXS(NIXS,*),IPARTS(*),
69 . IXS10(6,*) ,IXS16(8,*) ,IXS20(12,*) ,
70 . IGEO(NPROPGI,*),IS_WRITTEN_SKIN(*),NPF(*),
71 . H3D_PART(*),INFO1,NSKIN,TAG_SKINS6(*),IAD_ELEM(2,*),FR_ELEM(*),WEIGHT(*)
72 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
73 CHARACTER(LEN=NCHARLINE100)::KEYWORD
74 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER I,I1,II,J,LENR,NEL,NFT,N
79
80 INTEGER JJ,N1,N2
81 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAGPS,TAG_SKIN_ND
82 my_real
83 . , DIMENSION(:,:), ALLOCATABLE :: aflu, vflu,t6gps
84 INTEGER FACES(4,6),NS,K1,PWR(7),LL
85 DATA pwr/1,2,4,8,16,32,64/
86 DATA faces/4,3,2,1,
87 . 5,6,7,8,
88 . 1,2,6,5,
89 . 3,4,8,7,
90 . 2,3,7,6,
91 . 1,5,8,4/
92C-----------------------------------------------
93C
94 ALLOCATE(aflu(3,numnod),vflu(3,numnod),t6gps(6,numnod))
95 ALLOCATE(itagps(numnod),tag_skin_nd(numnod))
96 aflu = zero
97 vflu = zero
98 t6gps = zero
99 itagps = 0
100C------TAG_SKIN_ND only the big seg(mid-node of S10 not include)
101 tag_skin_nd = 0
102 DO i=1,numels
103 ll=tag_skins6(i)
104 DO jj=1,6
105 IF(mod(ll,pwr(jj+1))/pwr(jj) /= 0)cycle
106 DO k1=1,4
107 ns=ixs(faces(k1,jj)+1,i)
108 tag_skin_nd(ns) = 1
109 END DO
110 END DO
111 END DO
112 IF (keyword == 'FLDZ/OUTER' .OR. keyword == 'FLDF/OUTER') THEN
113 CALL gpsstrain_skin(elbuf_tab,vflu ,aflu ,iparg ,
114 . ixs ,ixs10 ,ixs16 ,ixs20 ,x ,
115 . itagps ,pm ,tag_skin_nd )
116 IF(nspmd > 1)THEN
117 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
118 CALL spmd_exch_nodareai(itagps,iad_elem,fr_elem,lenr,weight)
119 DO j=1,3
120 CALL spmd_exch_nodarea2(vflu,iad_elem,fr_elem,lenr,weight,j)
121 CALL spmd_exch_nodarea2(aflu,iad_elem,fr_elem,lenr,weight,j)
122 ENDDO
123 ENDIF
124 DO n=1,numnod
125 IF (itagps(n)>0) t6gps(1:3,n)=vflu(1:3,n)/itagps(n)
126 ENDDO
127C------------change shear to eij
128 DO n=1,numnod
129 IF (itagps(n)>0) t6gps(4:6,n)=half*aflu(1:3,n)/itagps(n)
130 ENDDO
131 END IF
132C
133 CALL h3d_sol_skin_scalar1(elbuf_tab,iparg,iparts,ixs,ixs10,
134 . skin_scalar,tag_skins6,t6gps,x ,
135 . npf,tf,h3d_part,is_written_skin,
136 . keyword,nskin,mat_param)
137C
138 DEALLOCATE(aflu,vflu,t6gps,itagps,tag_skin_nd)
139C-----------
140 RETURN
h3d_sol_skin_scalar1
subroutine h3d_sol_skin_scalar1(elbuf_tab, iparg, iparts, ixs, ixs10, skin_scalar, tag_skins6, t6gps, x, npf, tf, h3d_part, is_written_skin, keyword, nskin, mat_param)
Definition h3d_sol_skin_scalar1.F:42
initbuf_mod
Definition initbuf.F:160
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharline100
integer, parameter ncharline100
Definition names_and_titles_mod.F:1002
spmd_exch_nodarea2
subroutine spmd_exch_nodarea2(nodarea, iad_elem, fr_elem, lenr, weight, jj)
Definition spmd_exch_nodarea2.F:39
spmd_exch_nodareai
subroutine spmd_exch_nodareai(nodareai, iad_elem, fr_elem, lenr, weight)
Definition spmd_exch_nodareai.F:38
gpsstrain_skin
subroutine gpsstrain_skin(elbuf_tab, func1, func2, iparg, ixs, ixs10, ixs16, ixs20, x, itagps, pm, tag_skin_nd)
Definition tensgpstrain.F:607

◆ idx_fld_sol()

subroutine idx_fld_sol ( integer, intent(in) nel,
integer, intent(in) nuparam,
integer, intent(in) nfunc,
integer, dimension(nfunc) ifunc,
integer, dimension(*) npf,
tf,
dimension(nuparam) uparam,
intent(in) eps3,
intent(inout) fld_idx,
integer, intent(in) niparam,
integer, dimension(niparam), intent(in) iparam,
intent(in) pla )

Definition at line 150 of file h3d_sol_skin_scalar.F.

154C-----------------------------------------------
155c FLD failure model
156C-----------------------------------------------
157C I m p l i c i t T y p e s
158C-----------------------------------------------
159#include "implicit_f.inc"
160C-----------------------------------------------
161C G l o b a l P a r a m e t e r s
162C-----------------------------------------------
163C---------+---------+---+---+--------------------------------------------
164C VAR | SIZE |TYP| RW| DEFINITION
165C---------+---------+---+---+--------------------------------------------
166C NEL | 1 | I | R | SIZE OF THE ELEMENT GROUP NEL
167C NUPARAM | 1 | I | R | SIZE OF THE USER PARAMETER ARRAY
168C UPARAM | NUPARAM | F | R | USER MATERIAL PARAMETER ARRAY
169C---------+---------+---+---+--------------------------------------------
170C---------+---------+---+---+--------------------------------------------
171C EPS3 | NEL*3 | F | R | IN PLANE STRAIN TENSOR
172C---------+---------+---+---+--------------------------------------------
173C---------+---------+---+---+--------------------------------------------
174C I N P U T A r g u m e n t s
175C-----------------------------------------------
176 INTEGER, INTENT(IN) :: NEL,NUPARAM,NFUNC,NIPARAM
177 INTEGER ,DIMENSION(NFUNC) :: IFUNC
178 INTEGER, DIMENSION(NIPARAM), INTENT(IN) :: IPARAM
179 my_real ,DIMENSION(3,NEL), INTENT(IN) :: eps3
180 my_real,DIMENSION(NUPARAM) :: uparam
181 my_real ,DIMENSION(NEL), INTENT(IN) :: pla
182C-----------------------------------------------
183C I N P U T O U T P U T A r g u m e n t s
184C-----------------------------------------------
185 my_real ,DIMENSION(NEL), INTENT(INOUT) :: fld_idx
186C-----------------------------------------------
187C VARIABLES FOR FUNCTION INTERPOLATION
188C-----------------------------------------------
189 INTEGER NPF(*)
190 my_real finter , finterfld ,tf(*)
191 EXTERNAL finter
192C Y = FINTER(IFUNC(J),X,NPF,TF,DYDX)
193C Y : y = f(x)
194C X : x
195C DYDX : f'(x) = dy/dx
196C IFUNC(J): FUNCTION INDEX
197C J : FIRST(J=1), SECOND(J=2) .. FUNCTION USED FOR THIS LAW
198C NPF,TF : FUNCTION PARAMETER
199C-----------------------------------------------
200C L o c a l V a r i a b l e s
201C-----------------------------------------------
202 INTEGER :: I,II,J,IENG,LENF,NINDX,IMARGIN
203 my_real :: rani,r1,r2,s1,s2,ss,q,dydx,e12,fact_margin,fact_loosemetal
204 my_real ,ALLOCATABLE, DIMENSION(:) :: xf
205 my_real ,DIMENSION(NEL) :: emaj,emin,em,beta
206C=======================================================================
207c
208 ! -> Real parameters
209 fact_margin = uparam(1)
210 rani = uparam(3)
211 fact_loosemetal = uparam(4)
212 ! -> Integer parameters
213 imargin = iparam(2)
214 ieng = iparam(3)
215c
216 !=================================================================
217 ! - MINOR AND MAJOR (TRUE) STRAIN DEFORMATION
218 !=================================================================
219 DO i = 1,nel
220 e12= eps3(3,i)
221 s1 = half*(eps3(1,i) + eps3(2,i))
222 s2 = half*(eps3(1,i) - eps3(2,i))
223 q = sqrt(s2**2 + e12**2)
224 emaj(i) = s1 + q
225 emin(i) = s1 - q
226 IF (emin(i) >= emaj(i)) THEN
227 ss = emin(i)
228 emin(i) = emaj(i)
229 emaj(i) = ss
230 ENDIF
231 beta(i) = emin(i)/max(emaj(i),em20)
232 ENDDO
233c
234 !=================================================================
235 ! FAILURE MAJOR STRAIN FROM INPUT CURVE AND DAMAGE RATIO
236 !=================================================================
237 ! -> Engineering strains input
238 IF (ieng == 1) THEN ! transform input fld curve to true strain
239 ii = npf(ifunc(1))
240 lenf = npf(ifunc(1)+ 1) - npf(ifunc(1))
241 ALLOCATE(xf(lenf))
242 DO i = 1,lenf
243 xf(i) = log(tf(ii + i-1) + one)
244 ENDDO
245c
246 DO i = 1,nel
247 em(i) = finterfld(emin(i),lenf,xf)
248 ENDDO
249 DEALLOCATE(xf)
250 ! -> True strains input
251 ELSE
252 ! -> Classical formulation
253 IF (ieng == 0) THEN
254 DO i = 1,nel
255 em(i) = finter(ifunc(1),emin(i),npf,tf,dydx)
256 ENDDO
257 ! -> Non-linear path formulation
258 ELSEIF (ieng == 2) THEN
259 DO i = 1,nel
260 em(i) = finter(ifunc(1),beta(i),npf,tf,dydx)
261 ENDDO
262 ENDIF
263 ENDIF
264c
265 !=================================================================
266 ! FLD ZONE INDEX CALCULATION FOR ANIM OUTPUT
267 !=================================================================
268 r1 = fact_loosemetal
269 r2 = rani/(rani+one)
270
271 IF (ieng < 2) THEN
272 IF (imargin == 3) THEN
273 DO i = 1,nel
274 IF (emaj(i) >= em(i)) THEN
275 fld_idx(i) = 6 ! zone 6 = failure
276 ELSEIF (emaj(i) >= em(i)*(one - fact_margin)) THEN
277 fld_idx(i) = 5 ! zone 5 = margin to fail
278 ELSEIF (emaj(i)**2 + emin(i)**2 < r1**2) THEN
279 fld_idx(i) = 1 ! zone 1 = radius 0.02
280 ELSEIF (emaj(i) >= abs(emin(i))) THEN
281 fld_idx(i) = 4 ! zone 4 = safe (45 deg line)
282 ELSEIF (emaj(i) >= r2*abs(emin(i))) THEN
283 fld_idx(i) = 3 ! zone 3 = angle atan(r/(1+r)) - compression
284 ELSE
285 fld_idx(i) = 2 ! zone 2 - high wrinkle tendency
286 ENDIF
287 ENDDO
288 ELSE
289 DO i = 1,nel
290 IF (emaj(i) >= em(i)) THEN
291 fld_idx(i) = 6 ! zone 6 = failure
292 ELSEIF (emaj(i) >= em(i) - fact_margin) THEN
293 fld_idx(i) = 5 ! zone 5 = margin to fail
294 ELSEIF (emaj(i)**2 + emin(i)**2 < r1**2) THEN
295 fld_idx(i) = 1 ! zone 1 = radius 0.02
296 ELSEIF (emaj(i) >= abs(emin(i))) THEN
297 fld_idx(i) = 4 ! zone 4 = safe (45 deg line)
298 ELSEIF (emaj(i) >= r2*abs(emin(i))) THEN
299 fld_idx(i) = 3 ! zone 3 = angle atan(r/(1+r)) - compression
300 ELSE
301 fld_idx(i) = 2 ! zone 2 - high wrinkle tendency
302 ENDIF
303 ENDDO
304 ENDIF
305 ELSE
306 IF (imargin == 3) THEN
307 DO i = 1,nel
308 IF (pla(i) >= em(i)) THEN
309 fld_idx(i) = 6 ! zone 6 = failure
310 ELSEIF (pla(i) >= em(i)*(one - fact_margin)) THEN
311 fld_idx(i) = 5 ! zone 5 = margin to fail
312 ELSEIF (pla(i)**2 + beta(i)**2 < r1**2) THEN
313 fld_idx(i) = 1 ! zone 1 = radius 0.02
314 ELSEIF (pla(i) >= abs(beta(i))) THEN
315 fld_idx(i) = 4 ! zone 4 = safe (45 deg line)
316 ELSEIF (pla(i) >= r2*abs(beta(i))) THEN
317 fld_idx(i) = 3 ! zone 3 = angle atan(r/(1+r)) - compression
318 ELSE
319 fld_idx(i) = 2 ! zone 2 - high wrinkle tendency
320 ENDIF
321 ENDDO
322 ELSE
323 DO i = 1,nel
324 IF (pla(i) >= em(i)) THEN
325 fld_idx(i) = 6 ! zone 6 = failure
326 ELSEIF (pla(i) >= em(i) - fact_margin) THEN
327 fld_idx(i) = 5 ! zone 5 = margin to fail
328 ELSEIF (pla(i)**2 + beta(i)**2 < r1**2) THEN
329 fld_idx(i) = 1 ! zone 1 = radius 0.02
330 ELSEIF (pla(i) >= abs(beta(i))) THEN
331 fld_idx(i) = 4 ! zone 4 = safe (45 deg line)
332 ELSEIF (pla(i) >= r2*abs(beta(i))) THEN
333 fld_idx(i) = 3 ! zone 3 = angle atan(r/(1+r)) - compression
334 ELSE
335 fld_idx(i) = 2 ! zone 2 - high wrinkle tendency
336 ENDIF
337 ENDDO
338 ENDIF
339 ENDIF
340C------------------------
341 RETURN