36
39
40
41
42#include "implicit_f.inc"
43
44
45
48 TYPE(DETONATOR_WAVE_SHAPER_STRUCT_),TARGET :: DETONATOR
49
50
51
52#include "scr11_c.inc"
53#include "com04_c.inc"
54
55
56
57 INTEGER I, II, J, JJ, JJJ,NPE
59 INTEGER,POINTER,DIMENSION(:) :: IECR, IORDR, IFLG
60 my_real,
POINTER,
DIMENSION(:) :: dtime
61
62
63
64 INTEGER,EXTERNAL :: IOMBR
65
66
67 npe=detonator%NUMNOD
68 iecr => detonator%NODES(1:)
69 iordr => detonator%IORDR(1:)
70 iflg => detonator%FLAG(1:)
71 dtime => detonator%TIME(1:)
72
73
74
75
76
77
78
79
80 dtomin=ep20
81 iordr(1)=0
82
83 DO i=1,npe
84 ddmx =ep20
85 iflg(i)=0
86 ii=iecr(i)
87 yl=x(2,ii)
88 zl=x(3,ii)
89 IF(
iombr(detonator,x,iecr,ddmx,vdet) == 0)
THEN
90 dtime(i)=dto
91 IF(dtime(i) <= dtomin)THEN
92 iordr(1)=i
93 dtomin=dtime(i)
94 ENDIF
95 ELSE
96 dtime(i)=ep20
97 ENDIF
98 END DO
99
100 IF(iordr(1) == 0)THEN
102 . msgtype=msgerror,
103 . anmode=aninfo)
104 ENDIF
105
106
107
108
109 DO j=1,npe-1
110 jj=iordr(j)
111 jjj=iecr(jj)
112
113 yd=x(2,jjj)
114 zd=x(3,jjj)
115 dto0=dtime(jj)
116 iflg(jj)=1
117 dtomin=ep20
118 DO i=1,npe
119
120 IF(iflg(i) == 1)cycle
121 ddmx =ep20
122 ii=iecr(i)
123 yl=x(2,ii)
124 zl=x(3,ii)
125 IF(iabs(i-jj) == 1)THEN
126 d2 =(yd-yl)**2+(zd-zl)**2
127 dto=dto0+sqrt(d2)/vdto
128 dtime(i)=
min(dtime(i),dto)
129 ELSEIF(
iombr(detonator,x,iecr,ddmx,vdto) == 0)
THEN
130 dtime(i)=
min(dtime(i),dto)
131 ENDIF
132 IF(dtime(i) <= dtomin)THEN
133 iordr(j+1)=i
134 dtomin=dtime(i)
135 ENDIF
136 END DO
137 END DO
138
139 RETURN
integer function iombr(detonator_wave_shaper, x, iecr, ddmx, vdet_arg)
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)