OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
srho3.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!|| srho3 ../engine/source/elements/solid/solide/srho3.F
25!||--- called by ------------------------------------------------------
26!|| ig3duforc3 ../engine/source/elements/ige3d/ig3duforc3.F
27!|| s10forc3 ../engine/source/elements/solid/solide10/s10forc3.f
28!|| s16forc3 ../engine/source/elements/thickshell/solide16/s16forc3.F
29!|| s20forc3 ../engine/source/elements/solid/solide20/s20forc3.F
30!|| s4forc3 ../engine/source/elements/solid/solide4/s4forc3.F
31!|| s6cforc3 ../engine/source/elements/thickshell/solide6c/s6cforc3.F
32!|| s6zforc3 ../engine/source/elements/solid/solide6z/s6zforc3.F90
33!|| s8cforc3 ../engine/source/elements/thickshell/solide8c/s8cforc3.F
34!|| s8eforc3 ../engine/source/elements/solid/solide8e/s8eforc3.F
35!|| s8sforc3 ../engine/source/elements/solid/solide8s/s8sforc3.F
36!|| s8zforc3 ../engine/source/elements/solid/solide8z/s8zforc3.F
37!|| scforc3 ../engine/source/elements/thickshell/solidec/scforc3.F
38!|| sforc3 ../engine/source/elements/solid/solide/sforc3.F
39!|| szforc3 ../engine/source/elements/solid/solidez/szforc3.F
40!||--- calls -----------------------------------------------------
41!|| ancmsg ../engine/source/output/message/message.F
42!|| arret ../engine/source/system/arret.F
43!||--- uses -----------------------------------------------------
44!|| ale_mod ../common_source/modules/ale/ale_mod.F
45!|| i22bufbric_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
46!|| message_mod ../engine/share/message_module/message_mod.F
47!||====================================================================
48 SUBROUTINE srho3(
49 1 PM, VOLO, RHON, EINT,
50 2 DIVDE, FLUX, FLU1, VOLN,
51 3 DVOL, NGL, MAT, OFF,
52 4 IS_MAT_BCS,TAG22, VOLDP, VOL0DP,
53 5 AMU, OFFG, NEL, MTN,
54 6 JALE, ISMSTR, JEUL, JLAG)
55C-----------------------------------------------
56C M o d u l e s
57C-----------------------------------------------
58 USE message_mod
59 USE i22bufbric_mod
60 USE ale_mod
61C-----------------------------------------------
62C I m p l i c i t T y p e s
63C-----------------------------------------------
64#include "implicit_f.inc"
65#include "comlock.inc"
66C-----------------------------------------------
67C G l o b a l P a r a m e t e r s
68C-----------------------------------------------
69#include "param_c.inc"
70#include "mvsiz_p.inc"
71C-----------------------------------------------
72C C o m m o n B l o c k s
73C-----------------------------------------------
74#include "com08_c.inc"
75#include "scr06_c.inc"
76#include "impl1_c.inc"
77#include "com01_c.inc"
78#include "com04_c.inc"
79#include "inter22.inc"
80#include "scr05_c.inc"
81C-----------------------------------------------
82C D u m m y A r g u m e n t s
83C-----------------------------------------------
84 INTEGER, INTENT(IN) :: NEL
85 INTEGER, INTENT(IN) :: MTN
86 INTEGER, INTENT(IN) :: JALE
87 INTEGER, INTENT(IN) :: ISMSTR
88 INTEGER, INTENT(IN) :: JEUL
89 INTEGER, INTENT(IN) :: JLAG
90 INTEGER NGL(*), MAT(*), IS_MAT_BCS, IB,NIN,MCELL
91
92 my_real pm(npropm,nummat),volo(*), rhon(*),eint(*),flux(6,*), flu1(*),
93 . voln(*), dvol(*),divde(*),off(*),tag22(*),amu(*) ,offg(*)
94 DOUBLE PRECISION VOLDP(*),VOL0DP(*),DVDP
95C-----------------------------------------------
96C L o c a l V a r i a b l e s
97C-----------------------------------------------
98 my_real :: rho0,dvv, e0,vavg,rhon_old(mvsiz),ddvol,rhoref
99 INTEGER :: I,COUNT,LIST(MVSIZ),II, MX
100C-----------------------------------------------
101C S o u r c e L i n e s
102C-----------------------------------------------
103 rhon_old(1:nel)=rhon(1:nel)
104 rho0 = zero
105 IF(ale%GLOBAL%INCOMP==1 .AND. jeul+jale==1)THEN
106 mx = mat(1)
107 rho0 = pm(1,mx)
108 e0 = pm(23,mx)
109 DO i=1,nel
110 dvv = divde(i)
111 rhon(i) = rhon(i)-dvv*rho0
112 vavg = half*(voln(i)+volo(i))
113 dvol(i) = vavg*dvv
114 eint(i) = eint(i)*volo(i)-e0*dvv*vavg
115 ENDDO
116 ELSE
117 IF(jlag/=0)THEN
118 mx = mat(1)
119 rho0 = pm(1,mx)
120C--- due to /INIBRI/EREF
121 IF (tt==zero) THEN
122 IF (ismstr==11) THEN
123 volo(1:nel)=voln(1:nel)
124 ELSEIF(ismstr==1) THEN
125 DO i=1,nel
126 IF(offg(i)>one) volo(i)=voln(i)
127 ENDDO
128 END IF
129 END IF
130 IF (impl_s>0.AND.iline>0) THEN
131 DO i=1,nel
132 rhon(i) = rho0
133 eint(i) = eint(i)*voln(i)
134 ENDDO
135 ELSE
136 IF (mtn /= 115) THEN
137 DO i=1,nel
138 IF(offg(i)==zero.AND.voln(i)==one) voln(i)=volo(i)
139 dvol(i) = voln(i)-(rho0/rhon(i))*volo(i)
140 rhon(i) = rho0*(volo(i)/voln(i))
141 eint(i) = eint(i)*volo(i)
142 ENDDO
143 ELSE
144 DO i=1,nel
145 IF(offg(i)==zero.AND.voln(i)==one) voln(i)=volo(i)
146 dvol(i) = voln(i)-(rhon(i+nel)/rhon(i))*volo(i)
147 rhon(i) = rhon(i+nel)*(volo(i)/voln(i))
148 eint(i) = eint(i)*volo(i)
149 ENDDO
150 ENDIF
151 ENDIF
152 ELSEIF(jale/=0)THEN
153 DO i=1,nel
154 rhon(i) = rhon(i)/voln(i)
155 dvol(i) = voln(i)-volo(i)+half*dt1*(flu1(i)+flux(1,i)+flux(2,i)+flux(3,i)+flux(4,i)+flux(5,i)+flux(6,i))
156 volo(i) = voln(i)
157 ENDDO
158 ELSEIF(jeul/=0)THEN
159 DO i=1,nel
160 rhon(i) = rhon(i)/voln(i)
161 dvol(i) = half*dt1*(flu1(i)+flux(1,i)+flux(2,i)+flux(3,i)+flux(4,i)+flux(5,i)+flux(6,i))
162 ENDDO
163 endif!(JLAG/=0)
164
165 !---interface22---!
166 IF(int22/=0)THEN
167 IF(jeul+jale/=0)THEN
168 nin = 1
169 DO i=1,nel
170 ib = nint(tag22(i))
171 IF(ib==0)cycle
172 mcell = brick_list(nin,ib)%mainID
173 ddvol = brick_list(nin,ib)%POLY(mcell)%DDVOL
174 dvol(i) = dt1 * ddvol
175 IF(jeul/=0)THEN
176 rhon(i) = rhon(i) * voln(i) / brick_list(nin,ib)%vnew_scell
177 ENDIF
178 voln(i) = brick_list(nin,ib)%vnew_scell
179 volo(i) = brick_list(nin,ib)%vold_scell
180 dvol(i) = dvol(i) + voln(i)-volo(i) !USE ALE FORMULATION FOR POLYHEDRA EVEN WITH EULERIAN MATERIAL
181 volo(i) = voln(i)
182
183 brick_list(nin,ib)%vold_scell = voln(i) !for convection during next cycle : aconve()
184C write(*,FMT='(A,I10,A,F30.16)') "brick id =", NGL(I), " mass= ", RHON(I)*VOLN(I)
185 enddo!next I
186 endif!(JEUL+JALE/=0)
187 endif!INT22
188 !-----------------!
189
190 endif!IF(ALE%GLOBAL%INCOMP==1 .AND. JEUL+JALE==1)THEN
191
192 IF(jale+jeul/=0)THEN
193 count=0
194 DO i=1,nel
195 IF(is_mat_bcs== 1)cycle
196 IF(rhon(i)> zero)cycle
197 IF(off(i)== zero )cycle
198 count = count + 1
199 list(count) = i
200 ENDDO
201
202 DO ii = 1,count
203 i = list(ii)
204 CALL ancmsg(msgid=167,anmode=aninfo,i1=ngl(i),r1=rhon(i))
205 CALL arret(2)
206 ENDDO
207 ENDIF
208C
209 IF (ismdisp>0.OR.ismstr==11) THEN
210C change DXX,DYY,DZZ by DIVDE(I)=dt1*(DXX(I)+DYY(I)+DZZ(I)) as input
211C---------RHON(I) = RHO0*(VOLO(I)/VOLN(I)) just calculated above
212C---------VOLN(I)=VOLO(I) for small strain excepting initial stat case
213 DO i=1,nel
214 dvdp = divde(i)
215 rhon(i) = rhon_old(i) - rhon(i)*dvdp
216 rhon(i) = max(rhon(i),em30)
217 dvol(i)=voln(i)*dvdp
218 ENDDO
219 ELSEIF ((ismstr<=4.OR.ismstr==12).AND.jlag>0) THEN
220 DO i=1,nel
221 IF(offg(i)>one) THEN
222 dvdp = divde(i)
223 rhoref = rhon(i)
224 rhon(i) = rhon_old(i) - rhoref*dvdp
225 rhon(i) = max(rhon(i),em30)
226 dvol(i)=voln(i)*dvdp
227 IF (ismstr==12) amu(i) =rhon(i)/rhoref - one
228 END IF
229 ENDDO
230 ENDIF
231C
232 IF((ale%GLOBAL%INCOMP/=1 .OR. (jeul+jale)/=1).AND.jlag/=0.AND.n2d==0
233 . .AND.impl_s==0.AND.ismstr/=1.AND.ismstr/=3.AND.ismstr/=11)THEN
234 IF(iresp==1)THEN
235C------VOLDP doesn't change after switching to small strain,modifying VOL0DP to
236 DO i=1,nel
237 IF(offg(i)>one) THEN
238 dvdp = divde(i)*(volo(i)/voln(i))
239 vol0dp(i)=vol0dp(i)-dvdp*voldp(i)
240 ELSEIF(offg(i)==zero) THEN
241 voldp(i)=volo(i)
242 ELSE
243 dvdp = voldp(i)-(rho0/rhon_old(i))*vol0dp(i)
244 dvol(i) = dvdp
245 rhon(i) = rho0*(vol0dp(i)/voldp(i))
246 END IF
247 ENDDO
248 amu(1:nel) = vol0dp(1:nel)/voldp(1:nel) - one
249 END IF
250 ENDIF
251C-----AMU compute for DP in MMAIN: AMU() = RHON()/RHO0 - 1, because RHON*VOLDP=RHO0*VOL0DP
252
253C-----------------------------------------------
254 RETURN
255 END SUBROUTINE srho3
my_real
#define my_real
Definition cppsort.cpp:32
srho3
subroutine srho3(pm, volo, rhon, eint, divde, flux, flu1, voln, dvol, ngl, mat, off, is_mat_bcs, tag22, voldp, vol0dp, amu, offg, nel, mtn, jale, ismstr, jeul, jlag)
Definition srho3.F:55
max
#define max(a, b)
Definition macros.h:21
ale_mod
Definition ale_mod.F:150
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:253
i22bufbric_mod
Definition cut-cell-search_mod.F:95
i22bufbric_mod::brick_list
type(brick_entity), dimension(:,:), allocatable, target brick_list
Definition cut-cell-search_mod.F:105
message_mod
Definition message_mod.F:1257
s10forc3
subroutine s10forc3(timers, output, elbuf_tab, ng, pm, geo, ixs, x, a, v, ms, w, flux, flu1, veul, fv, ale_connect, iparg, tf, npf, bufmat, partsav, nloc_dmg, dt2t, neltst, ityptst, stifn, fsky, iads, offset, eani, iparts, ixs10, iads10, nel, fx, fy, fz, ar, vr, dr, ipm, istrain, isolnod, itask, temp, fthe, fthesky, iexpan, stifr, d, gresav, grth, igrth, table, mssa, dmels, igeo, xdp, voln, condn, condnsky, sfem_nodvar, itagdn, sensors, ioutprt, mat_elem, h3d_strain, dt, idel7nok, snpc, stf, sbufmat, svis, nsvois, idtmins, idel7ng, maxfunc, userl_avail, glob_therm, impl_s, idyna, s_sfem_nodvar)
Definition s10forc3.F:115
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
arret
subroutine arret(nn)
Definition arret.F:86