37 use element_mod , only : nixs
38
39
40
41#include "implicit_f.inc"
42
43
44
45
47 . x(3,*),gama(6)
48 INTEGER IXS(NIXS), KHBE, ITYP,ICSIG
49
50
51
52
54 . x1, x2, x3, x4,
55 . x5, x6, x7, x8,
56 . y1, y2, y3, y4,
57 . y5, y6, y7, y8,
58 . z1, z2, z3, z4,
59 . z5, z6, z7, z8,
60 .
61 . r11,r12,r13,r21,r22,r23,r31,r32,r33,
62 . g11,g22,g33,g12,g21,g23,g32,g13,g31,
63 . t11,t22,t33,t12,t21,t23,t32,t13,t31,
64 .
65 . cp ,sp
66 INTEGER NC1, NC2, NC3, NC4,
67 . NC5, NC6, NC7, NC8
68
69 nc1=ixs(2)
70 nc2=ixs(3)
71 nc3=ixs(4)
72 nc4=ixs(5)
73 nc5=ixs(6)
74 nc6=ixs(7)
75 nc7=ixs(8)
76 nc8=ixs(9)
77
78
79
80 x1=x(1,nc1)
81 y1=x(2,nc1)
82 z1=x(3,nc1)
83 x2=x(1,nc2)
84 y2=x(2,nc2)
85 z2=x(3,nc2)
86 x3=x(1,nc3)
87 y3=x(2,nc3)
88 z3=x(3,nc3)
89 x4=x(1,nc4)
90 y4=x(2,nc4)
91 z4=x(3,nc4)
92 x5=x(1,nc5)
93 y5=x(2,nc5)
94 z5=x(3,nc5)
95 x6=x(1,nc6)
96 y6=x(2,nc6)
97 z6=x(3,nc6)
98 x7=x(1,nc7)
99 y7=x(2,nc7)
100 z7=x(3,nc7)
101 x8=x(1,nc8)
102 y8=x(2,nc8)
103 z8=x(3,nc8)
104
105 IF(khbe/=15)THEN
106
107 IF (khbe==24.OR.khbe==14) THEN
109 . x1, x2, x3, x4, x5, x6, x7, x8,
110 . y1, y2, y3, y4, y5, y6, y7, y8,
111 . z1, z2, z3, z4, z5, z6, z7, z8,
112 . r12, r13, r11, r22, r23, r21, r32, r33, r31)
113 ELSE
115 . x1, x2, x3, x4, x5, x6, x7, x8,
116 . y1, y2, y3, y4, y5, y6, y7, y8,
117 . z1, z2, z3, z4, z5, z6, z7, z8,
118 . r11, r12, r13, r21, r22, r23, r31, r32, r33)
119 ENDIF
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
128
129
130 IF(ityp == 21 .OR. ityp == 22) THEN
131 cp = gama(1)
132 sp = gama(2)
133 IF(icsig == 10.OR.khbe == 15)THEN
134 t11=r11*cp+r12*sp
135 t12=r21*cp+r22*sp
136 t13=r31*cp+r32*sp
137 t21=r12*cp-r11*sp
138 t22=r22*cp-r21*sp
139 t23=r32*cp-r31*sp
140 ELSEIF(icsig == 100)THEN
141 t11=r13*cp+r11*sp
142 t12=r23*cp+r21*sp
143 t13=r33*cp+r31*sp
144 t21=r11*cp-r13*sp
145 t22=r21*cp-r23*sp
146 t23=r31*cp-r33*sp
147
148 ELSE
149 t11=r12*cp+r13*sp
150 t12=r22*cp+r23*sp
151 t13=r32*cp+r33*sp
152 t21=r13*cp-r12*sp
153 t22=r23*cp-r22*sp
154 t23=r33*cp-r32*sp
155 ENDIF
156 gama(1)=t11
157 gama(2)=t12
158 gama(3)=t13
159 gama(4)=t21
160 gama(5)=t22
161 gama(6)=t23
162 ELSE
163 g11=gama(1)
164 g21=gama(2)
165 g31=gama(3)
166 g12=gama(4)
167 g22=gama(5)
168 g32=gama(6)
169 g13=g21*g32-g31*g22
170 g23=g31*g12-g11*g32
171 g33=g11*g22-g21*g12
172
173 t11=r11*g11+r12*g21+r13*g31
174 t12=r11*g12+r12*g22+r13*g32
175 t13=r11*g13+r12*g23+r13*g33
176 t21=r21*g11+r22*g21+r23*g31
177 t22=r21*g12+r22*g22+r23*g32
178 t23=r21*g13+r22*g23+r23*g33
179 t31=r31*g11+r32*g21+r33*g31
180 t32=r31*g12+r32*g22+r33*g32
181 t33=r31*g13+r32*g23+r33*g33
182 gama(1)=t11
183 gama(2)=t21
184 gama(3)=t31
185 gama(4)=t12
186 gama(5)=t22
187 gama(6)=t32
188 ENDIF
189
190 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)
1.15.0