33!||====================================================================
35 1 X ,IRECT ,NSV ,INACTI ,CAND_P ,
36 2 NMN ,NRTM ,NSN ,CAND_E ,CAND_N ,
37 3 GAP ,NOINT ,II_STOK ,NCONTACT ,BMINMA ,
38 4 TZINF ,MAXBOX ,MINBOX ,MWAG ,CURV_MAX,
39 5 NB_N_B ,ESHIFT ,ILD ,IFQ ,IFPEN ,
40 8 STFN ,NIN ,STF ,IGAP ,GAP_S ,
41 A NSNR ,NCONT ,RENUM ,NSNROLD ,GAP_M ,
42 B GAPMIN ,GAPMAX ,CURV_MAX_MAX ,NUM_IMP ,GAP_S_L ,
43 C GAP_M_L ,INTTH ,ITASK ,BGAPSMX ,I_MEM ,
44 D KREMNOD ,REMNOD ,ITAB ,FLAGREMNODE ,DRAD ,
45 E ITIED ,CAND_F ,DGAPLOAD ,INTHEAT ,IDT_THERM,
55#include "implicit_f.inc"
64 INTEGER NMN, NRTM, NSN, NOINT,IDT,INACTI,IFQ, NIN, NSNR, NSNROLD
65 INTEGER IRECT(4,*),NSV(*),MWAG(*), RENUM(*),NUM_IMP, ITASK
66 INTEGER CAND_E(*),CAND_N(*),IFPEN(*),KREMNOD(*),REMNOD(*),ITAB(*)
67 INTEGER NCONTACT,ESHIFT,ILD,NB_N_B, IGAP, NCONT,INTTH,I_MEM,
68 * II_STOK, FLAGREMNODE, ITIED
69 INTEGER,
INTENT(IN) :: INTHEAT
70 INTEGER,
INTENT(IN) :: IDT_THERM
71 INTEGER,
INTENT(IN) :: NODADT_THERM
74 . GAP,TZINF,MAXBOX,MINBOX,CURV_MAX_MAX,
75 . GAPMIN, GAPMAX, BMINMA(12),CURV_MAX(NRTM),BGAPSMX
76 my_real ,
INTENT(IN) :: drad,dgapload
78 . x(3,*), cand_p(*), stfn(*),
79 . stf(*), gap_s(*), gap_m(*),
80 . gap_s_l(*), gap_m_l(*), cand_f(*)
85 parameter(i_add_max = 1001)
86 INTEGER ADD(2,I_ADD_MAX)
88 INTEGER I, J, IP0, IP1,
89 . loc_proc, n, isznsnr,
93 . xyzm(6,i_add_max-1), marge, aaa
102 INTEGER (KIND=8) :: NBX8,NBY8,NBZ8,RES8,LVOXEL8
106 maxsiz = 10 * (nrtm+100)
130 ip1 = ip0 + nsn + nsnrold + 3
137 xyzm(1,i_add) = bminma(4)
138 xyzm(2,i_add) = bminma(5)
139 xyzm(3,i_add) = bminma(6)
140 xyzm(4,i_add) = bminma(1)
141 xyzm(5,i_add) = bminma(2)
142 xyzm(6,i_add) = bminma(3)
146 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.
147 . ifq>0.OR.num_imp>0.OR.itied/=0)
THEN
153 marge = tzinf - (gap+dgapload)
155 1 add ,nsn ,renum ,nsnr ,isznsnr ,
156 2 irect ,x ,stf ,stfn ,xyzm ,
157 3 i_add ,nsv ,maxsiz ,ii_stok ,cand_n ,
158 4 cand_e,ncontact,noint ,tzinf ,maxbox ,
159 5 minbox,i_mem ,nb_n_b ,i_add_max,eshift ,
160 6 inacti,ifq ,mwag(ip0), cand_p ,ifpen ,
161 7 nrtm ,nsnrold,igap ,gap ,gap_s ,
162 8 gap_m ,gapmin ,gapmax ,marge ,curv_max ,
163 9 nin ,gap_s_l,gap_m_l,intth, drad ,itied ,
164 a cand_f ,kremnod ,remnod ,flagremnode,dgapload,
165 b intheat, idt_therm, nodadt_therm)
175 IF (i_mem /= 0)
RETURN
195 1 X ,IRECT ,NSV ,INACTI ,CAND_P ,
196 2 NMN ,NRTM ,NSN ,CAND_E ,CAND_N ,
197 3 GAP ,NOINT ,II_STOK ,NCONTACT ,BMINMA ,
198 4 TZINF ,MAXBOX ,MINBOX ,MWAG ,CURV_MAX,
199 5 NB_N_B ,ESHIFT ,ILD ,IFQ ,IFPEN ,
200 8 STFN ,NIN ,STF ,IGAP ,GAP_S ,
201 A NSNR ,NCONT ,RENUM ,NSNROLD ,GAP_M ,
202 B GAPMIN ,GAPMAX ,CURV_MAX_MAX,NUM_IMP,GAP_S_L ,
203 C GAP_M_L ,INTTH ,ITASK ,BGAPSMX ,I_MEM ,
204 D KREMNOD ,REMNOD ,ITAB ,FLAGREMNODE, DRAD ,
205 E ITIED ,CAND_F ,DGAPLOAD,REMOTE_S_NODE,LIST_REMOTE_S_NODE,
206 F TOTAL_NB_NRTM,INTHEAT,IDT_THERM,NODADT_THERM)
215#include "implicit_f.inc"
216#include "comlock.inc"
220#include "units_c.inc"
222#include "com01_c.inc"
226 INTEGER NMN,NSN, NOINT,IDT,INACTI,IFQ, NIN, NSNR, NSNROLD
227 INTEGER,
INTENT(in) :: NRTM
228 INTEGER,
INTENT(in) :: TOTAL_NB_NRTM
229 INTEGER IRECT(4,*),NSV(*),MWAG(*), RENUM(*),NUM_IMP, ITASK
230 INTEGER CAND_E(*),CAND_N(*),IFPEN(*),KREMNOD(*),REMNOD(*),ITAB(*)
231 INTEGER NCONTACT,ESHIFT,ILD,NB_N_B, IGAP, NCONT,INTTH,I_MEM,
232 * II_STOK, FLAGREMNODE, ITIED
233 INTEGER,
INTENT(inout) :: REMOTE_S_NODE
234 INTEGER,
INTENT(in) :: INTHEAT
235 INTEGER,
INTENT(in) :: IDT_THERM
236 INTEGER,
INTENT(in) :: NODADT_THERM
237 INTEGER,
DIMENSION(NSNR),
INTENT(inout) :: LIST_REMOTE_S_NODE
240 . GAP,TZINF,MAXBOX,MINBOX,CURV_MAX_MAX,
241 . GAPMIN, GAPMAX, BMINMA(12),CURV_MAX(NRTM),BGAPSMX
242 my_real ,
INTENT(IN) :: DRAD,DGAPLOAD
244 . X(3,*), CAND_P(*), STFN(*),
245 . STF(*), GAP_S(*), GAP_M(*),
246 . GAP_S_L(*), (*), CAND_F(*)
250 INTEGER I, J, IP0, IP1,
251 . loc_proc, n, isznsnr,
255 . xyzm(6,2), marge, aaa
264 INTEGER (KIND=8) :: NBX8,NBY8,NBZ8,RES8,LVOXEL8
282 ip1 = ip0 + nsn + nsnrold + 3
288 xyzm(1,1) = bminma(4)
289 xyzm(2,1) = bminma(5)
290 xyzm(3,1) = bminma(6)
291 xyzm(4,1) = bminma(1)
292 xyzm(5,1) = bminma(2)
293 xyzm(6,1) = bminma(3)
295 xyzm(1,2) = bminma(10)
296 xyzm(2,2) = bminma(11)
297 xyzm(3,2) = bminma(12)
298 xyzm(4,2) = bminma(7)
299 xyzm(5,2) = bminma(8)
300 xyzm(6,2) = bminma(9)
303 IF(inacti==5.OR.inacti==6.OR.inacti==7.OR.
304 . ifq>0.OR.num_imp>0.OR.itied/=0)
THEN
312 marge = tzinf-
max(gap+dgapload,drad)
329 . ((bminma(7)-bminma(10))*(bminma(8)-bminma(11))
330 . +(bminma(8)-bminma(11))*(bminma(9)-bminma(12))
331 . +(bminma(9)-bminma(12))*(bminma(7)-bminma(10))))
338 nbx = nint(aaa*(bminma(7)-bminma(10)))
339 nby = nint(aaa*(bminma(8)-bminma(11)))
340 nbz = nint(aaa*(bminma(9)-bminma(12)))
349 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
352 IF(res8 > lvoxel8)
THEN
354 aaa = aaa/((nbx8+2)*(nby8+2)*(nbz8+2))
356 nbx = int((nbx+2)*aaa)-2
357 nby = int((nby+2)*aaa)-2
358 nbz = int((nbz+2)*aaa)-2
367 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
369 IF(res8 > lvoxel8)
THEN
370 nbx =
min(100,
max(nbx8,1))
371 nby =
min(100,
max(nby8,1))
372 nbz =
min(100,
max(nbz8,1))
377 DO i=
inivoxel,(nbx+2)*(nby+2)*(nbz+2)
382 1 nsn ,renum ,nsnr ,isznsnr ,i_mem ,
383 2 irect ,x ,stf ,stfn ,xyzm ,
384 3 nsv ,ii_stok ,cand_n ,eshift ,cand_e ,
385 4 ncontact,noint ,tzinf ,gap_s_l ,gap_m_l ,
386 5
voxel1 ,nbx ,nby ,nbz ,intth ,
387 6 inacti ,ifq ,mwag(ip0),cand_p ,ifpen ,
388 7 nrtm ,nsnrold ,igap ,gap ,gap_s ,
389 8 gap_m ,gapmin ,gapmax ,marge ,curv_max,
390 9 nin ,itask ,bgapsmx ,kremnod
391 a itab ,flagremnode,drad ,itied ,cand_f ,
392 b dgapload,remote_s_node,list_remote_s_node,
393 c total_nb_nrtm,intheat,idt_therm,nodadt_therm)
401 IF (i_mem ==2)
RETURN
404 IF ( nb_n_b > ncont)
THEN
405 CALL ancmsg(msgid=85,anmode=aninfo,
410 ELSEIF(i_mem==2)
THEN
414 WRITE(istdo,*)
' **WARNING INTERFACE/MEMORY'
415 WRITE(iout,*)
' **WARNING INTERFACE NB:',noint
416 WRITE(iout,*)
' TOO MANY POSSIBLE IMPACTS'
417 WRITE(iout,*)
' SIZE OF INFLUENCE ZONE IS'
418 WRITE(iout,*)
' MULTIPLIED BY 0.75'
419#include "lockoff.inc"
422 tzinf = three_over_4*tzinf
426 IF( tzinf<=
max(gap+dgapload,drad) )
THEN
427 CALL ancmsg(msgid=98,anmode=aninfo
428 . i1=noint,c1=
'(I7BUCE)')
434 IF ( nb_n_b > ncont)
THEN
435 CALL ancmsg(msgid=100,anmode=aninfo,
subroutine i7buce(x, irect, nsv, inacti, cand_p, nmn, nrtm, nsn, cand_e, cand_n, gap, noint, ii_stok, ncontact, bminma, tzinf, maxbox, minbox, mwag, curv_max, nb_n_b, eshift, ild, ifq, ifpen, stfn, nin, stf, igap, gap_s, nsnr, ncont, renum, nsnrold, gap_m, gapmin, gapmax, curv_max_max, num_imp, gap_s_l, gap_m_l, intth, itask, bgapsmx, i_mem, kremnod, remnod, itab, flagremnode, drad, itied, cand_f, dgapload, intheat, idt_therm, nodadt_therm)
subroutine i7buce_vox(x, irect, nsv, inacti, cand_p, nmn, nrtm, nsn, cand_e, cand_n, gap, noint, ii_stok, ncontact, bminma, tzinf, maxbox, minbox, mwag, curv_max, nb_n_b, eshift, ild, ifq, ifpen, stfn, nin, stf, igap, gap_s, nsnr, ncont, renum, nsnrold, gap_m, gapmin, gapmax, curv_max_max, num_imp, gap_s_l, gap_m_l, intth, itask, bgapsmx, i_mem, kremnod, remnod, itab, flagremnode, drad, itied, cand_f, dgapload, remote_s_node, list_remote_s_node, total_nb_nrtm, intheat, idt_therm, nodadt_therm)
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 i7tri(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, stf, stfn, j_stok, multimp, istf, itab, gap, gap_s, gap_m, igap, gapmin, gapmax, marge, gap_s_l, gap_m_l, id, titr, ix1, ix2, ix3, ix4, nsvg, prov_n, prov_e, n11, n12, n13, pene, 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, stif)
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)