OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
srho3.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "param_c.inc"
#include "mvsiz_p.inc"
#include "com08_c.inc"
#include "scr06_c.inc"
#include "impl1_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "inter22.inc"
#include "scr05_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ srho3()

subroutine srho3 ( pm,
volo,
rhon,
eint,
divde,
flux,
flu1,
voln,
dvol,
integer, dimension(*) ngl,
integer, dimension(*) mat,
off,
integer is_mat_bcs,
tag22,
double precision, dimension(*) voldp,
double precision, dimension(*) vol0dp,
amu,
offg,
integer, intent(in) nel,
integer, intent(in) mtn,
integer, intent(in) jale,
integer, intent(in) ismstr,
integer, intent(in) jeul,
integer, intent(in) jlag )

Definition at line 48 of file srho3.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
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
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