OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
main_beam3.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!|| main_beam3 ../engine/source/elements/beam/main_beam3.F
25!||--- called by ------------------------------------------------------
26!|| pforc3 ../engine/source/elements/beam/pforc3.F
27!||--- calls -----------------------------------------------------
28!|| fail_beam3 ../engine/source/elements/beam/fail_beam3.F
29!|| m1lawp ../engine/source/materials/mat/mat001/m1lawp.F
30!|| m2lawp ../engine/source/materials/mat/mat002/m2lawp.F
31!|| sigeps44p ../engine/source/materials/mat/mat044/sigeps44p.F
32!||--- uses -----------------------------------------------------
33!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
34!|| mat_elem_mod ../common_source/modules/mat_elem/mat_elem_mod.F90
35!||====================================================================
36 SUBROUTINE main_beam3(
37 . ELBUF_STR,NEL ,ILAW ,JTHE ,IFAIL ,
38 . IPM ,PM ,GEO ,TEMPEL ,OFF ,
39 . MAT ,PID ,NGL ,TIME ,DTIME ,
40 . AL ,NPF ,TF ,EXX ,EXY ,
41 . EXZ ,KXX ,KYY ,KZZ ,F1 ,
42 . F2 ,F3 ,M1 ,M2 ,M3 ,
43 . BUFMAT ,NPROPG ,NPROPMI ,NPROPM ,NUMMAT ,
44 . NUMGEO ,SBUFMAT ,SNPC ,STF ,IOUT ,
45 . ISTDO ,NUVAR ,UVAR ,EPSD ,IMAT ,
46 . FOR ,MOM ,EINT ,ISMSTR ,MAT_PARAM,
47 . NTABLE ,TABLE)
48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE mat_elem_mod
52 USE elbufdef_mod
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER ,INTENT(IN) :: NEL
61 INTEGER ,INTENT(IN) :: ILAW
62 INTEGER ,INTENT(IN) :: IMAT
63 INTEGER ,INTENT(IN) :: JTHE
64 INTEGER ,INTENT(IN) :: IFAIL
65 INTEGER ,INTENT(IN) :: SBUFMAT
66 INTEGER ,INTENT(IN) :: SNPC
67 INTEGER ,INTENT(IN) :: STF
68 INTEGER ,INTENT(IN) :: NUMMAT
69 INTEGER ,INTENT(IN) :: NUMGEO
70 INTEGER ,INTENT(IN) :: NPROPMI
71 INTEGER ,INTENT(IN) :: NPROPM
72 INTEGER ,INTENT(IN) :: NPROPG
73 INTEGER ,INTENT(IN) :: IOUT
74 INTEGER ,INTENT(IN) :: ISTDO
75 INTEGER ,INTENT(IN) :: NUVAR
76 INTEGER ,INTENT(IN) :: ISMSTR
77 INTEGER ,INTENT(IN) :: NTABLE
78 TYPE(ttable), DIMENSION(NTABLE), INTENT(INOUT) :: TABLE ! TABLE DATA
79 INTEGER ,DIMENSION(SNPC) ,INTENT(IN) :: NPF
80 INTEGER ,DIMENSION(NPROPMI,NUMMAT) ,INTENT(IN) :: IPM
81 INTEGER ,DIMENSION(NEL) ,INTENT(IN) :: MAT
82 INTEGER ,DIMENSION(NEL) ,INTENT(IN) :: PID
83 INTEGER ,DIMENSION(NEL) ,INTENT(IN) :: NGL
84 my_real ,INTENT(IN) :: time
85 my_real ,INTENT(IN) :: dtime
86 my_real ,INTENT(IN) :: pm(npropm,nummat)
87 my_real ,INTENT(IN) :: geo(npropg,numgeo)
88 my_real ,INTENT(IN) :: tf(stf)
89 my_real ,INTENT(IN) :: bufmat(sbufmat)
90 my_real ,DIMENSION(NEL) ,INTENT(IN) :: al
91 my_real ,DIMENSION(NEL) ,INTENT(INOUT) :: tempel
92 my_real ,DIMENSION(NEL) ,INTENT(INOUT) :: exx,exy,exz
93 my_real ,DIMENSION(NEL) ,INTENT(INOUT) :: kxx,kyy,kzz
94 my_real ,DIMENSION(NEL) ,INTENT(INOUT) :: off
95 my_real ,DIMENSION(NEL) ,INTENT(INOUT) :: f1,f2,f3
96 my_real ,DIMENSION(NEL) ,INTENT(INOUT) :: m1,m2,m3
97 my_real ,DIMENSION(NEL,2),INTENT(INOUT) :: eint
98 my_real ,DIMENSION(NEL,3),INTENT(INOUT) :: for,mom
99 my_real ,DIMENSION(NEL) ,INTENT(OUT) :: epsd
100 my_real ,DIMENSION(NEL,NUVAR) ,INTENT(INOUT) :: uvar
101 TYPE (ELBUF_STRUCT_) ,INTENT(INOUT) :: ELBUF_STR
102 TYPE (MATPARAM_STRUCT_) ,INTENT(IN) :: MAT_PARAM
103C-----------------------------------------------
104C L o c a l V a r i a b l e s
105C-----------------------------------------------
106 INTEGER :: I,IPID,IPLA,ISRATE,NUPARAM,NFUNC,IADBUF,IFUNC(100)
107 my_real :: area,iyy,izz,ixx,asrate,epsdi,fact
108 my_real ,DIMENSION(NEL) :: dpla,svm,pressure,degmb,degfx,degsh,sigy,
109 . svm0
110c=======================================================================
111 ipid = pid(1)
112c-------------------
113c STRAIN RATE
114c-------------------
115 israte = ipm(3,imat)
116 asrate = min(one, pm(9,imat)*dtime)
117c
118 ! Geometric properties of the beam element
119 area = geo(1 ,ipid)
120 ixx = geo(4 ,ipid)
121 iyy = geo(2 ,ipid)
122 izz = geo(18,ipid)
123c
124 DO i = 1,nel
125 epsdi = half*(exx(i)**2) + (half*exy(i))**2 + (half*exz(i))**2
126 epsdi = al(i)*sqrt(three*epsdi)/three_half
127 sigy(i) = 1.e30
128 IF (israte > 0) THEN
129 epsd(i)= asrate*epsdi + (one - asrate)*epsd(i)
130 ELSE
131 epsd(i)= epsdi
132 ENDIF
133 ENDDO
134c-------------------
135c STRAIN
136c-------------------
137 DO i=1,nel
138 ! Strain increment
139 exx(i) = exx(i) * dtime
140 exy(i) = exy(i) * dtime
141 exz(i) = exz(i) * dtime
142 kxx(i) = kxx(i) * dtime
143 kyy(i) = kyy(i) * dtime
144 kzz(i) = kzz(i) * dtime
145 ! Initialization of internal energy increment
146 degmb(i) = for(i,1)*exx(i)
147 degsh(i) = for(i,2)*exy(i)+for(i,3)*exz(i)
148 degfx(i) = mom(i,1)*kxx(i)+mom(i,2)*kyy(i)+mom(i,3)*kzz(i)
149 ENDDO
150c
151 ! Compute undamaged forces and internal energy increment
152 IF (elbuf_str%GBUF%G_DMGSCL > 0) THEN
153 DO i = 1,nel
154 for(i,1) = for(i,1)/max(em20,elbuf_str%GBUF%DMGSCL(i))
155 for(i,2) = for(i,2)/max(em20,elbuf_str%GBUF%DMGSCL(i))
156 for(i,3) = for(i,3)/max(em20,elbuf_str%GBUF%DMGSCL(i))
157 mom(i,1) = mom(i,1)/max(em20,elbuf_str%GBUF%DMGSCL(i))
158 mom(i,2) = mom(i,2)/max(em20,elbuf_str%GBUF%DMGSCL(i))
159 mom(i,3) = mom(i,3)/max(em20,elbuf_str%GBUF%DMGSCL(i))
160 ENDDO
161 ENDIF
162c
163 ipla = elbuf_str%GBUF%G_PLA
164 ! Cumulated plastic strain increment
165 IF (ipla > 0) THEN
166 DO i = 1,nel
167 dpla(i) = elbuf_str%GBUF%PLA(i)
168 svm0(i) = for(i,1)*for(i,1) + three * area *
169 . ( mom(i,1)*mom(i,1) / max(ixx,em20)
170 . + mom(i,2)*mom(i,2) / max(iyy,em20)
171 . + mom(i,3)*mom(i,3) / max(izz,em20))
172 svm0(i) = sqrt(svm0(i)) / area
173 ENDDO
174 ENDIF
175c
176c---------------------------
177c material models
178c---------------------------
179 SELECT CASE(ilaw)
180c
181 CASE (1)
182 CALL m1lawp(
183 . pm ,for ,mom ,geo,
184 . off ,exx ,exy ,exz ,kxx,
185 . kyy ,kzz ,al ,f1 ,f2 ,
186 . f3 ,m1 ,m2 ,m3 ,nel,
187 . mat ,pid )
188c
189 CASE (2) ! Johnson-Cook
190 CALL m2lawp(
191 . pm ,for ,mom ,eint ,geo ,
192 . off ,elbuf_str%GBUF%PLA ,exx ,exy ,exz ,
193 . kxx ,kyy ,kzz ,al ,f1 ,
194 . f2 ,f3 ,m1 ,m2 ,m3 ,
195 . nel ,mat ,pid ,ngl ,ipm ,
196 . nummat ,nuvar ,uvar ,sigy )
197c
198 CASE (44) ! Cowper-Symonds
199 iadbuf = ipm(7 ,imat)
200 nuparam = ipm(9 ,imat)
201 nfunc = ipm(10,imat)
202 DO i=1,nfunc
203 ifunc(i) = ipm(10+i,imat)
204 ENDDO
205 CALL sigeps44p(
206 . nel ,ngl ,mat ,pid ,nuparam ,bufmat(iadbuf),
207 . geo ,off ,elbuf_str%GBUF%PLA ,al ,
208 . exx ,exy ,exz ,kxx ,kyy ,kzz ,
209 . f1 ,f2 ,f3 ,m1 ,m2 ,m3 ,
210 . for ,mom ,pm ,nuvar ,uvar ,nfunc ,
211 . ifunc ,tf ,npf ,sigy )
212c
213 END SELECT
214c
215c---------------------------
216c Plastic Work
217c---------------------------
218 IF (ipla > 0 .OR. ifail > 0) THEN
219 DO i = 1,nel
220 dpla(i) = elbuf_str%GBUF%PLA(i) - dpla(i)
221 ENDDO
222
223 DO i = 1,nel
224 svm(i) = f1(i)*f1(i) + three * area *
225 . ( m1(i)*m1(i) / max(ixx,em20)
226 . + m2(i)*m2(i) / max(iyy,em20)
227 . + m3(i)*m3(i) / max(izz,em20) )
228 svm(i) = sqrt(svm(i)) / area
229 pressure(i) = third * f1(i) / area
230 ENDDO
231
232 IF (ipla > 0) THEN
233 DO i = 1,nel
234 IF (elbuf_str%GBUF%G_WPLA > 0) elbuf_str%GBUF%WPLA(i) = elbuf_str%GBUF%WPLA(i) +
235 . half*(svm(i)+svm0(i))*dpla(i)*area*al(i)
236 ENDDO
237 ENDIF
238
239 ENDIF
240c
241c---------------------------
242c failure models
243c---------------------------
244 IF (ifail > 0) THEN
245c
246 CALL fail_beam3(elbuf_str ,mat_param%FAIL(1),nummat ,
247 . npropm ,snpc ,stf ,
248 . nel ,imat ,jthe ,dpla ,
249 . tempel ,ngl ,pm ,
250 . off ,epsd ,npf ,tf ,
251 . time ,iout ,istdo ,
252 . svm ,pressure,area ,al ,
253 . f1 ,f2 ,f3 ,m1 ,m2 ,
254 . m3 ,ismstr ,exx ,exy ,exz ,
255 . kxx ,kyy ,kzz ,dtime ,
256 . ntable ,table ,elbuf_str%GBUF%PLA , sigy )
257c
258 ! Compute damaged forces
259 IF (elbuf_str%GBUF%G_DMGSCL > 0) THEN
260 DO i = 1,nel
261 f1(i) = f1(i)*elbuf_str%GBUF%DMGSCL(i)
262 f2(i) = f2(i)*elbuf_str%GBUF%DMGSCL(i)
263 f3(i) = f3(i)*elbuf_str%GBUF%DMGSCL(i)
264 m1(i) = m1(i)*elbuf_str%GBUF%DMGSCL(i)
265 m2(i) = m2(i)*elbuf_str%GBUF%DMGSCL(i)
266 m3(i) = m3(i)*elbuf_str%GBUF%DMGSCL(i)
267 ENDDO
268 ENDIF
269c
270 END IF
271C-------------------------------------
272 DO i=1,nel
273 for(i,1)=f1(i)*off(i)
274 for(i,2)=for(i,2)*off(i)
275 for(i,3)=for(i,3)*off(i)
276 mom(i,1)=m1(i)*off(i)
277 mom(i,2)=m2(i)*off(i)
278 mom(i,3)=m3(i)*off(i)
279 ENDDO
280C
281 DO i=1,nel
282 f1(i) = for(i,1)
283 f2(i) = for(i,2)
284 f3(i) = for(i,3)
285 m1(i) = mom(i,1)
286 m2(i) = mom(i,2)
287 m3(i) = mom(i,3)
288 ENDDO
289c
290 ! Update internal energy
291 DO i=1,nel
292 degmb(i) = degmb(i) + for(i,1)*exx(i)
293 degsh(i) = degsh(i) + for(i,2)*exy(i) + for(i,3)*exz(i)
294 degfx(i) = degfx(i) + mom(i,1)*kxx(i) + mom(i,2)*kyy(i) + mom(i,3)*kzz(i)
295 fact = half*off(i)*al(i)
296 eint(i,1) = eint(i,1) + (degsh(i)+degmb(i))*fact
297 eint(i,2) = eint(i,2) + fact*degfx(i)
298 ENDDO
299C-----------------------------------------------
300 RETURN
301 END SUBROUTINE main_beam3
my_real
#define my_real
Definition cppsort.cpp:32
fail_beam3
subroutine fail_beam3(elbuf_str, fail, nummat, npropm, snpc, stf, nel, imat, jthe, dpla, tempel, ngl, pm, off, epsd, npf, tf, time, iout, istdo, svm, pressure, area, al, f1, f2, f3, m1, m2, m3, ismstr, epsxx, epsxy, epsxz, kxx, kyy, kzz, dtime, ntable, table, pla, sigy)
Definition fail_beam3.F:55
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
m1lawp
subroutine m1lawp(pm, for, mom, geo, off, exx, exy, exz, kxx, kyy, kzz, al, f1, f2, f3, m1, m2, m3, nel, mat, pid)
Definition m1lawp.F:34
m2lawp
subroutine m2lawp(pm, for, mom, eint, geo, off, pla, exx, exy, exz, kxx, kyy, kzz, al, fa1, fa2, fa3, ma1, ma2, ma3, nel, mat, pid, ngl, ipm, nummat, nuvar, uvar, sigy)
Definition m2lawp.F:35
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
main_beam3
subroutine main_beam3(elbuf_str, nel, ilaw, jthe, ifail, ipm, pm, geo, tempel, off, mat, pid, ngl, time, dtime, al, npf, tf, exx, exy, exz, kxx, kyy, kzz, f1, f2, f3, m1, m2, m3, bufmat, npropg, npropmi, npropm, nummat, numgeo, sbufmat, snpc, stf, iout, istdo, nuvar, uvar, epsd, imat, for, mom, eint, ismstr, mat_param, ntable, table)
Definition main_beam3.F:48
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
sigeps44p
subroutine sigeps44p(nel, ngl, mat, pid, nuparam, uparam, geo, off, pla, al, exx, exy, exz, kxx, kyy, kzz, fa1, fa2, fa3, ma1, ma2, ma3, for, mom, pm, nuvar, uvar, nfunc, ifunc, tf, npf, sigy)
Definition sigeps44p.F:37