50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69 USE elbufdef_mod
72
73
74
75#include "implicit_f.inc"
76#include "comlock.inc"
77
78
79
80#include "param_c.inc"
81#include "com01_c.inc"
82#include "com08_c.inc"
83#include "mvsiz_p.inc"
84
85
86
87 INTEGER NEL, NUPARAM, NUVAR,NFT,NIX,JTHE,
88 . IX(NIX,*), PID(*), ILAY, NG,PM(NPROPM,*),IPARG(*),MAT(*),
89 . IPM(NPROPMI,*)
91 . time ,timestep ,uparam(nuparam),
92 . sigy(nel) ,vk(nel) ,
93 . rho(nel) ,rho0(nel) ,volume(nel),
94 . eint(nel) ,bufvois(*) ,qnew(nel) ,
95 . ddvol(nel) ,qold(nel) ,
96 . epspxx(nel) ,epspyy(nel),epspzz(nel),
97 . epspxy(nel) ,epspyz(nel),epspzx(nel),
98 . depsxx(nel) ,depsyy(nel),depszz(nel),
99 . depsxy(nel) ,depsyz(nel),depszx(nel),
100 . epsxx(nel) ,epsyy(nel) ,epszz(nel) ,
101 . epsxy(nel) ,epsyz(nel) ,epszx(nel) ,
102 . sigoxx(nel) ,sigoyy(nel),sigozz(nel),
103 . sigoxy(nel) ,sigoyz(nel),sigozx(nel),
104 . v(3,*) ,w(3,*) ,x(3,*) ,
105 . geo(npropg,*),bufmat(*) ,
106 . stifn(mvsiz) ,vd2(*) ,vdx(*) ,
107 . vdy(*) ,vdz(*) ,ssp ,
108 . voln(*)
109 my_real,
intent(inout) :: psh(nel)
110 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
111
112
113
115 . signxx(nel),signyy(nel),signzz(nel),
116 . signxy(nel),signyz(nel),signzx(nel),
117 . sigvxx(nel),sigvyy(nel),sigvzz(nel),
118 . sigvxy(nel),sigvyz(nel),sigvzx(nel),
119 . soundsp(nel),viscmax(nel)
120
121
122
123 my_real uvar(nel,nuvar), off(nel), tburn(nel), bfrac(nel), deltax(nel)
124
125
126
127 INTEGER NPF(*), NFUNC, IFUNC(NFUNC)
129
130
131
133
134
135
136
137
138
139
140
141
142
143
144 my_real :: p,qa,qb,qal,qbl, pold,vold,einc,pnew
145 my_real :: bulk, d, eg, gr, c,
alpha,beta, c1, c2,fscale_g,fscale_b,fscale_p,fscale_rho
146 my_real :: p0,xl, dd, volo, espe, e0, total_bfrac, delta_bf, brate
147 my_real :: pg,pg_,ps, mu_g, mu_p, mu, rho_g,rho_g_, rho_s, rhog, rho_si
148 INTEGER :: funcb, funcg
149 INTEGER :: IBID, IBFRAC, I , K
150 my_real :: mass, df, tb, diff, g_rhoc2, p_rhoc2, rhoc2, ssp_g, ssp_s, mass_g, mass_s, vs
151 my_real :: vol_g, vol_s, fac,compac,invrhog
152 my_real :: m0,rho_s0,f,y_old,y,func_dot,func,v0,tmp
153
154 TYPE(G_BUFEL_) ,POINTER :: GBUF
155 TYPE(L_BUFEL_) ,POINTER :: LBUF
156 TYPE(BUF_LAY_) ,POINTER :: BUFLY
157
158
159
160 gbuf => elbuf_tab(ng)%GBUF
161 lbuf => elbuf_tab(ng)%BUFLY(ilay)%LBUF(1,1,1)
162 bufly => elbuf_tab(ng)%BUFLY(ilay)
163
164
165
166 bulk = uparam(01)
167 p0 = uparam(02)
168 psh(:) = uparam(03)
169 e0 = uparam(04)
170 d = uparam(05)
171 eg = uparam(06)
172 gr = uparam(07)
173 c = uparam(08)
175 c1 = uparam(10)
176 c2 = uparam(11)
177 fscale_g = uparam(12)
178 fscale_b = uparam(13)
179 fscale_p = uparam(14)
180 fscale_rho = uparam(15)
181 funcb = ifunc(1)
182 funcg = ifunc(2)
183
184 compac=0.93
185
186 IF(dt1 == zero)THEN
187 DO i=1,nel
188 eint(i) = eg*rho0(i)*volume(i)
189 uvar(i,1) = p0-psh(i)
190 uvar(i,2) = p0-psh(i)
191 uvar(i,3) = rho0(i)/compac
192 uvar(i,4) = zero
193 uvar(i,5) = p0-psh(i) !pold
194 uvar(i,6) = zero
195 uvar(i,7) = rho0(i)*volume(i)
196 ENDDO
197 signxx(1:nel) = - (p0-psh(i))
198 signyy(1:nel) = - (p0-psh(i))
199 signzz(1:nel) = - (p0-psh(i))
200 signxy(1:nel) = zero
201 signyz(1:nel) = zero
202 signzx(1:nel) = zero
203 sigvxx(1:nel) = zero
204 sigvyy(1:nel) = zero
205 sigvzz(1:nel) = zero
206 sigvxy(1:nel) = zero
207 sigvyz(1:nel) = zero
208 sigvzx(1:nel) = zero
209 DO i=1,nel
210 soundsp(i)= sqrt(bulk/rho0(i))
211 ENDDO
212 ENDIF
213
214 DO i=1,nel
215
216
217
218 mass = rho(i)*volume(i)
219 xl = deltax(i)
220 espe = eint(i)/mass
221 ps = uvar(i,1)
222 pg = uvar(i,2)
223 rho_s = uvar(i,3)
224 rho_g = uvar(i,4)
225 pold = uvar(i,5)
226
227
228
229
230
231 IF(bfrac(i) < one) THEN
232 tb = - tburn(i)
233 bfrac(i) = zero
234 IF(time > tb) bfrac(i) = c1*(time-tb)*two_third/xl
235 IF(bfrac(i) < em04) THEN
236 bfrac(i) = zero
237 ELSEIF(bfrac(i) > one) THEN
238 bfrac(i) = one
239 ENDIF
240 ENDIF
241
242
243
244
245
246
247 IF(bfrac(i) <= zero)THEN
248 total_bfrac = zero
249 uvar(i,6) = zero
250 ELSEIF(uvar(i,6) /= one)THEN
251 pg_=pg
252
253 brate = fscale_b*finter(funcb,(pg_)/fscale_p,npf,tf,diff)
254 delta_bf = gr*exp(c*log((one-
alpha*uvar(i,6))))*brate*timestep
255 uvar(i,6) = uvar(i,6) + delta_bf
256 uvar(i,6) =
max(
min(one,uvar(i,6)),zero)
257 total_bfrac = bfrac(i)*uvar(i,6)
258 ELSE
259
260 total_bfrac = bfrac(i)*uvar(i,6)
261 ENDIF
262
263
264
265
266 mass_s=(one-uvar(i,6))*uvar(i,7)
267 mass_g=uvar(i,7)-mass_s
268
269 rho_s=(one-uvar(i,6))*rho(i)
270 rho_g=zero
271
272
273 rho_si=rho0(i)/compac*(uvar(i,2)/bulk+one)
274
275
276
277 IF(mass_g > zero)rho_g=mass_g/(voln(i)-mass_s/
max(em10,rho_si))
278 pg = p0+rho_g*eg*exp(rho_g/d)
279 ps = p0+bulk*(rho_si/rho0(i)-one)
280 ssp_s = sqrt(bulk/rho0(i))
281 IF(rho_g > zero)THEN
282 ssp_g = rho0(i)/d*pg + exp(rho_g/d)* pg / (rho_g/rho0(i))*
283 ssp_g = sqrt(one/rho_g * ssp_g)
284 ELSE
285 ssp_g = zero
286 ENDIF
287
288
289
290
291 ssp = total_bfrac*ssp_g + (one-total_bfrac)*ssp_s
292 pnew = total_bfrac*pg + (one-total_bfrac)*ps
293 pnew = (pnew-psh(i))*off(i)
294
295
296
297 signxx(i) = -pnew
298 signyy(i) = -pnew
299 signzz(i) = -pnew
300 signxy(i) = zero
301 signyz(i) = zero
302 signzx(i) = zero
303 sigvxx(i) = zero
304 sigvyy(i) = zero
305 sigvzz(i) = zero
306 sigvxy(i) = zero
307 sigvyz(i) = zero
308 sigvzx(i) = zero
309 soundsp(i) = ssp
310
311 uvar(i,1)=ps
312 uvar(i,2)=pg
313 uvar(i,3)=rho_s
314 uvar(i,4)=rho_g
315 uvar(i,5)=pnew
316
317
318
319
320 if(time == zero)then
321 open(unit=1,file='F.txt' )
322 open(unit=2,file='Pg.txt' )
323 open(unit=3,file='rhoS.txt' )
324 open(unit=4,file='Ifrac.txt' )
325 else
326 open(unit=1,file='F.txt' , position="append")
327 open(unit=2,file='Pg.txt' , position="append")
328 open(unit=3,file='rhoS.txt', position="append")
329 open(unit=4,file='Ifrac.txt',position="append")
330 endif
331
332 WRITE(1,*)time,uvar(i,6)
333 WRITE(2,*)time,pg
334 WRITE(3,*)time,rho_s
335 WRITE(4,*)bfrac(i)
336
337 CLOSE(1)
338 CLOSE(2)
339 CLOSE(3)
340
341 enddo
342
343
344 RETURN
345