32
33
34
35
36
37
38
39#include "implicit_f.inc"
40
41
42
43#include "mvsiz_p.inc"
44
45
46
47#include "vect01_c.inc"
48#include "param_c.inc"
49
50
51
52 my_real,
INTENT(IN) :: pm(npropm, *), geo(npropg, *), aire(*), vol(*)
53 my_real,
INTENT(INOUT) :: dtx(*)
54 my_real,
INTENT(IN),
DIMENSION(:),
TARGET :: bufmat(*), deltax(*)
55 INTEGER, INTENT(IN) :: PID(*),MAT(*),IPM(NPROPMI, *)
56
57
58
59 INTEGER :: I, MX, IADBUF,IFLG(MVSIZ)
60 my_real,
DIMENSION(:),
POINTER :: uparam
61
63 . ssp(mvsiz) , dpdm(mvsiz) , rho0(mvsiz) ,
64 . bulk , c1 , p ,
65 . mas(mvsiz), mu1p1(mvsiz),mu1p2(mvsiz),rho1(mvsiz),rho2(mvsiz),
66 . gam,rho10,rho20,p0,vfrac1,vfrac2,uvar1,a1,r1,visa1,visb1,visa2,visb2,
67 . b1,b2,mas1,mas2,ssp1,ssp2,vis(mvsiz),a
68
69 INTEGER ISOLVER,NUPARAM
70
71
72
73
74
75
76
77 iadbuf = ipm(7,mat(1))
78 nuparam = ipm(9,mat(1))
79 uparam =>bufmat(iadbuf:iadbuf+nuparam-1)
80 isolver = uparam(17)
81 a1 = uparam(10)
82 rho10 = uparam(11)
83 rho20 = uparam(12)
84 r1 = uparam(6)
85 gam = uparam(5)
86 p0 = uparam(9)
87 c1 = uparam(4)
88 visa1 = uparam(1)
89 visb1 = uparam(3)
90 visa2 = uparam(13)
91 visb2 = uparam(15)
92
93 DO i=lft,llt
94 rho0(i)= rho10 * a1 + (one-a1)*rho20
95 mas(i)= rho0(i)*vol(i)
96 ENDDO
97
98 DO i=lft,llt
99 IF(gam*c1>=em30)THEN
100 rho1(i) = rho10
101 rho2(i) = rho20
102 ENDIF
103 ENDDO
104
105 IF (isolver==2) THEN
106 DO i=lft,llt
107 mas1 = a1 * vol(i)
108 IF (a1 < em10)THEN
109 mas1=zero
110 vfrac1=zero
111 vfrac2=one
112 ENDIF
113 IF (one-a1 < em10)THEN
114 mas2=zero
115 rho1=mas(i)/vol(i)
116 vfrac1=one
117 vfrac2=zero
118 ENDIF
119 a = (rho0(i)-rho2(i))/(rho1(i)-rho2(i))
120 vfrac1=a
121 IF(vfrac1<em20)vfrac1=zero
122 vfrac2 = one-vfrac1
123 ssp1=c1
124 ssp2=gam*p0*(rho2(i)/rho20)**gam
125 uvar1=a*rho1(i)
126 IF(ssp1>zero)THEN
127 ssp1 = vfrac1 / ssp1
128 ELSE
129 ssp1=zero
130 ENDIF
131 IF(ssp2>zero)THEN
132 ssp2 = vfrac2 / ssp2
133 ELSE
134 ssp2=zero
135 ENDIF
136 ssp(i) = ssp1 + ssp2
137 ssp(i) = sqrt(one / ssp(i) / rho0(i))
138 b1=uvar1
139 b2=rho0(i)-b1
140 vis(i)=(b1*rho1(i)*visa1 + b2*rho2(i)*visa2)/rho0(i)
141
142 ENDDO
143 ELSE
144 DO i=lft,llt
145 ssp(i)=sqrt(r1)
146 vis(i)=zero
147 ENDDO
148 ENDIF
149
150
151
152
153
154 IF(jsph==0)THEN
155 CALL dtel(ssp,pm,geo,pid,mat, rho0, vis, deltax, aire, vol, dtx)
156 ELSE
157 CALL dtsph(ssp,pm,geo,pid,mat, rho0, vis, deltax, vol, dtx)
158 ENDIF
159
160 RETURN
subroutine dtel(ssp, pm, geo, pid, mat, rho0, vis, deltax, aire, vol, dtx)
subroutine dtsph(ssp, pm, geo, pid, mat, rho0, vis, deltax, vol, dtx)