215
216
217
219
220
221
222#include "implicit_f.inc"
223#include "comlock.inc"
224
225
226
227#include "mvsiz_p.inc"
228
229
230
231#include "com08_c.inc"
232
233
234
235 INTEGER LLT,NC,N_MUL_MX,ITIED,NINT ,NKMAX
236 INTEGER LLL(*),JLL(*),SLL(*),COMNTAG(*),
237 . III(MVSIZ,21),IADLL(*)
238
240 . xll(*),v(3,*),a(3,*)
242 . xx(mvsiz,21),yy(mvsiz,21),zz(mvsiz,21),x(3,*)
243
244
245
246 INTEGER I,IK,NK,IAD,NN
248 . vx,vy,vz,vn,aa
250 . r(mvsiz),s(mvsiz),t(mvsiz),
251 . nsx(mvsiz), nsy(mvsiz), nsz(mvsiz),
252 . nx(mvsiz), ny(mvsiz), nz(mvsiz),
253 . ni(mvsiz,21)
254
255
256
257
258
259
260 CALL i20rst(llt ,r ,s ,t ,ni ,
261 2 nsx ,nsy ,nsz ,nx ,ny ,nz ,
262 3 xx ,yy ,zz )
263
264
265
266 IF(itied==0)THEN
267 DO i=1,llt
268
269
270
271 IF(r(i)>=-one.AND.s(i)>=-one.AND.t(i)>=-one.AND.
272 . r(i)<= one.AND.s(i)<= one.AND.t(i)<= one)THEN
273
274 nk = 21
275 vx = zero
276 vy = zero
277 vz = zero
278 DO ik=1,nk
279 vx = vx - (v(1,iii(i,ik))+dt12*a(1,iii(i,ik)))*ni(i,ik)
280 vy = vy - (v(2,iii(i,ik))+dt12*a(2,iii(i,ik)))*ni(i,ik)
281 vz = vz - (v(3,iii(i,ik))+dt12*a(3,iii(i,ik)))*ni(i,ik)
282 ENDDO
283
284
285
286
287 vn = nsx(i)*vx + nsy(i)*vy + nsz(i)*vz
288
289
290
291 IF(s(i)*vn<=zero)THEN
292
293
294 print *, "s = ",s(i)
295
296
297 aa = one/sqrt(nsx(i)*nsx(i)+nsy(i)*nsy(i)+nsz(i)*nsz(i))
298 nsx(i) = nsx(i)*aa
299 nsy(i) = nsy(i)*aa
300 nsz(i) = nsz(i)*aa
301#include "lockon.inc"
302 nc=nc+1
303 IF(nc>n_mul_mx)THEN
304#include "lockoff.inc"
305 CALL ancmsg(msgid=84,anmode=aninfo)
307 ENDIF
308 iadll(nc+1)=iadll(nc) + 63
309 IF(iadll(nc+1)-1>nkmax)THEN
310#include "lockoff.inc"
311 CALL ancmsg(msgid=84,anmode=aninfo)
313 ENDIF
314 iad = iadll(nc) - 1
315 DO ik=1,21
316 lll(iad+ik) = iii(i,ik)
317 jll(iad+ik) = 1
318 sll(iad+ik) = 0
319 xll(iad+ik) = nsx(i)*ni(i,ik)
320 lll(iad+ik+21) = iii(i,ik)
321 jll(iad+ik+21) = 2
322 sll(iad+ik+21) = 0
323 xll(iad+ik+21) = nsy(i)*ni(i,ik)
324 lll(iad+ik+42) = iii(i,ik)
325 jll(iad+ik+42) = 3
326 sll(iad+ik+42) = 0
327 xll(iad+ik+42) = nsz(i)*ni(i,ik)
328 nn = lll(iad+ik)
329 comntag(nn) = comntag(nn) + 1
330 ENDDO
331 sll(iad+21) = nint
332 sll(iad+42) = nint
333 sll(iad+63) = nint
334#include "lockoff.inc"
335 ENDIF
336 ENDIF
337 ENDDO
338 ELSEIF(itied==1)THEN
339
340
341
342 DO i=1,llt
343
344
345
346 IF(r(i)>=-one.AND.s(i)>=-one.AND.t(i)>=-one.AND.
347 . r(i)<= one.AND.s(i)<= one.AND.t(i)<= one)THEN
348
349 nk = 21
350 vx = zero
351 vy = zero
352 vz = zero
353 DO ik=1,nk
354 vx = vx - (v(1,iii(i,ik))+dt12*a(1,iii(i,ik)))*ni(i,ik)
355 vy = vy - (v(2,iii(i,ik))+dt12*a(2,iii(i,ik)))*ni(i,ik)
356 vz = vz - (v(3,iii(i,ik))+dt12*a(3,iii(i,ik)))*ni(i,ik)
357 ENDDO
358
359
360
361
362 vn = nx(i)*vx + ny(i)*vy + nz(i)*vz
363
364
365
366 IF(vn<=zero)THEN
367
368
369 print *, "s = ",s(i)
370
371#include "lockon.inc"
372 IF(nc+3>n_mul_mx)THEN
373#include "lockoff.inc"
374 CALL ancmsg(msgid=84,anmode=aninfo)
376 ENDIF
377 IF(iadll(nc+1)-1+21*3>nkmax)THEN
378#include "lockoff.inc"
379 CALL ancmsg(msgid=84,anmode=aninfo)
381 ENDIF
382
383 nc=nc+1
384 iadll(nc+1)=iadll(nc) + 21
385 iad = iadll(nc) - 1
386 DO ik=1,21
387 lll(iad+ik) = iii(i,ik)
388 jll(iad+ik) = 1
389 sll(iad+ik) = 0
390 xll(iad+ik) = ni(i,ik)
391 nn = lll(iad+ik)
392 comntag(nn) = comntag(nn) + 1
393 ENDDO
394 sll(iad+21) = nint
395
396 nc=nc+1
397 iadll(nc+1)=iadll(nc) + 21
398 iad = iadll(nc) - 1
399 DO ik=1,21
400 lll(iad+ik) = iii(i,ik)
401 jll(iad+ik) = 2
402 sll(iad+ik) = 0
403 xll(iad+ik) = ni(i,ik)
404 nn = lll(iad+ik)
405 comntag(nn) = comntag(nn) + 1
406 ENDDO
407 sll(iad+21) = nint
408
409 nc=nc+1
410 iadll(nc+1)=iadll(nc) + 21
411 iad = iadll(nc) - 1
412 DO ik=1,21
413 lll(iad+ik) = iii(i,ik)
414 jll(iad+ik) = 3
415 sll(iad+ik) = 0
416 xll(iad+ik) = ni(i,ik)
417 nn = lll(iad+ik)
418 comntag(nn) = comntag(nn) + 1
419 ENDDO
420 sll(iad+21) = nint
421#include "lockoff.inc"
422 ENDIF
423 ENDIF
424 ENDDO
425 ELSE
426
427
428
429 DO i=1,llt
430
431
432
433 IF(r(i)>=-one.AND.s(i)>=-one.AND.t(i)>=-one.AND.
434 . r(i)<= one.AND.s(i)<= one.AND.t(i)<= one)THEN
435
436 nk = 21
437
438 print *, "s = ",s(i)
439
440#include "lockon.inc"
441 IF(nc+3>n_mul_mx)THEN
442#include "lockoff.inc"
443 CALL ancmsg(msgid=84,anmode=aninfo)
445 ENDIF
446 IF(iadll(nc+1)-1+21*3>nkmax)THEN
447#include "lockoff.inc"
448 CALL ancmsg(msgid=84,anmode=aninfo)
450 ENDIF
451 nc=nc+1
452 iadll(nc+1)=iadll(nc) + 21
453 iad = iadll(nc) - 1
454 DO ik=1,21
455 lll(iad+ik) = iii(i,ik)
456 jll(iad+ik) = 1
457 sll(iad+ik) = 0
458 xll(iad+ik) = ni(i,ik)
459 nn = lll(iad+ik)
460 comntag(nn) = comntag(nn) + 1
461 ENDDO
462 sll(iad+21) = nint
463
464 nc=nc+1
465 iadll(nc+1)=iadll(nc) + 21
466 iad = iadll(nc) - 1
467 DO ik=1,21
468 lll(iad+ik) = iii(i,ik)
469 jll(iad+ik) = 2
470 sll(iad+ik) = 0
471 xll(iad+ik) = ni(i,ik)
472 nn = lll(iad+ik)
473 comntag(nn) = comntag(nn) + 1
474 ENDDO
475 sll(iad+21) = nint
476
477 nc=nc+1
478 iadll(nc+1)=iadll(nc) + 21
479 iad = iadll(nc) - 1
480 DO ik=1,21
481 lll(iad+ik) = iii(i,ik)
482 jll(iad+ik) = 3
483 sll(iad+ik) = 0
484 xll(iad+ik) = ni(i,ik)
485 nn = lll(iad+ik)
486 comntag(nn) = comntag(nn) + 1
487 ENDDO
488 sll(iad+21) = nint
489
490#include "lockoff.inc"
491 ENDIF
492 ENDDO
493 ENDIF
494
495
496
497 RETURN
subroutine i20rst(llt, r, s, t, ni, nsx, nsy, nsz, nx, ny, nz, xx, yy, zz)
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)