50
51
52
53 use glob_therm_mod
54
55
56
57#include "implicit_f.inc"
58
59
60
61#include "mvsiz_p.inc"
62
63
64
65#include "com08_c.inc"
66#include "param_c.inc"
67#include "scr05_c.inc"
68
69
70
71 INTEGER, INTENT(IN) :: JSMS
72 INTEGER, INTENT(IN) :: JTUR
73 INTEGER, INTENT(IN) :: ITY
74 INTEGER, INTENT(IN) :: JTHE
75 INTEGER, INTENT(IN) :: ISMSTR
76 INTEGER, INTENT(IN) :: JSPH,NPG
77
78 INTEGER NEL
80 . pm(npropm,*), sig(nel,6), rho(mvsiz),
81 . d1(*), d2(*), d3(*), d4(*),d5(*), d6(*),
82 . bpreld(nel,*), off(*)
83 INTEGER NELTST,ITYPTST,PID(*),G_DT
84 INTEGER MAT(*),NGL(*),IPM(NPROPMI,*)
86 . dt2t
87
89 . eint(*), qold(*),
90 . vol0(*),stifn(*), offg(*),geo(npropg,*),mumax(*)
92 . vnew(*), vd2(*), deltax(*), ssp(*), aire(*), vis(*),
93 . psh(*), pnew(*),qnew(*) ,ssp_eq(*), dvol(*),
94 . sold1(*), sold2(*), sold3(*), sold4(*), sold5(*), sold6(*),
95 . mssa(*), dmels(*),conde(*),amu(*),vol_avg(*),
dtel(*),
96 . rhoref(*) ,rhosp(*)
97 DOUBLE PRECISION VOL0DP(*)
98 type (glob_therm_) ,intent(inout) :: glob_therm
99
100
101
102 INTEGER I, MX,IBID
104 . reduc ,reduc1 , t1, t2 , ee, nu, ggt, treps, p, tp
106 . c1(mvsiz), lmbd(mvsiz), gg(mvsiz),
107 . rho0(mvsiz), rho0_1,c1_1
108
110 . df,dpdm,facq0,
111 . e1, e2, e3, e4, e5, e6, einc,
112 . bid1, bid2, bid3, dta, ym, dpdmp
113
114 facq0 = one
115 reduc1 = em04
116
117 DO i=1,nel
118 t1 = bpreld(i,1)+zep4*(bpreld(i,2)-bpreld(i,1))
119 t2 = bpreld(i,1)+zep7*(bpreld(i,2)-bpreld(i,1))
120 reduc = reduc1
121 tp = tt-t1
122 IF(tp > zero ) THEN
123 reduc =
min(reduc1*(one-tp/(t2-t1))+tp/(t2-t1), one)
124 ENDIF
125
126 mx = mat(i)
127 rho0_1 = pm(1, mx)
128 nu = pm(21, mx)
129 ee = pm(20, mx)*reduc
130 gg(i) = pm(22, mx)*reduc
131 c1_1 = pm(32, mx)
132 lmbd(i) = dt1*ee*nu/((one+nu)*(one-two*nu))
133 c1(i) = c1_1*reduc
134 rho0(i) =rho0_1
135
136
137 ssp(i)=sqrt((onep333*pm(22, mx)+c1_1)/rho0(i))
138 ENDDO
139
140 IF (jsph==0)THEN
142 1 pm, off, rho, bid1,
143 2 bid2, ssp, bid3, stifn,
144 3 dt2t, neltst, ityptst, aire,
145 4 offg, geo, pid, vnew,
146 5 vd2, deltax, vis, d1,
147 6 d2, d3, pnew, psh,
148 7 mat, ngl, qnew, ssp_eq,
149 8 vol0, mssa, dmels, ibid,
150 9 facq0, conde,
dtel, g_dt,
151 a ipm, rhoref, rhosp, nel,
152 b ity, ismstr, jtur, jthe,
153 c jsms, npg , glob_therm)
154 ELSE
156 1 pm, off, rho, bid1,
157 2 bid2, bid3, stifn, dt2t,
158 3 neltst, ityptst, offg, geo,
159 4 pid, mumax, ssp, vnew,
160 5 vd2, deltax, vis, d1,
161 6 d2, d3, pnew, psh,
162 7 mat, ngl, qnew, ssp_eq,
163 8 g_dt,
dtel, nel, ity,
164 9 jtur, jthe)
165 ENDIF
166
167 dta =half*dt1
168
169 DO i=1,nel
170 pnew(i) = c1(i)*amu(i)
171 treps = d1(i)+d2(i)+d3(i)
172 ggt = dt1*gg(i)
173 sig(i,1) = sig(i,1)+two*ggt*d1(i)+lmbd(i)*treps
174 sig(i,2) = sig(i,2)+two*ggt*d2(i)+lmbd(i)*treps
175 sig(i,3) = sig(i,3)+two*ggt*d3(i)+lmbd(i)*treps
176 sig(i,4) = sig(i,4)+ggt*d4(i)
177 sig(i,5) = sig(i,5)+ggt*d5(i)
178 sig(i,6) = sig(i,6)+ggt*d6(i)
179 qold(i) = qnew(i)
180 ENDDO
181
182
183
184
185
186
187
188 IF(ismstr == 1)THEN
189 IF(iresp==0)THEN
190 DO i=1,nel
191 IF(tt >= (bpreld(i,2)-two*dt1)) THEN
192 p = -third*(sig(i,1)+sig(i,2)+sig(i,3))
193 rho(i)=rho0_1*(one+p/c1_1)
194
195
196 ENDIF
197 ENDDO
198 ELSE
199 DO i=1,nel
200 IF(tt >= (bpreld(i,2)-two*dt1)) THEN
201 p = -third*(sig(i,1)+sig(i,2)+sig(i,3))
202 rho(i)=rho0_1*(one+p/c1_1)
203 vol0dp(i) = vol0(i)*(one+p/c1_1)
204
205 ENDIF
206 ENDDO
207 END IF
208 ELSEIF(ismstr==2)THEN
209 IF(iresp==0)THEN
210 DO i=1,nel
211 IF(offg(i) > one)THEN
212 IF(tt >= (bpreld(i,2)-two*dt1)) THEN
213 p = -third*(sig(i,1)+sig(i,2)+sig(i,3))
214 rho(i)=rho0_1*(one+p/c1_1)
215
216
217 ENDIF
218 ELSE
219 p = -third*(sig(i,1)+sig(i,2)+sig(i,3))
220 vol0(i) = vnew(i)*(one+p/c1_1)
221 rho(i) = rho0_1*vol0(i)/vnew(i)
222
223
224 END IF
225 ENDDO
226 ELSE
227 DO i=1,nel
228 IF(offg(i) > one)THEN
229 IF(tt >= (bpreld(i,2)-two*dt1)) THEN
230 p = -third*(sig(i,1)+sig(i,2)+sig(i,3))
231 rho(i) = rho0_1*(one+p/c1_1)
232 vol0dp(i) = vol0(i)*(one+p/c1_1)
233
234 ENDIF
235 ELSE
236 p = -third*(sig(i,1)+sig(i,2)+sig(i,3))
237 vol0(i) = vnew(i)*(one+p/c1_1)
238 vol0dp(i) = vol0(i)
239
240 rho(i) = rho0_1*vol0(i)/vnew(i)
241 END IF
242 ENDDO
243 END IF
244 ELSEIF(ismstr<=4)THEN
245 IF(iresp==0)THEN
246 DO i=1,nel
247 p = -third*(sig(i,1)+sig(i,2)+sig(i,3))
248 vol0(i)=vnew(i)*(one+p/c1_1)
249 rho(i)= rho0_1*vol0(i)/vnew(i)
250
251 ENDDO
252 ELSE
253 DO i=1,nel
254 p = -third*(sig(i,1)+sig(i,2)+sig(i,3))
255 vol0(i) = vnew(i)*(one+p/c1_1)
256 rho(i) = rho0_1*vol0(i)/vnew(i)
257 vol0dp(i) = vol0(i)
258
259 ENDDO
260 END IF
261 END IF
262
263 DO i=1,nel
264 e1=d1(i)*(sold1(i)+sig(i,1))
265 e2=d2(i)*(sold2(i)+sig(i,2))
266 e3=d3(i)*(sold3(i)+sig(i,3))
267 e4=d4(i)*(sold4(i)+sig(i,4))
268 e5=d5(i)*(sold5(i)+sig(i,5))
269 e6=d6(i)*(sold6(i)+sig(i,6))
270 einc= zero
271 eint(i)=(eint(i)+einc*off(i)) /
max(em15,vol0(i))
272 ENDDO
273
274 RETURN
subroutine dtel(ssp, pm, geo, pid, mat, rho0, vis, deltax, aire, vol, dtx)
subroutine mdtsph(pm, off, rho, rk, t, re, sti, dt2t, neltst, ityptst, offg, geo, pid, mumax, ssp, vol, vd2, deltax, vis, d1, d2, d3, pnew, psh, mat, ngl, qvis, ssp_eq, g_dt, dtsph, nel, ity, jtur, jthe)
subroutine mqviscb(pm, off, rho, rk, temp, ssp, re, sti, dt2t, neltst, ityptst, aire, offg, geo, pid, vol, vd2, deltax, vis, d1, d2, d3, pnew, psh, mat, ngl, qvis, ssp_eq, vol0, mssa, dmels, igeo, facq0, conde, dtel, g_dt, ipm, rhoref, rhosp, nel, ity, ismstr, jtur, jthe, jsms, npg, glob_therm)