38 1 X ,IRECT ,NSV ,BUMULT,NSEG ,
39 2 NMN ,NRTM ,MWA ,NSN ,CAND_E ,
40 3 CAND_N,GAP ,XYZM ,NOINT ,I_STOK ,
41 4 DIST ,TZINF,MAXBOX ,MINBOX,MSR ,
42 5 STF ,MULTIMP,ITAB ,GAP_S ,IGAP ,
43 6 GAPMIN ,GAPMAX,INACTI,NRTS ,IRECTS,
44 7 XM0 ,DEPTH ,MARGEREF ,DRAD,ID,TITR,
46 9 IX1 ,IX2 ,IX3 ,IX4 ,NSVG ,
47 1 X1 ,X2 ,X3 ,X4 ,Y1 ,
48 2 Y2 ,Y3 ,Y4 ,Z1 ,Z2 ,
49 3 Z3 ,Z4 ,XI ,YI ,ZI ,
50 4 X0 ,Y0 ,Z0 ,STIF ,NX1 ,
51 5 NY1 ,NZ1 ,NX2 ,NY2 ,NZ2 ,
52 6 NX3 ,NY3 ,NZ3 ,NX4 ,NY4 ,
53 7 NZ4 ,P1 ,P2 ,P3 ,P4 ,
54 8 LB1 ,LB2 ,LB3 ,LB4 ,LC1 ,
55 9 LC2 ,LC3 ,LC4 ,PENE ,PROV_N ,
56 1 PROV_E,N11 ,N21 ,N31 ,DGAPLOAD)
62#include "implicit_f.inc"
74#include "vect07_c.inc"
78 INTEGER NMN, NRTM, , NOINT,I_STOK,MULTIMP,IGAP,INACTI,
80 INTEGER IRECT(4,*),IRECTS(4,*),NSV(*),MSR(*),NSEG(*),MWA(*)
81 INTEGER CAND_E(*),CAND_N(*),MAXSIZ
85 . STF(*),(3,*),XYZM(6,*),GAP_S(*), XM0(3,*),
86 . DIST,BUMULT,GAP,TZINF,MAXBOX,MINBOX,GAPMIN,GAPMAX, DEPTH,
88 my_real ,
INTENT(IN) :: DGAPLOAD ,DRAD
90 CHARACTER(LEN=NCHARTITLE) :: TITR
91 INTEGER,
DIMENSION(MVSIZ),
INTENT(INOUT) :: PROV_N,PROV_E
92 INTEGER,
DIMENSION(MVSIZ),
INTENT(INOUT) :: IX1
93DIMENSION(MVSIZ),
INTENT(INOUT) :: X1,X2,X3,X4
94 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: Y1,Y2,Y3,Y4
95 ,
DIMENSION(MVSIZ),
INTENT(INOUT) :: Z1,Z2,Z3,Z4
96 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: XI,YI,ZI
97 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: x0,y0,z0,stif
98 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: n11,n21,n31,pene
99 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: nx1,ny1,nz1
100 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: nx2,ny2,nz2
101 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: nx3,ny3,nz3
102 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: nx4,ny4,nz4
103 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: p1,p2,p3,p4
104 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: lb1,lb2,lb3,lb4
105 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: lc1,lc2,lc3,lc4
109 INTEGER I, J, L, N1, N2, N3, N4, I_AMAX
110 INTEGER I_ADD, ADESTK, NB_NC, NB_EC, ADNSTK, IBID
111 INTEGER IP1, IP2, IP21, IP22, IP31,J_STOK,I_BID,NB_N_B
118 . dd1,dd2,dd3,dd4,dd,dd0,xmin,ymin,zmin,
119 . xmax,
ymax,zmax,tzinf0,minbox_st,maxbox_st,gapsmax,
120 . bid,tzinf_st,marge_st,gapv(mvsiz)
133 dx1=(x(1,n1)-x(1,n2))
134 dy1=(x(2,n1)-x(2,n2))
135 dz1=(x(3,n1)-x(3,n2))
136 dd1=sqrt(dx1**2+dy1**2+dz1**2)
138 dx3=(x(1,n1)-x(1,n4))
139 dy3=(x(2,n1)-x(2,n4))
140 dz3=(x(3,n1)-x(3,n4))
141 dd2=sqrt(dx3**2+dy3**2+dz3**2)
143 dx4=(x(1,n3)-x(1,n2))
144 dy4=(x(2,n3)-x(2,n2))
145 dz4=(x(3,n3)-x(3,n2))
146 dd3=sqrt(dx4**2+dy4**2+dz4**2)
148 dx6=(x(1,n4)-x(1,n3))
149 dy6=(x(2,n4)-x(2,n3))
150 dz6=(x(3,n4)-x(3,n3))
151 dd4=sqrt(dx6**2+dy6**2+dz6**2)
152 dd=dd+ (dd1+dd2+dd3+dd4)
158 dd =
max(dd0,onep251*(gap+dgapload))
159 dd =
max(dd0,onep251*depth)
160 dd =
max(dd ,onep251*drad)
165 tzinf = margeref +
max(depth,drad,(gap+dgapload))
169 tzinf_st = marge_st +
max(depth,drad,(gap+dgapload))
172 maxbox= half*(dd + 2*tzinf)
174 maxbox_st= half*(dd + 2*tzinf_st)
175 minbox_st= half*maxbox_st
190 xmin=
min(xmin,x(1,j))
191 ymin=
min(ymin,x(2,j))
192 zmin=
min(zmin,x(3,j))
193 xmax=
max(xmax,x(1,j))
195 zmax=
max(zmax,x(3,j))
205 xmin=
min(xmin,x(1,j))
206 ymin=
min(ymin,x(2,j))
207 zmin=
min(zmin,x(3,j))
208 xmax=
max(xmax,x(1,j))
210 zmax=
max(zmax,x(3,j))
242 maxsiz =
max(numnod,nrtm+100)
293 1 mwa(ip1),mwa(ip2),mwa(ip21),mwa(ip22),mwa(ip31+2*(i_add-2)),
294 2 irect ,x ,nb_nc ,nb_ec ,xyzm,
295 3 i_add ,nsv ,i_amax ,xmax ,
ymax,
296 4 zmax ,3*maxsiz,i_stok ,i_mem ,nb_n_b,
297 5 cand_n ,cand_e ,nsn ,noint ,tzinf_st,
298 6 maxbox_st,minbox_st,j_stok ,msr ,xm0 ,
299 7 multimp ,itab ,gap ,gap_s ,igap ,
300 8 gapmin ,gapmax ,marge_st,depth ,drad ,
302 1 ix1 ,ix2 ,ix3 ,ix4 ,nsvg ,
303 2 x1 ,x2 ,x3 ,x4 ,y1 ,
305 4 z3 ,z4 ,xi ,yi ,zi ,
306 5 x0 ,y0 ,z0 ,stif ,nx1 ,
307 6 ny1 ,nz1 ,nx2 ,ny2 ,nz2 ,
308 7 nx3 ,ny3 ,nz3 ,nx4 ,ny4 ,
309 8 nz4 ,p1 ,p2 ,p3 ,p4 ,
310 9 lb1 ,lb2 ,lb3 ,lb4 ,lc1 ,
311 1 lc2 ,lc3 ,lc4 ,pene ,prov_n ,
324 ELSE IF(i_mem==2)
THEN
325 marge_st = three_over_4*marge_st
326 tzinf_st = marge_st +
max(depth,drad,(gap+dgapload))
327 maxbox_st= half*(dd + 2*tzinf_st)
328 minbox_st= half*maxbox_st
330 IF(marge_st<em03)
THEN
334 IF (istamping == 1)
THEN
350 IF(i_add/=0)
GO TO 200
356 CALL i21cor3t(x ,irect ,nsv ,prov_e ,prov_n,
357 2 gapv ,igap ,gap ,gap_s ,gapmin ,
358 3 gapmax,xm0 ,depth,drad ,ix1 ,
359 4 ix2 ,ix3 ,ix4 ,nsvg ,x1 ,
360 5 x2 ,x3 ,x4 ,y1 ,y2 ,
361 6 y3 ,y4 ,z1 ,z2 ,z3 ,
362 7 z4 ,xi ,yi ,zi ,dgapload)
363 CALL i7dst3(ix3,ix4,x1 ,x2 ,x3 ,
364 1 x4 ,y1 ,y2 ,y3 ,y4 ,
365 2 z1 ,z2 ,z3 ,z4 ,xi ,
366 3 yi ,zi ,x0 ,y0 ,z0 ,
367 4 nx1,ny1,nz1,nx2,ny2,
369 6 ny4,nz4,p1 ,p2 ,p3 ,
370 7 p4 ,lb1,lb2,lb3,lb4,
371 8 lc1,lc2,lc3,lc4,j_stok)
372 CALL i7pen3(marge_st,gapv,n11,n21,n31,
374 2 ny2 ,nz2 ,nx3,ny3,nz3,
375 3 nx4 ,ny4 ,nz4,p1 ,p2 ,
377 IF(i_stok+j_stok<multimp*nsn)
THEN
378 CALL i7cmp3(i_stok,cand_e ,cand_n,1,pene,
382 CALL i7cmp3(i_bid,cand_e,cand_n,0,pene,
384 IF(i_stok+i_bid<multimp*nsn)
THEN
385 CALL i7cmp3(i_stok,cand_e,cand_n,1,pene,
388 marge_st = three_over_4*marge_st
389 tzinf_st = marge_st +
max(depth,drad,(gap+dgapload))
390 maxbox_st= half*(dd + 2*tzinf_st)
391 minbox_st= half*maxbox_st
393 IF(marge_st<em03)
THEN
397 IF (istamping == 1)
THEN
416 WRITE(iout,*)
' POSSIBLE IMPACT NUMBER:',i_stok,
' (<=',
417 . 1+(i_stok-1)/nsn,
'*NSN)'
420 . msgtype=msgwarning,
421 . anmode=aninfo_blind_2,
subroutine i21buc1(x, irect, nsv, bumult, nseg, nmn, nrtm, mwa, nsn, cand_e, cand_n, gap, xyzm, noint, i_stok, dist, tzinf, maxbox, minbox, msr, stf, multimp, itab, gap_s, igap, gapmin, gapmax, inacti, nrts, irects, xm0, depth, margeref, drad, id, titr, i_mem, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, x0, y0, z0, stif, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, pene, prov_n, prov_e, n11, n21, n31, dgapload)
subroutine i21tri(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, xm0, multimp, itab, gap, gap_s, igap, gapmin, gapmax, marge, depth, drad, id, titr, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, x0, y0, z0, stif, nx1, ny1, nz1, nx2, ny2, nz2, nx3, ny3, nz3, nx4, ny4, nz4, p1, p2, p3, p4, lb1, lb2, lb3, lb4, lc1, lc2, lc3, lc4, pene, prov_n, prov_e, n11, n21, n31, dgapload)
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 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)