/[PAMELA software]/yoda/techmodel/forroutines/tof/tofunpack.for
ViewVC logotype

Annotation of /yoda/techmodel/forroutines/tof/tofunpack.for

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4.4 - (hide annotations) (download)
Sat May 28 10:44:14 2005 UTC (19 years, 6 months ago) by kusanagi
Branch: MAIN
Changes since 4.1: +0 -0 lines
Main features of this release are:
- updated classes documentations;
- major changes on the calibration fortran routine for the calorimeter
- update on the TMTC thermistors
- removed old classes as CalibTrkBoth and CalibTrd

1 kusanagi 1.1 C--------------------------------------------------------------------
2     SUBROUTINE TOFUNPACK(vecta,lung,me)
3     C D.Campana, Dec. 04
4     C---------------------------------------------------------------------
5    
6     IMPLICIT NONE
7    
8     C
9     C Normal variables definition
10     C
11     integer lung
12     integer*1 vecta(lung)
13 kusanagi 4.1 integer*2 ibuf
14 kusanagi 1.1 integer me
15     integer check, crctof
16     integer ic0,sup,inf
17     integer i, ic, bit, bi,j
18 kusanagi 4.1 integer start,ntdc,tdcfirst
19 kusanagi 1.1 integer tdcid(12),evcount(12)
20     integer tdcmask(12),adc(4,12),tdc(4,12)
21     integer rawadc(4,12),rawtdc(4,12),grayadc(4,12),graytdc(4,12)
22     integer temp1(12),temp2(12)
23 kusanagi 4.1 logical flag2
24 kusanagi 1.1 C
25     c data start,ntdc /150,12/ ! to read data before Christmas 2004
26     data start,ntdc /153,12/ ! to read data after Christmas 2004
27    
28     COMMON / tofvar /tdcid,evcount,tdcmask,adc,tdc,temp1,temp2
29     save / tofvar /
30    
31     C
32     C Begin !
33     C
34    
35     C
36 kusanagi 4.1 C AAA : would be better to have a pattern for the tof!
37     C at this moment we have just a pointer (start)
38 kusanagi 1.1 C
39    
40     ic = start
41     C
42     c print *,'++++++++++ Tof Unpack ++++++++++++++++'
43    
44     do j = 1,ntdc
45 kusanagi 4.1 flag2=.true.
46     ic0 = ic ! first index for the CRC computation
47 kusanagi 1.1 tdcid(j) = 0
48     evcount(j) = 0
49     do bit = 0, 7
50     bi = ibits(vecta(ic),bit,1)
51     if (bi.eq.1) tdcid(j) = ibset(tdcid(j),bit)
52     bi = ibits(vecta(ic+1),bit,1)
53     if (bi.eq.1) evcount(j) = ibset(evcount(j),bit)
54     enddo
55     c
56     ic=ic+2
57     tdcmask(j) = 0
58     do bit = 0, 7
59     bi = ibits(vecta(ic),bit,1)
60     if (bi.eq.1) tdcmask(j) = ibset(tdcmask(j),bit+8)
61     bi = ibits(vecta(ic+1),bit,1)
62     if (bi.eq.1) tdcmask(j) = ibset(tdcmask(j),bit)
63     enddo
64 kusanagi 4.1 c
65 kusanagi 1.1 ic=ic+2
66 kusanagi 4.1 c
67     c
68     c if first 3 bit of the word RAWADC are equal to 0
69     c the data storage is shifted by a word --> ic = ic+1
70     c and TEMP2 is overwritten by the CRC --> flag2=.false.
71     c
72     tdcfirst = 0
73     do bit = 5,7
74     bi = ibits(vecta(ic),bit,1)
75     if (bi.eq.1) tdcfirst = ibset(tdcfirst,bit-5)
76     enddo
77     if (tdcfirst.eq.0) then
78     ic=ic+1
79     flag2=.false.
80     endif
81     c
82 kusanagi 1.1 do i=1,4
83     rawadc(i,j) = 0
84     rawtdc(i,j) = 0
85     grayadc(i,j) = 0
86     graytdc(i,j) = 0
87     do bit = 0, 7
88     bi = ibits(vecta(ic),bit,1)
89     if (bi.eq.1) rawadc(i,j) = ibset(rawadc(i,j),bit+8)
90     bi = ibits(vecta(ic+1),bit,1)
91     if (bi.eq.1) rawadc(i,j) = ibset(rawadc(i,j),bit)
92     bi = ibits(vecta(ic+2),bit,1)
93     if (bi.eq.1) rawtdc(i,j) = ibset(rawtdc(i,j),bit+8)
94     bi = ibits(vecta(ic+3),bit,1)
95     if (bi.eq.1) rawtdc(i,j) = ibset(rawtdc(i,j),bit)
96     enddo
97     c
98     c adc e tdc data have to be translated from Gray code to binary (bit 0-11)
99     c bit 12 is added after conversion (control bit)
100     c bit 13 is 1(0) for charge(time) information
101     c bits 14-15 give the channel 1-4 on the board.
102     c
103     grayadc(i,j)=ibits(rawadc(i,j),0,12)
104     graytdc(i,j)=ibits(rawtdc(i,j),0,12)
105     c
106     call graytobin(grayadc(i,j),adc(i,j),12)
107     call graytobin(graytdc(i,j),tdc(i,j),12)
108     c
109     bi = ibits(rawtdc(i,j),12,1)
110     if (bi.eq.1) tdc(i,j) = ibset(tdc(i,j),12)
111     bi = ibits(rawadc(i,j),12,1)
112     if (bi.eq.1) adc(i,j) = ibset(adc(i,j),12)
113     c
114     ic=ic+4
115     enddo
116     c
117     temp1(j) = 0
118     temp2(j) = 0
119     do bit = 0, 7
120     bi = ibits(vecta(ic),bit,1)
121     if (bi.eq.1) temp1(j) = ibset(temp1(j),bit)
122 kusanagi 4.1 enddo
123     ic=ic+1
124     c
125     if (flag2.eqv..true.) then
126     do bit = 0, 7
127     bi = ibits(vecta(ic),bit,1)
128     if (bi.eq.1) temp2(j) = ibset(temp2(j),bit)
129     enddo
130     ic=ic+1
131     else
132     temp2(j) = 99
133     endif
134 kusanagi 1.1 c
135     c vecta(ic) is the CRC
136     c Check consistency of CRC.
137     c
138 kusanagi 4.1 ccc if(vecta(ic).lt.0)vecta(ic)=vecta(ic)+256
139    
140     ibuf=0
141     do bit = 0, 7
142     bi = ibits(vecta(ic),bit,1)
143     if (bi.eq.1) ibuf = ibset(ibuf,bit)
144     enddo
145     c
146 kusanagi 1.1 check = 0
147     inf = ic0
148     sup = ic - 1
149     do i = inf,sup
150     check=crctof(check,vecta(i))
151     enddo
152 kusanagi 4.1 c if (check.ne.vecta(ic)) then
153     if (check.ne.ibuf) then
154     c print *,'crc wrong ',ibuf, check
155 kusanagi 1.1 me = 1
156     endif
157    
158     c
159     c print *,'---------> ic, j' ,ic,j
160     ic=ic+1
161    
162     enddo ! j = 1,ntdc
163    
164    
165     RETURN
166     END

  ViewVC Help
Powered by ViewVC 1.1.23