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