1 |
|
*** * * * *** * * * *** * * * *** * * * *** * * * *** * * * *** |
2 |
|
* this file contains all subroutines and functions |
3 |
|
* that are needed for position finding algorithms: |
4 |
|
* |
5 |
|
* subroutine idtoc(ipfa,cpfa) |
6 |
|
* |
7 |
|
* integer function npfastrips(ic,angle) |
8 |
|
* |
9 |
|
* real function pfaeta(ic,angle) |
10 |
|
* real function pfaetal(ic,angle) |
11 |
|
* real function pfaeta2(ic,angle) |
12 |
|
* real function pfaeta3(ic,angle) |
13 |
|
* real function pfaeta4(ic,angle) |
14 |
|
* real function cog(ncog,ic) |
15 |
|
* |
16 |
|
* real function fbad_cog(ncog,ic) |
17 |
|
* real function fbad_eta(ic,angle) |
18 |
|
* |
19 |
|
* real function riseta(iview,angle) |
20 |
|
* FUNCTION risxeta2(x) |
21 |
|
* FUNCTION risxeta3(x) |
22 |
|
* FUNCTION risxeta4(x) |
23 |
|
* FUNCTION risyeta2(x) |
24 |
|
* FUNCTION risy_cog(x) |
25 |
|
* FUNCTION risx_cog(x) |
26 |
|
* |
27 |
|
* real function pfacorr(ic,angle) |
28 |
|
* |
29 |
|
* NB - The angle is the "effective angle", which is relative |
30 |
|
* to the sensor and it takes into account the magnetic field |
31 |
|
* |
32 |
|
*** * * * *** * * * *** * * * *** * * * *** * * * *** * * * *** |
33 |
|
|
34 |
subroutine idtoc(ipfa,cpfa) |
subroutine idtoc(ipfa,cpfa) |
35 |
|
|
50 |
|
|
51 |
end |
end |
52 |
|
|
|
*** * * * *** * * * *** * * * *** * * * *** * * * *** * * * *** |
|
|
* this file contains all subroutines and functions |
|
|
* that are needed for position finding algorithms |
|
|
* |
|
|
* |
|
|
*** * * * *** * * * *** * * * *** * * * *** * * * *** * * * *** |
|
53 |
|
|
54 |
|
|
55 |
integer function npfastrips(ic,PFA,angle) |
integer function npfastrips(ic,angle) |
56 |
*-------------------------------------------------------------- |
*-------------------------------------------------------------- |
57 |
* thid function returns the number of strips used |
* thid function returns the number of strips used |
58 |
* to evaluate the position of a cluster, according to the p.f.a. |
* to evaluate the position of a cluster, according to the p.f.a. |
61 |
include 'level1.f' |
include 'level1.f' |
62 |
include 'calib.f' |
include 'calib.f' |
63 |
|
|
64 |
character*4 usedPFA,PFA |
character*4 usedPFA |
65 |
|
|
66 |
|
|
67 |
|
|
68 |
usedPFA=PFA |
call idtoc(pfaid,usedPFA) |
69 |
|
|
70 |
npfastrips=0 |
npfastrips=-1 |
71 |
|
|
72 |
if(usedPFA.eq.'COG1')npfastrips=1 |
if(usedPFA.eq.'COG1')npfastrips=1 |
73 |
if(usedPFA.eq.'COG2')npfastrips=2 |
if(usedPFA.eq.'COG2')npfastrips=2 |
77 |
if(usedPFA.eq.'ETA3')npfastrips=3 |
if(usedPFA.eq.'ETA3')npfastrips=3 |
78 |
if(usedPFA.eq.'ETA4')npfastrips=4 |
if(usedPFA.eq.'ETA4')npfastrips=4 |
79 |
* ---------------------------------------------------------------- |
* ---------------------------------------------------------------- |
80 |
if(usedPFA.eq.'ETA')then |
if(usedPFA.eq.'ETA'.or.usedPFA.eq.'ETAL')then |
81 |
c print*,VIEW(ic),angle |
c print*,VIEW(ic),angle |
82 |
if(mod(int(VIEW(ic)),2).eq.1)then !Y-view |
if(mod(int(VIEW(ic)),2).eq.1)then !Y-view |
83 |
if( abs(angle).ge.e2fay.and.abs(angle).lt.e2tay )then |
if( abs(angle).ge.e2fay.and.abs(angle).lt.e2tay )then |
87 |
elseif( abs(angle).ge.e4fay.and.abs(angle).lt.e4tay )then |
elseif( abs(angle).ge.e4fay.and.abs(angle).lt.e4tay )then |
88 |
npfastrips=4 |
npfastrips=4 |
89 |
else |
else |
90 |
npfastrips=4 |
npfastrips=4 !COG4 |
|
c usedPFA='COG' |
|
91 |
endif |
endif |
92 |
else !X-view |
else !X-view |
93 |
if( abs(angle).ge.e2fax.and.abs(angle).lt.e2tax )then |
if( abs(angle).ge.e2fax.and.abs(angle).lt.e2tax )then |
97 |
elseif( abs(angle).ge.e4fax.and.abs(angle).lt.e4tax )then |
elseif( abs(angle).ge.e4fax.and.abs(angle).lt.e4tax )then |
98 |
npfastrips=4 |
npfastrips=4 |
99 |
else |
else |
100 |
npfastrips=4 |
npfastrips=4 !COG4 |
|
c usedPFA='COG' |
|
101 |
endif |
endif |
102 |
endif |
endif |
103 |
endif |
endif |
104 |
* ---------------------------------------------------------------- |
* ---------------------------------------------------------------- |
105 |
if(usedPFA.eq.'COG')then |
if(usedPFA.eq.'COG')then |
106 |
|
|
107 |
iv=VIEW(ic) |
npfastrips=0 |
108 |
if(mod(iv,2).eq.1)incut=incuty |
|
109 |
if(mod(iv,2).eq.0)incut=incutx |
c$$$ iv=VIEW(ic) |
110 |
istart = INDSTART(IC) |
c$$$ if(mod(iv,2).eq.1)incut=incuty |
111 |
istop = TOTCLLENGTH |
c$$$ if(mod(iv,2).eq.0)incut=incutx |
112 |
if(ic.lt.NCLSTR1)istop=INDSTART(IC+1)-1 |
c$$$ istart = INDSTART(IC) |
113 |
mu = 0 |
c$$$ istop = TOTCLLENGTH |
114 |
do i = INDMAX(IC),istart,-1 |
c$$$ if(ic.lt.NCLSTR1)istop=INDSTART(IC+1)-1 |
115 |
ipos = i-INDMAX(ic) |
c$$$ mu = 0 |
116 |
cut = incut*CLSIGMA(i) |
c$$$ do i = INDMAX(IC),istart,-1 |
117 |
if(CLSIGNAL(i).ge.cut)then |
c$$$ ipos = i-INDMAX(ic) |
118 |
mu = mu + 1 |
c$$$ cut = incut*CLSIGMA(i) |
119 |
print*,i,mu |
c$$$ if(CLSIGNAL(i).ge.cut)then |
120 |
else |
c$$$ mu = mu + 1 |
121 |
goto 10 |
c$$$ print*,i,mu |
122 |
endif |
c$$$ else |
123 |
enddo |
c$$$ goto 10 |
124 |
10 continue |
c$$$ endif |
125 |
do i = INDMAX(IC)+1,istop |
c$$$ enddo |
126 |
ipos = i-INDMAX(ic) |
c$$$ 10 continue |
127 |
cut = incut*CLSIGMA(i) |
c$$$ do i = INDMAX(IC)+1,istop |
128 |
if(CLSIGNAL(i).ge.cut)then |
c$$$ ipos = i-INDMAX(ic) |
129 |
mu = mu + 1 |
c$$$ cut = incut*CLSIGMA(i) |
130 |
print*,i,mu |
c$$$ if(CLSIGNAL(i).ge.cut)then |
131 |
else |
c$$$ mu = mu + 1 |
132 |
goto 20 |
c$$$ print*,i,mu |
133 |
endif |
c$$$ else |
134 |
enddo |
c$$$ goto 20 |
135 |
20 continue |
c$$$ endif |
136 |
npfastrips=mu |
c$$$ enddo |
137 |
|
c$$$ 20 continue |
138 |
|
c$$$ npfastrips=mu |
139 |
|
|
140 |
endif |
endif |
141 |
* ---------------------------------------------------------------- |
* ---------------------------------------------------------------- |
142 |
|
|
143 |
c print*,pfastrips |
c print*,pfaid,usedPFA,angle,npfastrips |
144 |
|
|
145 |
return |
return |
146 |
end |
end |
163 |
|
|
164 |
if(mod(int(VIEW(ic)),2).eq.1)then !Y-view |
if(mod(int(VIEW(ic)),2).eq.1)then !Y-view |
165 |
|
|
166 |
if( abs(angle).ge.e2fay.and.abs(angle).le.e2tay )then |
if( abs(angle).ge.e2fay.and.abs(angle).lt.e2tay )then |
167 |
pfaeta = pfaeta2(ic,angle) |
pfaeta = pfaeta2(ic,angle) |
168 |
elseif( abs(angle).ge.e3fay.and.abs(angle).le.e3tay )then |
cc print*,pfaeta2(ic,angle) |
169 |
|
elseif( abs(angle).ge.e3fay.and.abs(angle).lt.e3tay )then |
170 |
pfaeta = pfaeta3(ic,angle) |
pfaeta = pfaeta3(ic,angle) |
171 |
elseif( abs(angle).ge.e4fay.and.abs(angle).le.e4tay )then |
elseif( abs(angle).ge.e4fay.and.abs(angle).lt.e4tay )then |
172 |
pfaeta = pfaeta4(ic,angle) |
pfaeta = pfaeta4(ic,angle) |
173 |
else |
else |
174 |
pfaeta = cog(4,ic) |
pfaeta = cog(4,ic) |
176 |
|
|
177 |
else !X-view |
else !X-view |
178 |
|
|
179 |
if( abs(angle).ge.e2fax.and.abs(angle).le.e2tax )then |
if( abs(angle).ge.e2fax.and.abs(angle).lt.e2tax )then |
180 |
pfaeta = pfaeta2(ic,angle) |
pfaeta = pfaeta2(ic,angle) |
181 |
elseif( abs(angle).ge.e3fax.and.abs(angle).le.e3tax )then |
elseif( abs(angle).ge.e3fax.and.abs(angle).lt.e3tax )then |
182 |
pfaeta = pfaeta3(ic,angle) |
pfaeta = pfaeta3(ic,angle) |
183 |
elseif( abs(angle).ge.e4fax.and.abs(angle).le.e4tax )then |
elseif( abs(angle).ge.e4fax.and.abs(angle).lt.e4tax )then |
184 |
pfaeta = pfaeta4(ic,angle) |
pfaeta = pfaeta4(ic,angle) |
185 |
else |
else |
186 |
pfaeta = cog(4,ic) |
pfaeta = cog(4,ic) |
205 |
include 'level1.f' |
include 'level1.f' |
206 |
include 'calib.f' |
include 'calib.f' |
207 |
|
|
208 |
pfaeta = 0 |
pfaetal = 0 |
209 |
|
|
210 |
if(mod(int(VIEW(ic)),2).eq.1)then !Y-view |
if(mod(int(VIEW(ic)),2).eq.1)then !Y-view |
211 |
|
|
212 |
if( abs(angle).ge.e2fay.and.abs(angle).le.e2tay )then |
if( abs(angle).ge.e2fay.and.abs(angle).lt.e2tay )then |
213 |
pfaeta = pfaeta2(ic,angle)+pfacorr(ic,angle) |
pfaetal = pfaeta2(ic,angle)+pfacorr(ic,angle) |
214 |
elseif( abs(angle).ge.e3fay.and.abs(angle).le.e3tay )then |
cc print*,VIEW(ic),angle,pfaeta2(ic,angle),pfacorr(ic,angle) |
215 |
pfaeta = pfaeta3(ic,angle)+pfacorr(ic,angle) |
elseif( abs(angle).ge.e3fay.and.abs(angle).lt.e3tay )then |
216 |
elseif( abs(angle).ge.e4fay.and.abs(angle).le.e4tay )then |
pfaetal = pfaeta3(ic,angle)+pfacorr(ic,angle) |
217 |
pfaeta = pfaeta4(ic,angle)+pfacorr(ic,angle) |
elseif( abs(angle).ge.e4fay.and.abs(angle).lt.e4tay )then |
218 |
|
pfaetal = pfaeta4(ic,angle)+pfacorr(ic,angle) |
219 |
else |
else |
220 |
pfaeta = cog(4,ic) |
pfaetal = cog(4,ic) |
221 |
endif |
endif |
222 |
|
|
223 |
else !X-view |
else !X-view |
224 |
|
|
225 |
if( abs(angle).ge.e2fax.and.abs(angle).le.e2tax )then |
if( abs(angle).ge.e2fax.and.abs(angle).lt.e2tax )then |
226 |
pfaeta = pfaeta2(ic,angle)+pfacorr(ic,angle) |
pfaetal = pfaeta2(ic,angle)+pfacorr(ic,angle) |
227 |
elseif( abs(angle).ge.e3fax.and.abs(angle).le.e3tax )then |
cc print*,VIEW(ic),angle,pfaeta2(ic,angle),pfacorr(ic,angle) |
228 |
pfaeta = pfaeta3(ic,angle)+pfacorr(ic,angle) |
elseif( abs(angle).ge.e3fax.and.abs(angle).lt.e3tax )then |
229 |
elseif( abs(angle).ge.e4fax.and.abs(angle).le.e4tax )then |
pfaetal = pfaeta3(ic,angle)+pfacorr(ic,angle) |
230 |
pfaeta = pfaeta4(ic,angle)+pfacorr(ic,angle) |
elseif( abs(angle).ge.e4fax.and.abs(angle).lt.e4tax )then |
231 |
|
pfaetal = pfaeta4(ic,angle)+pfacorr(ic,angle) |
232 |
else |
else |
233 |
pfaeta = cog(4,ic) |
pfaetal = cog(4,ic) |
234 |
endif |
endif |
235 |
|
|
236 |
endif |
endif |
685 |
|
|
686 |
|
|
687 |
*** * * * *** * * * *** * * * *** * * * *** * * * *** * * * *** |
*** * * * *** * * * *** * * * *** * * * *** * * * *** * * * *** |
|
c$$$ real function cog0(ncog,ic) |
|
|
c$$$*------------------------------------------------- |
|
|
c$$$* this function returns |
|
|
c$$$* |
|
|
c$$$* - the Center-Of-Gravity of the cluster IC |
|
|
c$$$* evaluated using NCOG strips, |
|
|
c$$$* calculated relative to MAXS(IC) |
|
|
c$$$* |
|
|
c$$$* - zero in case that not enough strips |
|
|
c$$$* have a positive signal |
|
|
c$$$* |
|
|
c$$$* NOTE: |
|
|
c$$$* This is the old definition, used by Straulino. |
|
|
c$$$* The new routine, according to Landi, |
|
|
c$$$* is COG(NCOG,IC) |
|
|
c$$$*------------------------------------------------- |
|
|
c$$$ |
|
|
c$$$ |
|
|
c$$$ include 'commontracker.f' |
|
|
c$$$ include 'level1.f' |
|
|
c$$$ |
|
|
c$$$* --> signal of the central strip |
|
|
c$$$ sc = CLSIGNAL(INDMAX(ic)) !center |
|
|
c$$$ |
|
|
c$$$* signal of adjacent strips |
|
|
c$$$* --> left |
|
|
c$$$ sl1 = 0 !left 1 |
|
|
c$$$ if( |
|
|
c$$$ $ (INDMAX(ic)-1).ge.INDSTART(ic) |
|
|
c$$$ $ ) |
|
|
c$$$ $ sl1 = max(0.,CLSIGNAL(INDMAX(ic)-1)) |
|
|
c$$$ |
|
|
c$$$ sl2 = 0 !left 2 |
|
|
c$$$ if( |
|
|
c$$$ $ (INDMAX(ic)-2).ge.INDSTART(ic) |
|
|
c$$$ $ ) |
|
|
c$$$ $ sl2 = max(0.,CLSIGNAL(INDMAX(ic)-2)) |
|
|
c$$$ |
|
|
c$$$* --> right |
|
|
c$$$ sr1 = 0 !right 1 |
|
|
c$$$ if( |
|
|
c$$$ $ (ic.ne.NCLSTR1.and.(INDMAX(ic)+1).lt.INDSTART(ic+1)) |
|
|
c$$$ $ .or. |
|
|
c$$$ $ (ic.eq.NCLSTR1.and.(INDMAX(ic)+1).le.TOTCLLENGTH) |
|
|
c$$$ $ ) |
|
|
c$$$ $ sr1 = max(0.,CLSIGNAL(INDMAX(ic)+1)) |
|
|
c$$$ |
|
|
c$$$ sr2 = 0 !right 2 |
|
|
c$$$ if( |
|
|
c$$$ $ (ic.ne.NCLSTR1.and.(INDMAX(ic)+2).lt.INDSTART(ic+1)) |
|
|
c$$$ $ .or. |
|
|
c$$$ $ (ic.eq.NCLSTR1.and.(INDMAX(ic)+2).le.TOTCLLENGTH) |
|
|
c$$$ $ ) |
|
|
c$$$ $ sr2 = max(0.,CLSIGNAL(INDMAX(ic)+2)) |
|
|
c$$$ |
|
|
c$$$************************************************************ |
|
|
c$$$* COG computation |
|
|
c$$$************************************************************ |
|
|
c$$$ |
|
|
c$$$c print*,sl2,sl1,sc,sr1,sr2 |
|
|
c$$$ |
|
|
c$$$ COG = 0. |
|
|
c$$$ |
|
|
c$$$ if(sl1.gt.sr1.and.sl1.gt.0.)then |
|
|
c$$$ |
|
|
c$$$ if(ncog.eq.2.and.sl1.ne.0)then |
|
|
c$$$ COG = -sl1/(sl1+sc) |
|
|
c$$$ elseif(ncog.eq.3.and.sl1.ne.0.and.sr1.ne.0)then |
|
|
c$$$ COG = (sr1-sl1)/(sl1+sc+sr1) |
|
|
c$$$ elseif(ncog.eq.4.and.sl1.ne.0.and.sr1.ne.0.and.sl2.ne.0)then |
|
|
c$$$ COG = (sr1-sl1-2*sl2)/(sl2+sl1+sc+sr1) |
|
|
c$$$ else |
|
|
c$$$ COG = 0. |
|
|
c$$$ endif |
|
|
c$$$ |
|
|
c$$$ elseif(sl1.le.sr1.and.sr1.gt.0.)then |
|
|
c$$$ |
|
|
c$$$ if(ncog.eq.2.and.sr1.ne.0)then |
|
|
c$$$ COG = sr1/(sc+sr1) |
|
|
c$$$ elseif(ncog.eq.3.and.sr1.ne.0.and.sl1.ne.0)then |
|
|
c$$$ COG = (sr1-sl1)/(sl1+sc+sr1) |
|
|
c$$$ elseif(ncog.eq.4.and.sr1.ne.0.and.sl1.ne.0.and.sr2.ne.0)then |
|
|
c$$$ COG = (2*sr2+sr1-sl1)/(sl2+sl1+sc+sr1) |
|
|
c$$$ else |
|
|
c$$$ COG = 0. |
|
|
c$$$ endif |
|
|
c$$$ |
|
|
c$$$ endif |
|
|
c$$$ |
|
|
c$$$ COG0 = COG |
|
|
c$$$ |
|
|
c$$$c print *,ncog,ic,cog,'/////////////' |
|
|
c$$$ |
|
|
c$$$ return |
|
|
c$$$ end |
|
|
|
|
|
*** * * * *** * * * *** * * * *** * * * *** * * * *** * * * *** |
|
688 |
real function cog(ncog,ic) |
real function cog(ncog,ic) |
689 |
*------------------------------------------------- |
*------------------------------------------------- |
690 |
* this function returns |
* this function returns |
1001 |
SGN = 0. |
SGN = 0. |
1002 |
SNU = 0. |
SNU = 0. |
1003 |
SDE = 0. |
SDE = 0. |
|
c$$$ do i=INDMAX(IC),istart,-1 |
|
|
c$$$ ipos = i-INDMAX(ic) |
|
|
c$$$ cut = incut*CLSIGMA(i) |
|
|
c$$$ if(CLSIGNAL(i).gt.cut)then |
|
|
c$$$ COG = COG + ipos*CLSIGNAL(i) |
|
|
c$$$ SGN = SGN + CLSIGNAL(i) |
|
|
c$$$ else |
|
|
c$$$ goto 10 |
|
|
c$$$ endif |
|
|
c$$$ enddo |
|
|
c$$$ 10 continue |
|
|
c$$$ do i=INDMAX(IC)+1,istop |
|
|
c$$$ ipos = i-INDMAX(ic) |
|
|
c$$$ cut = incut*CLSIGMA(i) |
|
|
c$$$ if(CLSIGNAL(i).gt.cut)then |
|
|
c$$$ COG = COG + ipos*CLSIGNAL(i) |
|
|
c$$$ SGN = SGN + CLSIGNAL(i) |
|
|
c$$$ else |
|
|
c$$$ goto 20 |
|
|
c$$$ endif |
|
|
c$$$ enddo |
|
|
c$$$ 20 continue |
|
|
c$$$ if(SGN.le.0)then |
|
|
c$$$ print*,'fbad_cog(0,ic) --> ic, dedx ',ic,SGN |
|
|
c$$$ print*,(CLSIGNAL(i)/CLSIGMA(i),i=istart,istop) |
|
|
c$$$ print*,(CLSIGNAL(i),i=istart,istop) |
|
|
c$$$ print*,'fbad_cog(0,ic) --> NOT EVALUATED ' |
|
|
c$$$ else |
|
|
c$$$ COG=COG/SGN |
|
|
c$$$ endif |
|
1004 |
|
|
1005 |
do i=INDMAX(IC),istart,-1 |
do i=INDMAX(IC),istart,-1 |
1006 |
ipos = i-INDMAX(ic) |
ipos = i-INDMAX(ic) |
1048 |
end |
end |
1049 |
|
|
1050 |
|
|
1051 |
*** * * * *** * * * *** * * * *** * * * *** * * * *** * * * *** |
c$$$*** * * * *** * * * *** * * * *** * * * *** * * * *** * * * *** |
1052 |
real function fbad_cog0(ncog,ic) |
c$$$ real function fbad_cog0(ncog,ic) |
1053 |
*------------------------------------------------------- |
c$$$*------------------------------------------------------- |
1054 |
* this function returns a factor that takes into |
c$$$* this function returns a factor that takes into |
1055 |
* account deterioration of the spatial resolution |
c$$$* account deterioration of the spatial resolution |
1056 |
* in the case BAD strips are included in the cluster. |
c$$$* in the case BAD strips are included in the cluster. |
1057 |
* This factor should multiply the nominal spatial |
c$$$* This factor should multiply the nominal spatial |
1058 |
* resolution. |
c$$$* resolution. |
1059 |
* |
c$$$* |
1060 |
* NB!!! |
c$$$* NB!!! |
1061 |
* (this is the old version. It consider only the two |
c$$$* (this is the old version. It consider only the two |
1062 |
* strips with the greatest signal. The new one is |
c$$$* strips with the greatest signal. The new one is |
1063 |
* fbad_cog(ncog,ic) ) |
c$$$* fbad_cog(ncog,ic) ) |
1064 |
* |
c$$$* |
1065 |
*------------------------------------------------------- |
c$$$*------------------------------------------------------- |
1066 |
|
c$$$ |
1067 |
include 'commontracker.f' |
c$$$ include 'commontracker.f' |
1068 |
include 'level1.f' |
c$$$ include 'level1.f' |
1069 |
include 'calib.f' |
c$$$ include 'calib.f' |
1070 |
|
c$$$ |
1071 |
* --> signal of the central strip |
c$$$* --> signal of the central strip |
1072 |
sc = CLSIGNAL(INDMAX(ic)) !center |
c$$$ sc = CLSIGNAL(INDMAX(ic)) !center |
1073 |
|
c$$$ |
1074 |
* signal of adjacent strips |
c$$$* signal of adjacent strips |
1075 |
* --> left |
c$$$* --> left |
1076 |
sl1 = 0 !left 1 |
c$$$ sl1 = 0 !left 1 |
1077 |
if( |
c$$$ if( |
1078 |
$ (INDMAX(ic)-1).ge.INDSTART(ic) |
c$$$ $ (INDMAX(ic)-1).ge.INDSTART(ic) |
1079 |
$ ) |
c$$$ $ ) |
1080 |
$ sl1 = max(0.,CLSIGNAL(INDMAX(ic)-1)) |
c$$$ $ sl1 = max(0.,CLSIGNAL(INDMAX(ic)-1)) |
1081 |
|
c$$$ |
1082 |
sl2 = 0 !left 2 |
c$$$ sl2 = 0 !left 2 |
1083 |
if( |
c$$$ if( |
1084 |
$ (INDMAX(ic)-2).ge.INDSTART(ic) |
c$$$ $ (INDMAX(ic)-2).ge.INDSTART(ic) |
1085 |
$ ) |
c$$$ $ ) |
1086 |
$ sl2 = max(0.,CLSIGNAL(INDMAX(ic)-2)) |
c$$$ $ sl2 = max(0.,CLSIGNAL(INDMAX(ic)-2)) |
1087 |
|
c$$$ |
1088 |
* --> right |
c$$$* --> right |
1089 |
sr1 = 0 !right 1 |
c$$$ sr1 = 0 !right 1 |
1090 |
if( |
c$$$ if( |
1091 |
$ (ic.ne.NCLSTR1.and.(INDMAX(ic)+1).lt.INDSTART(ic+1)) |
c$$$ $ (ic.ne.NCLSTR1.and.(INDMAX(ic)+1).lt.INDSTART(ic+1)) |
1092 |
$ .or. |
c$$$ $ .or. |
1093 |
$ (ic.eq.NCLSTR1.and.(INDMAX(ic)+1).le.TOTCLLENGTH) |
c$$$ $ (ic.eq.NCLSTR1.and.(INDMAX(ic)+1).le.TOTCLLENGTH) |
1094 |
$ ) |
c$$$ $ ) |
1095 |
$ sr1 = max(0.,CLSIGNAL(INDMAX(ic)+1)) |
c$$$ $ sr1 = max(0.,CLSIGNAL(INDMAX(ic)+1)) |
1096 |
|
c$$$ |
1097 |
sr2 = 0 !right 2 |
c$$$ sr2 = 0 !right 2 |
1098 |
if( |
c$$$ if( |
1099 |
$ (ic.ne.NCLSTR1.and.(INDMAX(ic)+2).lt.INDSTART(ic+1)) |
c$$$ $ (ic.ne.NCLSTR1.and.(INDMAX(ic)+2).lt.INDSTART(ic+1)) |
1100 |
$ .or. |
c$$$ $ .or. |
1101 |
$ (ic.eq.NCLSTR1.and.(INDMAX(ic)+2).le.TOTCLLENGTH) |
c$$$ $ (ic.eq.NCLSTR1.and.(INDMAX(ic)+2).le.TOTCLLENGTH) |
1102 |
$ ) |
c$$$ $ ) |
1103 |
$ sr2 = max(0.,CLSIGNAL(INDMAX(ic)+2)) |
c$$$ $ sr2 = max(0.,CLSIGNAL(INDMAX(ic)+2)) |
1104 |
|
c$$$ |
1105 |
|
c$$$ |
1106 |
if(mod(int(VIEW(ic)),2).eq.1)then !Y-view |
c$$$ if(mod(int(VIEW(ic)),2).eq.1)then !Y-view |
1107 |
f = 4. |
c$$$ f = 4. |
1108 |
si = 8.4 |
c$$$ si = 8.4 |
1109 |
else !X-view |
c$$$ else !X-view |
1110 |
f = 6. |
c$$$ f = 6. |
1111 |
si = 3.9 |
c$$$ si = 3.9 |
1112 |
endif |
c$$$ endif |
1113 |
|
c$$$ |
1114 |
fbad_cog = 1. |
c$$$ fbad_cog = 1. |
1115 |
f0 = 1 |
c$$$ f0 = 1 |
1116 |
f1 = 1 |
c$$$ f1 = 1 |
1117 |
f2 = 1 |
c$$$ f2 = 1 |
1118 |
f3 = 1 |
c$$$ f3 = 1 |
1119 |
if(sl1.gt.sr1.and.sl1.gt.0.)then |
c$$$ if(sl1.gt.sr1.and.sl1.gt.0.)then |
1120 |
|
c$$$ |
1121 |
if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)) ).eq.0)f0=f |
c$$$ if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)) ).eq.0)f0=f |
1122 |
if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)-1)).eq.0)f1=f |
c$$$ if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)-1)).eq.0)f1=f |
1123 |
c if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)+1)).eq.0)f3=f |
c$$$c if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)+1)).eq.0)f3=f |
1124 |
|
c$$$ |
1125 |
if(ncog.eq.2.and.sl1.ne.0)then |
c$$$ if(ncog.eq.2.and.sl1.ne.0)then |
1126 |
fbad_cog = (f1**2*sc**2/sl1**2+f0**2)/(sc**2/sl1**2+1.) |
c$$$ fbad_cog = (f1**2*sc**2/sl1**2+f0**2)/(sc**2/sl1**2+1.) |
1127 |
elseif(ncog.eq.3.and.sl1.ne.0.and.sr1.ne.0)then |
c$$$ elseif(ncog.eq.3.and.sl1.ne.0.and.sr1.ne.0)then |
1128 |
fbad_cog = 1. |
c$$$ fbad_cog = 1. |
1129 |
elseif(ncog.eq.4.and.sl1.ne.0.and.sr1.ne.0.and.sl2.ne.0)then |
c$$$ elseif(ncog.eq.4.and.sl1.ne.0.and.sr1.ne.0.and.sl2.ne.0)then |
1130 |
fbad_cog = 1. |
c$$$ fbad_cog = 1. |
1131 |
else |
c$$$ else |
1132 |
fbad_cog = 1. |
c$$$ fbad_cog = 1. |
1133 |
endif |
c$$$ endif |
1134 |
|
c$$$ |
1135 |
elseif(sl1.le.sr1.and.sr1.gt.0.)then |
c$$$ elseif(sl1.le.sr1.and.sr1.gt.0.)then |
1136 |
|
c$$$ |
1137 |
|
c$$$ |
1138 |
if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)) ).eq.0)f0=f |
c$$$ if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)) ).eq.0)f0=f |
1139 |
if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)+1)).eq.0)f1=f |
c$$$ if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)+1)).eq.0)f1=f |
1140 |
c if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)-1)).eq.0)f3=f |
c$$$c if(BAD(VIEW(ic),nvk(MAXS(ic)),nst(MAXS(ic)-1)).eq.0)f3=f |
1141 |
|
c$$$ |
1142 |
if(ncog.eq.2.and.sr1.ne.0)then |
c$$$ if(ncog.eq.2.and.sr1.ne.0)then |
1143 |
fbad_cog = (f1**2*sc**2/sr1**2+f0**2)/(sc**2/sr1**2+1.) |
c$$$ fbad_cog = (f1**2*sc**2/sr1**2+f0**2)/(sc**2/sr1**2+1.) |
1144 |
elseif(ncog.eq.3.and.sr1.ne.0.and.sl1.ne.0)then |
c$$$ elseif(ncog.eq.3.and.sr1.ne.0.and.sl1.ne.0)then |
1145 |
fbad_cog = 1. |
c$$$ fbad_cog = 1. |
1146 |
elseif(ncog.eq.4.and.sr1.ne.0.and.sl1.ne.0.and.sr2.ne.0)then |
c$$$ elseif(ncog.eq.4.and.sr1.ne.0.and.sl1.ne.0.and.sr2.ne.0)then |
1147 |
fbad_cog = 1. |
c$$$ fbad_cog = 1. |
1148 |
else |
c$$$ else |
1149 |
fbad_cog = 1. |
c$$$ fbad_cog = 1. |
1150 |
endif |
c$$$ endif |
1151 |
|
c$$$ |
1152 |
endif |
c$$$ endif |
1153 |
|
c$$$ |
1154 |
fbad_cog0 = sqrt(fbad_cog) |
c$$$ fbad_cog0 = sqrt(fbad_cog) |
1155 |
|
c$$$ |
1156 |
return |
c$$$ return |
1157 |
end |
c$$$ end |
1158 |
|
c$$$ |
1159 |
|
c$$$ |
1160 |
|
c$$$ |
1161 |
|
|
1162 |
*** * * * *** * * * *** * * * *** * * * *** * * * *** * * * *** |
*** * * * *** * * * *** * * * *** * * * *** * * * *** * * * *** |
1163 |
|
|
1655 |
|
|
1656 |
|
|
1657 |
*** * * * *** * * * *** * * * *** * * * *** * * * *** * * * *** |
*** * * * *** * * * *** * * * *** * * * *** * * * *** * * * *** |
1658 |
real function pfacorr(ic,angle) !(1) |
real function pfacorr(ic,angle) |
1659 |
*-------------------------------------------------------------- |
*-------------------------------------------------------------- |
1660 |
* this function returns the landi correction for this cluster |
* this function returns the landi correction for this cluster |
1661 |
*-------------------------------------------------------------- |
*-------------------------------------------------------------- |