48
49
50
54
55
56
57
58#include "implicit_f.inc"
59#include "comlock.inc"
60
61
62
63#include "units_c.inc"
64#include "warn_c.inc"
65
66
67
68 INTEGER NMN, NRTM, NSN, NOINT,IDT,, NIN, NRTSR,
69 . IGAP,IAUTO, I_MEM, ITASK
70 INTEGER IRECTS(2,*),IRECTM(2,*),ADDCM(*),CHAINE(2,*)
71 INTEGER CAND_M(*),CAND_S(*),IFPEN(*),FLAGREMNODE,KREMNODE(*),(*)
72 INTEGER ESHIFT,ILD,NB_N_B, NCONTACT, NCONT, ITAB(*),
73 . IFORM,II_STOK
74
76 . tzinf,maxbox,minbox,bminma(6),bgapsmx
78 . maxgap,gapmin,gap
79 my_real ,
INTENT(IN) :: dgapload,drad
81 . x(3,*),stifs(*),penis(2,*),stifm(*),
82 . gap_s(*),gap_m(*),gap_s_l(*),gap_m_l(*)
83
84
85
86 INTEGER I_ADD_MAX,ISZNSNR
87 parameter(i_add_max = 1001)
88
89 INTEGER I, J, N1, N2, I_ADD, MAXSIZ,JJ,
90 . ADD(2,I_ADD_MAX), N
92 . xyzm(6,i_add_max-1), marge, aaa
94 . dd,dd1,marge_st,dx1,dy1,dz1
95 INTEGER :: L
96 INTEGER NB_OLD(2,I_ADD_MAX+1)
97 INTEGER NBX,NBY,NBZ
98 INTEGER (KIND=8) :: NBX8,NBY8,NBZ8,RES8,LVOXEL8
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118 maxsiz = 3*(
max(nrtm,nrts+nrtsr)+100)
119
120
121
122
123
124
125
126 add(1,1) = 0
127 add(2,1) = 0
128 add(1,2) = 0
129 add(2,2) = 0
130 i_add = 1
131 xyzm(1,i_add) = bminma(4)
132 xyzm(2,i_add) = bminma(5)
133 xyzm(3,i_add) = bminma(6)
134 xyzm(4,i_add) = bminma(1)
135 xyzm(5,i_add) = bminma(2)
136 xyzm(6,i_add) = bminma(3)
137 i_mem = 0
138
139 IF (iform /= 2) THEN
140 isznsnr = 0
141 DO i=1,nrtm
142 addcm(i)=0
143 ENDDO
144 ELSE
145 isznsnr = nrtsr
146 ENDIF
147
148
149
150
151 marge = tzinf -
max(maxgap+dgapload,drad)
152
153 IF( nmn /= 0 ) THEN
154 aaa = sqrt(nmn /
155 . ((bminma(1)-bminma(4))*(bminma(2)-bminma(5))
156 . +(bminma(2)-bminma(5))*(bminma(3)-bminma(6))
157 . +(bminma(3)-bminma(6))*(bminma(1)-bminma(4))))
158 ELSE
159 aaa = 0
160 ENDIF
161
162 aaa = 0.75*aaa
163
164 nbx = nint(aaa*(bminma(1)-bminma(4)))
165 nby = nint(aaa*(bminma(2)-bminma(5)))
166 nbz = nint(aaa*(bminma(3)-bminma(6)))
170
171 nbx8=nbx
172 nby8=nby
173 nbz8=nbz
174 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
176
177 IF(res8 > lvoxel8)THEN
179 aaa = aaa/((nbx8+2)*(nby8+2)*(nbz8+2))
180 aaa = aaa**(third)
181 nbx = int((nbx+2)*aaa)-2
182 nby = int((nby+2)*aaa)-2
183 nbz = int((nbz+2)*aaa)-2
187 nbx8 = nbx
188 nby8 = nby
189 nbz8 = nbz
190 res8=(nbx8+2)*(nby8+2)*(nbz8+2)
191 END IF
192
193
194 IF(res8 > lvoxel8) THEN
195 nbx =
min(100,
max(nbx8,1))
196 nby =
min(100,
max(nby8,1))
197 nbz =
min(100,
max(nbz8,1))
198 END IF
199
200 DO i=
inivoxel,(nbx+2)*(nby+2)*(nbz+2)
202 ENDDO
204
205
206
208 1 irects ,irectm ,x ,nrtm ,nrtsr ,
209 2 xyzm ,ii_stok ,cand_s ,cand_m ,ncontact,
210 3 noint ,tzinf ,i_mem ,eshift ,addcm ,
211 4 chaine ,nrts ,itab ,stifs ,stifm ,
212 5 iauto ,
voxel1 ,nbx ,nby ,nbz ,
213 6 itask ,ifpen ,iform ,gapmin ,drad ,
214 7 marge ,gap_s ,gap_m ,gap_s_l, gap_m_l,
215 8 bgapsmx, igap ,gap ,flagremnode,kremnode,
216 9 remnode,dgapload )
217
219
220 100 CONTINUE
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245 IF (i_mem == 2) RETURN
246
247 IF(i_mem==1)THEN
248 nb_n_b = nb_n_b + 1
249 IF ( nb_n_b >
max(nrtm,nrts))
THEN
250 CALL ancmsg(msgid=85,anmode=aninfo,
251 . i1=noint)
253 ENDIF
254 ild = 1
255 ELSEIF(i_mem==2) THEN
256 IF(debug(1)>=1) THEN
257 iwarn = iwarn+1
258#include "lockon.inc"
259 WRITE(istdo,*)' **WARNING INTERFACE/MEMORY'
260 WRITE(iout,*)' **WARNING INTERFACE NB:',noint
261 WRITE(iout,*)' TOO MANY POSSIBLE IMPACTS'
262 WRITE(iout,*)' SIZE OF INFLUENCE ZONE IS'
263 WRITE(iout,*)' MULTIPLIED BY 0.75'
264#include "lockoff.inc"
265 ENDIF
266 tzinf = three_over_4*tzinf
267
268
269
270 IF( tzinf<=
max(maxgap+dgapload,drad) )
THEN
271 CALL ancmsg(msgid=98,anmode=aninfo,
272 . i1=noint,c1='(I11BUCE)')
274 ENDIF
275 ild = 1
276 ELSEIF(i_mem==3)THEN
277 nb_n_b = nb_n_b + 1
278 IF ( nb_n_b >
max(nrtm,nrts))
THEN
279 CALL ancmsg(msgid=99,anmode=aninfo,
280 . i1=noint,c1='(I11BUCE)')
282 ENDIF
283 ild = 1
284 ENDIF
285
286 RETURN
subroutine i11trivox(irects, irectm, x, nrtm, nrtsr, xyzm, ii_stok, cand_s, cand_m, nsn4, noint, tzinf, i_mem, eshift, addcm, chaine, nrts, itab, stfs, stfm, iauto, voxel, nbx, nby, nbz, itask, ifpen, iform, gapmin, drad, marge, gap_s, gap_m, gap_s_l, gap_m_l, bgapsmx, igap, gap, flagremnode, kremnode, remnode, dgapload)
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)