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
55 INTEGER, INTENT(IN) :: PID(*),MAT(*),IPM(NPROPMI, *)
56
57
58
59 INTEGER :: I, MX, IADBUF,IFLG(MVSIZ), BIJ(
60DIMENSION(:),POINTER :: uparam
61
63 . ssp(mvsiz) , dpdm(mvsiz) , rho0(mvsiz) , g(mvsiz) ,
64 . bulk(mvsiz) , c1(mvsiz) , g43(mvsiz) , p
65 . av1(mvsiz) , av2(mvsiz) , av3(mvsiz) , av4(mvsiz) ,
66 . rho10(mvsiz), rho20(mvsiz), rho30(mvsiz), rho40(mvsiz),
67 . c01(mvsiz) , c02(mvsiz) , c03(mvsiz) , c04(mvsiz) ,
68 . c11(mvsiz) , c12(mvsiz) , c13(mvsiz) , c14(mvsiz) ,
69 . c21(mvsiz) , c22(mvsiz) , c23(mvsiz) , c24(mvsiz) ,
70 . c31(mvsiz) , c32(mvsiz) , c33(mvsiz) , c34(mvsiz) ,
71 . c41(mvsiz) , c42(mvsiz) , c43(mvsiz) , c44(mvsiz) ,
72 . c51(mvsiz) , c52(mvsiz) , c53(mvsiz) , c54(mvsiz) ,
73 . g1(mvsiz) , g2(mvsiz) , g3(mvsiz) , g4(mvsiz) ,
74 . e01(mvsiz) , e02(mvsiz) , e03(mvsiz) , e04(mvsiz) ,
75 . pm1(mvsiz) , pm2(mvsiz) , pm3(mvsiz) , pm4(mvsiz)
76 . dpdm1(mvsiz), dpdm2(mvsiz), dpdm3(mvsiz), dpdm4(mvsiz),
77 . pext , pfar , vdet(mvsiz) ,
78 . ssp1(mvsiz) , ssp2(mvsiz) , ssp3(mvsiz) , ssp4(mvsiz),
79 . vis(mvsiz) , rho0_bak(mvsiz)
80
81 INTEGER :: IAV(4),IRHO(4)
82
83
84
85 iav(1:4) = (/ 4,5,6,46 /)
86 irho(1:4) = (/ 9,10,11,47 /)
87
88
89
90 iflg(1) = zero
91 DO i=1,llt
92 iadbuf = ipm(7,mat(i))
93 uparam =>bufmat(iadbuf:iadbuf+280)
94 bij(1:4) = uparam(277:280)
95 av1(i) = uparam(iav(bij(1)))
96 av2(i) = uparam(iav(bij(2)))
97 av3(i) = uparam(iav(bij(3)))
98 av4(i) = uparam(iav(bij(4)))
99 pfar = uparam(07)
100 pext = uparam(08)
101 rho10(i) = uparam(irho(bij(1)))
102 rho20(i) = uparam(irho(bij(2)))
103 rho30(i) = uparam(irho(bij(3)))
104 rho40(i) = uparam(irho(bij(4)))
105 c11(i) = uparam(12)
106 c12(i) = uparam(13)
107 c13(i) = uparam(14)
108 c14(i) = zero
109 c21(i) = uparam(15)
110 c22(i) = uparam(16)
111 c23(i) = uparam(17)
112 c24(i) = zero
113 c31(i) = uparam(18)
114 c32(i) = uparam(20)
115 c33(i) = uparam(21)
116 c34(i) = zero
117 c41(i) = uparam(22)
118 c42(i) = uparam(23)
119 c43(i) = uparam(24)
120 c44(i) = zero
121 c51(i) = uparam(25)
122 c52(i) = uparam(26)
123 c53(i) = uparam(27)
124 c54(i) = zero
125 g1(i) = uparam(28)*two_third
126 g2(i) = uparam(29)*two_third
127 g3(i) = uparam(30)*two_third
128 g4(i) = zero
129 iflg(i) = uparam(31)
130 e01(i) = uparam(32)
131 e02(i) = uparam(33)
132 e03(i) = uparam(34)
133 e04(i) = uparam(48)
134 c01(i) = uparam(35)
135 c02(i) = uparam(36)
136 c03(i) = uparam(37)
137 c04(i) = uparam(49)
138 pm1(i) = uparam(39)
139 pm2(i) = uparam(40)
140 pm3(i) = uparam(41)
141 pm4(i) = uparam(56)
142 vdet(i) = uparam(42)
143 vis(i) = zero
144 enddo
145
146 IF (iflg(1) == 6) THEN
147 DO i=lft,llt
148 dtx(i)=ep20
149 ENDDO
150 RETURN
151 ENDIF
152
153 DO i=lft,llt
154
155 IF(av1(i)>zero .AND. rho10(i) > zero) THEN
156 dpdm1(i) = c11(i)+c51(i)*e01(i)+c41(i)*(c01(i)+c41(i)*e01(i))
157 dpdm1(i) = g1(i) +
max(dpdm1(i), c11(i))
158 ELSE
159 dpdm1(i) = zero
160 ENDIF
161
162 IF(av2(i)>zero .AND. rho20(i) > zero) THEN
163 dpdm2(i) = c12(i)+c52(i)*e02(i)+c42(i)*(c02(i)+c42(i)*e02(i))
164 dpdm2(i) = g2(i) +
max(dpdm2(i), c12(i))
165 ELSE
166 dpdm2(i) = zero
167 ENDIF
168
169 IF(av3(i)>zero .AND. rho30(i) > zero) THEN
170 dpdm3(i) = c13(i)+c53(i)*e03(i)+c43(i)*(c03(i)+c43(i)*e03(i))
171 dpdm3(i) = g3(i) +
max(dpdm3(i), c13(i))
172 ELSE
173 dpdm3(i) = zero
174 ENDIF
175 enddo
176
177 DO i=lft,llt
178
179 IF(av1(i)>zero) THEN
180 ssp1(i) = sqrt(abs(dpdm1(i))/rho10(i))
181 ELSE
182 ssp1(i) = zero
183 ENDIF
184
185 IF(av2(i)>zero) THEN
186 ssp2(i)=sqrt(abs(dpdm2(i))/rho20(i))
187 ELSE
188 ssp2(i)=zero
189 ENDIF
190
191 IF(av3(i)>zero) THEN
192 ssp3(i)=sqrt(abs(dpdm3(i))/rho30(i))
193 ELSE
194 ssp3(i)=zero
195 ENDIF
196
197 IF(av4(i)>zero) THEN
198 ssp4(i)=vdet(i)
199 ELSE
200 ssp4(i)=zero
201 ENDIF
202 END do
203
204 DO i=lft,llt
205 rho0(i) = av1(i)*rho10(i) + av2(i)*rho20(i) + av3(i)*rho30(i) + av4(i)*rho40(i)
206 ENDDO
207
208 DO i=lft,llt
209 bulk(i) = av1(i)*rho10(i)*ssp1(i)**2
210 . + av2(i)*rho20(i)*ssp2(i)**2
211 . + av3(i)*rho30(i)*ssp3(i)**2
212 . + av4(i)*rho40(i)*ssp4(i)**2
213 IF (rho0(i) > zero) THEN
214 ssp(i) = sqrt(bulk(i)/rho0(i))
215 rho0_bak(i)=rho0(i)
216 ELSE
217 ssp(i) = em20
218 rho0_bak(i)=em20
219 ENDIF
220 enddo
221
222
223
224
225 IF(jsph==0)THEN
226 CALL dtel(ssp,pm,geo,pid,mat, rho0_bak, vis, deltax, aire, vol
227 ELSE
228 CALL dtsph(ssp,pm,geo,pid,mat, rho0_bak, vis, deltax, vol, dtx)
229 ENDIF
230
231 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)