39 SUBROUTINE m5in2(PM,MAT,M151_ID,DETONATORS,TB,X,IX,NIX)
49#include "implicit_f.inc"
59#include "vect01_c.inc"
66 INTEGER MAT(*),NIX,IX(NIX,*)
67 INTEGER,
INTENT(IN) :: M151_ID
68 my_real pm(npropm,nummat), tb(*),x(3,*),vdet2
73 INTEGER I, N, MTL, MT, IOPT
74 INTEGER NDETPS,NDETSG,,NDETPL,NDETCORD,NPE,NPE2,NDETPS_NO_SHADOW,NDETPS_SHADOW
75 LOGICAL HAS_DETONATOR(MVSIZ)
77 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
78 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
79 . xc(mvsiz), yc(mvsiz), zc(mvsiz), bt(mvsiz),
80 . dl(mvsiz), alt, xlp, ylp, zlp, xlp1,
81 . ylp1, zlp1, xlp2, ylp2, zlp2, xl0, yl0, zl0, xl1, yl1, zl1,
82 . xl2, yl2, zl2, ps1, ps2, dl1, dl2, s1, s2, s3,
83 . nx, ny, nz , nn, vdet
84 INTEGER :: NODE1, NODE2, NODE3, NODE4, II, GRNOD_ID, INOD, NNOD, NODE_ID
85 INTEGER :: I_SHADOW_FLAG
88 ndetps = detonators%N_DET_POINT
89 ndetsg = detonators%N_DET_LINE
90 necran = detonators%N_DET_WAVE_SHAPER
91 ndetpl = detonators%N_DET_PLANE
92 ndetcord = detonators%N_DET_CORD
97 DO i = 1, detonators%N_DET_POINT
98 i_shadow_flag = detonators%POINT(i)%SHADOW
99 IF(i_shadow_flag == 0)
THEN
100 ndetps_no_shadow = ndetps_no_shadow + 1
102 ndetps_shadow = ndetps_shadow + 1
108 IF(detonators%N_DET - ndetps_shadow > 0)
THEN
131 has_detonator(i)=.false.
133 yc(i)=fourth*(y1(i)+y2(i)+y3(i)+y4(i))
134 zc(i)=fourth*(z1(i)+z2(i)+z3(i)+z4(i))
143 i_shadow_flag = detonators%POINT(n)%SHADOW
144 IF(i_shadow_flag /= 0)cycle
145 mtl=detonators%POINT(n)%MAT
146 grnod_id=detonators%POINT(n)%GRNOD_ID
147 IF(mtl == 0 .OR. mtl == mat(i) .OR. mtl == m151_id)
THEN
149 IF(grnod_id == 0)
THEN
150 alt=detonators%POINT(n)%TDET
151 xlp=detonators%POINT(n)%XDET
152 ylp=detonators%POINT(n)%YDET
153 zlp=detonators%POINT(n)%ZDET
154 dl(i) =(xc(i)-xlp)**2+(yc(i)-ylp)**2+(zc(i)-zlp)**2
156 bt(i) =alt+dl(i)/pm(38,mat(i))
157 IF(bt(i) < abs(tb(i))) tb(i)=-bt(i)
158 has_detonator(i)=.true.
161 nnod = detonators%POINT(n)%NNOD
162 alt=detonators%POINT(n)%TDET
163 has_detonator(i)=.true.
165 node_id=detonators%POINT(n)%NODLIST(inod)
169 dl(i) =(xc(i)-xlp)**2+(yc(i)-ylp)**2+(zc(i)-zlp)**2
171 bt(i) =alt+dl(i)/pm(38,mat(i))
172 IF(bt(i) < abs(tb(i))) tb(i)=-bt(i)
185 alt=detonators%LINE(n)%TDET
186 mtl=detonators%LINE(n)%MAT
187 xlp1=detonators%LINE(n)%XDET_1
188 ylp1=detonators%LINE(n)%YDET_1
189 zlp1=detonators%LINE(n)%ZDET_1
190 xlp2=detonators%LINE(n)%XDET_2
191 ylp2=detonators%LINE(n)%YDET_2
192 zlp2=detonators%LINE(n)%ZDET_2
194 IF(mtl == 0 .OR. mtl == mat(i) .OR. mtl == m151_id)
THEN
204 ps1 =xl1*xl0+yl1*yl0+zl1*zl0
205 ps2 =xl2*xl0+yl2*yl0+zl2*zl0
206 IF(ps1*ps2 > zero)
THEN
207 dl1 =sqrt(xl1**2+yl1**2+zl1**2)
208 dl2 =sqrt(xl2**2+yl2**2+zl2**2)
211 s1 =yl1*zl0 - zl1*yl0
212 s2 =zl1*xl0 - xl1*zl0
213 s3 =xl1*yl0 - yl1*xl0
214 dl(i)=sqrt((s1**2+s2**2+s3**2)/(xl0**2+yl0**2+zl0**2))
216 bt(i)=alt+dl(i)/pm(38,mat(i))
217 IF(bt(i) < abs(tb(i))) tb(i)=-bt(i)
218 has_detonator(i)= .true.
229 alt=detonators%WAVE_SHAPER(n)%TDET
230 mtl=detonators%WAVE_SHAPER(n)%MAT
231 vdet =detonators%WAVE_SHAPER(n)%VDET
232 yd =detonators%WAVE_SHAPER(n)%YDET
233 zd =detonators%WAVE_SHAPER(n)%ZDET
234 npe=detonators%WAVE_SHAPER(n)%NUMNOD
237 IF(vdet == zero)vdet=pm(38,mat(1))
239 CALL ecran1(detonators%WAVE_SHAPER(n),x,vdet)
242 IF(mtl /= mat(i) .AND. mtl /= 0 .AND. mtl /= m151_id) cycle
243 yd =detonators%WAVE_SHAPER(n)%YDET
244 zd =detonators%WAVE_SHAPER(n)%ZDET
248 CALL ecran2(detonators%WAVE_SHAPER(n),x,vdet)
250 IF(bt(i) < abs(tb(i))) tb(i)=-bt(i)
251 has_detonator(i)= .true.
261 alt=detonators%PLANE(n)%TDET
262 mtl=detonators%PLANE(n)%MAT
263 xlp=detonators%PLANE(n)%XDET
264 ylp=detonators%PLANE(n)%YDET
265 zlp=detonators%PLANE(n)%ZDET
266 nx=detonators%PLANE(n)%NX
267 ny=detonators%PLANE(n)%NY
268 nz=detonators%PLANE(n)%NZ
269 nn=sqrt(nx**2+ny**2+nz**2)
271 dl1=xlp*nx + ylp*ny + zlp*nz
274 IF(mtl == 0 .OR. mtl == mat(i) .OR. mtl == m151_id)
THEN
279 dl(i) = (xc(i)-xlp)*nx + (yc(i)-ylp)*ny + (zc(i)-zlp)*nz
282 bt(i) =alt+dl(i)/pm(38,mat(i))
283 IF(bt(i) < abs(tb(i))) tb(i)=-bt(i)
284 has_detonator(i)=.true.
293 IF(ndetcord /= 0)
THEN
295 alt = detonators%CORD(n)%TDET
296 mtl = detonators%CORD(n)%MAT
297 vdet2 = detonators%CORD(n)%VDET
298 iopt = detonators%CORD(n)%IOPT
299 npe2 = detonators%CORD(n)%NUMNOD
304 IF(mtl /= mat(1) .AND. mtl /= 0 .AND. mtl /= m151_id) cycle
306 CALL detcord(detonators%CORD(n),x,xc,yc,zc,vdto,vdet2,alt,bt,tb,has_detonator,iopt)