52
53
54
57 USE intbufdef_mod
59
60
61
62#include "implicit_f.inc"
63
64
65
66#include "mvsiz_p.inc"
67
68
69
70#include "com04_c.inc"
71#include "param_c.inc"
72#include "scr03_c.inc"
73#include "units_c.inc"
74#include "vect07_c.inc"
75#include "scr17_c.inc"
76
77
78
79 INTEGER NUMINT, IWRN, I_MEM, RESORT
80 INTEGER INSCR(*), IXS(NIXS,*), IXC(NIXC,*),
81 . IXTG(NIXTG,*), IPARI(*), ITAB(*), MWA(*), IKINE(*),
82 . KNOD2ELS(*), KNOD2ELC(*), KNOD2ELTG(*),
83 . NOD2ELS(*), NOD2ELC(*), NOD2ELTG(*),
84 . NPBY(NNPBY,*), LPBY(*), IPARTS(*), IPARTC(*), IPARTG(*)
85 TYPE(INTSTAMP_DATA) INTSTAMP
86 INTEGER NOM_OPT(LNOPT1,*)
88 . x(3,*), pm(*), geo(*),rwa(6,*),
89 . thksh4_var(*), thksh3_var(*), thknod(*),
90 . skew(lskew,*), ms(*), in(*), v(3,*), vr(3,*), rby(nrby,*),
91 . thk_part(*)
92 INTEGER ID
93 CHARACTER(LEN=NCHARTITLE) :: TITR
94 TYPE(INTBUF_STRUCT_) :: INTBUF_TAB
95
96
97
98 INTEGER NRTS, NRTM, NSN, NMN, NTY, NST, MST, NOINT,
99 . I, I_STOK,IRS,IRM,
100 . NSEG, NGROUS, NG, INACTI,IWPENE,
101 . JLT_NEW,IGAP,MULTIMP,IADM,INTTH,
102 . ISU1, ISU2,
103 . ISK, IROT, J, MSR, IRB, K, , N
104 INTEGER, DIMENSION(MVSIZ) ::PROV_N,PROV_E
105 INTEGER, DIMENSION(MVSIZ) :: IX1,IX2,IX3,IX4,NSVG
106 my_real,
DIMENSION(MVSIZ) :: x1,x2,x3,x4
107 my_real,
DIMENSION(MVSIZ) :: y1,y2,y3,y4
108 my_real,
DIMENSION(MVSIZ) :: z1,z2,z3,z4
109 my_real,
DIMENSION(MVSIZ) :: xi,yi,zi
110 my_real,
DIMENSION(MVSIZ) :: x0,y0,z0,stif
111 my_real,
DIMENSION(MVSIZ) :: n11,n21,n31,pene1
112 my_real,
DIMENSION(MVSIZ) :: nx1,ny1,nz1
113 my_real,
DIMENSION(MVSIZ) :: nx2,ny2,nz2
114 my_real,
DIMENSION(MVSIZ) :: nx3,ny3,nz3
115 my_real,
DIMENSION(MVSIZ) :: nx4,ny4,nz4
116 my_real,
DIMENSION(MVSIZ) :: p1,p2,p3,p4
117 my_real,
DIMENSION(MVSIZ) :: lb1,lb2,lb3,lb4
118 my_real,
DIMENSION(MVSIZ) :: lc1,lc2,lc3,lc4
119 INTEGER, DIMENSION(:),ALLOCATABLE :: TAGNOD
120 my_real,
DIMENSION(:) ,
POINTER :: gap_s0
121 my_real,
TARGET,
DIMENSION(1):: gaps0_bid
122
124 . maxbox,minbox
126 . gapv(mvsiz), pene(mvsiz),gap0
127 CHARACTER MESS*40
128 DATA mess/'/INTER/TYPE21 INITIALIZATIONS '/
129
130
132 iwpene = 0
133 nrts =ipari(3)
134 nrtm =ipari(4)
135 nsn =ipari(5)
136 nmn =ipari(6)
137 nty =ipari(7)
138 nst =ipari(8)
139 mst =ipari(9)
140 noint =ipari(15)
141 igap =ipari(21)
142 inacti= ipari(22)
143 multimp= ipari(23)
144 irm= ipari(24)
145 irs= ipari(25)
146 isu1=ipari(45)
147 isu2=ipari(46)
148 iadm=ipari(44)
149 intth=ipari(47)
150
151
152 IF (resort == 0)THEN
153 WRITE(iout,2001)noint,nty
154 END IF
155
156
157 IF(nty==21) THEN
158
159
160
161
162 IF(igap == 2) THEN
163 gap0 = intbuf_tab%VARIABLES(2)
165 1 x ,intbuf_tab%IRECTS,intbuf_tab%IRECTM,nrts,nrtm,
166 2 geo ,pm ,ixs ,ixc ,ixtg ,
167 3 -numint ,nty ,noint ,nsn ,intbuf_tab%NSV,
168 4 gap0,igap ,intbuf_tab%GAP_S,intbuf_tab%VARIABLES(13),
169 . intbuf_tab%VARIABLES(6),
170 5 intbuf_tab%VARIABLES(16),intbuf_tab%IELES,intbuf_tab%STF,
171 . nmn ,intbuf_tab%MSR ,
172 6 knod2els ,knod2elc ,knod2eltg ,nod2els ,nod2elc ,
173 7 nod2eltg ,thknod ,
174 8 ikine ,itab ,inacti ,intbuf_tab%VARIABLES(19),
175 . intbuf_tab%STFNS,
176 9 intbuf_tab%VARIABLES(23),intbuf_tab%GAP_S(1+nsn:2*nsn),intbuf_tab%AREAS,
177 . intbuf_tab%XM0,intbuf_tab%VARIABLES(27),
178 a intbuf_tab%VARIABLES(28),intbuf_tab%VARIABLES(29),intth ,intbuf_tab%VARIABLES(32),
179 . iparts ,
180 b ipartc, ipartg, thk_part,intbuf_tab%THKNOD0 ,
id,titr ,
181 c intbuf_tab%VARIABLES(46),resort )
182
183 ELSE
184 gap_s0 => gaps0_bid
185 gap0 = intbuf_tab%VARIABLES(2)
187 1 x ,intbuf_tab%IRECTS,intbuf_tab%IRECTM,nrts,nrtm,
188 2 geo ,pm ,ixs ,ixc ,ixtg ,
189 3 -numint ,nty ,noint ,nsn ,intbuf_tab%NSV,
190 4 gap0,igap ,intbuf_tab%GAP_S,intbuf_tab%VARIABLES(13),
191 . intbuf_tab%VARIABLES(6),
192 5 intbuf_tab%VARIABLES(16),intbuf_tab%IELES,intbuf_tab%STF,
193 . nmn ,intbuf_tab%MSR ,
194 6 knod2els ,knod2elc ,knod2eltg ,nod2els ,nod2elc ,
195 7 nod2eltg ,thknod ,
196 8 ikine ,itab ,inacti ,intbuf_tab%VARIABLES(19),
197 . intbuf_tab%STFNS,
198 9 intbuf_tab%VARIABLES(23),gap_s0,intbuf_tab%AREAS,
199 . intbuf_tab%XM0,intbuf_tab%VARIABLES(27),
200 a intbuf_tab%VARIABLES(28),intbuf_tab%VARIABLES(29),intth ,intbuf_tab%VARIABLES(32),
201 . iparts ,
202 b ipartc, ipartg, thk_part,intbuf_tab%THKNOD0 ,
id,titr ,
203 c intbuf_tab%VARIABLES(46),resort )
204
205 ENDIF
206
207
208
210 1 x ,intbuf_tab%IRECTM,nrtm ,nmn ,intbuf_tab%MSR ,
211 2 -numint ,nty ,noint ,intbuf_tab%NOD_NORMAL,intbuf_tab%XM0)
212
213 IF(iadm/=0)THEN
215 1 nrtm ,intbuf_tab%XM0,intbuf_tab%NOD_NORMAL,intbuf_tab%IRECTM,intbuf_tab%RCURV,
216 2 intbuf_tab%ANGLM)
217 END IF
218
219 CALL i21reset(nsn, intbuf_tab%IRTLM, intbuf_tab%CSTS)
220
221
222
223 maxbox = intbuf_tab%VARIABLES(9)
224 minbox = intbuf_tab%VARIABLES(12)
226 1 x ,intbuf_tab%IRECTM ,intbuf_tab%NSV,intbuf_tab%VARIABLES(4),nseg ,
227 2 nmn ,nrtm ,mwa ,nsn ,intbuf_tab%CAND_E ,
228 3 intbuf_tab%CAND_N ,gap0,rwa ,noint,i_stok ,
229 4 intbuf_tab%VARIABLES(5),intbuf_tab%VARIABLES(8),maxbox ,minbox ,intbuf_tab%MSR,
230 5 intbuf_tab%STF ,multimp ,itab ,intbuf_tab%GAP_S ,igap ,
231 6 intbuf_tab%VARIABLES(13),intbuf_tab%VARIABLES(16) ,inacti ,nrts ,intbuf_tab%IRECTS,
232 7 intbuf_tab%XM0 ,intbuf_tab%VARIABLES(23),intbuf_tab%VARIABLES(22),
233 8 intbuf_tab%VARIABLES(32),
id,titr,i_mem,
234 9 ix1 ,ix2 ,ix3 ,ix4 ,nsvg ,
235 1 x1 ,x2 ,x3 ,x4 ,y1 ,
236 2 y2 ,y3 ,y4 ,z1 ,z2 ,
237 3 z3 ,z4 ,xi ,yi ,zi ,
238 4 x0 ,y0 ,z0 ,stif ,nx1 ,
239 5 ny1 ,nz1 ,nx2 ,ny2 ,nz2 ,
240 6 nx3 ,ny3 ,nz3 ,nx4 ,ny4 ,
241 7 nz4 ,p1 ,p2 ,p3 ,p4 ,
242 8 lb1 ,lb2 ,lb3 ,lb4 ,lc1 ,
243 9 lc2 ,lc3 ,lc4 ,pene1 ,prov_n ,
244 1 prov_e,n11 ,n21 ,n31 ,intbuf_tab%VARIABLES(46))
245 IF (i_mem == 2 ) resort = resort + 1
246 IF (i_mem == 2 ) RETURN
247 intbuf_tab%VARIABLES(9) = maxbox
248 intbuf_tab%VARIABLES(12) = minbox
249 intbuf_tab%VARIABLES(2) = gap0
250
251
252
253 ngrous=1+(i_stok-1)/nvsiz
254
255 DO 700 ng=1,ngrous
256
257 IF(ipri>=1) WRITE(iout,2007)
258 nft = (ng-1) * nvsiz
259 lft = 1
260 llt = min0( nvsiz, i_stok - nft )
262 1 llt ,intbuf_tab%CAND_N(1+nft),intbuf_tab%CAND_E(1+nft),intbuf_tab%IRECTM,intbuf_tab%NSV,
263 2 intbuf_tab%GAP_S,x ,intbuf_tab%IRTLM,intbuf_tab%CSTS,
264 . intbuf_tab%VARIABLES(23),
265 3 intbuf_tab%NOD_NORMAL,intbuf_tab%XM0,pene,intbuf_tab%PENIS,intbuf_tab%IFPEN,
266 4 igap ,intbuf_tab%VARIABLES(2), intbuf_tab%VARIABLES(16), intbuf_tab%VARIABLES(13) ,
267 . intbuf_tab%VARIABLES(32),
268 5 intbuf_tab%VARIABLES(46))
269 700 CONTINUE
270
272 . itab ,inacti,intbuf_tab%CAND_E,intbuf_tab%CAND_N,intbuf_tab%STFNS,
273 1 x ,i_stok,intbuf_tab%NSV,iwpene ,intbuf_tab%PENIS,
274 2 noint ,nty ,intbuf_tab%GAP_S,intbuf_tab%MSR,intbuf_tab%IRTLM,
275 3 intbuf_tab%IRECTM ,intbuf_tab%XM0,intbuf_tab%VARIABLES(13),intbuf_tab%VARIABLES(16),
276 . intbuf_tab%VARIABLES(23),
277 4 nsn ,mwa ,intbuf_tab%VARIABLES(32),
id,titr)
278
279 IF(iwpene==0.AND.(inacti==5.OR.inacti==6))
280 . ipari(22) = -inacti
281 intbuf_tab%I_STOK(1)=iwpene
282
283
284
285
286
287
288
289 irb=intstamp%IRB
290 msr=intstamp%MSR
291 intstamp%XG(1)=x(1,msr)
292 intstamp%XG(2)=x(2,msr)
293 intstamp%XG(3)=x(3,msr)
294 intstamp%V(1) =v(1,msr)
295 intstamp%V(2) =v(2,msr)
296 intstamp%V(3) =v(3,msr)
297 intstamp%MASS =ms(msr)
298 DO j=1,9
299 intstamp%ROT(j)=rby(j,irb)
300 END DO
301 intstamp%IN(1)=rby(10,irb)
302 intstamp%IN(2)=rby(11,irb)
303 intstamp%IN(3)=rby(12,irb)
304 intstamp%VR(1)=vr(1,msr)
305 intstamp%VR(2)=vr(2,msr)
306 intstamp%VR(3)=vr(3,msr)
307
308
309
310 k=0
311 DO n=1,irb-1
312 k=k+npby(2,n)
313 END DO
314
316
317 nsl=npby(2,irb)
318 DO i=1,nsl
319 n=lpby(k+i)
321 END DO
322
323 DO i=1,nmn
324 n=intbuf_tab%MSR(i)
327 . msgtype=msgerror,
328 . anmode=aninfo,
330 . c1=titr,
331 . i2=itab(n),
332 . i3=nom_opt(1,irb))
333 END IF
334 END DO
335
336
337
338
339 irot=intstamp%IROT
341 1 irot ,intstamp%XG,intstamp%ROT,nmn ,intbuf_tab%NOD_NORMAL,
342 2 intbuf_tab%XM0,intstamp%BRACKET,nrtm,intbuf_tab%IRECTM,
343 . intbuf_tab%VARIABLES(27),
344 3 intbuf_tab%VARIABLES(28),intbuf_tab%VARIABLES(29),nsn,intbuf_tab%XSAV)
345
346 ENDIF
348
349 RETURN
350
351 2001 FORMAT(//,1x,'INTERFACE NUMBER. . . . . . . . . . . . . .',i10/
352 + ,1x,'INTERFACE TYPE. . . . . . . . . . . . . . .',i6/)
353 2002 FORMAT(//
354 +' SECONDARY NEAREST NEAREST MAIN NODES SECONDARY '/
355 +' NODE MAIN SEGMENT S T')
356 2022 FORMAT(//
357 +' SECONDARY NEAREST MAIN NODES SECONDARY '/
358 +' NODE SEGMENT ',
359 +' S T DIST')
360 2003 FORMAT(//
361 +' MAIN NEAREST NEAREST SECONDARY NODES MAIN'/
362 +' NODE SECONDARY SEGMENT S T')
363 2007 FORMAT(//' IMPACT CANDIDATES',/,
364 +' MAIN SECONDARY NODES '/
365 +' NODE ')
366 2011 FORMAT(//' IMPACT CANDIDATES',/,
367 +' MAIN NODES SECONDARY NODES ')
368
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 i21norm3(x, irectm, nrtm, nmn, msr, nint, nty, noint, nod_normal, xm0)
subroutine i21rcurv(nrtm, xm0, nod_normal, irect, rcurv, anglm)
subroutine i21pwr3(itab, inacti, cand_e, cand_n, stfn, x, i_stok, nsv, iwpene, peni, noint, nty, gap_s, msr, irtlm, irect, xm0, gapmin, gapmax, depth, nsn, itag, drad, id, titr)
subroutine i21rot(irot, xg, rot, nmn, nod_normal, xm0, bracket, nrtm, irectm, lxm, lym, lzm, nsn, xsav)
integer, parameter nchartitle
subroutine i21dst3(jlt, cand_n, cand_e, irect, nsv, gap_s, x, irtlm, csts, depth, nod_normal, xm0, pene, peni, ifpen, igap, gap, gapmax, gapmin, drad, dgapload)
subroutine i21gap3(x, irects, irectm, nrts, nrtm, geo, pm, ixs, ixc, ixtg, nint, nty, noint, nsn, nsv, gap, igap, gap_s, gapmin, criter, gapmax, ieles, stf, nmn, msr, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, thknod, ikine, itab, inacti, gapscale, stfn, depth, gap_s0, area_s0, xm0, lxm, lym, lzm, intth, drad, iparts, ipartc, ipartg, thk_part, thknod0, id, titr, dgapload, resort)
subroutine i21reset(nsn, irtlm, csts)
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)
subroutine tagnod(ix, nix, nix1, nix2, numel, iparte, tagbuf, npart)