58
59
60
61#include "implicit_f.inc"
62
63
64
65#include "mvsiz_p.inc"
66
67
68
69#include "com01_c.inc"
70#include "com04_c.inc"
71#include "scr06_c.inc"
72#include "units_c.inc"
73#include "vect07_c.inc"
74
75
76
77 INTEGER NMN, NRTM, NSN, NOINT,I_STOK,MULTIMP,IGAP,INACTI,
78 . NRTS,I_MEM, IDDLEVEL
79 INTEGER IRECT(4,*),IRECTS(4,*),NSV(*),MSR(*),NSEG(*),MWA(*)
80 INTEGER CAND_E(*),CAND_N(*),MAXSIZ
81 INTEGER ITAB(*)
82
84 . stf(*),x(3,*),xyzm(6,*),gap_s(*),
85 . dist,bumult,gap,tzinf,maxbox,minbox,gapmin,gapmax,
86 . margeref, gap_m(*)
87 INTEGER ID
88 CHARACTER(LEN=NCHARTITLE) :: TITR
89 INTEGER, DIMENSION(MVSIZ), INTENT(INOUT) :: PROV_N,PROV_E
90 INTEGER, DIMENSION(MVSIZ), INTENT(INOUT) :: IX1,IX2,IX3,IX4,NSVG
91 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: x1,x2,x3,x4
92 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: y1,y2,y3,y4
93 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: z1,z2,z3,z4
94 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: xi,yi,zi
95 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: x0,y0,z0
96 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: n11,n21,n31,pene
97 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: nx1,ny1,nz1
98 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: nx2,ny2,nz2
99 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: nx3,ny3,nz3
100 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: nx4,ny4,nz4
101 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: p1,p2,p3,p4
102 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: lb1,lb2,lb3,lb4
103 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: lc1,lc2,lc3,lc4
104
105
106
107 INTEGER I, J, L, N1, N2, N3, , I_AMAX
108 INTEGER I_ADD, ADESTK, NB_NC, NB_EC, ADNSTK, IBID
109 INTEGER IP1, IP2, IP21, IP22, IP31,J_STOK,I_BID,NB_N_B
110
112 . dx1,dy1,dz1,
113 . dx3,dy3,dz3,
114 . dx4,dy4,dz4,
115 . dx6,dy6,dz6,
116 . dd1,dd2,dd3,dd4,dd,dd0,xmin,ymin,zmin,tb,
117 . xmax,
ymax,zmax,minbox_st,maxbox_st,gapsmax,
118 . bid,tzinf_st,marge,marge_st,gapv(mvsiz),
119 . xmax_m,ymax_m,zmax_m,xmin_m,ymin_m,zmin_m,
120 . xmax_s,ymax_s,zmax_s,xmin_s,ymin_s,zmin_s
121
122
123
124
125
126
127 dd=zero
128 DO 10 l=1,nrtm
129
130 n1=irect(1,l)
131 n2=irect(2,l)
132 n3=irect(3,l)
133 n4=irect(4,l)
134
135 dx1=(x(1,n1)-x(1,n2))
136 dy1=(x(2,n1)-x(2,n2))
137 dz1=(x(3,n1)-x(3,n2))
138 dd1=sqrt(dx1**2+dy1**2+dz1**2)
139
140 dx3=(x(1,n1)-x(1,n4))
141 dy3=(x(2,n1)-x(2,n4))
142 dz3=(x(3,n1)-x(3,n4))
143 dd2=sqrt(dx3**2+dy3**2+dz3**2)
144
145 dx4=(x(1,n3)-x(1,n2))
146 dy4=(x(2,n3)-x(2,n2))
147 dz4=(x(3,n3)-x(3,n2))
148 dd3=sqrt(dx4**2+dy4**2+dz4**2)
149
150 dx6=(x(1,n4)-x(1,n3))
151 dy6=(x(2,n4)-x(2,n3))
152 dz6=(x(3,n4)-x(3,n3))
153 dd4=sqrt(dx6**2+dy6**2+dz6**2)
154 dd=dd+ (dd1+dd2+dd3+dd4)
155 10 CONTINUE
156
157
158 dd0= dd/nrtm/four
159 dd =
max(dd0,onep251*gap)
160
161 marge = sqrt(three)*bumult*dd
162
163 tzinf = marge + sqrt(three)*gap
164
165 marge_st = bmul0*sqrt(three)*dd
166
167 IF(iddlevel==0) marge_st = marge
168 tzinf_st = marge_st + sqrt(three)*gap
169
170
171
172 maxbox= half*(dd + 2*tzinf)
173 minbox= half*maxbox
174 maxbox_st= half*(dd + 2*tzinf_st)
175 minbox_st= half*maxbox_st
176
177 dist = zero
178
179
180
181
182 xmin_m=ep30
183 xmax_m=-ep30
184 ymin_m=ep30
185 ymax_m=-ep30
186 zmin_m=ep30
187 zmax_m=-ep30
188
189 DO 20 i=1,nmn
190 j=msr(i)
191 xmin_m=
min(xmin_m,x(1,j))
192 ymin_m=
min(ymin_m,x(2,j))
193 zmin_m=
min(zmin_m,x(3,j))
194 xmax_m=
max(xmax_m,x(1,j))
195 ymax_m=
max(ymax_m,x(2,j))
196 zmax_m=
max(zmax_m,x(3,j))
197 20 CONTINUE
198
199 xmin_s=ep30
200 xmax_s=-ep30
201 ymin_s=ep30
202 ymax_s=-ep30
203 zmin_s=ep30
204 zmax_s=-ep30
205
206 DO 25 i=1,nsn
207 j=nsv(i)
208 xmin_s=
min(xmin_s,x(1,j))
209 ymin_s=
min(ymin_s,x(2,j))
210 zmin_s=
min(zmin_s,x(3,j))
211 xmax_s=
max(xmax_s,x(1,j))
212 ymax_s=
max(ymax_s,x(2,j))
213 zmax_s=
max(zmax_s,x(3,j))
214 25 CONTINUE
215
216 xmin=
min(xmin_m-tzinf_st,xmin_s)
217 ymin=
min(ymin_m-tzinf_st,ymin_s)
218 zmin=
min(zmin_m-tzinf_st,zmin_s)
219 xmax=
max(xmax_m+tzinf_st,xmax_s)
220 ymax=
max(ymax_m+tzinf_st,ymax_s)
221 zmax=
max(zmax_m+tzinf_st,zmax_s)
222
223
224
225 nb_n_b = 1
226 i_mem = 0
227
228
229 100 CONTINUE
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251 maxsiz =
max(numnod,nrtm+100)
252 ip1 = 1
253 ip2 = ip1+maxsiz
254
255 ip21= ip2+3*maxsiz
256 ip22= ip21+numnod
257 ip31= ip22+numnod
258
259
260
261
262
263
264
265
266 mwa(ip31) = 0
267 mwa(ip31+1) = 0
268 mwa(ip31+2) = 0
269 mwa(ip31+3) = 0
270 i_add = 1
271 i_amax = 1
272 xyzm(1,i_add) = xmin
273 xyzm(2,i_add) = ymin
274 xyzm(3,i_add) = zmin
275 xyzm(4,i_add) = xmax
277 xyzm(6,i_add) = zmax
278 i_stok = 0
279 j_stok = 0
280 adnstk = 0
281 adestk = 0
282 nb_nc = nsn
283 nb_ec = nrtm
284
285
286
287 DO 120 i=1,nb_ec
288 mwa(ip1+i-1) = i
289 120 CONTINUE
290 DO 140 i=1,nb_nc
291 mwa(ip21+i-1) = i
292 140 CONTINUE
293
294
295
296
297
298 200 CONTINUE
299
300
302 1 mwa(ip1),mwa(ip2),mwa(ip21),mwa(ip22),mwa(ip31+2*(i_add-2)),
303 2 irect ,x ,nb_nc ,nb_ec ,xyzm,
304 3 i_add ,nsv ,i_amax ,xmax ,
ymax,
305 4 zmax ,3*maxsiz,i_stok ,i_mem ,nb_n_b,
306 5 cand_n ,cand_e ,nsn ,noint ,tzinf_st ,
307 6 maxbox_st,minbox_st,j_stok ,msr ,
308 7 multimp ,itab ,gap ,gap_s ,igap ,
309 8 gapmin ,gapmax ,marge_st,
id ,titr ,
310 9 gap_m ,prov_n,prov_e ,ix1,ix2,
311 1 ix3 ,ix4 ,nsvg ,x1 ,x2 ,
312 2 x3 ,x4 ,y1 ,y2 ,y3 ,
313 3 y4 ,z1 ,z2 ,z3 ,z4 ,
314 4 xi ,yi ,zi ,x0 ,y0 ,
315 5 z0 ,nx1 ,ny1 ,nz1,nx2,
316 6 ny2 ,nz2 ,nx3 ,ny3,nz3,
317 7 nx4 ,ny4 ,nz4 ,p1 ,p2 ,
318 8 p3 ,p4 ,lb1 ,lb2,lb3,
319 9 lb4 ,lc1 ,lc2 ,lc3,lc4,
320 1 n11 ,n21 ,n31 ,pene)
321
322
323 IF (i_mem == 2)THEN
324 RETURN
325 ENDIF
326
327
328 IF(i_mem==1)THEN
329 nb_n_b = nb_n_b + 1
330 i_mem = 0
331 GO TO 100
332 ELSE IF(i_mem==2) THEN
333 marge_st = three_over_4*marge_st
334 tzinf_st = marge_st + sqrt(three)*gap
335 i_mem = 0
336 IF(marge_st<em03) THEN
337
338
339
340 IF (istamping == 1) THEN
342 . msgtype=msgerror,
343 . anmode=aninfo,
345 . c1=titr)
346 ELSE
348 . msgtype=msgerror,
349 . anmode=aninfo,
351 . c1=titr)
352 ENDIF
353 ENDIF
354 GO TO 100
355 ENDIF
356 IF(i_add/=0) GO TO 200
357
358
359 IF(j_stok/=0)THEN
360 lft = 1
361 llt = j_stok
362
363 CALL i23cor3t(x ,irect ,nsv ,prov_e ,prov_n,
364 2 gapv ,igap ,gap ,gap_s ,gapmin ,
365 3 gapmax,msr ,gap_m,ix1 ,ix2 ,
366 4 ix3 ,ix4 ,nsvg ,x1 ,x2 ,
367 5 x3 ,x4 ,y1 ,y2 ,y3 ,
368 6 y4 ,z1 ,z2 ,z3 ,z4 ,
369 7 xi ,yi ,zi )
370
371 CALL i7dst3(ix3,ix4,x1 ,x2 ,x3 ,
372 1 x4 ,y1 ,y2 ,y3 ,y4 ,
373 2 z1 ,z2 ,z3 ,z4 ,xi ,
374 3 yi ,zi ,x0 ,y0 ,z0 ,
375 4 nx1,ny1,nz1,nx2,ny2,
376 5 nz2,nx3,ny3,nz3,nx4,
377 6 ny4,nz4,p1 ,p2 ,p3 ,
378 7 p4 ,lb1,lb2,lb3,lb4,
379 8 lc1,lc2,lc3,lc4,llt)
380
381 CALL i7pen3(marge_st,gapv,n11,n21,n31,
382 1 pene ,nx1 ,ny1,nz1,nx2,
383 2 ny2 ,nz2 ,nx3,ny3,nz3,
384 3 nx4 ,ny4 ,nz4,p1 ,p2 ,
385 4 p3 ,p4,llt)
386
387 IF(i_stok+j_stok<multimp*nsn) THEN
388 CALL i7cmp3(i_stok,cand_e ,cand_n,1,pene,
389 1 prov_n,prov_e)
390 ELSE
391 i_bid = 0
392 CALL i7cmp3(i_bid,cand_e,cand_n,0,pene,
393 1 prov_n,prov_e)
394 IF(i_stok+i_bid<multimp*nsn) THEN
395 CALL i7cmp3(i_stok,cand_e,cand_n,1,pene,
396 1 prov_n,prov_e)
397 ELSE
398 i_mem = 2
399 RETURN
400 marge_st = three_over_4*marge_st
401 tzinf_st = marge_st + gap
402
403
404
405 i_mem = 0
406 IF(marge_st<em03) THEN
407
408
409
410 IF (istamping == 1) THEN
412 . msgtype=msgerror,
413 . anmode=aninfo,
415 . c1=titr)
416 ELSE
418 . msgtype=msgerror,
419 . anmode=aninfo,
421 . c1=titr)
422 ENDIF
423 ENDIF
424 GO TO 100
425 ENDIF
426 ENDIF
427 ENDIF
428
429 IF(nsn/=0)THEN
430 WRITE(iout,*)' POSSIBLE IMPACT NUMBER:',i_stok,' (<=',
431 . 1+(I_STOK-1)/NSN,'*nsn)'
432
433 ELSE
434 CALL ANCMSG(MSGID=552,
435 . MSGTYPE=MSGWARNING,
436 . ANMODE=ANINFO_BLIND_2,
437 . I1=ID,
438 . C1=TITR)
439 ENDIF
440
441
442
443 DO I=1,NUMNOD
444 MWA(I)=0
445 ENDDO
446
447 RETURN
subroutine i23tri(bpe, pe, bpn, pn, add, irect, x, nb_nc, nb_ec, xyzm, i_add, nsv, i_amax, xmax, ymax, zmax, maxsiz, i_stok, i_mem, nb_n_b, cand_n, cand_e, nsn, noint, tzinf, maxbox, minbox, j_stok, msr, multimp, itab, gap, gap_s, igap, gapmin, gapmax, marge, id, titr, gap_m, prov_n, prov_e, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, x0, y0, z0, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, n11, n21, n31, pene)
subroutine i7cmp3(i_stok, cand_e, cand_n, iflag, pene, prov_n, prov_e)
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
integer, parameter nchartitle
subroutine i23cor3t(x, irect, nsv, cand_e, cand_n, gapv, igap, gap, gap_s, gapmin, gapmax, msr, gap_m, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi)
subroutine i7dst3(ix3, ix4, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, x0, y0, z0, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, last)
subroutine i7pen3(marge, gapv, n1, n2, n3, pene, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, last)
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)