OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
s4voln_m.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!|| s4voln_m ../engine/source/elements/solid/solide4_sfem/s4voln_m.F
25!||--- called by ------------------------------------------------------
26!|| s4forc3 ../engine/source/elements/solid/solide4/s4forc3.F
27!||--- calls -----------------------------------------------------
28!|| jacob_j33 ../engine/source/elements/solid/solide8e/jacob_j33.F
29!||--- uses -----------------------------------------------------
30!|| matparam_def_mod ../common_source/modules/mat_elem/matparam_def_mod.F90
31!||====================================================================
32 SUBROUTINE s4voln_m(
33 1 SFEM_NODVAR, NC1, NC2, NC3,
34 2 NC4, MAT, OFFG, RHO,
35 3 RHO0, FXX, FXY, FXZ,
36 4 FYX, FYY, FYZ, FZX,
37 5 FZY, FZZ, VOL0, VOLN,
38 6 VOL0DP, VOLDP, AMU0, DXX,
39 7 DYY, DZZ, MATPARAM, NEL,
40 8 ISMSTR, S_SFEM_NODVAR)
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE matparam_def_mod
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C G l o b a l P a r a m e t e r s
51C-----------------------------------------------
52#include "mvsiz_p.inc"
53#include "com04_c.inc"
54#include "com08_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58 INTEGER, INTENT(IN) :: ISMSTR
59 INTEGER NC1(*),NC2(*),NC3(*),NC4(*),MAT(*),NEL
60 INTEGER,INTENT(IN) :: S_SFEM_NODVAR
61 my_real :: OFFG(*),VOL0(*),AMU0(*),
62 . DXX(*),DYY(*),DZZ(*),VOLN(*),
63 . FXX(*), FXY(*), FXZ(*),
64 . FYX(*), FYY(*), FYZ(*),
65 . FZX(*), FZY(*), FZZ(*),
66 . rho(*),rho0
67 my_real,INTENT(INOUT) :: sfem_nodvar(s_sfem_nodvar)
68 TYPE(matparam_struct_), DIMENSION(NUMMAT) :: MATPARAM
69C-----------------------------------------------
70C C o m m o n B l o c k s
71C-----------------------------------------------
72#include "scr18_c.inc"
73#include "scr05_c.inc"
74C-----------------------------------------------
75C L o c a l V a r i a b l e s
76C-----------------------------------------------
77 INTEGER I,MX
78 my_real AMU(MVSIZ), SUM,DTR,DTREP_R,DIVDE(MVSIZ),JAC_M(MVSIZ),JAC(MVSIZ),FAC,BASE,JFAC,DVDP
79 DOUBLE PRECISION VOL0DP(*),VOLDP(*),SUMDP
80C-----------------------------------------------
81C S o u r c e L i n e s
82C-----------------------------------------------
83 MX = mat(1)
84 IF(ismstr == 1 .OR. ismstr == 11)THEN
85 IF (tt==zero) THEN
86 DO i=1,nel
87 IF(offg(i) == zero) cycle
88 amu0(i) = rho(i)/rho0-one
89 ENDDO
90 ELSE
91 DO i=1,nel
92 IF(offg(i) == zero) cycle
93 sum=sfem_nodvar(nc1(i))+sfem_nodvar(nc2(i))+sfem_nodvar(nc3(i))+sfem_nodvar(nc4(i))
94 amu(i) = four/sum -one
95 divde(i) = amu0(i)-amu(i)
96 dtr=divde(i)/dt1
97 dtrep_r = third*(dtr-dxx(i)-dyy(i)-dzz(i))
98 dxx(i) = dxx(i) + dtrep_r
99 dyy(i) = dyy(i) + dtrep_r
100 dzz(i) = dzz(i) + dtrep_r
101 amu0(i)= rho(i)/rho0-one-divde(i)
102 ENDDO
103 END IF
104 ELSE
105c-------------------------------------------------------------------------
106 IF(iresp == 1)THEN
107 DO i=1,nel
108 IF(offg(i) == zero .OR. abs(offg(i)) > one) cycle
109 sumdp=sfem_nodvar(nc1(i))+sfem_nodvar(nc2(i))+sfem_nodvar(nc3(i))+sfem_nodvar(nc4(i))
110 voldp(i) = fourth*sumdp*vol0dp(i)
111 voln(i) = voldp(i)
112 ENDDO
113 ELSE
114 DO i=1,nel
115 IF(offg(i) == zero .OR. abs(offg(i)) > one) cycle
116 sum=sfem_nodvar(nc1(i))+sfem_nodvar(nc2(i))+sfem_nodvar(nc3(i))+sfem_nodvar(nc4(i))
117 voln(i)=fourth*sum*vol0(i)
118 ENDDO
119 END IF
120 IF (matparam(mx)%STRAIN_FORMULATION == 1) THEN
121C------compute AMU(t+dt) for large strain
122 IF(iresp == 1)THEN
123 amu(1:nel) = vol0dp(1:nel)/voldp(1:nel) - one
124 ELSE
125 amu(1:nel) = vol0(1:nel)/voln(1:nel) - one
126 END IF
127 IF (tt == zero) THEN
128 amu0(1:nel) = amu(1:nel)
129 ELSE
130 DO i = 1,nel
131 IF(offg(i)==zero.OR.abs(offg(i))>one) cycle
132 dtr = (dxx(i) + dyy(i) + dzz(i))*dt1
133 dtrep_r = third*((amu(i)-amu0(i))+dtr)/dt1
134 dxx(i) = dxx(i) - dtrep_r
135 dyy(i) = dyy(i) - dtrep_r
136 dzz(i) = dzz(i) - dtrep_r
137 amu0(i) = amu(i)
138 ENDDO
139 END IF
140 ENDIF
141 IF(ismstr >= 10)THEN
142 DO i=1,nel
143 IF(offg(i)==zero) cycle
144 jac_m(i)=voln(i)/vol0(i)
145 ENDDO
146 ENDIF
147 IF((ismstr == 2.OR.ismstr == 12).AND.idtmin(1) == 3) THEN
148 IF (tt==zero) THEN
149 DO i=1,nel
150 IF(offg(i)==zero) cycle
151 amu0(i) = rho(i)/rho0-one
152 ENDDO
153 ELSE
154 DO i=1,nel
155 IF(offg(i) == zero .OR. abs(offg(i)) <= one) cycle
156 sum=sfem_nodvar(nc1(i))+sfem_nodvar(nc2(i))+sfem_nodvar(nc3(i))+sfem_nodvar(nc4(i))
157 amu(i) = four/sum -one
158 divde(i) = amu0(i)-amu(i)
159 dtr=divde(i)/dt1
160 dtrep_r = third*(dtr-dxx(i)-dyy(i)-dzz(i))
161 dxx(i) = dxx(i) + dtrep_r
162 dyy(i) = dyy(i) + dtrep_r
163 dzz(i) = dzz(i) + dtrep_r
164 dvdp = divde(i)*(vol0(i)/voln(i))
165 amu0(i)= rho(i)/rho0-one-dvdp
166 ENDDO
167C for total strain modif in the next
168 IF(iresp == 1 .AND. ismstr == 12)THEN
169 DO i=1,nel
170 IF(offg(i) == zero .OR. abs(offg(i)) <= one) cycle
171 dvdp = divde(i)*(vol0(i)/voln(i))
172 amu0(i) = vol0dp(i)/voldp(i)-one-dvdp
173 ENDDO
174 END IF
175 END IF !(TT==ZERO) THEN
176 ENDIF
177 ENDIF
178C--------total strain modif
179 IF (ismstr == 11) THEN
180C---- modify Dii w/ rho/rho_0
181 DO i=1,nel
182 dtrep_r = -third*(amu0(i)+fxx(i)+fyy(i)+fzz(i))
183 fxx(i) = fxx(i) + dtrep_r
184 fyy(i) = fyy(i) + dtrep_r
185 fzz(i) = fzz(i) + dtrep_r
186 ENDDO
187 ELSEIF(ismstr >= 10) THEN
188 DO i=1,nel
189 IF(abs(offg(i))<=one) cycle
190 dtrep_r = -third*(amu0(i)+fxx(i)+fyy(i)+fzz(i))
191 fxx(i) = fxx(i) + dtrep_r
192 fyy(i) = fyy(i) + dtrep_r
193 fzz(i) = fzz(i) + dtrep_r
194 ENDDO
195 CALL jacob_j33(
196 1 jac, fxx, fxy, fxz,
197 2 fyx, fyy, fyz, fzx,
198 3 fzy, fzz, nel)
199C
200 fac=third
201 DO i=1,nel
202 IF(abs(offg(i)) > one) cycle
203 base = jac_m(i)/max(em20,jac(i))
204 jfac =exp(fac*log(max(em20,base)))
205 fxx(i) = jfac*fxx(i)+jfac-one
206 fyy(i) = jfac*fyy(i)+jfac-one
207 fzz(i) = jfac*fzz(i)+jfac-one
208 fxy(i) = jfac*fxy(i)
209 fyx(i) = jfac*fyx(i)
210 fzx(i) = jfac*fzx(i)
211 fxz(i) = jfac*fxz(i)
212 fyz(i) = jfac*fyz(i)
213 fzy(i) = jfac*fzy(i)
214 ENDDO
215 END IF
216 RETURN
217 END
jacob_j33
subroutine jacob_j33(det, aj1, aj2, aj3, aj4, aj5, aj6, aj7, aj8, aj9, nel)
Definition jacob_j33.F:37
max
#define max(a, b)
Definition macros.h:21
s4voln_m
subroutine s4voln_m(sfem_nodvar, nc1, nc2, nc3, nc4, mat, offg, rho, rho0, fxx, fxy, fxz, fyx, fyy, fyz, fzx, fzy, fzz, vol0, voln, vol0dp, voldp, amu0, dxx, dyy, dzz, matparam, nel, ismstr, s_sfem_nodvar)
Definition s4voln_m.F:41