CalculiX  2.13
A Free Software Three-Dimensional Structural Finite Element Program
Functions/Subroutines
rectcyl.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine rectcyl (co, v, fn, stn, qfn, een, cs, n, icntrl, t, filab, imag, mi, emn)
 

Function/Subroutine Documentation

◆ rectcyl()

subroutine rectcyl ( real*8, dimension(3,*)  co,
real*8, dimension(0:mi(2),*)  v,
real*8, dimension(0:mi(2),*)  fn,
real*8, dimension(6,*)  stn,
real*8, dimension(3,*)  qfn,
real*8, dimension(6,*)  een,
real*8, dimension(17,*)  cs,
integer  n,
integer  icntrl,
real*8, dimension(3)  t,
character*87, dimension(*)  filab,
integer  imag,
integer, dimension(*)  mi,
real*8, dimension(6,*)  emn 
)
21 !
22 ! icntrl=1: rectangular to cylindrical coordinates for nodal
23 ! coordinates in field co
24 ! icntrl=-1: cylindrical to rectangular coordinates for nodal
25 ! coordinates in field co
26 ! icntrl=2: rectangular to cylindrical coordinates for fields
27 ! v,fn,stn,een and emn
28 ! icntrl=-2: cylindrical to rectangular coordinates for fields
29 ! v,fn,stn, een and emn
30 !
31 ! the axis of the cylindrical coordinates is defined by points
32 ! a with coordinates csab(1..3) and b with coordinates csab(4..6).
33 ! Theta=0 (2nd cylindrical coordinate) is defined by the vector t,
34 ! which is perpendicular to the axis. The subroutine should be called
35 ! with icntrl=1 before calling it with icntrl=-1.
36 !
37 ! for icntrl=2 the imaginary part is extra taken into account if
38 ! imag=1
39 !
40  implicit none
41 !
42  character*87 filab(*)
43  integer i,j,n,icntrl,imag,mi(*)
44  real*8 co(3,*),v(0:mi(2),*),fn(0:mi(2),*),stn(6,*),een(6,*),
45  & a(3,3),emn(6,*),
46  & xr,xt,xz,b(3,3),cs(17,*),t(3),u(3),qfn(3,*),csab(7),
47  & xn(3),r(3),z,theta,rr,c(3,3),ctm,ct,st,ddx,ddy,dd
48 !
49  do i=1,7
50  csab(i)=cs(5+i,1)
51  enddo
52 !
53  if(icntrl.eq.1) then
54 !
55 ! normal along the cylindrical axis
56 !
57  xn(1)=csab(4)-csab(1)
58  xn(2)=csab(5)-csab(2)
59  xn(3)=csab(6)-csab(3)
60  dd=dsqrt(xn(1)*xn(1)+xn(2)*xn(2)+xn(3)*xn(3))
61  do i=1,3
62  xn(i)=xn(i)/dd
63  enddo
64 !
65 ! normal to the cylindrical axis (vector t)
66 !
67  if(dabs(xn(1)).gt.1.d-10) then
68  t(2)=1.d0
69  t(3)=0.d0
70  t(1)=-xn(2)/xn(1)
71  elseif(dabs(xn(2)).gt.1.d-10) then
72  t(3)=1.d0
73  t(1)=0.d0
74  t(2)=-xn(3)/xn(2)
75  else
76  t(1)=1.d0
77  t(2)=0.d0
78  t(3)=-xn(1)/xn(3)
79  endif
80  dd=dsqrt(t(1)*t(1)+t(2)*t(2)+t(3)*t(3))
81  do i=1,3
82  t(i)=t(i)/dd
83  enddo
84 !
85 ! normal to xn and t
86 !
87  u(1)=xn(2)*t(3)-xn(3)*t(2)
88  u(2)=-xn(1)*t(3)+xn(3)*t(1)
89  u(3)=xn(1)*t(2)-xn(2)*t(1)
90 !
91 ! loop over all nodes to convert
92 !
93  do i=1,n
94  do j=1,3
95  r(j)=co(j,i)-csab(j)
96  enddo
97  z=r(1)*xn(1)+r(2)*xn(2)+r(3)*xn(3)
98  do j=1,3
99  r(j)=r(j)-z*xn(j)
100  enddo
101  rr=dsqrt(r(1)*r(1)+r(2)*r(2)+r(3)*r(3))
102  if(dabs(rr).lt.1.d-10) then
103  theta=0.d0
104  else
105  do j=1,3
106  r(j)=r(j)/rr
107  enddo
108  ddx=t(1)*r(1)+t(2)*r(2)+t(3)*r(3)
109  ddy=u(1)*r(1)+u(2)*r(2)+u(3)*r(3)
110  theta=datan2(ddy,ddx)
111  endif
112  co(1,i)=rr
113  co(2,i)=theta
114  co(3,i)=z
115  enddo
116  elseif(icntrl.eq.-1) then
117 !
118 ! normal along the cylindrical axis
119 !
120  xn(1)=csab(4)-csab(1)
121  xn(2)=csab(5)-csab(2)
122  xn(3)=csab(6)-csab(3)
123  dd=dsqrt(xn(1)*xn(1)+xn(2)*xn(2)+xn(3)*xn(3))
124  do i=1,3
125  xn(i)=xn(i)/dd
126  enddo
127 !
128 ! loop over all nodes to convert
129 !
130  do i=1,n
131  rr=co(1,i)
132  theta=co(2,i)
133 c write(*,*) 'rectcyl',i,co(2,i)
134  z=co(3,i)
135  ct=dcos(theta)
136  st=dsin(theta)
137  ctm=1.d0-ct
138 !
139 ! rotation matrix
140 !
141  c(1,1)=ct+ctm*xn(1)*xn(1)
142  c(1,2)=-st*xn(3)+ctm*xn(1)*xn(2)
143  c(1,3)=st*xn(2)+ctm*xn(1)*xn(3)
144  c(2,1)=st*xn(3)+ctm*xn(2)*xn(1)
145  c(2,2)=ct+ctm*xn(2)*xn(2)
146  c(2,3)=-st*xn(1)+ctm*xn(2)*xn(3)
147  c(3,1)=-st*xn(2)+ctm*xn(3)*xn(1)
148  c(3,2)=st*xn(1)+ctm*xn(3)*xn(2)
149  c(3,3)=ct+ctm*xn(3)*xn(3)
150 !
151  co(1,i)=csab(1)+z*xn(1)+
152  & rr*(c(1,1)*t(1)+c(1,2)*t(2)+c(1,3)*t(3))
153  co(2,i)=csab(2)+z*xn(2)+
154  & rr*(c(2,1)*t(1)+c(2,2)*t(2)+c(2,3)*t(3))
155  co(3,i)=csab(3)+z*xn(3)+
156  & rr*(c(3,1)*t(1)+c(3,2)*t(2)+c(3,3)*t(3))
157  enddo
158  elseif(icntrl.eq.2) then
159  do i=1,n
160  j=i
161  call transformatrix(csab,co(1,i),a)
162 !
163  if((filab(1)(1:3).eq.'U ').or.
164  & (filab(11)(1:4).eq.'PU')) then
165  xr=v(1,j)*a(1,1)+v(2,j)*a(2,1)+v(3,j)*a(3,1)
166  xt=v(1,j)*a(1,2)+v(2,j)*a(2,2)+v(3,j)*a(3,2)
167  xz=v(1,j)*a(1,3)+v(2,j)*a(2,3)+v(3,j)*a(3,3)
168  v(1,j)=xr
169  v(2,j)=xt
170  v(3,j)=xz
171  endif
172 !
173  if((filab(3)(1:4).eq.'S ').or.
174  & (filab(18)(1:4).eq.'PHS ')) then
175  b(1,1)=stn(1,j)*a(1,1)+stn(4,j)*a(2,1)+stn(5,j)*a(3,1)
176  b(1,2)=stn(1,j)*a(1,2)+stn(4,j)*a(2,2)+stn(5,j)*a(3,2)
177  b(1,3)=stn(1,j)*a(1,3)+stn(4,j)*a(2,3)+stn(5,j)*a(3,3)
178  b(2,1)=stn(4,j)*a(1,1)+stn(2,j)*a(2,1)+stn(6,j)*a(3,1)
179  b(2,2)=stn(4,j)*a(1,2)+stn(2,j)*a(2,2)+stn(6,j)*a(3,2)
180  b(2,3)=stn(4,j)*a(1,3)+stn(2,j)*a(2,3)+stn(6,j)*a(3,3)
181  b(3,1)=stn(5,j)*a(1,1)+stn(6,j)*a(2,1)+stn(3,j)*a(3,1)
182  b(3,2)=stn(5,j)*a(1,2)+stn(6,j)*a(2,2)+stn(3,j)*a(3,2)
183  b(3,3)=stn(5,j)*a(1,3)+stn(6,j)*a(2,3)+stn(3,j)*a(3,3)
184 !
185  stn(1,j)=a(1,1)*b(1,1)+a(2,1)*b(2,1)+a(3,1)*b(3,1)
186  stn(2,j)=a(1,2)*b(1,2)+a(2,2)*b(2,2)+a(3,2)*b(3,2)
187  stn(3,j)=a(1,3)*b(1,3)+a(2,3)*b(2,3)+a(3,3)*b(3,3)
188  stn(4,j)=a(1,1)*b(1,2)+a(2,1)*b(2,2)+a(3,1)*b(3,2)
189  stn(5,j)=a(1,1)*b(1,3)+a(2,1)*b(2,3)+a(3,1)*b(3,3)
190  stn(6,j)=a(1,2)*b(1,3)+a(2,2)*b(2,3)+a(3,2)*b(3,3)
191  endif
192 !
193  if(filab(4)(1:4).eq.'E ') then
194  b(1,1)=een(1,j)*a(1,1)+een(4,j)*a(2,1)+een(5,j)*a(3,1)
195  b(1,2)=een(1,j)*a(1,2)+een(4,j)*a(2,2)+een(5,j)*a(3,2)
196  b(1,3)=een(1,j)*a(1,3)+een(4,j)*a(2,3)+een(5,j)*a(3,3)
197  b(2,1)=een(4,j)*a(1,1)+een(2,j)*a(2,1)+een(6,j)*a(3,1)
198  b(2,2)=een(4,j)*a(1,2)+een(2,j)*a(2,2)+een(6,j)*a(3,2)
199  b(2,3)=een(4,j)*a(1,3)+een(2,j)*a(2,3)+een(6,j)*a(3,3)
200  b(3,1)=een(5,j)*a(1,1)+een(6,j)*a(2,1)+een(3,j)*a(3,1)
201  b(3,2)=een(5,j)*a(1,2)+een(6,j)*a(2,2)+een(3,j)*a(3,2)
202  b(3,3)=een(5,j)*a(1,3)+een(6,j)*a(2,3)+een(3,j)*a(3,3)
203 !
204  een(1,j)=a(1,1)*b(1,1)+a(2,1)*b(2,1)+a(3,1)*b(3,1)
205  een(2,j)=a(1,2)*b(1,2)+a(2,2)*b(2,2)+a(3,2)*b(3,2)
206  een(3,j)=a(1,3)*b(1,3)+a(2,3)*b(2,3)+a(3,3)*b(3,3)
207  een(4,j)=a(1,1)*b(1,2)+a(2,1)*b(2,2)+a(3,1)*b(3,2)
208  een(5,j)=a(1,1)*b(1,3)+a(2,1)*b(2,3)+a(3,1)*b(3,3)
209  een(6,j)=a(1,2)*b(1,3)+a(2,2)*b(2,3)+a(3,2)*b(3,3)
210  endif
211 !
212  if(filab(5)(1:4).eq.'RF ') then
213  xr=fn(1,j)*a(1,1)+fn(2,j)*a(2,1)+fn(3,j)*a(3,1)
214  xt=fn(1,j)*a(1,2)+fn(2,j)*a(2,2)+fn(3,j)*a(3,2)
215  xz=fn(1,j)*a(1,3)+fn(2,j)*a(2,3)+fn(3,j)*a(3,3)
216  fn(1,j)=xr
217  fn(2,j)=xt
218  fn(3,j)=xz
219  endif
220 !
221  if(filab(9)(1:4).eq.'HFL ') then
222  xr=qfn(1,j)*a(1,1)+qfn(2,j)*a(2,1)+qfn(3,j)*a(3,1)
223  xt=qfn(1,j)*a(1,2)+qfn(2,j)*a(2,2)+qfn(3,j)*a(3,2)
224  xz=qfn(1,j)*a(1,3)+qfn(2,j)*a(2,3)+qfn(3,j)*a(3,3)
225  qfn(1,j)=xr
226  qfn(2,j)=xt
227  qfn(3,j)=xz
228  endif
229 !
230  if(filab(32)(1:4).eq.'ME ') then
231  b(1,1)=emn(1,j)*a(1,1)+emn(4,j)*a(2,1)+emn(5,j)*a(3,1)
232  b(1,2)=emn(1,j)*a(1,2)+emn(4,j)*a(2,2)+emn(5,j)*a(3,2)
233  b(1,3)=emn(1,j)*a(1,3)+emn(4,j)*a(2,3)+emn(5,j)*a(3,3)
234  b(2,1)=emn(4,j)*a(1,1)+emn(2,j)*a(2,1)+emn(6,j)*a(3,1)
235  b(2,2)=emn(4,j)*a(1,2)+emn(2,j)*a(2,2)+emn(6,j)*a(3,2)
236  b(2,3)=emn(4,j)*a(1,3)+emn(2,j)*a(2,3)+emn(6,j)*a(3,3)
237  b(3,1)=emn(5,j)*a(1,1)+emn(6,j)*a(2,1)+emn(3,j)*a(3,1)
238  b(3,2)=emn(5,j)*a(1,2)+emn(6,j)*a(2,2)+emn(3,j)*a(3,2)
239  b(3,3)=emn(5,j)*a(1,3)+emn(6,j)*a(2,3)+emn(3,j)*a(3,3)
240 !
241  emn(1,j)=a(1,1)*b(1,1)+a(2,1)*b(2,1)+a(3,1)*b(3,1)
242  emn(2,j)=a(1,2)*b(1,2)+a(2,2)*b(2,2)+a(3,2)*b(3,2)
243  emn(3,j)=a(1,3)*b(1,3)+a(2,3)*b(2,3)+a(3,3)*b(3,3)
244  emn(4,j)=a(1,1)*b(1,2)+a(2,1)*b(2,2)+a(3,1)*b(3,2)
245  emn(5,j)=a(1,1)*b(1,3)+a(2,1)*b(2,3)+a(3,1)*b(3,3)
246  emn(6,j)=a(1,2)*b(1,3)+a(2,2)*b(2,3)+a(3,2)*b(3,3)
247  endif
248 !
249 ! imaginary part for cyclic symmetry frequency calculations
250 !
251  if(imag.eq.1) then
252 !
253  j=i+n
254 !
255  if((filab(1)(1:3).eq.'U ').or.
256  & (filab(11)(1:4).eq.'PU')) then
257  xr=v(1,j)*a(1,1)+v(2,j)*a(2,1)+v(3,j)*a(3,1)
258  xt=v(1,j)*a(1,2)+v(2,j)*a(2,2)+v(3,j)*a(3,2)
259  xz=v(1,j)*a(1,3)+v(2,j)*a(2,3)+v(3,j)*a(3,3)
260  v(1,j)=xr
261  v(2,j)=xt
262  v(3,j)=xz
263  endif
264 !
265  if((filab(3)(1:4).eq.'S ').or.
266  & (filab(18)(1:4).eq.'PHS ')) then
267  b(1,1)=stn(1,j)*a(1,1)+stn(4,j)*a(2,1)+stn(5,j)*a(3,1)
268  b(1,2)=stn(1,j)*a(1,2)+stn(4,j)*a(2,2)+stn(5,j)*a(3,2)
269  b(1,3)=stn(1,j)*a(1,3)+stn(4,j)*a(2,3)+stn(5,j)*a(3,3)
270  b(2,1)=stn(4,j)*a(1,1)+stn(2,j)*a(2,1)+stn(6,j)*a(3,1)
271  b(2,2)=stn(4,j)*a(1,2)+stn(2,j)*a(2,2)+stn(6,j)*a(3,2)
272  b(2,3)=stn(4,j)*a(1,3)+stn(2,j)*a(2,3)+stn(6,j)*a(3,3)
273  b(3,1)=stn(5,j)*a(1,1)+stn(6,j)*a(2,1)+stn(3,j)*a(3,1)
274  b(3,2)=stn(5,j)*a(1,2)+stn(6,j)*a(2,2)+stn(3,j)*a(3,2)
275  b(3,3)=stn(5,j)*a(1,3)+stn(6,j)*a(2,3)+stn(3,j)*a(3,3)
276 !
277  stn(1,j)=a(1,1)*b(1,1)+a(2,1)*b(2,1)+a(3,1)*b(3,1)
278  stn(2,j)=a(1,2)*b(1,2)+a(2,2)*b(2,2)+a(3,2)*b(3,2)
279  stn(3,j)=a(1,3)*b(1,3)+a(2,3)*b(2,3)+a(3,3)*b(3,3)
280  stn(4,j)=a(1,1)*b(1,2)+a(2,1)*b(2,2)+a(3,1)*b(3,2)
281  stn(5,j)=a(1,1)*b(1,3)+a(2,1)*b(2,3)+a(3,1)*b(3,3)
282  stn(6,j)=a(1,2)*b(1,3)+a(2,2)*b(2,3)+a(3,2)*b(3,3)
283  endif
284 !
285  if(filab(4)(1:4).eq.'E ') then
286  b(1,1)=een(1,j)*a(1,1)+een(4,j)*a(2,1)+een(5,j)*a(3,1)
287  b(1,2)=een(1,j)*a(1,2)+een(4,j)*a(2,2)+een(5,j)*a(3,2)
288  b(1,3)=een(1,j)*a(1,3)+een(4,j)*a(2,3)+een(5,j)*a(3,3)
289  b(2,1)=een(4,j)*a(1,1)+een(2,j)*a(2,1)+een(6,j)*a(3,1)
290  b(2,2)=een(4,j)*a(1,2)+een(2,j)*a(2,2)+een(6,j)*a(3,2)
291  b(2,3)=een(4,j)*a(1,3)+een(2,j)*a(2,3)+een(6,j)*a(3,3)
292  b(3,1)=een(5,j)*a(1,1)+een(6,j)*a(2,1)+een(3,j)*a(3,1)
293  b(3,2)=een(5,j)*a(1,2)+een(6,j)*a(2,2)+een(3,j)*a(3,2)
294  b(3,3)=een(5,j)*a(1,3)+een(6,j)*a(2,3)+een(3,j)*a(3,3)
295 !
296  een(1,j)=a(1,1)*b(1,1)+a(2,1)*b(2,1)+a(3,1)*b(3,1)
297  een(2,j)=a(1,2)*b(1,2)+a(2,2)*b(2,2)+a(3,2)*b(3,2)
298  een(3,j)=a(1,3)*b(1,3)+a(2,3)*b(2,3)+a(3,3)*b(3,3)
299  een(4,j)=a(1,1)*b(1,2)+a(2,1)*b(2,2)+a(3,1)*b(3,2)
300  een(5,j)=a(1,1)*b(1,3)+a(2,1)*b(2,3)+a(3,1)*b(3,3)
301  een(6,j)=a(1,2)*b(1,3)+a(2,2)*b(2,3)+a(3,2)*b(3,3)
302  endif
303 !
304  if(filab(5)(1:4).eq.'RF ') then
305  xr=fn(1,j)*a(1,1)+fn(2,j)*a(2,1)+fn(3,j)*a(3,1)
306  xt=fn(1,j)*a(1,2)+fn(2,j)*a(2,2)+fn(3,j)*a(3,2)
307  xz=fn(1,j)*a(1,3)+fn(2,j)*a(2,3)+fn(3,j)*a(3,3)
308  fn(1,j)=xr
309  fn(2,j)=xt
310  fn(3,j)=xz
311  endif
312 !
313  if(filab(9)(1:4).eq.'HFL ') then
314  xr=qfn(1,j)*a(1,1)+qfn(2,j)*a(2,1)+qfn(3,j)*a(3,1)
315  xt=qfn(1,j)*a(1,2)+qfn(2,j)*a(2,2)+qfn(3,j)*a(3,2)
316  xz=qfn(1,j)*a(1,3)+qfn(2,j)*a(2,3)+qfn(3,j)*a(3,3)
317  qfn(1,j)=xr
318  qfn(2,j)=xt
319  qfn(3,j)=xz
320  endif
321 !
322  if(filab(32)(1:4).eq.'ME ') then
323  b(1,1)=emn(1,j)*a(1,1)+emn(4,j)*a(2,1)+emn(5,j)*a(3,1)
324  b(1,2)=emn(1,j)*a(1,2)+emn(4,j)*a(2,2)+emn(5,j)*a(3,2)
325  b(1,3)=emn(1,j)*a(1,3)+emn(4,j)*a(2,3)+emn(5,j)*a(3,3)
326  b(2,1)=emn(4,j)*a(1,1)+emn(2,j)*a(2,1)+emn(6,j)*a(3,1)
327  b(2,2)=emn(4,j)*a(1,2)+emn(2,j)*a(2,2)+emn(6,j)*a(3,2)
328  b(2,3)=emn(4,j)*a(1,3)+emn(2,j)*a(2,3)+emn(6,j)*a(3,3)
329  b(3,1)=emn(5,j)*a(1,1)+emn(6,j)*a(2,1)+emn(3,j)*a(3,1)
330  b(3,2)=emn(5,j)*a(1,2)+emn(6,j)*a(2,2)+emn(3,j)*a(3,2)
331  b(3,3)=emn(5,j)*a(1,3)+emn(6,j)*a(2,3)+emn(3,j)*a(3,3)
332 !
333  emn(1,j)=a(1,1)*b(1,1)+a(2,1)*b(2,1)+a(3,1)*b(3,1)
334  emn(2,j)=a(1,2)*b(1,2)+a(2,2)*b(2,2)+a(3,2)*b(3,2)
335  emn(3,j)=a(1,3)*b(1,3)+a(2,3)*b(2,3)+a(3,3)*b(3,3)
336  emn(4,j)=a(1,1)*b(1,2)+a(2,1)*b(2,2)+a(3,1)*b(3,2)
337  emn(5,j)=a(1,1)*b(1,3)+a(2,1)*b(2,3)+a(3,1)*b(3,3)
338  emn(6,j)=a(1,2)*b(1,3)+a(2,2)*b(2,3)+a(3,2)*b(3,3)
339  endif
340  endif
341  enddo
342  elseif(icntrl.eq.-2) then
343  do i=1,n
344  j=i
345  call transformatrix(csab,co(1,i),a)
346 !
347  if((filab(1)(1:3).eq.'U ').or.
348  & (filab(11)(1:4).eq.'PU')) then
349  xr=v(1,j)*a(1,1)+v(2,j)*a(1,2)+v(3,j)*a(1,3)
350  xt=v(1,j)*a(2,1)+v(2,j)*a(2,2)+v(3,j)*a(2,3)
351  xz=v(1,j)*a(3,1)+v(2,j)*a(3,2)+v(3,j)*a(3,3)
352  v(1,j)=xr
353  v(2,j)=xt
354  v(3,j)=xz
355  endif
356 !
357  if((filab(3)(1:4).eq.'S ').or.
358  & (filab(18)(1:4).eq.'PHS ')) then
359  b(1,1)=stn(1,j)*a(1,1)+stn(4,j)*a(1,2)+stn(5,j)*a(1,3)
360  b(1,2)=stn(1,j)*a(2,1)+stn(4,j)*a(2,2)+stn(5,j)*a(2,3)
361  b(1,3)=stn(1,j)*a(3,1)+stn(4,j)*a(3,2)+stn(5,j)*a(3,3)
362  b(2,1)=stn(4,j)*a(1,1)+stn(2,j)*a(1,2)+stn(6,j)*a(1,3)
363  b(2,2)=stn(4,j)*a(2,1)+stn(2,j)*a(2,2)+stn(6,j)*a(2,3)
364  b(2,3)=stn(4,j)*a(3,1)+stn(2,j)*a(3,2)+stn(6,j)*a(3,3)
365  b(3,1)=stn(5,j)*a(1,1)+stn(6,j)*a(1,2)+stn(3,j)*a(1,3)
366  b(3,2)=stn(5,j)*a(2,1)+stn(6,j)*a(2,2)+stn(3,j)*a(2,3)
367  b(3,3)=stn(5,j)*a(3,1)+stn(6,j)*a(3,2)+stn(3,j)*a(3,3)
368 !
369  stn(1,j)=a(1,1)*b(1,1)+a(1,2)*b(2,1)+a(1,3)*b(3,1)
370  stn(2,j)=a(2,1)*b(1,2)+a(2,2)*b(2,2)+a(2,3)*b(3,2)
371  stn(3,j)=a(3,1)*b(1,3)+a(3,2)*b(2,3)+a(3,3)*b(3,3)
372  stn(4,j)=a(1,1)*b(1,2)+a(1,2)*b(2,2)+a(1,3)*b(3,2)
373  stn(5,j)=a(1,1)*b(1,3)+a(1,2)*b(2,3)+a(1,3)*b(3,3)
374  stn(6,j)=a(2,1)*b(1,3)+a(2,2)*b(2,3)+a(2,3)*b(3,3)
375  endif
376 !
377  if(filab(4)(1:4).eq.'E ') then
378  b(1,1)=een(1,j)*a(1,1)+een(4,j)*a(1,2)+een(5,j)*a(1,3)
379  b(1,2)=een(1,j)*a(2,1)+een(4,j)*a(2,2)+een(5,j)*a(2,3)
380  b(1,3)=een(1,j)*a(3,1)+een(4,j)*a(3,2)+een(5,j)*a(3,3)
381  b(2,1)=een(4,j)*a(1,1)+een(2,j)*a(1,2)+een(6,j)*a(1,3)
382  b(2,2)=een(4,j)*a(2,1)+een(2,j)*a(2,2)+een(6,j)*a(2,3)
383  b(2,3)=een(4,j)*a(3,1)+een(2,j)*a(3,2)+een(6,j)*a(3,3)
384  b(3,1)=een(5,j)*a(1,1)+een(6,j)*a(1,2)+een(3,j)*a(1,3)
385  b(3,2)=een(5,j)*a(2,1)+een(6,j)*a(2,2)+een(3,j)*a(2,3)
386  b(3,3)=een(5,j)*a(3,1)+een(6,j)*a(3,2)+een(3,j)*a(3,3)
387 !
388  een(1,j)=a(1,1)*b(1,1)+a(1,2)*b(2,1)+a(1,3)*b(3,1)
389  een(2,j)=a(2,1)*b(1,2)+a(2,2)*b(2,2)+a(2,3)*b(3,2)
390  een(3,j)=a(3,1)*b(1,3)+a(3,2)*b(2,3)+a(3,3)*b(3,3)
391  een(4,j)=a(1,1)*b(1,2)+a(1,2)*b(2,2)+a(1,3)*b(3,2)
392  een(5,j)=a(1,1)*b(1,3)+a(1,2)*b(2,3)+a(1,3)*b(3,3)
393  een(6,j)=a(2,1)*b(1,3)+a(2,2)*b(2,3)+a(2,3)*b(3,3)
394  endif
395 !
396  if(filab(5)(1:4).eq.'RF ') then
397  xr=fn(1,j)*a(1,1)+fn(2,j)*a(1,2)+fn(3,j)*a(1,3)
398  xt=fn(1,j)*a(2,1)+fn(2,j)*a(2,2)+fn(3,j)*a(2,3)
399  xz=fn(1,j)*a(3,1)+fn(2,j)*a(3,2)+fn(3,j)*a(3,3)
400  fn(1,j)=xr
401  fn(2,j)=xt
402  fn(3,j)=xz
403  endif
404 !
405  if(filab(9)(1:4).eq.'HFL ') then
406  xr=qfn(1,j)*a(1,1)+qfn(2,j)*a(1,2)+qfn(3,j)*a(1,3)
407  xt=qfn(1,j)*a(2,1)+qfn(2,j)*a(2,2)+qfn(3,j)*a(2,3)
408  xz=qfn(1,j)*a(3,1)+qfn(2,j)*a(3,2)+qfn(3,j)*a(3,3)
409  qfn(1,j)=xr
410  qfn(2,j)=xt
411  qfn(3,j)=xz
412  endif
413 !
414  if(filab(32)(1:4).eq.'ME ') then
415  b(1,1)=emn(1,j)*a(1,1)+emn(4,j)*a(1,2)+emn(5,j)*a(1,3)
416  b(1,2)=emn(1,j)*a(2,1)+emn(4,j)*a(2,2)+emn(5,j)*a(2,3)
417  b(1,3)=emn(1,j)*a(3,1)+emn(4,j)*a(3,2)+emn(5,j)*a(3,3)
418  b(2,1)=emn(4,j)*a(1,1)+emn(2,j)*a(1,2)+emn(6,j)*a(1,3)
419  b(2,2)=emn(4,j)*a(2,1)+emn(2,j)*a(2,2)+emn(6,j)*a(2,3)
420  b(2,3)=emn(4,j)*a(3,1)+emn(2,j)*a(3,2)+emn(6,j)*a(3,3)
421  b(3,1)=emn(5,j)*a(1,1)+emn(6,j)*a(1,2)+emn(3,j)*a(1,3)
422  b(3,2)=emn(5,j)*a(2,1)+emn(6,j)*a(2,2)+emn(3,j)*a(2,3)
423  b(3,3)=emn(5,j)*a(3,1)+emn(6,j)*a(3,2)+emn(3,j)*a(3,3)
424 !
425  emn(1,j)=a(1,1)*b(1,1)+a(1,2)*b(2,1)+a(1,3)*b(3,1)
426  emn(2,j)=a(2,1)*b(1,2)+a(2,2)*b(2,2)+a(2,3)*b(3,2)
427  emn(3,j)=a(3,1)*b(1,3)+a(3,2)*b(2,3)+a(3,3)*b(3,3)
428  emn(4,j)=a(1,1)*b(1,2)+a(1,2)*b(2,2)+a(1,3)*b(3,2)
429  emn(5,j)=a(1,1)*b(1,3)+a(1,2)*b(2,3)+a(1,3)*b(3,3)
430  emn(6,j)=a(2,1)*b(1,3)+a(2,2)*b(2,3)+a(2,3)*b(3,3)
431  endif
432 !
433 ! imaginary part for cyclic symmetry frequency calculations
434 !
435  if(imag.eq.1) then
436 !
437  j=i+n
438 !
439  if((filab(1)(1:3).eq.'U ').or.
440  & (filab(11)(1:4).eq.'PU')) then
441  xr=v(1,j)*a(1,1)+v(2,j)*a(1,2)+v(3,j)*a(1,3)
442  xt=v(1,j)*a(2,1)+v(2,j)*a(2,2)+v(3,j)*a(2,3)
443  xz=v(1,j)*a(3,1)+v(2,j)*a(3,2)+v(3,j)*a(3,3)
444  v(1,j)=xr
445  v(2,j)=xt
446  v(3,j)=xz
447  endif
448 !
449  if((filab(3)(1:4).eq.'S ').or.
450  & (filab(18)(1:4).eq.'PHS ')) then
451  b(1,1)=stn(1,j)*a(1,1)+stn(4,j)*a(1,2)+stn(5,j)*a(1,3)
452  b(1,2)=stn(1,j)*a(2,1)+stn(4,j)*a(2,2)+stn(5,j)*a(2,3)
453  b(1,3)=stn(1,j)*a(3,1)+stn(4,j)*a(3,2)+stn(5,j)*a(3,3)
454  b(2,1)=stn(4,j)*a(1,1)+stn(2,j)*a(1,2)+stn(6,j)*a(1,3)
455  b(2,2)=stn(4,j)*a(2,1)+stn(2,j)*a(2,2)+stn(6,j)*a(2,3)
456  b(2,3)=stn(4,j)*a(3,1)+stn(2,j)*a(3,2)+stn(6,j)*a(3,3)
457  b(3,1)=stn(5,j)*a(1,1)+stn(6,j)*a(1,2)+stn(3,j)*a(1,3)
458  b(3,2)=stn(5,j)*a(2,1)+stn(6,j)*a(2,2)+stn(3,j)*a(2,3)
459  b(3,3)=stn(5,j)*a(3,1)+stn(6,j)*a(3,2)+stn(3,j)*a(3,3)
460 !
461  stn(1,j)=a(1,1)*b(1,1)+a(1,2)*b(2,1)+a(1,3)*b(3,1)
462  stn(2,j)=a(2,1)*b(1,2)+a(2,2)*b(2,2)+a(2,3)*b(3,2)
463  stn(3,j)=a(3,1)*b(1,3)+a(3,2)*b(2,3)+a(3,3)*b(3,3)
464  stn(4,j)=a(1,1)*b(1,2)+a(1,2)*b(2,2)+a(1,3)*b(3,2)
465  stn(5,j)=a(1,1)*b(1,3)+a(1,2)*b(2,3)+a(1,3)*b(3,3)
466  stn(6,j)=a(2,1)*b(1,3)+a(2,2)*b(2,3)+a(2,3)*b(3,3)
467  endif
468 !
469  if(filab(4)(1:4).eq.'E ') then
470  b(1,1)=een(1,j)*a(1,1)+een(4,j)*a(1,2)+een(5,j)*a(1,3)
471  b(1,2)=een(1,j)*a(2,1)+een(4,j)*a(2,2)+een(5,j)*a(2,3)
472  b(1,3)=een(1,j)*a(3,1)+een(4,j)*a(3,2)+een(5,j)*a(3,3)
473  b(2,1)=een(4,j)*a(1,1)+een(2,j)*a(1,2)+een(6,j)*a(1,3)
474  b(2,2)=een(4,j)*a(2,1)+een(2,j)*a(2,2)+een(6,j)*a(2,3)
475  b(2,3)=een(4,j)*a(3,1)+een(2,j)*a(3,2)+een(6,j)*a(3,3)
476  b(3,1)=een(5,j)*a(1,1)+een(6,j)*a(1,2)+een(3,j)*a(1,3)
477  b(3,2)=een(5,j)*a(2,1)+een(6,j)*a(2,2)+een(3,j)*a(2,3)
478  b(3,3)=een(5,j)*a(3,1)+een(6,j)*a(3,2)+een(3,j)*a(3,3)
479 !
480  een(1,j)=a(1,1)*b(1,1)+a(1,2)*b(2,1)+a(1,3)*b(3,1)
481  een(2,j)=a(2,1)*b(1,2)+a(2,2)*b(2,2)+a(2,3)*b(3,2)
482  een(3,j)=a(3,1)*b(1,3)+a(3,2)*b(2,3)+a(3,3)*b(3,3)
483  een(4,j)=a(1,1)*b(1,2)+a(1,2)*b(2,2)+a(1,3)*b(3,2)
484  een(5,j)=a(1,1)*b(1,3)+a(1,2)*b(2,3)+a(1,3)*b(3,3)
485  een(6,j)=a(2,1)*b(1,3)+a(2,2)*b(2,3)+a(2,3)*b(3,3)
486  endif
487 !
488  if(filab(5)(1:4).eq.'RF ') then
489  xr=fn(1,j)*a(1,1)+fn(2,j)*a(1,2)+fn(3,j)*a(1,3)
490  xt=fn(1,j)*a(2,1)+fn(2,j)*a(2,2)+fn(3,j)*a(2,3)
491  xz=fn(1,j)*a(3,1)+fn(2,j)*a(3,2)+fn(3,j)*a(3,3)
492  fn(1,j)=xr
493  fn(2,j)=xt
494  fn(3,j)=xz
495  endif
496 !
497  if(filab(9)(1:4).eq.'HFL ') then
498  xr=qfn(1,j)*a(1,1)+qfn(2,j)*a(1,2)+qfn(3,j)*a(1,3)
499  xt=qfn(1,j)*a(2,1)+qfn(2,j)*a(2,2)+qfn(3,j)*a(2,3)
500  xz=qfn(1,j)*a(3,1)+qfn(2,j)*a(3,2)+qfn(3,j)*a(3,3)
501  qfn(1,j)=xr
502  qfn(2,j)=xt
503  qfn(3,j)=xz
504  endif
505 !
506  if(filab(32)(1:4).eq.'ME ') then
507  b(1,1)=emn(1,j)*a(1,1)+emn(4,j)*a(1,2)+emn(5,j)*a(1,3)
508  b(1,2)=emn(1,j)*a(2,1)+emn(4,j)*a(2,2)+emn(5,j)*a(2,3)
509  b(1,3)=emn(1,j)*a(3,1)+emn(4,j)*a(3,2)+emn(5,j)*a(3,3)
510  b(2,1)=emn(4,j)*a(1,1)+emn(2,j)*a(1,2)+emn(6,j)*a(1,3)
511  b(2,2)=emn(4,j)*a(2,1)+emn(2,j)*a(2,2)+emn(6,j)*a(2,3)
512  b(2,3)=emn(4,j)*a(3,1)+emn(2,j)*a(3,2)+emn(6,j)*a(3,3)
513  b(3,1)=emn(5,j)*a(1,1)+emn(6,j)*a(1,2)+emn(3,j)*a(1,3)
514  b(3,2)=emn(5,j)*a(2,1)+emn(6,j)*a(2,2)+emn(3,j)*a(2,3)
515  b(3,3)=emn(5,j)*a(3,1)+emn(6,j)*a(3,2)+emn(3,j)*a(3,3)
516 !
517  emn(1,j)=a(1,1)*b(1,1)+a(1,2)*b(2,1)+a(1,3)*b(3,1)
518  emn(2,j)=a(2,1)*b(1,2)+a(2,2)*b(2,2)+a(2,3)*b(3,2)
519  emn(3,j)=a(3,1)*b(1,3)+a(3,2)*b(2,3)+a(3,3)*b(3,3)
520  emn(4,j)=a(1,1)*b(1,2)+a(1,2)*b(2,2)+a(1,3)*b(3,2)
521  emn(5,j)=a(1,1)*b(1,3)+a(1,2)*b(2,3)+a(1,3)*b(3,3)
522  emn(6,j)=a(2,1)*b(1,3)+a(2,2)*b(2,3)+a(2,3)*b(3,3)
523  endif
524  endif
525 !
526  enddo
527  endif
528 !
529  return
transformatrix
subroutine transformatrix(xab, p, a)
Definition: transformatrix.f:20
Hosted by OpenAircraft.com, (Michigan UAV, LLC)