201
202
203
206
207
208
209#include "implicit_f.inc"
210#include "comlock.inc"
211
212
213
214#include "units_c.inc"
215#include "warn_c.inc"
216#include "com01_c.inc"
217
218
219
220 INTEGER NMN, NSN, NOINT, INACTI, IFQ, NIN, NSNR, NSNROLD
221 INTEGER, INTENT(in) :: NRTM
222 INTEGER, INTENT(in) :: TOTAL_NB_NRTM
223 INTEGER IRECT(4,*),NSV(*),CAND_A(*), RENUM(*),NUM_IMP, ITASK
224 INTEGER CAND_E(*),CAND_N(*),IFPEN(*),KREMNOD(*),REMNOD(*),ITAB(*)
225 INTEGER ,ESHIFT,ILD,NB_N_B, IGAP, NCONT,INTTH,I_MEM,
226 * II_STOK, FLAGREMNODE, ITIED
227 INTEGER, INTENT(inout) :: REMOTE_S_NODE
228 INTEGER, INTENT(in) :: INTHEAT
229 INTEGER, INTENT(in) :: IDT_THERM
230 INTEGER, INTENT(in) :: NODADT_THERM
231 INTEGER, DIMENSION(NSNR), INTENT(inout) :: LIST_REMOTE_S_NODE
232
234 . gap,tzinf,maxbox,minbox,curv_max_max,
235 . gapmin, gapmax, bminma(12),curv_max(nrtm),bgapsmx
236 my_real ,
INTENT(IN) :: drad,dgapload
238 . x(3,*), cand_p(*), stfn(*),
239 . stf(*), gap_s(*), gap_m(*),
240 . gap_s_l(*), gap_m_l(*), cand_f(*)
241
242
243
244 INTEGER I,
245 . ISZNSNR
246
248 . xyzm(6,2), marge, aaa
249
250
251
252
253
254
255
256 INTEGER NBX,NBY,NBZ
257 INTEGER (KIND=8) :: NBX8,NBY8,NBZ8,RES8,LVOXEL8
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279 xyzm(1,1) = bminma(4)
280 xyzm(2,1) = bminma(5)
281 xyzm(3,1) = bminma(6)
282 xyzm(4,1) = bminma(1)
283 xyzm(5,1) = bminma(2)
284 xyzm(6,1) = bminma(3)
285
286 xyzm(1,2) = bminma(10)
287 xyzm(2,2) = bminma(11)
288 xyzm(3,2) = bminma(12)
289 xyzm(4,2) = bminma(7)
290 xyzm(5,2) = bminma(8)
291 xyzm(6,2) = bminma(9)
292 i_mem = 0
293
294 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.
295 . ifq>0.OR.num_imp>0.OR.itied/=0) THEN
296 isznsnr = nsnr
297 ELSE
298 isznsnr = 0
299 END IF
300
301
302
303 marge = tzinf-
max(gap+dgapload,drad)
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318 IF( nmn /= 0 ) THEN
319 aaa = sqrt(nmn /
320 . ((bminma(7)-bminma(10))*(bminma(8)-bminma(11))
321 . +(bminma(8)-bminma(11))*(bminma(9)-bminma(12))
322 . +(bminma(9)-bminma(12))*(bminma(7)-bminma(10))))
323 ELSE
324 aaa = 0
325 ENDIF
326
327 aaa = 0.75*aaa
328
329 nbx = nint(aaa*(bminma(7)-bminma(10)))
330 nby = nint(aaa*(bminma(8)-bminma(11)))
331 nbz = nint(aaa*(bminma(9)-bminma(12)))
332
336
337 nbx8=nbx
338 nby8=nby
339 nbz8=nbz
340 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
342
343 IF(res8 > lvoxel8) THEN
345 aaa = aaa/((nbx8+2)*(nby8+2)*(nbz8+2))
346 aaa = aaa**(third)
347 nbx = int((nbx+2)*aaa)-2
348 nby = int((nby+2)*aaa)-2
349 nbz = int((nbz+2)*aaa)-2
353 ENDIF
354
355 nbx8=nbx
356 nby8=nby
357 nbz8=nbz
358 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
359
360 IF(res8 > lvoxel8) THEN
361 nbx =
min(100,
max(nbx8,1))
362 nby =
min(100,
max(nby8,1))
363 nbz =
min(100,
max(nbz8,1))
364 ENDIF
365
366
367
368 DO i=
inivoxel,(nbx+2)*(nby+2)*(nbz+2)
370 ENDDO
373 1 nsn ,renum ,nsnr ,isznsnr ,i_mem ,
374 2 irect ,x ,stf ,stfn ,xyzm ,
375 3 nsv ,ii_stok ,cand_n ,eshift ,cand_e ,
376 4 ncontact,noint ,tzinf ,gap_s_l ,gap_m_l ,
377 5
voxel1 ,nbx ,nby ,nbz ,intth ,
378 6 inacti ,ifq ,cand_a,cand_p ,ifpen ,
379 7 nrtm ,nsnrold ,igap ,gap ,gap_s ,
380 8 gap_m ,gapmin ,gapmax ,marge ,curv_max,
381 9 nin ,itask ,bgapsmx ,kremnod ,remnod ,
382 a itab ,flagremnode,drad ,itied ,cand_f ,
383 b dgapload,remote_s_node,list_remote_s_node,
384 c total_nb_nrtm,intheat,idt_therm,nodadt_therm)
385
386
387
388
389
390
391 IF (i_mem ==2) RETURN
392 IF(i_mem==1)THEN
393 nb_n_b = nb_n_b + 1
394 IF ( nb_n_b > ncont) THEN
395 CALL ancmsg(msgid=85,anmode=aninfo,
396 . i1=noint)
398 ENDIF
399 ild = 1
400 ELSEIF(i_mem==2) THEN
401 IF(debug(1)>=1) THEN
402 iwarn = iwarn+1
403#include "lockon.inc"
404 WRITE(istdo,*)' **WARNING INTERFACE/MEMORY'
405 WRITE(iout,*)' **WARNING INTERFACE NB:',noint
406 WRITE(iout,*)' TOO MANY POSSIBLE IMPACTS'
407 WRITE(iout,*)' SIZE OF INFLUENCE ZONE IS'
408 WRITE(iout,*)' MULTIPLIED BY 0.75'
409#include "lockoff.inc"
410 ENDIF
411 RETURN
412 tzinf = three_over_4*tzinf
413
414
415
416 IF( tzinf<=
max(gap+dgapload,drad) )
THEN
417 CALL ancmsg(msgid=98,anmode=aninfo,
418 . i1=noint,c1='(I7BUCE)')
420 ENDIF
421 ild = 1
422 ELSEIF(i_mem==3)THEN
423 nb_n_b = nb_n_b + 1
424 IF ( nb_n_b > ncont) THEN
425 CALL ancmsg(msgid=100,anmode=aninfo,
426 . i1=noint)
428 ENDIF
429 ild = 1
430 ENDIF
431
432 RETURN
subroutine i7trivox(nsn, renum, nsnr, isznsnr, i_mem, irect, x, stf, stfn, xyzm, nsv, ii_stok, cand_n, eshift, cand_e, mulnsn, noint, tzinf, gap_s_l, gap_m_l, voxel, nbx, nby, nbz, intth, inacti, ifq, cand_a, cand_p, ifpen, nrtm, nsnrold, igap, gap, gap_s, gap_m, gapmin, gapmax, marge, curv_max, nin, itask, bgapsmx, kremnod, remnod, itab, flagremnode, drad, itied, cand_f, dgapload, remote_s_node, list_remote_s_node, total_nb_nrtm, intheat, idt_therm, nodadt_therm)
integer, dimension(lvoxel) voxel1
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)