45
46
47
50
51
52
53#include "implicit_f.inc"
54#include "comlock.inc"
55
56
57
58#include "com01_c.inc"
59#include "task_c.inc"
60
61
62
63 INTEGER NMN, NRTM, NSN, NOINT,IDT,NIN, NSNR
64 INTEGER IRECT(4,*),NSV(*),ITASK,ILEV,IEDGE,NSNE
65 INTEGER CAND_E(*),CAND_N(*),MSEGTYP(*)
66 INTEGER NCONTACT,ESHIFT,ILD,NB_N_B, NCONT,I_MEM,
67 . II_STOK,ITAB(*),NBINFLG(*),MBINFLG(*),ISEADD(*),
68 . ISEDGE(*),CAND_T(*),FLAGREMNODE,KREMNOD(*),REMNOD(*),
69 . CAND_A(*) ,RENUM(*),NSNROLD,IRTSE(5,*),IS2SE(2,*)
70
72 . gap,pmax_gap,vmaxdt,
73 . bminma(6),curv_max(nrtm),bgapsmx, marge
74 my_real ,
INTENT(IN) :: dgapload
76 . x(3,*), v(3,*), stfn(*),pene_old(5,nsn),
77 . stf(*), gap_s(*), gap_m(*),edge_l2(*)
78
79
80
81 INTEGER I, J, IP0, IP1, MAXSIZ,
82 . LOC_PROC, N, ISZNSNR,
83 . NSNFIOLD(NSPMD)
84 INTEGER, INTENT(IN) :: INTHEAT
85 INTEGER, INTENT(IN) :: IDT_THERM
86 INTEGER, INTENT(IN) :: NODADT_THERM
87
89 . xyzm(6), aaa
90 INTEGER NBX,NBY,NBZ,NSNF,NSNL
91 INTEGER (KIND=8) :: NBX8,NBY8,NBZ8,RES8,LVOXEL8
92
93
94
95
96
97
98
99
100
101 nsnf = 1 + itask*nsn / nthread
102 nsnl = (itask+1)*nsn / nthread
103 pene_old(4,nsnf:nsnl) = pene_old(3,nsnf:nsnl)
104
105
106
107
108
109
110
111
112 xyzm(1) = bminma(4)
113 xyzm(2) = bminma(5)
114 xyzm(3) = bminma(6)
115 xyzm(4) = bminma(1)
116 xyzm(5) = bminma(2)
117 xyzm(6) = bminma(3)
118 i_mem = 0
119
120 isznsnr = nsnr
121
122
123
124
125
126
127
128 IF( nmn /= 0) THEN
129 aaa = sqrt(nmn /
130 . ((bminma(1)-bminma(4))*(bminma(2)-bminma(5))
131 . +(bminma(2)-bminma(5))*(bminma(3)-bminma(6))
132 . +(bminma(3)-bminma(6))*(bminma(1)-bminma(4))))
133 ELSE
134 aaa = 0
135 ENDIF
136
137 aaa = 0.75*aaa
138
139 nbx = nint(aaa*(bminma(1)-bminma(4)))
140 nby = nint(aaa*(bminma(2)-bminma(5)))
141 nbz = nint(aaa*(bminma(3)-bminma(6)))
145
146 nbx8=nbx
147 nby8=nby
148 nbz8=nbz
149 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
151
152 IF(res8 > lvoxel8) THEN
154 aaa = aaa/((nbx8+2)*(nby8+2)*(nbz8+2))
155 aaa = aaa**(third)
156 nbx = int((nbx+2)*aaa)-2
157 nby = int((nby+2)*aaa)-2
158 nbz = int((nbz+2)*aaa)-2
162 ENDIF
163
164 nbx8=nbx
165 nby8=nby
166 nbz8=nbz
167 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
168
169 IF(res8 > lvoxel8) THEN
170 nbx =
min(100,
max(nbx8,1))
171 nby =
min(100,
max(nby8,1))
172 nbz =
min(100,
max(nbz8,1))
173 ENDIF
174
175
176
177
178 DO i=
inivoxel,(nbx+2)*(nby+2)*(nbz+2)
180 ENDDO
182
183
185 1 nsn ,nsnr ,isznsnr ,i_mem ,vmaxdt ,
186 2 irect ,x ,stf ,stfn ,xyzm ,
187 3 nsv ,ii_stok ,cand_n ,eshift ,cand_e ,
188 4 ncontact,noint ,v ,bgapsmx ,
189 5
voxel1 ,nbx ,nby ,nbz ,pmax_gap ,
190 6 nrtm ,gap_s ,gap_m ,marge ,curv_max ,
191 7 nin ,itask ,pene_old,itab ,nbinflg ,
192 8 mbinflg ,ilev ,msegtyp ,edge_l2 ,iedge ,
193 9 iseadd ,isedge ,cand_t ,flagremnode,kremnod,
194 a remnod ,cand_a ,renum ,nsnrold ,irtse ,
195 b is2se ,nsne ,dgapload,intheat,idt_therm,nodadt_therm)
196 234 continue
197
198
199
200
201
202
203
204 RETURN
subroutine i24trivox(nsn, nsnr, isznsnr, i_mem, vmaxdt, irect, x, stf, stfn, xyzm, nsv, ii_stok, cand_n, eshift, cand_e, mulnsn, noint, v, bgapsmx, voxel, nbx, nby, nbz, pmax_gap, nrtm, gap_s, gap_m, marge, curv_max, nin, itask, pene_old, itab, nbinflg, mbinflg, ilev, msegtyp, edge_l2, iedge, iseadd, isedge, cand_t, flagremnode, kremnod, remnod, cand_a, renum, nsnrold, irtse, is2se, nsne, dgapload, intheat, idt_therm, nodadt_therm)
integer, dimension(lvoxel) voxel1