OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dama24.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine dama24 (nel, nindx, indx, ngl, pm, scle2, sig, dam, ang, eps_f, crak, cdam, s01, s02, s03, s04, s05, s06, deps1, deps2, deps3, deps4, deps5, deps6, de1, de2, de3, scal1, scal2, scal3)

Function/Subroutine Documentation

◆ dama24()

subroutine dama24 ( integer nel,
integer nindx,
integer, dimension(nindx) indx,
integer, dimension(nel) ngl,
dimension(npropm) pm,
intent(in) scle2,
intent(inout) sig,
intent(inout) dam,
intent(inout) ang,
intent(inout) eps_f,
intent(inout) crak,
intent(out) cdam,
intent(in) s01,
intent(in) s02,
intent(in) s03,
intent(in) s04,
intent(in) s05,
intent(in) s06,
intent(in) deps1,
intent(in) deps2,
intent(in) deps3,
intent(in) deps4,
intent(in) deps5,
intent(in) deps6,
intent(in) de1,
intent(in) de2,
intent(in) de3,
intent(in) scal1,
intent(in) scal2,
intent(in) scal3 )

Definition at line 31 of file dama24.F.

36C-----------------------------------------------
37C I m p l i c i t T y p e s
38C-----------------------------------------------
39#include "implicit_f.inc"
40C-----------------------------------------------
41C C o m m o n B l o c k s
42C-----------------------------------------------
43#include "param_c.inc"
44#include "units_c.inc"
45C-----------------------------------------------
46C D u m m y A r g u m e n t s
47C-----------------------------------------------
48 INTEGER NEL,NINDX
49 INTEGER INDX(NINDX),NGL(NEL)
50 my_real, DIMENSION(NPROPM) :: pm
51 my_real, DIMENSION(NEL) ,INTENT(IN) :: s01,s02,s03,s04,s05,s06,
52 . deps1,deps2,deps3,deps4,deps5,deps6,de1,de2,de3,
53 . scal1,scal2,scal3,scle2
54 my_real ,DIMENSION(NEL,3,3) ,INTENT(OUT) :: cdam
55 my_real, DIMENSION(NEL,6) ,INTENT(INOUT) :: sig,ang
56 my_real, DIMENSION(NEL,3) ,INTENT(INOUT) :: eps_f,dam,crak
57C-----------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER I,J,K,IDEB,IDIR
61 my_real eps(6), epstot(6), de(3), scal(3), sigo(6), dir(6),ang0(6)
62 my_real young, nu, g, dsup, vmax, qq, aa, ac, epst, sftry, den, depsf
63C=======================================================================
64 ideb = 0
65c
66 young = pm(20)
67 nu = pm(21)
68 g = pm(22)
69 dsup = pm(26)
70 vmax = pm(27)
71 qq = pm(28)
72 aa = pm(38)
73 ac = pm(41)
74 epst = pm(42)
75c-------------------
76 DO j = 1,nindx
77 i = indx(j)
78 eps(1) = deps1(i)
79 eps(2) = deps2(i)
80 eps(3) = deps3(i)
81 eps(4) = deps4(i)
82 eps(5) = deps5(i)
83 eps(6) = deps6(i)
84 de(1) = de1(i)
85 de(2) = de2(i)
86 de(3) = de3(i)
87 scal(1) = scal1(i)
88 scal(2) = scal2(i)
89 scal(3) = scal3(i)
90 epstot(1)= crak(i,1)
91 epstot(2)= crak(i,2)
92 epstot(3)= crak(i,3)
93 epstot(4)= s04(i)/g
94 epstot(5)= s05(i)/g
95 epstot(6)= s06(i)/g
96 ang0(1) = ang(i,1)
97 ang0(2) = ang(i,2)
98 ang0(3) = ang(i,3)
99 ang0(4) = ang(i,4)
100 ang0(5) = ang(i,5)
101 ang0(6) = ang(i,6)
102c---------------------
103 sigo(1) = s01(i)
104 sigo(2) = s02(i)
105 sigo(3) = s03(i)
106 sigo(4) = s04(i)
107 sigo(5) = s05(i)
108 sigo(6) = s06(i)
109c---------------------
110 IF (dam(i,1) > zero) THEN
111 idir = 3
112 IF (dam(i,2) == zero) THEN
113 idir = 2
114 CALL pri224(sigo,epstot,eps,dir(4),ang0)
115 ENDIF
116 ELSE
117 idir = 1
118 CALL pri324(sigo,epstot,eps,dir)
119 ENDIF
120c
121c SAUVE LA DEFORMATION A RUPTURE
122c
123 sftry = min(epstot(idir),epstot(idir)-scle2(i)*eps(idir),epst)
124 sftry = max(sftry,fourth*epst)
125c
126 IF (epstot(idir) < sftry) THEN
127 IF (ideb==1) THEN
128 WRITE(iout, '(A,I1,A,I10,A,5X,A,E10.3,A,E10.3,A,E10.3)')
129 . ' FAILURE-',idir,' ELEMENT #',ngl(i),' FUNNY!',
130 . ' EPS_F ',sftry,'EPSTOT',epstot(idir),' EPST ',epst
131 WRITE(istdo,'(A,I1,A,I10,A,5X,A,E10.3,A,E10.3,A,E10.3)')
132 . ' FAILURE-',idir,' ELEMENT #',ngl(i),' FUNNY!',
133 . ' EPS_F ',sftry,'EPSTOT',epstot(idir),' EPST ',epst
134 ENDIF
135 sig(i,1) = s01(i)
136 sig(i,2) = s02(i)
137 sig(i,3) = s03(i)
138 sig(i,4) = s04(i)
139 sig(i,5) = s05(i)
140 sig(i,6) = s06(i)
141c
142 cycle
143 ENDIF
144c
145c SAUVE LES DIRECTIONS DE DOMMAGE
146c
147 IF (idir == 1) THEN
148 ang(i,1:6) = dir(1:6)
149 ELSEIF (idir == 2) THEN
150 ang(i,4:6) = dir(4:6)
151 ENDIF
152c
153c CALCULE LE DOMMAGE
154c
155 DO k=1,3
156 crak(i,k) = epstot(k)
157 depsf = epstot(k) - sftry
158 IF (depsf >= zero .AND. eps_f(i,k) < zero) THEN ! EPS_F initialized to -1
159 IF (k >= 2) THEN
160 IF (dam(i,k-1) == zero) cycle
161 ENDIF
162 IF (ideb==1) THEN
163 WRITE(iout, '(A,I1,A,I10,A,3F6.3,A,3F6.3,A,E10.3,A,E10.3)')
164 . ' FAILURE-',k,' ELEMENT #',ngl(i),
165 . ' VEC-1 ',ang(i,1),ang(i,2),ang(i,3),
166 . ' VEC-2 ',ang(i,4),ang(i,5),ang(i,6),
167 . ' EPS_F ',sftry,' EPSTOT ',epstot(k)
168 WRITE(istdo,'(A,I1,A,I10,A,3F6.3,A,3F6.3,A,E10.3,A,E10.3)')
169 . ' FAILURE-',k,' ELEMENT #',ngl(i),
170 . ' VEC-1 ',ang(i,1),ang(i,2),ang(i,3),
171 . ' VEC-2 ',ang(i,4),ang(i,5),ang(i,6),
172 . ' EPS_F ',sftry,' EPSTOT ',epstot(k)
173 ENDIF
174
175 eps_f(i,k) = sftry
176 dam(i,k) = qq * (one - eps_f(i,k) / max(epstot(k),em20) )
177 dam(i,k) = max(dam(i,k),em20)
178 dam(i,k) = min(dam(i,k),dsup)
179 de(k) = one - dam(i,k)
180 scal(k) = zero
181c
182c
183c EPS_F(I,K) = SFTRY
184c DAM(I,K) = QQ * DEPSF / EPSTOT(K)
185c DAM(I,K) = MIN(DAM(I,K),DSUP)
186c DE(K) = ONE - DAM(I,K)
187c SCAL(K)= ZERO
188 ENDIF
189 ENDDO ! next K
190c
191c CALCULE LA MATRICE DE HOOKE ET LES CONTRAINTES (rotation repere !)
192c
193 den = one - nu**2
194 . * (scal(1)*scal(2) + scal(2)*scal(3) + scal(3)*scal(1)
195 . + two*nu*scal(1)*scal(2)*scal(3))
196C
197 cdam(i,1,1) = young*de(1)*(one-nu**2*scal(2)*scal(3))/den
198 cdam(i,2,2) = young*de(2)*(one-nu**2*scal(1)*scal(3))/den
199 cdam(i,3,3) = young*de(3)*(one-nu**2*scal(2)*scal(1))/den
200 cdam(i,1,2) = nu*young*scal(1)*scal(2)*(one+nu*scal(3))/den
201 cdam(i,2,3) = nu*young*scal(2)*scal(3)*(one+nu*scal(1))/den
202 cdam(i,1,3) = nu*young*scal(1)*scal(3)*(one+nu*scal(2))/den
203 cdam(i,2,1) = cdam(i,1,2)
204 cdam(i,3,1) = cdam(i,1,3)
205 cdam(i,3,2) = cdam(i,2,3)
206c
207 sig(i,1) = cdam(i,1,1)*epstot(1)
208 . + cdam(i,1,2)*epstot(2)
209 . + cdam(i,1,3)*epstot(3)
210 sig(i,2) = cdam(i,2,1)*epstot(1)
211 . + cdam(i,2,2)*epstot(2)
212 . + cdam(i,2,3)*epstot(3)
213 sig(i,3) = cdam(i,3,1)*epstot(1)
214 . + cdam(i,3,2)*epstot(2)
215 . + cdam(i,3,3)*epstot(3)
216 sig(i,4) = scal(1)*scal(2)*sigo(4)
217 sig(i,5) = scal(2)*scal(3)*sigo(5)
218 sig(i,6) = scal(3)*scal(1)*sigo(6)
219c
220 ENDDO
221c-----------
222 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
pri224
subroutine pri224(sig3d, epstot, eps, dir3d, ang)
Definition pri224.F:29
pri324
subroutine pri324(sig, epstot, eps, vec)
Definition pri324.F:29