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