46
47
48
51
52
53
54#include "implicit_f.inc"
55#include "comlock.inc"
56
57
58
59#include "com01_c.inc"
60#include "units_c.inc"
61#include "warn_c.inc"
62
63
64
65 INTEGER NRTM, NSN, NOINT,IDT,INACTI,NIN,NSNR,NSNROLD,NMN,ITASK
66 INTEGER IRECT(4,*), NSV(*), NUM_IMP, IRECTG(4,*)
67 INTEGER CAND_E(*),CAND_N(*),MSR(*),MWAG(*),RENUM(*),IFPEN(*)
68 INTEGER NCONTACT,ESHIFT,ILD,, I_MEM,IGAP,ICURV,NCONT,
69 . WEIGHT(*),II_STOK
70 INTEGER, INTENT(IN) :: INTHEAT
71 INTEGER, INTENT(IN) :: IDT_THERM
72 INTEGER, INTENT(IN) :: NODADT_THERM
73
75 . gap,tzinf,maxbox,minbox,
76 . gapmin, gapmax, bminma(6),curv_max(nrtm), bgapsmx,
77 . lxm, lym, lzm
79 . x(3,*), stfn(*), stf(*), gap_s(*), gap_m(*),
80 . cand_p(*)
81
82
83
84 INTEGER I_ADD_MAX
85 parameter(i_add_max = 1001)
86
87 INTEGER I, J, I_ADD, IP0, IP1, MAXSIZ,
88 . ADD(2,I_ADD_MAX), LOC_PROC, N, ISZNSNR,
89 . NSNFIOLD(NSPMD)
90
92 . xyzm(6,i_add_max-1), marge, aaa
93
94
95
96
97
98
99
100 INTEGER NBX,NBY,NBZ
101 INTEGER (KIND=8) :: NBX8,NBY8,NBZ8,RES8,LVOXEL8
102
103
104
105
106C
107
108
109
110
111
112
113
114
115
116
117
118
119 maxsiz = 3*(nrtm+100)
120
121 ip0 = 1
122 ip1 = ip0 + nsn + nsnrold + 3
123
124
125
126
127
128
129
130 add(1,1) = 0
131 add(2,1) = 0
132 add(1,2) = 0
133 add(2,2) = 0
134 i_add = 1
135
136
137
138 xyzm(1,i_add) = bminma(4)
139 xyzm(2,i_add) = bminma(5)
140 xyzm(3,i_add) = bminma(6)
141 xyzm(4,i_add) = bminma(1)
142 xyzm(5,i_add) = bminma(2)
143 xyzm(6,i_add) = bminma(3)
144 i_mem = 0
145
146 isznsnr = nsnr
147
148
149
150
151
152 marge = tzinf - sqrt(three)*gap
153
154
155
156
157
158
159
160
161
162
163
164
165 aaa = sqrt(nmn /
166 . ((bminma(1)-bminma(4))*(bminma(2)-bminma(5))
167 . +(bminma(2)-bminma(5))*(bminma(3)-bminma(6))
168 . +(bminma(3)-bminma(6))*(bminma(1)-bminma(4))))
169
170 aaa = 0.75*aaa
171
172 nbx = nint(aaa*(bminma(1)-bminma(4)))
173 nby = nint(aaa*(bminma(2)-bminma(5)))
174 nbz = nint(aaa*(bminma(3)-bminma(6)))
177 nbz
178
179 nbx8=nbx
180 nby8=nby
181 nbz8=nbz
182 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
184
185 IF(res8 > lvoxel8) THEN
187 aaa = aaa/((nbx8+2)*(nby8+2)*(nbz8+2))
188 aaa = aaa**(third)
189 nbx = int((nbx+2)*aaa)-2
190 nby = int((nby+2)*aaa)-2
191 nbz = int((nbz+2)*aaa)-2
195 ENDIF
196
197 nbx8=nbx
198 nby8=nby
199 nbz8=nbz
200 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
201
202 IF(res8 > lvoxel8) THEN
203 nbx =
min(100,
max(nbx8,1))
204 nby =
min(100,
max(nby8,1))
205 nbz =
min(100,
max(nbz8,1))
206 ENDIF
207
208
209
210 DO i=
inivoxel,(nbx+2)*(nby+2)*(nbz+2)
212 ENDDO
214
216 1 nsn ,renum ,nsnr ,isznsnr ,i_mem ,
217 2 irect ,x ,stf ,stfn ,xyzm ,
218 3 nsv ,ii_stok ,cand_n ,eshift ,cand_e ,
219 4 ncontact,noint ,tzinf ,msr ,
221 6 inacti ,mwag(ip0),cand_p ,ifpen ,
222 7 nrtm ,nsnrold ,igap ,gap ,gap_s ,
223 8 gap_m ,gapmin ,gapmax ,marge ,curv_max,
224 9 nin ,itask ,bgapsmx ,intheat,idt_therm,nodadt_therm)
225 234 continue
226
227
228
229
230
231 IF (i_mem ==2) RETURN
232 IF(i_mem==1)THEN
233 nb_n_b = nb_n_b + 1
234 IF ( nb_n_bTHEN
235 IF (istamping == 1)THEN
236 CALL ancmsg(msgid=101,anmode=aninfo,
237 . i1=noint,i2=noint
238 ELSE
239 CALL ancmsg(msgid=85,anmode=aninfo,
240 . i1=noint)
241 ENDIF
243 ENDIF
244 ild = 1
245 ELSEIF(i_mem==2) THEN
246 IF(debug(1)>=1) THEN
247 iwarn = iwarn+1
248#include "lockon.inc"
249 WRITE(istdo,*)' **WARNING INTERFACE/MEMORY'
250 WRITE(iout,*)' **WARNING INTERFACE NB:',noint
251 WRITE(iout,*)' TOO MANY POSSIBLE IMPACTS'
252 WRITE(iout,*)' SIZE OF INFLUENCE ZONE IS'
253 WRITE(iout,*)' MULTIPLIED BY 0.75'
254#include "lockoff.inc"
255 ENDIF
256 RETURN
257 tzinf = three_over_4*tzinf
258
259
260
261 IF( tzinf<=gap ) THEN
262 CALL ancmsg(msgid=98,anmode
263 . i1=noint,c1='(I23BUCE)')
265 ENDIF
266 ild = 1
267 ELSEIF(i_mem==3)THEN
268 nb_n_b = nb_n_b + 1
269 IF ( nb_n_b > ncont) THEN
270 CALL ancmsg(msgid=100,anmode=aninfo,
271 . i1=noint)
273 ENDIF
274 ild = 1
275 ENDIF
276
277 RETURN
subroutine i23trivox(nsn, renum, nsnr, isznsnr, i_mem, irect, x, stf, stfn, xyzm, nsv, ii_stok, cand_n, eshift, cand_e, mulnsn, noint, tzinf, msr, voxel, nbx, nby, nbz, inacti, cand_a, cand_p, ifpen, nrtm, nsnrold, igap, gap, gap_s, gap_m, gapmin, gapmax, marge, curv_max, nin, itask, bgapsmx, 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)