40
41
42
43#include "implicit_f.inc"
44
45
46
47#include "mvsiz_p.inc"
48
49
50
51 INTEGER, INTENT(IN) :: NEL
52 INTEGER IXS(NIXS,*)
53
55 . deltax(*),volg(*),
56 . x1(*), x2(*), x3(*), x4(*), x5(*), x6(*), x7(*), x8(*),
57 . y1(*), y2(*), y3(*), y4(*), y5(*), y6(*), y7(*), y8(*),
58 . z1(*), z2(*), z3(*), z4(*), z5(*), z6(*), z7(*), z8(*)
59
60
61
62#include "scr17_c.inc"
63
64
65
66 INTEGER I, J, IPT, IDEGE(MVSIZ)
67
69 . aj11, aj12, aj13, aj21,
70 . aj22, aj23, aj31, aj32,
71 . aj33, ai11, ai12, ai13,
72 . ai21, ai22, ai23, ai31,
73 . ai32, ai33
74
76 . x12(mvsiz), x34(mvsiz), x56(mvsiz),
77 . x78(mvsiz), y12(mvsiz), y34(mvsiz), y56(mvsiz), y78(mvsiz),
78 . z12(mvsiz), z34(mvsiz), z56(mvsiz), z78(mvsiz), x14(mvsiz),
79 . x23(mvsiz), x58(mvsiz), x67(mvsiz), y14(mvsiz), y23(mvsiz),
80 . y58(mvsiz), y67(mvsiz), z14(mvsiz), z23(mvsiz), z58(mvsiz),
81 . z67(mvsiz), x15(mvsiz), x26(mvsiz), x37(mvsiz), x48(mvsiz),
82 . y15(mvsiz), y26(mvsiz), y37(mvsiz), y48(mvsiz), z15(mvsiz),
83 . z26(mvsiz), z37(mvsiz), z48(mvsiz), h(8), vlinv,
84 . delta1,delta2,delta3,
85 . spx1,spx2,spx3,spx4,spx5,spx6,spx7,spx8,
86 . spy1,spy2,spy3,spy4,spy5,spy6,spy7,spy8,
87 . spz1,spz2,spz3,spz4,spz5,spz6,spz7,spz8,
88 . xx1,yy1,zz1,xx2,yy2,zz2,xx3,yy3,zz3,smax(mvsiz),vmin,
89 . p1(8), p2(8), p3(8),vlinc(mvsiz,8)
90
91
92 IF (idts6>0) THEN
94 1 volg, deltax, x1, x2,
95 2 x3, x4, x5, x6,
96 3 x7, x8, y1, y2,
97 4 y3, y4, y5, y6,
98 5 y7, y8, z1, z2,
99 6 z3, z4, z5, z6,
100 7 z7, z8, ixs,
idege,
101 8 nel)
102 ELSE
104 END IF
105
106 DO i=1,nel
107 x12(i)=x1(i)-x2(i)
108 y12(i)=y1(i)-y2(i)
109 z12(i)=z1(i)-z2(i)
110 x34(i)=x3(i)-x4(i)
111 y34(i)=y3(i)-y4(i)
112 z34(i)=z3(i)-z4(i)
113 x56(i)=x5(i)-x6(i)
114 y56(i)=y5(i)-y6(i)
115 z56(i)=z5(i)-z6(i)
116 x78(i)=x7(i)-x8(i)
117 y78(i)=y7(i)-y8(i)
118 z78(i)=z7(i)-z8(i)
119 x14(i)=x1(i)-x4(i)
120 y14(i)=y1(i)-y4(i)
121 z14(i)=z1(i)-z4(i)
122 x23(i)=x2(i)-x3(i)
123 y23(i)=y2(i)-y3(i)
124 z23(i)=z2(i)-z3(i)
125 x58(i)=x5(i)-x8(i)
126 y58(i)=y5(i)-y8(i)
127 z58(i)=z5(i)-z8(i)
128 x67(i)=x6(i)-x7(i)
129 y67(i)=y6(i)-y7(i)
130 z67(i)=z6(i)-z7(i)
131 x15(i)=x1(i)-x5(i)
132 y15(i)=y1(i)-y5(i)
133 z15(i)=z1(i)-z5(i)
134 x26(i)=x2(i)-x6(i)
135 y26(i)=y2(i)-y6(i)
136 z26(i)=z2(i)-z6(i)
137 x37(i)=x3(i)-x7(i)
138 y37(i)=y3(i)-y7(i)
139 z37(i)=z3(i)-z7(i)
140 x48(i)=x4(i)-x8(i)
141 y48(i)=y4(i)-y8(i)
142 z48(i)=z4(i)-z8(i)
143 END DO
144
145 DO ipt=1,8
146 CALL basisf (h,p1,p2,p3,ipt)
147
148 DO i=1,nel
149 aj11=p1(1)*x12(i)+p1(3)*x34(i)+p1(5)*x56(i)+p1(7)*x78(i)
150 aj12=p1(1)*y12(i)+p1(3)*y34(i)+p1(5)*y56(i)+p1(7)*y78(i)
151 aj13=p1(1)*z12(i)+p1(3)*z34(i)+p1(5)*z56(i)+p1(7)*z78(i)
152 aj21=p2(1)*x14(i)+p2(2)*x23(i)+p2(5)*x58(i)+p2(6)*x67(i)
153 aj22=p2(1)*y14(i)+p2(2)*y23(i)+p2(5)*y58(i)+p2(6)*y67(i)
154 aj23=p2(1)*z14(i)+p2(2)*z23(i)+p2(5)*z58(i)+p2(6)*z67(i)
155 aj31=p3(1)*x15(i)+p3(2)*x26(i)+p3(3)*x37(i)+p3(4)*x48
156 aj32=p3(1)*y15(i)+p3(2)*y26(i)+p3(3)*y37(i)+p3(4)*y48(i)
157 aj33=p3(1)*z15(i)+p3(2)*z26(i)+p3(3)*z37(i)+p3(4)*z48(i)
158
159 ai11= aj22*aj33-aj23*aj32
160 ai21=-aj21*aj33+aj23*aj31
161 ai31= aj21*aj32-aj22*aj31
162 vlinc(i,ipt)=aj11*ai11+aj12*ai21+aj13*ai31
163 ENDDO
164 END DO
165
166 DO i=1,nel
167
168 xx1 = x1(i) + x2(i) + x3(i) + x4(i)
169 . - x5(i) - x6(i) - x7(i) - x8(i)
170 yy1 = y1(i) + y2(i) + y3(i) + y4(i)
171 . - y5(i) - y6(i) - y7(i) - y8(i)
172 zz1 = z1(i) + z2(i) + z3(i) + z4(i)
173 . - z5(i) - z6(i) - z7(i) - z8(i)
174 xx2 = x1(i) + x2(i) + x5(i) + x6(i)
175 . - x3(i) - x4(i) - x7(i) - x8(i)
176 yy2 = y1(i) + y2(i) + y5(i) + y6(i)
177 . - y3(i) - y4(i) - y7(i) - y8(i)
178 zz2 = z1(i) + z2(i) + z5(i) + z6(i)
179 . - z3(i) - z4(i) - z7(i) - z8(i)
180 xx3 = x1(i) + x4(i) + x5(i) + x8(i)
181 . - x3(i) - x2(i) - x7(i) - x6(i)
182 yy3 = y1(i) + y4(i) + y5(i) + y8(i)
183 . - y3(i) - y2(i) - y7(i) - y6(i)
184 zz3 = z1(i) + z4(i) + z5(i) + z8(i)
185 . - z3(i) - z2(i) - z7(i) - z6(i)
186
187 smax(i) = (yy1 * zz2 - yy2 * zz1)**2
188 . + (zz1 * xx2 - zz2 * xx1)**2
189 . + (xx1 * yy2 - xx2 * yy1)**2
190 smax(i) =
max(smax(i),(yy1 * zz3 - yy3 * zz1)**2
191 . + (zz1 * xx3 - zz3 * xx1)**2
192 . + (xx1 * yy3 - xx3 * yy1)**2)
193 smax(i) =
max(smax(i),(yy3 * zz2 - yy2 * zz3)**2
194 . + (zz3 * xx2 - zz2 * xx3)**2
195 . + (xx3 * yy2 - xx2 * yy3)**2)
196 ENDDO
197
198 IF (idts6>0) THEN
199 DO i=1,nel
201 vmin =
min(vlinc(i,1),vlinc(i,2),vlinc(i,3),vlinc(i,4),
202 . vlinc(i,5),vlinc(i,6),vlinc(i,7),vlinc(i,8))
203
204 deltax(i)=hundred28*vmin/sqrt(smax(i))
205 ENDIF
206 ENDDO
207 ELSE
208 DO i=1,nel
209 vmin =
min(vlinc(i,1),vlinc(i,2),vlinc(i,3),vlinc(i,4),
210 . vlinc(i,5),vlinc(i,6),vlinc(i,7),vlinc(i,8))
211
212 deltax(i)=hundred28*vmin/sqrt(smax(i))
213 ENDDO
214 ENDIF
215
216
217
218 RETURN
subroutine idege(x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, a, amax, fac, it4, it, indx, n_indx)
subroutine sdlen_dege(volg, lat, x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, ixs, idege, nel)
subroutine basisf(h, p1, p2, p3, ipt)