31
32
33
34#include "implicit_f.inc"
35
36
37
38
39
40
41 INTEGER, INTENT(IN) :: IINT
42 INTEGER, INTENT(IN) :: ISORTH
43
45 . tens(6),gama(6),frame(3,3)
46 INTEGER IXS(NIXS), KCVT, KHBE, ITYP
47
48
49
50
52 . l11,l12,l13,l22,l23,l33,
53 . r11,r12,r13,r21,r22,r23,r31,r32,r33,
54 . g11,g22,g33,g12,g21,g23,g32,g13,g31,
55 . t11,t22,t33,t12,t21,t23,t32,t13,t31,
56 . s11,s12,s21,s13,s31,s22,s23,s32,s33
57
58
59
60
61 IF (khbe /= 17 .OR. iint /= 3) RETURN
62 r11 = frame(1,1)
63 r21 = frame(2,1)
64 r31 = frame(3,1)
65 r12 = frame(1,2)
66 r22 = frame(2,2)
67 r32 = frame(3,2)
68 r13 = frame(1,3)
69 r23 = frame(2,3)
70 r33 = frame(3,3)
71
72
73
74
75 IF (kcvt==2) THEN
76 IF (isorth > 0) THEN
77 g11=gama(1)
78 g21=gama(2)
79 g31=gama(3)
80 g12=gama(4)
81 g22=gama(5)
82 g32=gama(6)
83 g13=g21*g32-g31*g22
84 g23=g31*g12-g11*g32
85 g33=g11*g22-g21*g12
86
87 t11=r11*g11+r12*g21+r13*g31
88 t12=r11*g12+r12*g22+r13*g32
89 t13=r11*g13+r12*g23+r13*g33
90 t21=r21*g11+r22*g21+r23*g31
91 t22=r21*g12+r22*g22+r23*g32
92 t23=r21*g13+r22*g23+r23*g33
93 t31=r31*g11+r32*g21+r33*g31
94 t32=r31*g12+r32*g22+r33*g32
95 t33=r31*g13+r32*g23+r33*g33
96 r11=t11
97 r12=t12
98 r13=t13
99 r21=t21
100 r22=t22
101 r23=t23
102 r31=t31
103 r32=t32
104 r33=t33
105 ENDIF
106 ENDIF
107
108
109
110
111
112
113
114
115
116
117
118
119
120 l11 =tens(1)
121 l22 =tens(2)
122 l33 =tens(3)
123 l12 =tens(4)
124 l23 =tens(5)
125 l13 =tens(6)
126 s11 =l11*r11+l12*r12+l13*r13
127 s12 =l11*r21+l12*r22+l13*r23
128 s13 =l11*r31+l12*r32+l13*r33
129 s21 =l12*r11+l22*r12+l23*r13
130 s22 =l12*r21+l22*r22+l23*r23
131 s23 =l12*r31+l22*r32+l23*r33
132 s31 =l13*r11+l23*r12+l33*r13
133 s32 =l13*r21+l23*r22+l33*r23
134 s33 =l13*r31+l23*r32+l33*r33
135 tens(1)=r11*s11+r12*s21+r13*s31
136 tens(2)=r21*s12+r22*s22+r23*s32
137 tens(3)=r31*s13+r32*s23+r33*s33
138 tens(4)=r11*s12+r12*s22+r13*s32
139 tens(5)=r21*s13+r22*s23+r23*s33
140 tens(6)=r11*s13+r12*s23+r13*s33
141
142 RETURN