OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
fail_fabric_c.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| fail_fabric_c ../engine/source/materials/fail/fabric/fail_fabric_c.F
25!||--- called by ------------------------------------------------------
26!|| mulawc ../engine/source/materials/mat_share/mulawc.F90
27!|| usermat_shell ../engine/source/materials/mat_share/usermat_shell.F
28!||--- calls -----------------------------------------------------
29!|| finter ../engine/source/tools/curve/finter.F
30!||====================================================================
31 SUBROUTINE fail_fabric_c(
32 1 NEL ,NGL ,NUPARAM ,NUVAR ,NFUNC ,
33 2 UPARAM ,UVAR ,IFUNC ,TIME ,TIMESTEP ,
34 3 NPF ,TF ,DEPS1 ,DEPS2 ,EPS1 ,
35 4 EPS2 ,SIG1 ,SIG2 ,DFMAX ,TDEL ,
36 5 IPG ,ILAY ,IPT ,OFF ,FOFF )
37C-----------------------------------------------
38c Anisotropic fabric tension strain failure
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C---------+---------+---+---+--------------------------------------------
44C VAR | SIZE |TYP| RW| DEFINITION
45C---------+---------+---+---+--------------------------------------------
46C NEL | 1 | I | R | SIZE OF THE ELEMENT GROUP NEL
47C NUPARAM | 1 | I | R | SIZE OF THE USER PARAMETER ARRAY
48C UPARAM | NUPARAM | F | R | USER MATERIAL PARAMETER ARRAY
49C NUVAR | 1 | I | R | NUMBER OF USER ELEMENT VARIABLES
50C UVAR |NEL*NUVAR| F |R/W| USER ELEMENT VARIABLE ARRAY
51C---------+---------+---+---+--------------------------------------------
52C NFUNC | 1 | I | R | NUMBER FUNCTION USED FOR THIS USER LAW not used
53C IFUNC | NFUNC | I | R | FUNCTION INDEX not used
54C NPF | * | I | R | FUNCTION ARRAY
55C TF | * | F | R | FUNCTION ARRAY
56C---------+---------+---+---+--------------------------------------------
57C TIME | 1 | F | R | CURRENT TIME
58C TIMESTEP| 1 | F | R | CURRENT TIME STEP
59C---------+---------+---+---+--------------------------------------------
60C EPS1 | NEL | F | R | STRAIN IN 1st FIBER DIRECTION
61C EPS2 | NEL | F | R | STRAIN IN 2nd FIBER DIRECTION
62C DEPS1 | NEL | F | R | STRAIN INCREMENT IN 1st FIBER DIRECTION
63C DEPS2 | NEL | F | R | STRAIN INCREMENT IN 2nd FIBER DIRECTION
64C SIG1 | NEL | F | W | STRESS IN 1st FIBER DIRECTION
65C SIG2 | NEL | F | W | STRESS IN 2nd FIBER DIRECTION
66C---------+---------+---+---+--------------------------------------------
67C OFF | NEL | F | R | DELETED ELEMENT FLAG (=1. ON, =0. OFF)
68C FOFF | NEL | I |R/W| DELETED INTEGRATION POINT FLAG (=1 ON, =0 OFF)
69C DFMAX | NEL | F |R/W| MAX DAMAGE FACTOR
70C TDEL | NEL | F | W | FAILURE TIME
71C---------+---------+---+---+--------------------------------------------
72C NGL ELEMENT ID
73C IPG CURRENT GAUSS POINT (in plane)
74C ILAY CURRENT LAYER
75C IPT CURRENT INTEGRATION POINT IN THE LAYER
76C---------+---------+---+---+--------------------------------------------
77#include "units_c.inc"
78#include "comlock.inc"
79C-----------------------------------------------
80C I N P U T A r g u m e n t s
81C-----------------------------------------------
82 INTEGER, INTENT(IN) :: NEL,NUPARAM,NUVAR,IPG,ILAY,IPT
83 INTEGER ,DIMENSION(NEL), INTENT(IN) :: NGL
84 my_real, INTENT(IN) :: TIME,TIMESTEP
85 my_real ,DIMENSION(NUPARAM), INTENT(IN) :: UPARAM
86 my_real ,DIMENSION(NEL), INTENT(IN) :: DEPS1,DEPS2,EPS1,EPS2,OFF
87C-----------------------------------------------
88C I N P U T O U T P U T A r g u m e n t s
89C-----------------------------------------------
90 INTEGER ,DIMENSION(NEL), INTENT(INOUT) :: FOFF
91 my_real ,DIMENSION(NEL), INTENT(INOUT) :: dfmax,sig1,sig2
92 my_real ,DIMENSION(NEL), INTENT(OUT) :: tdel
93 my_real, DIMENSION(NEL,NUVAR), INTENT(INOUT) :: uvar
94C-----------------------------------------------
95C VARIABLES FOR FUNCTION INTERPOLATION
96C-----------------------------------------------
97 INTEGER NPF(*), NFUNC, IFUNC(NFUNC)
98 my_real finter ,tf(*)
99 EXTERNAL finter
100C-----------------------------------------------
101C L o c a l V a r i a b l e s
102C-----------------------------------------------
103 INTEGER :: I,J,NINDX1,NINDX2,NDIR
104 my_real :: xfac,rf1,rr1,rf2,rr2,dydx,epsr1,epsr2,epsf1,epsf2,dmg1,dmg2
105 INTEGER ,DIMENSION(NEL) :: INDX1,INDX2
106 my_real ,DIMENSION(NEL) :: RFAC1,RFAC2,EPSP1,EPSP2
107c-----------------------------------------------------------------------
108c UVAR(1) = stress reduction factor in 1st fiber direction
109c UVAR(2) = stress reduction factor in 2nd fiber direction
110C=======================================================================
111 nindx1 = 0
112 nindx2 = 0
113 epsf1 = uparam(1)
114 epsr1 = uparam(2)
115 epsf2 = uparam(3)
116 epsr2 = uparam(4)
117 xfac = uparam(5)
118 ndir = nint(uparam(6))
119C-------------------
120C STRAIN
121C-------------------
122 IF (ifunc(1) > 0) THEN ! strain rate dependency
123 DO i=1,nel
124 epsp1(i) = xfac * deps1(i) / max(timestep,em20)
125 epsp2(i) = xfac * deps2(i) / max(timestep,em20)
126 rfac1(i) = finter(ifunc(1),epsp1(i),npf,tf,dydx)
127 rfac1(i) = max(rfac1(i),em20)
128 rfac2(i) = finter(ifunc(1),epsp2(i),npf,tf,dydx)
129 rfac2(i) = max(rfac2(i),em20)
130 ENDDO
131 ELSE
132 rfac1(1:nel) = one
133 rfac2(1:nel) = one
134 ENDIF
135c
136 DO i=1,nel
137 dmg1 = zero
138 dmg2 = zero
139 rf1 = epsf1*rfac1(i)
140 rr1 = epsr1*rfac1(i)
141 rf2 = epsf2*rfac2(i)
142 rr2 = epsr2*rfac2(i)
143 IF (eps1(i) > rf1) dmg1 = min(one, (eps1(i)-rf1)/(rr1-rf1))
144 IF (eps2(i) > rf2) dmg2 = min(one, (eps2(i)-rf2)/(rr2-rf2))
145c
146 IF (uvar(i,1) == zero .and. dmg1 > zero) THEN
147 nindx1 = nindx1 + 1
148 indx1(nindx1) = i
149 ENDIF
150 IF (uvar(i,2) == zero .and. dmg2 > zero) THEN
151 nindx2 = nindx2 + 1
152 indx2(nindx2) = i
153 ENDIF
154 uvar(i,1) = max(uvar(i,1), dmg1)
155 uvar(i,2) = max(uvar(i,2), dmg2)
156 IF (uvar(i,1)>zero .and. sig1(i)>zero) sig1(i) = sig1(i)*(one-uvar(i,1))
157 IF (uvar(i,2)>zero .and. sig2(i)>zero) sig2(i) = sig2(i)*(one-uvar(i,2))
158 IF (ndir == 2) THEN
159 IF (uvar(i,1) == one .AND. uvar(i,2) == one) THEN
160 foff(i) = 0
161 tdel(i) = time
162 ENDIF
163 ELSE
164 IF (uvar(i,1) == one .OR. uvar(i,2) == one) THEN
165 foff(i) = 0
166 tdel(i) = time
167 ENDIF
168 ENDIF
169 ENDDO
170c
171c--- Output of Maximum Damage : 0 < DFMAX < 1
172 DO i=1,nel
173 dfmax(i) = max(dfmax(i), uvar(i,1))
174 dfmax(i) = max(dfmax(i), uvar(i,2))
175 ENDDO
176c----------------------------------------------
177c Output
178c----------------------------------------------
179 DO j=1,nindx1
180 i = indx1(j)
181 IF (uvar(i,1) > zero) THEN
182#include "lockon.inc"
183 WRITE(iout, 1100) ngl(i),ipg,ilay,ipt,time
184 WRITE(istdo,1100) ngl(i),ipg,ilay,ipt,time
185#include "lockoff.inc"
186 ENDIF
187 ENDDO
188 DO j=1,nindx2
189 i = indx2(j)
190 IF (uvar(i,2) > zero) THEN
191#include "lockon.inc"
192 WRITE(iout, 2100) ngl(i),ipg,ilay,ipt,time
193 WRITE(istdo,2200) ngl(i),ipg,ilay,ipt,time
194#include "lockoff.inc"
195 ENDIF
196 ENDDO
197C-----------------------------------------------
198 1100 FORMAT(1x,'START DAMAGE (FABRIC) OF FIBER 1, ELEMENT ',i10,1x,',GAUSS PT',
199 . i2,1x,',LAYER',i3,1x,',INTEGRATION PT',i3,1x,'AT TIME :',1pe12.4)
200 1200 FORMAT(1x,'START DAMAGE (FABRIC) OF FIBER 2, ELEMENT ',i10,1x,',GAUSS PT',
201 . i2,1x,',LAYER',i3,1x,',INTEGRATION PT',i3,1x,'AT TIME :',1pe12.4)
202 2100 FORMAT(1x,'START DAMAGE (FABRIC) OF FIBER 1, ELEMENT ',i10,1x,',GAUSS PT',
203 . i2,1x,',LAYER',i3,1x,',INTEGRATION PT',i3,1x,'AT TIME :',1pe12.4)
204 2200 FORMAT(1x,'START DAMAGE (FABRIC) OF FIBER 2, ELEMENT ',i10,1x,',GAUSS PT',
205 . i2,1x,',LAYER',i3,1x,',INTEGRATION PT',i3,1x,'AT TIME :',1pe12.4)
206 3000 FORMAT(1x,'FAILURE (FABRIC) OF ELEMENT ',i10,1x,',GAUSS PT',
207 . i2,1x,',LAYER',i3,1x,',INTEGRATION PT',i3,1x,'AT TIME :',1pe12.4)
208C-----------------------------------------------
209 RETURN
210 END
fail_fabric_c
subroutine fail_fabric_c(nel, ngl, nuparam, nuvar, nfunc, uparam, uvar, ifunc, time, timestep, npf, tf, deps1, deps2, eps1, eps2, sig1, sig2, dfmax, tdel, ipg, ilay, ipt, off, foff)
Definition fail_fabric_c.F:37
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21