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