36
37
38
39
40
41
42
43
45
46
47
48#include "implicit_f.inc"
49
50
51
52#include "com04_c.inc"
53#include "com08_c.inc"
54#include "task_c.inc"
55#include "parit_c.inc"
56#include "param_c.inc"
57
58
59
60 INTEGER NALE(*),ICODT(*),ISKEW(*),ITASK,NODFT,NODLT
61 my_real v(3,numnod),w(3,numnod),dsave(3,*),skew(lskew,*),d(3,numnod),fsky(8,lsky),fskyv(lsky,8)
62
63
64
65 INTEGER N,LCOD, INDX2(1024),I,NINDX2,NISKFT,NISKLT,K
67
68
69
70 fac=zero
71 IF(dt1 > zero)fac=one/dt1
72 IF(
ale%SUB%IFSUB == 0)
THEN
73 DO n=nodft,nodlt
74 w(1,n)=fac*(d(1,n)-dsave(1,n))
75 w(2,n)=fac*(d(2,n)-dsave(2,n))
76 w(3,n)=fac*(d(3,n)-dsave(3,n))
77 dsave(1,n)=v(1,n)
78 dsave(2,n)=v(2,n)
79 dsave(3,n)=v(3,n)
80 IF(nale(n) == 0)THEN
81 v(1,n)=w(1,n)
82 v(2,n)=w(2,n)
83 v(3,n)=w(3,n)
84 ENDIF
85 ENDDO
86 DO i=nodft,nodlt,1024
87 nindx2 = 0
88 DO n = i,
min(nodlt,i+1023)
89 lcod=icodt(n+numnod+numnod)
90 IF(nale(n)*lcod /= 0)THEN
91 nindx2 = nindx2 + 1
92 indx2(nindx2) = n
93 ENDIF
94 ENDDO
95 IF (nindx2 /= 0)
96 .
CALL bcs3v(nindx2,indx2,iskew,icodt(2*numnod+1),v,
97 . w ,skew)
98 ENDDO
99
100 IF(iparit > 0)THEN
101 niskft = 1+itask*lsky/nthread
102 nisklt = (itask+1)*lsky/nthread
103 IF(ivector == 1) THEN
104 DO k=1,8
105 DO i=niskft,nisklt
106 fskyv(i,k)=zero
107 ENDDO
108 ENDDO
109 ELSE
110 DO k=1,8
111 DO i=niskft,nisklt
112 fsky(k,i)=zero
113 ENDDO
114 ENDDO
115 ENDIF
116 ENDIF
117 ENDIF
118
119 RETURN
subroutine bcs3v(nindx, indx, iskew, icodt, w, v, b)