63
64
65
66
67
68
69
70
71
72
73#include "implicit_f.inc"
74
75
76
77#include "mvsiz_p.inc"
78
79
80
81#include "com04_c.inc"
82#include "param_c.inc"
83#include "scr08_c.inc"
84#include "vect07_c.inc"
85
86
87
88 INTEGER NMN, NRTM, NSN, NOINT, IGNORE, NINT,ILEV
89 INTEGER IRECT(4,*),NSV(*),NSEG(*),MWA(*)
90 INTEGER MSR(*),IRTL(*),MAXSIZ,KNOD2ELS(*), KNOD2ELC(*),
91 . KNOD2ELTG(*), NOD2ELS(*), NOD2ELC(*), NOD2ELTG(*),
92 . IXC(NIXC,*),IXTG(NIXTG,*),(*),
93 . IXS(NIXS,*),IXS10(*), IXS16(*), IXS20(*),IPARTTG(*),IGEO(*),
94 . IWORKSH(*)
95
97 . x(3,*),xyzm(6,*),st(*),dmin(*),tzinf05,thk(*),thk_part(*),
98 . geo(npropg,*),pm(*),pm_stack(*)
99 INTEGER ID
100 CHARACTER(LEN=NCHARTITLE) :: TITR
101 INTEGER, DIMENSION(MVSIZ), INTENT(INOUT) :: PROV_N,PROV_E,NSVG
102 INTEGER, DIMENSION(MVSIZ), INTENT(INOUT) :: IX1,IX2,IX3,IX4
103 my_real,
DIMENSION(MVSIZ),
INTENT(IN)
104 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: x1,x2,x3,x4
105 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: y1,y2,y3,y4
106 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: z1,z2,z3,z4
107 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: xi,yi,zi
108 my_real,
DIMENSION(MVSIZ),
INTENT(IN) :: x0,y0,z0
109 my_real,
DIMENSION(MVSIZ),
INTENT(IN) :: nx1,ny1,nz1
110 my_real,
DIMENSION(MVSIZ),
INTENT(IN) :: nx2,ny2,nz2
111 my_real,
DIMENSION(MVSIZ),
INTENT(IN) :: nx3,ny3,nz3
112 my_real,
DIMENSION(MVSIZ),
INTENT(IN) :: nx4,ny4,nz4
113 my_real,
DIMENSION(MVSIZ),
INTENT(IN) :: p1,p2,p3,p4
114 my_real,
DIMENSION(MVSIZ),
INTENT(IN) :: lb1,lb2,lb3,lb4
115 my_real,
DIMENSION(MVSIZ),
INTENT(IN) :: lc1,lc2,lc3,lc4
116 my_real,
DIMENSION(MVSIZ),
INTENT(INOUT) :: stif
117 my_real,
DIMENSION(MVSIZ),
INTENT(IN) :: s,t
118
119
120
121 INTEGER I, J, L, N1, N2, N3, N4, I_AMAX,I_MEM
122 INTEGER I_ADD, ADESTK, NB_NC, NB_EC, ADNSTK,IEL,N
123 INTEGER IP1, IP2, IP21, IP22, IP31,J_STOK,I_BID,NB_N_B,IS,IAD,
124 . MG,IP,NELS,NELC,NELTG,JJ,JJJ,IFLAG
125
127 . dx1,dy1,dz1,dx3,dy3,dz3,dx4,dy4,dz4,dx6,dy6,dz6,
128 . dd1,dd2,dd3,dd4,dd,xmin,ymin,zmin,maxbox,minbox,xmax,
ymax,zmax,
129 . bid,tzinfmin,thksecnd,thkmain,
area,vol,gapv(mvsiz),dsearch
130
131
132
133
134 dd = zero
135 dsearch = tzinf05
136 iflag = 1
137 IF (ignore >= 2) THEN
138 thksecnd = zero
139 thkmain = zero
140
141 DO 5 l=1,nrtm
142
143 n1=irect(1,l)
144 n2=irect(2,l)
145 n3=irect(3,l)
146 n4=irect(4,l)
147
148 dx1=(x(1,n1)-x(1,n3))
149 dy1=(x(2,n1)-x(2,n3))
150 dz1=(x(3,n1)-x(3,n3))
151 dd=
max(dd,sqrt(dx1**2+dy1**2+dz1**2))
152
153 dx3=(x(1,n2)-x(1,n4))
154 dy3=(x(2,n2)-x(2,n4))
155 dz3=(x(3,n2)-x(3,n4))
156 dd=
max(dd,sqrt(dx1**2+dy1**2+dz1**2))
157 5 CONTINUE
158 DO i=1,nsn
159 is = nsv(i)
160
161 DO iad = knod2elc(is)+1,knod2elc(is+1)
162 iel = nod2elc(iad)
163 mg=ixc(6,iel)
164 ip = ipartc(iel)
165 IF ( thk_part(ip) /= zero) THEN
166 thksecnd =
max(thksecnd,thk_part(ip)
167 ELSEIF ( thk(iel) /= zero) THEN
168 thksecnd =
max(thksecnd,thk(iel))
169 ELSE
170 thksecnd =
max(thksecnd,geo(1,mg))
171 ENDIF
172 ENDDO
173
174 DO iad = knod2eltg(is)+1,knod2eltg(is+1)
175 iel = nod2eltg(iad)
176 mg=ixtg(5,iel)
177 ip = iparttg(iel)
178 IF ( thk_part(ip) /= zero) THEN
179 thksecnd =
max(thksecnd,thk_part(ip))
180 ELSEIF ( thk(iel) /= zero) THEN
181 thksecnd =
max(thksecnd,thk(iel))
182 ELSE
183 thksecnd =
max(thksecnd,geo(1,mg))
184 ENDIF
185 ENDDO
186 ENDDO
187 DO i=1,nrtm
188 nels = 0
189 nelc = 0
190 neltg = 0
191 CALL insol3(x,irect,ixs,nint,nels,i,
192 .
area,noint,knod2els ,nod2els ,0 ,ixs10,
193 . ixs16,ixs20)
194 CALL incoq3(irect,ixc ,ixtg ,nint ,nelc ,
195 . neltg,i,geo ,pm ,knod2elc ,
196 . knod2eltg ,nod2elc ,nod2eltg,thk,2,igeo ,
197 . pm_stack , iworksh)
198 IF (nelc /= 0) THEN
199 mg=ixc(6,nelc)
200 ip = ipartc(nelc)
201 IF ( thk_part(ip) /= zero) THEN
202 thkmain =
max(thkmain,thk_part(ip))
203 ELSEIF ( thk(nelc) /= zero) THEN
204 thkmain =
max(thkmain,thk(nelc))
205 ELSE
206 thkmain =
max(thkmain,geo(1,mg))
207 ENDIF
208 ELSEIF (neltg /= 0)THEN
209 mg=ixtg(5,neltg)
210 ip = iparttg(neltg)
211 IF ( thk_part(ip) /= zero) THEN
212 thkmain =
max(thkmain,thk_part(ip))
213 ELSEIF ( thk(numelc+neltg) /= zero) THEN
214 thkmain =
max(thkmain,thk(numelc+neltg))
215 ELSE
216 thkmain =
max(thkmain,geo(1,mg))
217 ENDIF
218 ELSEIF(nels/=0 .AND. nels <= numels8 .AND. ignore == 2) THEN
219 DO jj=1,8
220 jjj=ixs(jj+1,nels)
221 xc(jj)=x(1,jjj)
222 yc(jj)=x(2,jjj)
223 zc(jj)=x(3,jjj)
224 END DO
226
227 thkmain =
max(thkmain,vol/
area)
228 ENDIF
229 ENDDO
230
231 IF(tzinf05==zero)
232 . tzinf05 =
max(zep05*dd,0.6*(thkmain+thksecnd))
233 maxbox= two*tzinf05
234 minbox= half*maxbox
235 tzinfmin = tzinf05
236 ELSE
237
238 DO 10 l=1,nrtm
239
240 n1=irect(1,l)
241 n2=irect(2,l)
242 n3=irect(3,l)
243 n4=irect(4,l)
244
245 dx1=(x(1,n1)-x(1,n2))
246 dy1=(x(2,n1)-x(2,n2))
247 dz1=(x(3,n1)-x(3,n2))
248 dd1=(dx1**2+dy1**2+dz1**2)
249
250 dx3=(x(1,n1)-x(1,n4))
251 dy3=(x(2,n1)-x(2,n4))
252 dz3=(x(3,n1)-x(3,n4))
253 dd2=(dx3**2+dy3**2+dz3**2)
254
255 dx4=(x(1,n3)-x(1,n2))
256 dy4=(x(2,n3)-x(2,n2))
257 dz4=(x(3,n3)-x(3,n2))
258 dd3=(dx4**2+dy4**2+dz4**2)
259
260 dx6=(x(1,n4)-x(1,n3))
261 dy6=(x(2,n4)-x(2,n3))
262 dz6=(x(3,n4)-x(3,n3))
263 dd4=(dx6**2+dy6**2+dz6**2)
264 dd=dd+ (dd1+dd2+dd3+dd4)
265 10 CONTINUE
266
267 dd = sqrt(dd/nrtm/four)
268 IF(tzinf05==zero)tzinf05 = dd
269 maxbox= two*tzinf05
270 minbox= half*maxbox
271 tzinfmin = tzinf05*em01
272 ENDIF
273
274
275
276 xmin=ep30
277 xmax=-ep30
278 ymin=ep30
280 zmin=ep30
281 zmax=-ep30
282
283 DO 20 i=1,nmn
284 j=msr(i)
285 xmin=
min(xmin,x(1,j))
286 ymin=
min(ymin,x(2,j))
287 zmin=
min(zmin,x(3,j))
288 xmax=
max(xmax,x(1,j))
290 zmax=
max(zmax,x(3,j))
291 20 CONTINUE
292 xmin=xmin-tzinf05
293 ymin=ymin-tzinf05
294 zmin=zmin-tzinf05
295 xmax=xmax+tzinf05
297 zmax=zmax+tzinf05
298 DO 25 i=1,nsn
299 j=nsv(i)
300 xmin=
min(xmin,x(1,j))
301 ymin=
min(ymin,x(2,j))
302 zmin=
min(zmin,x(3,j))
303 xmax=
max(xmax,x(1,j))
305 zmax=
max(zmax,x(3,j))
306 25 CONTINUE
307
308
309
310
311 nb_n_b = 1
312 i_mem = 0
313
314
315 100 CONTINUE
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337 maxsiz =
max(numnod,nrtm+100)
338 ip1 = 1
339 ip2 = ip1+maxsiz
340
341 ip21= ip2+3*maxsiz
342 ip22= ip21+numnod
343 ip31= ip22+numnod
344
345
346
347
348
349
350
351
352 mwa(ip31) = 0
353 mwa(ip31+1) = 0
354 mwa(ip31+2) = 0
355 mwa(ip31+3) = 0
356 i_add = 1
357 i_amax = 1
358 xyzm(1,i_add) = xmin
359 xyzm(2,i_add) = ymin
360 xyzm(3,i_add) = zmin
361 xyzm(4,i_add) = xmax
363 xyzm(6,i_add) = zmax
364 j_stok = 0
365 adnstk = 0
366 adestk = 0
367 nb_nc = nsn
368 nb_ec = nrtm
369
370
371
372 DO 120 i=1,nb_ec
373 mwa(ip1+i-1) = i
374 120 CONTINUE
375 DO 140 i=1,nb_nc
376 mwa(ip21+i-1) = i
377 140 CONTINUE
378
379
380
381
382
383 200 CONTINUE
384
385
387 1 mwa(ip1),mwa(ip2),mwa(ip21),mwa(ip22),mwa(ip31+2*(i_add-2)),
388 2 irect ,x ,nb_nc ,nb_ec ,xyzm,
389 3 i_add ,nsv ,i_amax ,xmax ,
ymax,
390 4 zmax ,3*maxsiz,i_mem ,nb_n_b ,nsn ,
391 5 noint ,tzinf05 ,maxbox ,minbox ,j_stok,
392 6 irtl ,st ,dmin ,ignore ,thk ,
393 7 knod2els,knod2elc,knod2eltg,nod2els ,nod2elc,
394 8 nod2eltg,nint ,ixc ,
395 9 ixtg ,thk_part ,ipartc ,geo ,ixs ,
396 a ixs10 ,pm ,ixs16 ,ixs20 ,iparttg,
397 b
id ,titr ,igeo ,dsearch ,pm_stack ,
398 c iworksh ,
399 d ix1 ,ix2 ,ix3,ix4 ,nsvg ,
400 1 prov_n ,prov_e ,n11,n12 ,n13 ,
401 2 x1 ,x2 ,x3 ,x4 ,stif ,
402 3 y1 ,y2 ,y3 ,y4 ,z1 ,
403 4 z2 ,z3 ,z4 ,xi ,yi ,
404 5 zi ,x0 ,y0 ,z0 ,nx1 ,
405 6 ny1 ,nz1 ,nx2,ny2 ,nz2 ,
406 7 nx3 ,ny3 ,nz3,nx4 ,ny4 ,
407 8 nz4 ,p1 ,p2 ,p3 ,p4 ,
408 9 lb1 ,lb2 ,lb3,lb4 ,lc1 ,
409 1 lc2 ,lc3 ,lc4,s ,t ,
410 2 ilev)
411
412
413
414 IF(i_mem==1)THEN
415 nb_n_b = nb_n_b + 1
416 i_mem = 0
417 GO TO 100
418 ELSE IF(i_mem==2) THEN
419 tzinf05 = three_over_4*tzinf05
420
421
422
423 i_mem = 0
424 IF( tzinf05<tzinfmin ) THEN
426 . msgtype=msgerror,
427 . anmode=aninfo,
429 . c1=titr)
430 ENDIF
431 GO TO 100
432 ENDIF
433 IF(i_add/=0) GO TO 200
434
435
436 IF(j_stok/=0)THEN
437 lft = 1
438 llt = j_stok
439 CALL i2cor3(x ,irect ,nsv ,prov_e ,prov_n,
440 . bid ,bid ,gapv ,0 ,tzinf05,
441 . bid ,bid ,0 ,nint ,ixc ,
442 4 ixtg ,thk_part,ipartc,geo , noint,
443 5 ixs ,ixs10 ,pm ,thk ,knod2els,
444 6 knod2elc,knod2eltg,nod2els,nod2elc,nod2eltg,
445 7 ignore,ixs16 ,ixs20 ,iparttg,igeo,dsearch ,
446 8 pm_stack , iworksh ,ix1 ,ix2 ,
447 5 ix3 ,ix4 ,nsvg,x1 ,x2 ,
448 6 x3 ,x4 ,y1 ,y2 ,y3 ,
449 7 y4 ,z1 ,z2 ,z3 ,z4 ,
450 8 xi ,yi ,zi ,stif ,iflag )
451
452 IF (ilev == 27) THEN
453
454 CALL i2dst3_27(gapv,prov_e ,prov_n,tzinf05,irtl,st,dmin,ignore,
455 . thk ,knod2els,knod2elc,knod2eltg,nod2els,
456 . nod2elc,nod2eltg,x,irect,
457 . nint,ixc ,ixtg ,thk_part,ipartc,geo,
458 . noint,ixs,ixs10,pm,ix3,
459 1 ix4,x1 ,x2 ,x3 ,x4 ,
460 1 y1 ,y2 ,y3 ,y4 ,z1 ,
461 2 z2 ,z3 ,z4 ,xi ,yi ,
462 3 zi ,x0 ,y0 ,z0 ,nx1,
463 4 ny1,nz1,nx2,ny2,nz2,
464 5 nx3,ny3,nz3,nx4,ny4,
465 6 nz4,p1 ,p2 ,p3 ,p4 ,
466 7 lb1,lb2,lb3,lb4,lc1,
467 8 lc2,lc3,lc4,s ,t )
468 ELSE
469 CALL i2dst3(gapv,prov_e ,prov_n,tzinf05,irtl,st,dmin,ignore,
470 . thk ,knod2els,knod2elc,knod2eltg,nod2els,
471 . nod2elc,nod2eltg,x,irect,
472 . nint,ixc ,ixtg ,thk_part,ipartc,geo,
473 . noint,ixs,ixs10,pm,ix3,
474 1 ix4,x1 ,x2 ,x3 ,x4 ,
475 1 y1 ,y2 ,y3 ,y4 ,z1 ,
476 2 z2 ,z3 ,z4 ,xi ,yi ,
477 3 zi ,x0 ,y0 ,z0 ,nx1,
478 4 ny1,nz1,nx2,ny2,nz2,
479 5 nx3,ny3,nz3,nx4,ny4,
480 6 nz4,p1 ,p2 ,p3 ,p4 ,
481 7 lb1,lb2,lb3,lb4,lc1,
482 8 lc2,lc3,lc4,s ,t )
483 ENDIF
484
485 ENDIF
486
487
488 RETURN
subroutine area(d1, x, x2, y, y2, eint, stif0)
subroutine i2cor3(x, irect, nsv, cand_e, cand_n, stf, stfn, gapv, igap, gap, gap_s, gap_m, istf, nint, ixc, ixtg, thk_part, ipartc, geo, noint, ixs, ixs10, pm, thk, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, ignore, ixs16, ixs20, iparttg, igeo, dsearch, pm_stack, iworksh, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, stif, iflag)
subroutine i2dst3(gapv, cand_e, cand_n, tzinf, irtl, st, dmin, ignore, thk, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, x, irect, nint, ixc, ixtg, thk_part, ipartc, geo, noint, ixs, ixs10, pm, 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, s, t)
subroutine i2dst3_27(gapv, cand_e, cand_n, tzinf, irtl, st, dmin, ignore, thk, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, x, irect, nint, ixc, ixtg, thk_part, ipartc, geo, noint, ixs, ixs10, pm, 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, s, t)
subroutine i2tri(bpe, pe, bpn, pn, add, irect, x, nb_nc, nb_ec, xyzm, i_add, nsv, i_amax, xmax, ymax, zmax, maxsiz, i_mem, nb_n_b, nsn, noint, tzinf, maxbox, minbox, j_stok, irtl, st, dmin, ignore, thk, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, nint, ixc, ixtg, thk_part, ipartc, geo, ixs, ixs10, pm, ixs16, ixs20, iparttg, id, titr, igeo, dsearch, pm_stack, iworksh, ix1, ix2, ix3, ix4, nsvg, prov_n, prov_e, n11, n12, n13, x1, x2, x3, x4, stif, 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, s, t, ilev)
subroutine incoq3(irect, ixc, ixtg, nint, nel, neltg, is, geo, pm, knod2elc, knod2eltg, nod2elc, nod2eltg, thk, nty, igeo, pm_stack, iworksh)
subroutine insol3(x, irect, ixs, nint, nel, i, area, noint, knod2els, nod2els, ir, ixs10, ixs16, ixs20)
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
integer, parameter nchartitle
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)