34 1 ELBUF_TAB, IXS, BUFMAT , IPARG, IPM,
35 2 IDLOC , NG , brickID, VOL
55 use element_mod ,
only : nixs
59#include "implicit_f.inc"
70 INTEGER,
INTENT(IN) :: IDLOC,IPARG(NPARG,*), NG, IXS(NIXS,NUMELS), brickID
71TYPE(BUF_MAT_) ,
POINTER :: MBUF
72 my_real,
INTENT(IN),
TARGET :: bufmat(*)
73 TYPE(g_bufel_) ,
POINTER :: GBUF
74 TYPE(l_bufel_) ,
POINTER :: LBUF
75 TYPE(elbuf_struct_),
TARGET,
DIMENSION(NGROUP) :: ELBUF_TAB
87 INTEGER NITER, ITER,MT, LLT_, IADBUF
89 . SSP,C1,R1,PMIN,RHO10,RHO20,
90 . rho1,rho2, p,gam,p0,
91 . tol, mas, mas1, mas2,
92 . error, p1,p2,f1,f2,df11,df12,df21
93 . psh, ssp1, ssp2, rho, uvar(5)
102 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
103 gbuf => elbuf_tab(ng)%GBUF
104 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
108 uvar(1) = mbuf%VAR((0*llt_ + idloc))
109 uvar(2) = mbuf%VAR((1*llt_ + idloc))
110 uvar(3) = mbuf%VAR((2*llt_ + idloc))
111 uvar(4) = mbuf%VAR((3*llt_ + idloc))
112 uvar(5) = mbuf%VAR((4*llt_ + idloc))
117 rho10 = bufmat(iadbuf-1+11)
118 rho20 = bufmat(iadbuf-1+12)
119 r1 = bufmat(iadbuf-1+06)
120 p0 = bufmat(iadbuf-1+09)
121 gam = bufmat(iadbuf-1+05)
122 c1 = bufmat(iadbuf-1+04)
123 pmin = bufmat(iadbuf-1+08)
124 psh = bufmat(iadbuf-1+16)
126 rho = gbuf%RHO(idloc)
128 uvar(1) = mbuf%VAR((1-1)*llt_ +idloc)
129 uvar(2) = mbuf%VAR((2-1)*llt_ +idloc)
130 uvar(3) = mbuf%VAR((3-1)*llt_ +idloc)
131 uvar(4) = mbuf%VAR((4-1)*llt_ +idloc)
132 uvar(5) = mbuf%VAR((5-1)*llt_ +idloc)
156 IF (mas1 / mas < em10)
THEN
163 p = p0 * (rho2/rho20)**gam
164 ELSEIF (mas2 / mas < em10)
THEN
171 p = r1 * rho1 - c1 + p0
175 DO WHILE(iter < niter .AND. error > tol)
176 p1 = r1 * rho1 - c1 + p0
177 p2 = p0 * (rho2/rho20)**gam
178 f1 = mas1 / rho1 + mas2 / rho2 - vol
180 df11 = - mas1 / (rho1 * rho1)
181 df12 = - mas2 / (rho2 * rho2)
183 df22 = - gam * p0 / (rho20**gam) * rho2**(gam - one)
184 det = df11 * df22 - df12 * df21
185 drho1 = (-df22 * f1 + df12 * f2) / det
186 drho2 = (df21 * f1 - df11 * f2) / det
187 drho1 =
min(three * rho1,
max(drho1, - half * rho1))
188 drho2 =
min(three * rho2,
max(drho2, - half * rho2))
191 error = abs(drho1 / rho1) + abs
194 IF (abs(p1 - p2) > 1.d-5)
THEN
197 IF (error > tol)
THEN
198 print*,
"*** WARNING LAW37, convergence tol. ", error, tol
200 p = r1 * rho1 - c1 + p0
203 ssp2 = gam * p0 * (rho2/rho20)**gam
208 uvar(4) = uvar(1)/rho1
209 IF(uvar(4)<em20)uvar(4)=zero
210 uvar(5) = one-uvar(4)
211 IF (ssp1 > zero)
THEN
212 ssp1 = uvar(4) / ssp1
216 IF (ssp2 > zero)
THEN
217 ssp2 = uvar(5) / ssp2
222 ssp = sqrt(one / ssp / rho)
224 p =
max(pmin, p) + psh
226 uvar(1) =
max(zero, uvar(1))
227 uvar(2) =
max(zero, uvar(2))
228 uvar(3) =
max(zero, uvar(3))
229 uvar(4) =
max(zero, uvar(4))
234 mbuf%VAR((1-1)*llt_ +idloc) = uvar(1)
235 mbuf%VAR((2-1)*llt_ +idloc) = uvar(2)
236 mbuf%VAR((3-1)*llt_ +idloc) = uvar
237 mbuf%VAR((4-1)*llt_ +idloc) = uvar(4)
238 mbuf%VAR((5-1)*llt_ +idloc) = uvar(5)
253 lbuf%SSP(idloc) = ssp ;