50 use element_mod , only : nixs
51
52
53
54#include "implicit_f.inc"
55
56
57
58
59
60
61 INTEGER, INTENT(INOUT) :: ISORTH
62
64 . x(3,*),tens(6),gama(6)
65 INTEGER IXS(NIXS), KCVT, KHBE, ITYP
66
67
68
69
71 . x1, x2, x3, x4,
72 . x5, x6, x7, x8,
73 . y1, y2, y3, y4,
74 . y5, y6, y7, y8,
75 . z1, z2, z3, z4,
76 . z5, z6, z7, z8,
77 . l11,l12,l13,l22,l23,l33,
78 . r11,r12,r13,r21,r22,r23,r31,r32,r33,
79 . g11,g22,g33,g12,g21,g23,g32,g13,g31,
80 . t11,t22,t33,t12,t21,t23,t32,t13,t31,
81 . s11,s12,s21,s13,s31,s22,s23,s32,s33
82 INTEGER NC1, NC2, NC3, NC4,
83 . NC5, NC6, NC7, NC8
84
85
86 IF (kcvt==0.AND.isorth==0) RETURN
87 nc1=ixs(2)
88 nc2=ixs(3)
89 nc3=ixs(4)
90 nc4=ixs(5)
91 nc5=ixs(6)
92 nc6=ixs(7)
93 nc7=ixs(8)
94 nc8=ixs(9)
95
96
97
98 x1=x(1,nc1)
99 y1=x(2,nc1)
100 z1=x(3,nc1)
101 x2=x(1,nc2)
102 y2=x(2,nc2)
103 z2=x(3,nc2)
104 x3=x(1,nc3)
105 y3=x(2,nc3)
106 z3=x(3,nc3)
107 x4=x(1,nc4)
108 y4=x(2,nc4)
109 z4=x(3,nc4)
110 x5=x(1,nc5)
111 y5=x(2,nc5)
112 z5=x(3,nc5)
113 x6=x(1,nc6)
114 y6=x(2,nc6)
115 z6=x(3,nc6)
116 x7=x(1,nc7)
117 y7=x(2,nc7)
118 z7=x(3,nc7)
119 x8=x(1,nc8)
120 y8=x(2,nc8)
121 z8=x(3,nc8)
122
123 IF (ityp == 43) THEN
124
126 . x1, x2, x3, x4, x5, x6, x7, x8,
127 . y1, y2, y3, y4, y5, y6, y7, y8,
128 . z1, z2, z3, z4, z5, z6, z7, z8,
129 . r11, r12, r13, r21, r22, r23, r31, r32, r33)
130 ELSEIF(khbe/=15)THEN
131
132 IF (khbe==24.OR.khbe==14) THEN
134 . x1, x2, x3, x4, x5, x6, x7, x8,
135 . y1, y2, y3, y4, y5, y6, y7, y8,
136 . z1, z2, z3, z4, z5, z6, z7, z8,
137 . r12, r13, r11, r22, r23, r21, r32, r33, r31)
138 ELSE
140 . x1, x2, x3, x4, x5, x6, x7, x8,
141 . y1, y2, y3, y4, y5, y6, y7, y8,
142 . z1, z2, z3, z4, z5, z6, z7, z8,
143 . r11, r12, r13, r21, r22, r23, r31, r32, r33)
144 ENDIF
145 ELSE
147 . x1, x2, x3, x4, x5, x6, x7, x8,
148 . y1, y2, y3, y4, y5, y6, y7, y8,
149 . z1, z2, z3, z4, z5, z6, z7, z8,
150 . r11, r12, r13, r21, r22, r23, r31, r32, r33)
151 ENDIF
152
153
154
155 IF (kcvt==2) THEN
156 IF (isorth > 0) THEN
157 g11=gama(1)
158 g21=gama(2)
159 g31=gama(3)
160 g12=gama(4)
161 g22=gama(5)
162 g32=gama(6)
163 g13=g21*g32-g31*g22
164 g23=g31*g12-g11*g32
165 g33=g11*g22-g21*g12
166
167 t11=r11*g11+r12*g21+r13*g31
168 t12=r11*g12+r12*g22+r13*g32
169 t13=r11*g13+r12*g23+r13*g33
170 t21=r21*g11+r22*g21+r23*g31
171 t22=r21*g12+r22*g22+r23*g32
172 t23=r21*g13+r22*g23+r23*g33
173 t31=r31*g11+r32*g21+r33*g31
174 t32=r31*g12+r32*g22+r33*g32
175 t33=r31*g13+r32*g23+r33*g33
176 r11=t11
177 r12=t12
178 r13=t13
179 r21=t21
180 r22=t22
181 r23=t23
182 r31=t31
183 r32=t32
184 r33=t33
185 ENDIF
186 ENDIF
187
188
189
190
191
192
193
194
195
196
197
198
199
200 l11 =tens(1)
201 l22 =tens(2)
202 l33 =tens(3)
203 l12 =tens(4)
204 l23 =tens(5)
205 l13 =tens(6)
206 s11 =l11*r11+l12*r12+l13*r13
207 s12 =l11*r21+l12*r22+l13*r23
208 s13 =l11*r31+l12*r32+l13*r33
209 s21 =l12*r11+l22*r12+l23*r13
210 s22 =l12*r21+l22*r22+l23*r23
211 s23 =l12*r31+l22*r32+l23*r33
212 s31 =l13*r11+l23*r12+l33*r13
213 s32 =l13*r21+l23*r22+l33*r23
214 s33 =l13*r31+l23*r32+l33*r33
215 tens(1)=r11*s11+r12*s21+r13*s31
216 tens(2)=r21*s12+r22*s22+r23*s32
217 tens(3)=r31*s13+r32*s23+r33*s33
218 tens(4)=r11*s12+r12*s22+r13*s32
219 tens(5)=r21*s13+r22*s23+r23*s33
220 tens(6)=r11*s13+r12*s23+r13*s33
221
222 RETURN
subroutine scoor431(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
subroutine scortho31(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)
subroutine sortho31(x1, x2, x3, x4, x5, x6, x7, x8, y1, y2, y3, y4, y5, y6, y7, y8, z1, z2, z3, z4, z5, z6, z7, z8, e1x, e2x, e3x, e1y, e2y, e3y, e1z, e2z, e3z)