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 47 of file srho3.F.

54C-----------------------------------------------
55C M o d u l e s
56C-----------------------------------------------
57 USE message_mod
58 USE i22bufbric_mod
59 USE ale_mod
60C-----------------------------------------------
61C I m p l i c i t T y p e s
62C-----------------------------------------------
63#include "implicit_f.inc"
64#include "comlock.inc"
65C-----------------------------------------------
66C G l o b a l P a r a m e t e r s
67C-----------------------------------------------
68#include "param_c.inc"
69#include "mvsiz_p.inc"
70C-----------------------------------------------
71C C o m m o n B l o c k s
72C-----------------------------------------------
73#include "com08_c.inc"
74#include "scr06_c.inc"
75#include "impl1_c.inc"
76#include "com01_c.inc"
77#include "com04_c.inc"
78#include "inter22.inc"
79#include "scr05_c.inc"
80C-----------------------------------------------
81C D u m m y A r g u m e n t s
82C-----------------------------------------------
83 INTEGER, INTENT(IN) :: NEL
84 INTEGER, INTENT(IN) :: MTN
85 INTEGER, INTENT(IN) :: JALE
86 INTEGER, INTENT(IN) :: ISMSTR
87 INTEGER, INTENT(IN) :: JEUL
88 INTEGER, INTENT(IN) :: JLAG
89 INTEGER NGL(*), MAT(*), IS_MAT_BCS, IB,NIN,MCELL
90
91 my_real pm(npropm,nummat),volo(*), rhon(*),eint(*),flux(6,*), flu1(*),
92 . voln(*), dvol(*),divde(*),off(*),tag22(*),amu(*) ,offg(*)
93 DOUBLE PRECISION VOLDP(*),VOL0DP(*),DVDP
94C-----------------------------------------------
95C L o c a l V a r i a b l e s
96C-----------------------------------------------
97 my_real :: rho0,dvv, e0,vavg,rv,rvp,rhon_old(mvsiz),ddvol,rhoref
98 INTEGER :: I, J,COUNT,LIST(MVSIZ),II, MX
99C-----------------------------------------------
100C S o u r c e L i n e s
101C-----------------------------------------------
102 rhon_old(1:nel)=rhon(1:nel)
103 rho0 = zero
104 IF(ale%GLOBAL%INCOMP==1 .AND. jeul+jale==1)THEN
105 mx = mat(1)
106 rho0 = pm(1,mx)
107 e0 = pm(23,mx)
108 DO i=1,nel
109 dvv = divde(i)
110 rhon(i) = rhon(i)-dvv*rho0
111 vavg = half*(voln(i)+volo(i))
112 dvol(i) = vavg*dvv
113 eint(i) = eint(i)*volo(i)-e0*dvv*vavg
114 ENDDO
115 ELSE
116 IF(jlag/=0)THEN
117 mx = mat(1)
118 rho0 = pm(1,mx)
119C--- due to /INIBRI/EREF
120 IF (tt==zero) THEN
121 IF (ismstr==11) THEN
122 volo(1:nel)=voln(1:nel)
123 ELSEIF(ismstr==1) THEN
124 DO i=1,nel
125 IF(offg(i)>one) volo(i)=voln(i)
126 ENDDO
127 END IF
128 END IF
129 IF (impl_s>0.AND.iline>0) THEN
130 DO i=1,nel
131 rhon(i) = rho0
132 eint(i) = eint(i)*voln(i)
133 ENDDO
134 ELSE
135 IF (mtn /= 115) THEN
136 DO i=1,nel
137 IF(offg(i)==zero.AND.voln(i)==one) voln(i)=volo(i)
138 dvol(i) = voln(i)-(rho0/rhon(i))*volo(i)
139 rhon(i) = rho0*(volo(i)/voln(i))
140 eint(i) = eint(i)*volo(i)
141 ENDDO
142 ELSE
143 DO i=1,nel
144 IF(offg(i)==zero.AND.voln(i)==one) voln(i)=volo(i)
145 dvol(i) = voln(i)-(rhon(i+nel)/rhon(i))*volo(i)
146 rhon(i) = rhon(i+nel)*(volo(i)/voln(i))
147 eint(i) = eint(i)*volo(i)
148 ENDDO
149 ENDIF
150 ENDIF
151 ELSEIF(jale/=0)THEN
152 DO i=1,nel
153 rhon(i) = rhon(i)/voln(i)
154 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))
155 volo(i) = voln(i)
156 ENDDO
157 ELSEIF(jeul/=0)THEN
158 DO i=1,nel
159 rhon(i) = rhon(i)/voln(i)
160 dvol(i) = half*dt1*(flu1(i)+flux(1,i)+flux(2,i)+flux(3,i)+flux(4,i)+flux(5,i)+flux(6,i))
161 ENDDO
162 endif!(JLAG/=0)
163
164 !---interface22---!
165 IF(int22/=0)THEN
166 IF(jeul+jale/=0)THEN
167 nin = 1
168 DO i=1,nel
169 ib = nint(tag22(i))
170 IF(ib==0)cycle
171 mcell = brick_list(nin,ib)%mainID
172 ddvol = brick_list(nin,ib)%POLY(mcell)%DDVOL
173 dvol(i) = dt1 * ddvol
174 IF(jeul/=0)THEN
175 rhon(i) = rhon(i) * voln(i) / brick_list(nin,ib)%vnew_scell
176 ENDIF
177 voln(i) = brick_list(nin,ib)%vnew_scell
178 volo(i) = brick_list(nin,ib)%vold_scell
179 dvol(i) = dvol(i) + voln(i)-volo(i) !USE ALE FORMULATION FOR POLYHEDRA EVEN WITH EULERIAN MATERIAL
180 volo(i) = voln(i)
181
182 brick_list(nin,ib)%vold_scell = voln(i) !for convection during next cycle : aconve()
183C write(*,FMT='(A,I10,A,F30.16)') "brick id =", NGL(I), " mass= ", RHON(I)*VOLN(I)
184 enddo!next I
185 endif!(JEUL+JALE/=0)
186 endif!INT22
187 !-----------------!
188
189 endif!IF(ALE%GLOBAL%INCOMP==1 .AND. JEUL+JALE==1)THEN
190
191 IF(jale+jeul/=0)THEN
192 count=0
193 DO i=1,nel
194 IF(is_mat_bcs== 1)cycle
195 IF(rhon(i)> zero)cycle
196 IF(off(i)== zero )cycle
197 count = count + 1
198 list(count) = i
199 ENDDO
200
201 DO ii = 1,count
202 i = list(ii)
203 CALL ancmsg(msgid=167,anmode=aninfo,i1=ngl(i),r1=rhon(i))
204 CALL arret(2)
205 ENDDO
206 ENDIF
207C
208 IF (ismdisp>0.OR.ismstr==11) THEN
209C change DXX,DYY,DZZ by DIVDE(I)=dt1*(DXX(I)+DYY(I)+DZZ(I)) as input
210C---------RHON(I) = RHO0*(VOLO(I)/VOLN(I)) just calculated above
211C---------VOLN(I)=VOLO(I) for small strain excepting initial stat case
212 DO i=1,nel
213 dvdp = divde(i)
214 rhon(i) = rhon_old(i) - rhon(i)*dvdp
215 rhon(i) = max(rhon(i),em30)
216 dvol(i)=voln(i)*dvdp
217 ENDDO
218 ELSEIF ((ismstr<=4.OR.ismstr==12).AND.jlag>0) THEN
219 DO i=1,nel
220 IF(offg(i)>one) THEN
221 dvdp = divde(i)
222 rhoref = rhon(i)
223 rhon(i) = rhon_old(i) - rhoref*dvdp
224 rhon(i) = max(rhon(i),em30)
225 dvol(i)=voln(i)*dvdp
226 IF (ismstr==12) amu(i) =rhon(i)/rhoref - one
227 END IF
228 ENDDO
229 ENDIF
230C
231 IF((ale%GLOBAL%INCOMP/=1 .OR. (jeul+jale)/=1).AND.jlag/=0.AND.n2d==0
232 . .AND.impl_s==0.AND.ismstr/=1.AND.ismstr/=3.AND.ismstr/=11)THEN
233 IF(iresp==1)THEN
234C------VOLDP doesn't change after switching to small strain,modifying VOL0DP to
235 DO i=1,nel
236 IF(offg(i)>one) THEN
237 dvdp = divde(i)*(volo(i)/voln(i))
238 vol0dp(i)=vol0dp(i)-dvdp*voldp(i)
239 ELSEIF(offg(i)==zero) THEN
240 voldp(i)=volo(i)
241 ELSE
242 dvdp = voldp(i)-(rho0/rhon_old(i))*vol0dp(i)
243 dvol(i) = dvdp
244 rhon(i) = rho0*(vol0dp(i)/voldp(i))
245 END IF
246 ENDDO
247 amu(1:nel) = vol0dp(1:nel)/voldp(1:nel) - one
248 END IF
249 ENDIF
250C-----AMU compute for DP in MMAIN: AMU() = RHON()/RHO0 - 1, because RHON*VOLDP=RHO0*VOL0DP
251
252C-----------------------------------------------
253 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:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
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:1249
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:889
arret
subroutine arret(nn)
Definition arret.F:87