COSMOS v7.655  COSMOSv7655
(AirShowerMC)
ctransVectZx.f
Go to the documentation of this file.
1 #include "ZsaveStruc.h"
2 !cc test ctransVectZx, ciTransVectZx
3 ! implicit none
4 ! include 'Zcoord.h'
5 ! record /coord/ wa, wb, dir1, dir2
6 ! real*8 norm
7 !
8 !
9 !
10 ! wa.r(1) = .50
11 ! wa.r(2) = 0.2
12 ! wa.r(3) = sqrt(1. - (wa.r(1)**2+wa.r(2)**2))
13 !
14 ! wb.r(1) = wa.r(2)
15 ! wb.r(2) = -wa.r(1)
16 ! wb.r(3) = 0.
17 ! norm = sqrt( wb.r(1)**2 + wb.r(2)**2 + wb.r(3)**2)
18 ! wb.r(1) = wb.r(1)/norm
19 ! wb.r(2) = wb.r(2)/norm
20 ! wb.r(3) = wb.r(3)/norm
21 !
22 !
23 ! dir1.r(1) = sqrt(2.)/3.
24 ! dir1.r(2) = dir1.r(1)*1.1
25 ! dir1.r(3) = sqrt(1. - dir1.r(1)**2 - dir1.r(2)**2)
26 ! write(*,*) dir1.r(1), dir1.r(2), dir1.r(3)
27 ! call ctransVectZx(1, wa, wb, dir1, dir2)
28 ! write(*,*) dir2.x, dir2.y, dir2.z
29 ! call ciTransVectZx(1, wa, wb, dir2, dir2)
30 ! write(*,*) dir2.x, dir2.y, dir2.z
31 ! call ctransVectZx(2, wa, wb, dir1, dir1)
32 ! write(*,*) dir1.r(1), dir1.r(2), dir1.r(3)
33 ! end
34 !-------------------------------------------------------------
35  subroutine ctransvectzx(init, zax, xax, dir1, dir2)
36 !
37 !
38 ! /usage/ call ctransVectZx(init, zax, xax, dir1, dir2)
39 ! Directions cosines(dir1) are given in a system
40 ! (=R).
41 ! The z axis of R has dircetion cos zax in B.
42 ! The x axis of R has direction cos xax in B.
43 !
44 ! This subroutine transform the angles so that (dir1)
45 ! be the direction cosines in the B-system,
46 ! and put the result into dir2.
47 ! dir2 can be the same one as dir1, or zax.
48 ! init: if zax and xax are different from those from the
49 ! previous call, give 1 else give a diff. value.
50 ! zax: /coord/
51 ! xax: /coord/
52 ! dir1: /coord/
53 ! dir2; /coord/
54 ! *** Note *** If you are ok with an arbitrary x axis, use ctransVectZ.
55 !
56  implicit none
57 
58 #include "Zcoord.h"
59  type(coord)::xax
60  type(coord)::zax
61  type(coord)::dir1
62  type(coord)::dir2
63  integer init
64 !
65  type(coord)::yvec
66  type(coord)::temp
67  real*8 norm
68 
69 #ifdef USESAVE
70  save yvec
71 #endif
72 
73  character*70 msg
74 ! y -axis unit vector
75  if(init .eq. 1) then
76  yvec%r(1) = zax%r(2) * xax%r(3) - zax%r(3) * xax%r(2)
77  yvec%r(2) = zax%r(3) * xax%r(1) - zax%r(1) * xax%r(3)
78  yvec%r(3) = zax%r(1) * xax%r(2) - zax%r(2) * xax%r(1)
79 ! need not normalize; but check it
80  norm = yvec%r(1)**2 + yvec%r(2)**2 + yvec%r(3)**2
81  if(abs(norm-1.0) .gt. 1.e-4) then
82  write(msg, *)
83  * 'ctransVectZx: input dir. cos. are not orthogonal'
84  call cerrormsg(msg, 0)
85  endif
86  endif
87 !
88  temp%r(1) = dir1%r(1) * xax%r(1) + dir1%r(2) *yvec%r(1) +
89  * dir1%r(3) *zax%r(1)
90  temp%r(2) = dir1%r(1) * xax%r(2) + dir1%r(2) *yvec%r(2) +
91  * dir1%r(3) *zax%r(2)
92  temp%r(3) = dir1%r(1) * xax%r(3) + dir1%r(2) *yvec%r(3) +
93  * dir1%r(3) *zax%r(3)
94 !
95  ! @jaxa, temp undefined warning comes out
96  ! since temp.sys is not used.
97 ! dir2 = temp
98  dir2%r(:) =temp%r(:)
99  end
100 ! ===================================================
101  subroutine citransvectzx(init, zax, xax, dir1, dir2)
102 ! ===================================================
103 ! This is the inverse of ctransVectZx
104 !
105 ! /usage/ call ciTransVectZx(init, zax, xax, dir1, dir2)
106 ! Suppose 2 system B and R.
107 ! Directions cosines(dir1) are given in B
108 !
109 ! The z axis of R has dircetion cos zax in B.
110 ! The x axis of R has direction cos xax in B.
111 !
112 ! This subroutine transform the angles so that (dir1)
113 ! be the direction cosines in the R-system,
114 ! and put the result into dir2.
115 ! dir2 can be the same one as dir1, or zax.
116 ! init: if zax and xax are different from those from the preious call, give 1
117 ! else give a diff. value.
118 ! zax: /coord/
119 ! xax: /coord/
120 ! dir1: /coord/
121 ! dir2; /coord/
122 !
123  implicit none
124 #include "Zcoord.h"
125  type(coord)::xax
126  type(coord)::zax
127  type(coord)::dir1
128  type(coord)::dir2
129  integer init
130 !
131  type(coord)::yvec
132  type(coord)::temp
133  real*8 norm
134 #ifdef USESAVE
135  save yvec
136 #endif
137  character*70 msg
138 ! y -axis unit vector
139  if(init .eq. 1) then
140  yvec%r(1) = zax%r(2) * xax%r(3) - zax%r(3) * xax%r(2)
141  yvec%r(2) = zax%r(3) * xax%r(1) - zax%r(1) * xax%r(3)
142  yvec%r(3) = zax%r(1) * xax%r(2) - zax%r(2) * xax%r(1)
143 ! need not normalize; but check it
144  norm = yvec%r(1)**2 + yvec%r(2)**2 + yvec%r(3)**2
145  if(abs(norm-1.0) .gt. 1.e-4) then
146  write(msg, *)
147  * 'ctransVectZx: input dir. cos. are not orthogonal'
148  call cerrormsg(msg, 0)
149  endif
150  endif
151 !
152  temp%r(1) = dir1%r(1) * xax%r(1) + dir1%r(2) *xax%r(2) +
153  * dir1%r(3) *xax%r(3)
154  temp%r(2) = dir1%r(1) * yvec%r(1)+ dir1%r(2) *yvec%r(2) +
155  * dir1%r(3) *yvec%r(3)
156  temp%r(3) = dir1%r(1) * zax%r(1) + dir1%r(2) *zax%r(2) +
157  * dir1%r(3) *zax%r(3)
158  dir2 = temp
159  end
160 
161 
cerrormsg
subroutine cerrormsg(msg, needrtn)
Definition: cerrorMsg.f:4
e
dE dx *! Nuc Int sampling table e
Definition: cblkMuInt.h:130
ctransvectzx
subroutine ctransvectzx(init, zax, xax, dir1, dir2)
Definition: ctransVectZx.f:36
citransvectzx
subroutine citransvectzx(init, zax, xax, dir1, dir2)
Definition: ctransVectZx.f:102
coord
Definition: Zcoord.h:43