39
40
41
42 USE elbufdef_mod
43
44
45
46#include "implicit_f.inc"
47
48
49
50#include "mvsiz_p.inc"
51
52
53
54
55
56
57 INTEGER NEL
58
59 my_real volgp(mvsiz,8),qvis(nel),
60 . px1(mvsiz,8),px2(mvsiz,8),px3(mvsiz,8),px4(mvsiz,8),
61 . px5(mvsiz,8),px6(mvsiz,8),px7(mvsiz,8),px8(mvsiz,8),
62 . py1(mvsiz,8),py2(mvsiz,8),py3(mvsiz,8),py4(mvsiz,8),
63 . py5(mvsiz,8),py6(mvsiz,8),py7(mvsiz,8),py8(mvsiz,8),
64 . pz1(mvsiz,8),pz2(mvsiz,8),pz3(mvsiz,8),pz4(mvsiz,8),
65 . pz5(mvsiz,8),pz6(mvsiz,8),pz7(mvsiz,8),pz8(mvsiz,8)
66 my_real :: f11(mvsiz),f12(mvsiz),f13(mvsiz),f14(mvsiz),
67 . f15(mvsiz), f16(mvsiz), f17(mvsiz), f18(mvsiz), f21(mvsiz),
68 . f22(mvsiz), f23(mvsiz), f24(mvsiz), f25(mvsiz), f26(mvsiz),
69 . f27(mvsiz), f28(mvsiz), f31(mvsiz), f32(mvsiz), f33(mvsiz),
70 . f34(mvsiz), f35(mvsiz), f36(mvsiz), f37(mvsiz), f38(mvsiz)
71 my_real,
DIMENSION(MVSIZ,6),
INTENT(INOUT) :: svis
72 TYPE (BUF_LAY_) ,TARGET :: BUFLY
73
74
75
76 INTEGER I,J,IPT,II(6)
77
79 . s1, s2, s3,
80 . s4, s5, s6
81 TYPE(L_BUFEL_) ,POINTER :: LBUF
82
83
84 DO i=1,6
85 ii(i) = nel*(i-1)
86 ENDDO
87
88 DO i=1,nel
89 f11(i)=zero
90 f21(i)=zero
91 f31(i)=zero
92 f12(i)=zero
93 f22(i)=zero
94 f32(i)=zero
95 f13(i)=zero
96 f23(i)=zero
97 f33(i)=zero
98 f14(i)=zero
99 f24(i)=zero
100 f34(i)=zero
101 f15(i)=zero
102 f25(i)=zero
103 f35(i)=zero
104 f16(i)=zero
105 f26(i)=zero
106 f36(i)=zero
107 f17(i)=zero
108 f27(i)=zero
109 f37(i)=zero
110 f18(i)=zero
111 f28(i)=zero
112 f38(i)=zero
113 ENDDO
114
115 DO ipt=1,8
116 lbuf => bufly%LBUF(1,1,ipt)
117 DO i=1,nel
118 j = 6*(i-1)
119 s1=(lbuf%SIG(ii(1)+i)+svis(i,1)-qvis(i))*volgp(i,ipt)
120 s2=(lbuf%SIG(ii(2)+i)+svis(i,2)-qvis(i))*volgp(i,ipt)
121 s3=(lbuf%SIG(ii(3)+i)+svis(i,3)-qvis(i))*volgp(i,ipt)
122 s4=(lbuf%SIG(ii(4)+i)+svis(i,4))*volgp(i,ipt)
123 s5=(lbuf%SIG(ii(5)+i)+svis(i,5))*volgp(i,ipt)
124 s6=(lbuf%SIG(ii(6)+i)+svis(i,6))*volgp(i,ipt)
125
126 f11(i)=f11(i)
127 - -(s1*px1(i,ipt)+s4*py1(i,ipt)+s6*pz1(i,ipt))
128 f21(i)=f21(i)
129 - -(s2*py1(i,ipt)+s4*px1(i,ipt)+s5*pz1(i,ipt))
130 f31(i)=f31(i)
131 - -(s3*pz1(i,ipt)+s6*px1(i,ipt)+s5*py1(i,ipt))
132 f12(i)=f12(i)
133 - -(s1*px2(i,ipt)+s4*py2(i,ipt)+s6*pz2(i,ipt))
134 f22(i)=f22(i)
135 - -(s2*py2(i,ipt)+s4*px2(i,ipt)+s5*pz2(i,ipt))
136 f32(i)=f32(i)
137 - -(s3*pz2(i,ipt)+s6*px2(i,ipt)+s5*py2(i,ipt))
138 f13(i)=f13(i)
139 - -(s1*px3(i,ipt)+s4*py3(i,ipt)+s6*pz3(i,ipt))
140 f23(i)=f23(i)
141 - -(s2*py3(i,ipt)+s4*px3(i,ipt)+s5*pz3(i,ipt))
142 f33(i)=f33(i)
143 - -(s3*pz3(i,ipt)+s6*px3(i,ipt)+s5*py3(i,ipt))
144 f14(i)=f14(i)
145 - -(s1*px4(i,ipt)+s4*py4(i,ipt)+s6*pz4(i,ipt))
146 f24(i)=f24(i)
147 - -(s2*py4(i,ipt)+s4*px4(i,ipt)+s5*pz4(i,ipt))
148 f34(i)=f34(i)
149 - -(s3*pz4(i,ipt)+s6*px4(i,ipt)+s5*py4(i,ipt))
150 f15(i)=f15(i)
151 - -(s1*px5(i,ipt)+s4*py5(i,ipt)+s6*pz5(i,ipt))
152 f25(i)=f25(i)
153 - -(s2*py5(i,ipt)+s4*px5(i,ipt)+s5*pz5(i,ipt))
154 f35(i)=f35(i)
155 - -(s3*pz5(i,ipt)+s6*px5(i,ipt)+s5*py5(i,ipt))
156 f16(i)=f16(i)
157 - -(s1*px6(i,ipt)+s4*py6(i,ipt)+s6*pz6(i,ipt))
158 f26(i)=f26(i)
159 - -(s2*py6(i,ipt)+s4*px6(i,ipt)+s5*pz6(i,ipt))
160 f36(i)=f36(i)
161 - -(s3*pz6(i,ipt)+s6*px6(i,ipt)+s5*py6(i,ipt))
162 f17(i)=f17(i)
163 - -(s1*px7(i,ipt)+s4*py7(i,ipt)+s6*pz7(i,ipt))
164 f27(i)=f27(i)
165 - -(s2*py7(i,ipt)+s4*px7(i,ipt)+s5*pz7(i,ipt))
166 f37(i)=f37(i)
167 - -(s3*pz7(i,ipt)+s6*px7(i,ipt)+s5*py7(i,ipt))
168 f18(i)=f18(i)
169 - -(s1*px8(i,ipt)+s4*py8(i,ipt)+s6*pz8(i,ipt))
170 f28(i)=f28(i)
171 - -(s2*py8(i,ipt)+s4*px8(i,ipt)+s5*pz8(i,ipt))
172 f38(i)=f38(i)
173 - -(s3*pz8(i,ipt)+s6*px8(i,ipt)+s5*py8(i,ipt))
174 ENDDO
175
176 ENDDO
177
178 RETURN