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 353 of file h3d_sol_skin_scalar.F.

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

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

◆ 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 152 of file h3d_sol_skin_scalar.F.

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