33 1 ELBUF_TAB, IXS, BUFMAT , IPARG, IPM,
34 2 IDLOC , NG , brickID, VOL
57#include
"implicit_f.inc"
68 INTEGER,
INTENT(IN) :: IDLOC,IPARG(NPARG,*), NG, IXS(NIXS,NUMELS), brickID, IPM(NPROPMI,*)
69 TYPE(BUF_MAT_) ,
POINTER :: MBUF
70 my_real,
INTENT(IN),
TARGET :: bufmat(*)
71 TYPE(g_bufel_) ,
POINTER :: GBUF
72 TYPE(l_bufel_) ,
POINTER :: LBUF
73 TYPE(elbuf_struct_),
TARGET,
DIMENSION(NGROUP) ::
85 INTEGER NITER, ITER,MT, LLT_, IADBUF
87 . SSP,C1,R1,PMIN,RHO10,RHO20,
88 . rho1,rho2, p,gam,p0,
89 . tol, mas, mas1, mas2
90 . error, p1,p2,f1,f2,df11,df12,df21,df22,det,drho1,drho2,
91 . psh, ssp1, ssp2, rho, uvar(5)
100 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
101 gbuf => elbuf_tab(ng)%GBUF
102 lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
106 uvar(1) = mbuf%VAR((0*llt_ + idloc))
107 uvar(2) = mbuf%VAR((1*llt_ + idloc))
108 uvar(3) = mbuf%VAR((2*llt_ + idloc))
109 uvar(4) = mbuf%VAR((3*llt_ + idloc))
110 uvar(5) = mbuf%VAR((4*llt_ + idloc))
115 rho10 = bufmat(iadbuf-1+11)
116 rho20 = bufmat(iadbuf-1+12)
117 r1 = bufmat(iadbuf-1+06)
118 p0 = bufmat(iadbuf-1+09)
119 gam = bufmat(iadbuf-1+05)
120 c1 = bufmat(iadbuf-1+04)
121 pmin = bufmat(iadbuf-1+08)
122 psh = bufmat(iadbuf-1+16)
124 rho = gbuf%RHO(idloc)
126 uvar(1) = mbuf%VAR((1-1)*llt_ +idloc)
127 uvar(2) = mbuf%VAR((2-1)*llt_ +idloc)
128 uvar(3) = mbuf%VAR((3-1)*llt_ +idloc)
129 uvar(4) = mbuf%VAR((4-1)*llt_ +idloc)
130 uvar(5) = mbuf%VAR((5-1)*llt_ +idloc)
154 IF (mas1 / mas < em10)
THEN
161 p = p0 * (rho2/rho20)**gam
162 ELSEIF (mas2 / mas < em10)
THEN
169 p = r1 * rho1 - c1 + p0
173 DO WHILE(iter < niter .AND. error > tol)
174 p1 = r1 * rho1 - c1 + p0
175 p2 = p0 * (rho2/rho20)**gam
176 f1 = mas1 / rho1 + mas2 / rho2 - vol
178 df11 = - mas1 / (rho1 * rho1)
179 df12 = - mas2 / (rho2 * rho2)
181 df22 = - gam * p0 / (rho20**gam) * rho2**(gam - one)
182 det = df11 * df22 - df12 * df21
183 drho1 = (-df22 * f1 + df12 * f2) / det
184 drho2 = (df21 * f1 - df11 * f2) / det
185 drho1 =
min(three * rho1,
max(drho1, - half * rho1))
186 drho2 =
min(three * rho2,
max(drho2, - half * rho2))
189 error = abs(drho1 / rho1) + abs(drho2 / rho2)
192 IF (abs(p1 - p2) > 1.d-5)
THEN
195 IF (error > tol)
THEN
196 print*,
"*** WARNING LAW37, convergence tol. ", error, tol
198 p = r1 * rho1 - c1 + p0
201 ssp2 = gam * p0 * (rho2/rho20)**gam
206 uvar(4) = uvar(1)/rho1
207 IF(uvar(4)<em20)uvar(4)=zero
208 uvar(5) = one-uvar(4)
209 IF (ssp1 > zero)
THEN
210 ssp1 = uvar(4) / ssp1
214 IF (ssp2 > zero)
THEN
215 ssp2 = uvar(5) / ssp2
220 ssp = sqrt(one / ssp / rho)
222 p =
max(pmin, p) + psh
224 uvar(1) =
max(zero, uvar(1))
225 uvar(2) =
max(zero, uvar(2))
226 uvar(3) =
max(zero, uvar(3))
227 uvar(4) =
max(zero, uvar(4))
228 uvar(5) =
max(zero, uvar(5))
232 mbuf%VAR((1-1)*llt_ +idloc) = uvar(1)
233 mbuf%VAR((2-1)*llt_ +idloc) = uvar(2)
234 mbuf%VAR((3-1)*llt_ +idloc) = uvar(3)
235 mbuf%VAR((4-1)*llt_ +idloc) = uvar(4)
236 mbuf%VAR((5-1)*llt_ +idloc) = uvar(5)
251 lbuf%SSP(idloc) = ssp ;