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