c c-------------------------------------------- c userfunction for AYEBALL. c-------------------------------------------- ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc logical function userin ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c--- c User initialization routine c Called once at the beginning of aqcuisition and used c to initialize various things. c--- implicit none include 'aye_fix.inc' include 'aye_flt.inc' c et - event type c np - number of parameters c ev - event vector c c..the event-structure is: c 1) for monitor event: c - evtype c - emon c 2) for gamma-ray event: c - evtype c - gepat for EG c - gepat for TESSA c - (E,t) for all detectors which fired c 3) for the ppac/IC event: c - event type bit register (if not gamma-ray event) c - ppac-readout R,L,U,D c - deltaE (ppac) c - TDC TOF (ppac-ionchamber) c - TAC TOF (ppac-ionchamber) c - RF TOF (ppac-rf) c - Rec-gamma tac c - Pile up signal (=1/2 for OK/PILEUP) c - Ion chamber anodes c - Ion chamber position c c..the pseudoevent structure is: c c pev(#) contents c ----------- ----------------------------- c 1-20 Ege c 21-40 Tge c 41-60 doppler corrected energies c 61-80 bit hit pattern germanium c 81-100 adc hit pattern germanium c 101,102,103 1st, 2nd, 3rd corrected energy c 104 number of eurogam Ge c 105 number of tessa Ge c 106 number of all Ge c c 120 event type bit register c 121 event length c c 123 monitor E c c 131 R c 132 L c 133 U c 134 D c 135 X c 136 RL c 137 Y c 138 UD c 139 deltaE c 140 TDC TOF (PPAC - ION) c 141 TAC TOF (PPAC - ION) c 142 RF TOF c 143 rec-gamma TAC c 144 PPAC,IC pileup bits (1,2) c 145 E * T**2 c 151-153 Ion anodes E1,E2,E3 c 157 Ion position raw c 160 calculated position c 161 E1+E2 c 162 E1+E2+E3 c c Created: July 1995 c DJB, ANL c c c declaring variables ... c integer*2 et,np integer*2 ev(*),nPEV parameter (nPEV=300) integer*2 pev(nPEV) integer*2 i,j,k,m,n,index,locev,locpev integer*4 ii integer*2 nrge1,nrge2,nrge integer*2 evtype,evbits(16),patge1(16),patge2(16) integer*2 ge_pattern1,ge_pattern2 real*8 delran integer*4 iseed real*4 gamma real*4 ang1_5,dps1_5 parameter (ang1_5=158.) real*4 ang6_10,dps6_10 parameter (ang6_10=134.) real*4 ang11_15,dps11_15 parameter (ang11_15=101.0) real*4 ang16_20,dps16_20 parameter (ang16_20=79.0) real*4 degrad parameter (degrad=57.29578) real*4 dps(20) integer*2 NANODES real*4 R,L,U,D,X,Y,RL,UD integer*2 lowt,hight integer*2 data integer*4 ddata data lowt,hight /10,2040/ data iseed /123457/ DATA NANODES/3/ integer*4 spn, mass, z logical user, user1, userex, fixflt INTEGER*4 INZVECTOR(*),W2VECTOR(*),W1VECTOR(*),CONVECTOR(*) CHARACTER*10 CON_NAME, H_NAME LOGICAL H_OK, CON_OK LOGICAL CONNUMBER LOGICAL H1NUMBER, H2NUMBER INTEGER*4 Z1_CON_N, Z2_CON_N, Z3_CON_N, Z4_CON_N, Z5_CON_N, Z6_CON_N INTEGER*4 M1_CON_N, M2_CON_N, M3_CON_N, M4_CON_N, M5_CON_N INTEGER*4 GGPART_H_N, GPART_H_N c c getting access to conditions ... c CON_NAME='Z1' CON_OK=CONNUMBER(CON_NAME,Z1_CON_N) CON_NAME='Z2' CON_OK=CONNUMBER(CON_NAME,Z2_CON_N) CON_NAME='Z3' CON_OK=CONNUMBER(CON_NAME,Z3_CON_N) CON_NAME='Z4' CON_OK=CONNUMBER(CON_NAME,Z4_CON_N) CON_NAME='Z5' CON_OK=CONNUMBER(CON_NAME,Z5_CON_N) CON_NAME='Z6' CON_OK=CONNUMBER(CON_NAME,Z6_CON_N) CON_NAME='M1' CON_OK=CONNUMBER(CON_NAME,M1_CON_N) CON_NAME='M2' CON_OK=CONNUMBER(CON_NAME,M2_CON_N) CON_NAME='M3' CON_OK=CONNUMBER(CON_NAME,M3_CON_N) CON_NAME='M4' CON_OK=CONNUMBER(CON_NAME,M4_CON_N) CON_NAME='M5' CON_OK=CONNUMBER(CON_NAME,M5_CON_N) c c getting access to histograms ... c H_NAME='GGPART' H_OK=H2NUMBER(H_NAME,GGPART_H_N) H_NAME='GPART' H_OK=H2NUMBER(H_NAME,GPART_H_N) call defPEV (pev(1),pev(nPEV)) call deffix(fixarr,fixzzz) call defflt(fltarr,fltzzz) c--- c Define the random number seeds. c--- iseed = 123457 userin=.true. return ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc entry user (et,np,ev,INZVECTOR,W2VECTOR,W1VECTOR,CONVECTOR) ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c------------------------------------------------------------- c START PROCESSING THE EVENT HERE!!!!!!!! c------------------------------------------------------------- call zeroI2(npev,pev) nrge1 = 0 nrge2 = 0 nrge = 0 locev=1 !pointer for raw event vector pev(121)=np !event length in words c------------------------------------------------------------- c get the event type bit register c------------------------------------------------------------- evtype=ev(locev) locev=locev+1 call bit16(evtype,evbits) pev(120)=evtype c------------------------------------------------------------- c Monitor Event c------------------------------------------------------------- if ( iand(evtype,1) .ne. 0) then pev(123) = and (ev(locev),X'0FFF') !emon locev=locev+1 userin=.true. return !ignore anything else endif c------------------------------------------------------------- c Do all the germanium and neutron stuff here if they fired c------------------------------------------------------------- if ( iand(evtype,'003c'x) .ne. 0) then c..Get the hit pattern for the germaniums. ge_pattern1=iand(ev(locev),'0FFF'x) ge_pattern2=iand(ev(locev+1),'0FFF'x) locev=locev+2 call bit16(ge_pattern1,patge1) call bit16(ge_pattern2,patge2) if ((ge_pattern1+ge_pattern2).ne.0 ) then do i=1,20 j = i !loc of raw ge e in pev k = 20 + i !loc of ge time in pev l = 40 + i !loc of corrected ge e in pev m = 60 + i !loc of bit hit patt for ge #i in pev n = 80 + i !loc of adc hit patt for ge #i in pev index=0 if (i.le.10) then if (patge1(i).eq.1) index=1 !EG are 1-10 else if (patge2(i-10).eq.1) index=2 !TESSA are 11-20 endif if (index.gt.0) then !check ge bits pev(j) = ev(locev) !raw ge energy pev(k) = iand(ev(locev+1),'0fff'x) !ge time locev = locev + 2 pev(m) = i !bit hit pattern if (pev(j).gt.1 .and. pev(j).lt.8190) then !valid ge energy pev(n)=i !adc hit pattern nrge = nrge + 1 !total ge mult if (index.eq.1) then nrge1 = nrge1 + 1 !EG mult else nrge2 = nrge2 + 1 !TESSA mult endif delran = ran(iseed) - 0.5 pev(l) = nint( (dps(i)*pev(j) + delran)/2.0 ) if (nrge.le.3) pev(100+nrge)=pev(l) !1st 3 energies endif endif enddo pev(104) = nrge1 pev(105) = nrge2 pev(106) = nrge endif endif c------------------------------------------------------------- c Do all the PPAC and Ion Chamber stuff here if they fired c------------------------------------------------------------- if ( iand(evtype,106) .ne. 0) then c---------- c PPAC part c---------- c..first generate the (X,Y) position & the LR and UD sums R = FLOAT(iand(EV(locev),'0FFF'X)) L = FLOAT(iand(EV(locev+1),'0FFF'X)) U = FLOAT(iand(EV(locev+2),'0FFF'X)) D = FLOAT(iand(EV(locev+3),'0FFF'X)) c..store R,L,U,D readouts (raw data) PEV(131)=R PEV(132)=L PEV(133)=U PEV(134)=D IF(R.GT.lowt .AND .R.LT. hight & .AND. & L.GT.lowt .AND. L.LT. hight) THEN X = ( (R-L) + XOFFSET ) * XSCALE RL = (R+L)/2 PEV(135)=NINT(X) PEV(136)=NINT(RL) ENDIF IF(U.GT.lowt .AND. U.LT. hight & .AND. & D.GT.lowt .AND.D.LT. hight) THEN Y = ( (D-U) + YOFFSET ) * YSCALE UD = (U+D)/2 PEV(137)=NINT(Y) PEV(138)=NINT(UD) ENDIF locev = locev + 4 c..PPAC DELTA ENERGY pev(139)= and (ev(locev),X'0FFF') locev = locev + 1 c..TOF tdc (ppac-dssd time of flight) pev(140) = and (ev(locev),X'0FFF') locev = locev + 1 c..TOF TAC (ppac-dssd time of flight for long times) pev(141) = and (ev(locev),X'0FFF') locev = locev + 1 c..TOF (ppac-rf) pev(142) = and (ev(locev),X'0FFF') locev = locev + 1 c..TOF (rec-gamma TAC) pev(143) = and (ev(locev),X'0FFF') locev = locev + 1 c...pileup bit for PPAC and IC pev(144)= and (ev(locev),X'0FFF') LOCEV=LOCEV+1 c------------------- c Ionization chamber c------------------- c..anodes do i=1,NANODES pev(150+i) = iand(ev(locev),'0FFF'X) LOCEV=LOCEV+1 enddo c..raw position pev(157) = iand(ev(locev),'0FFF'X) LOCEV=LOCEV+1 C..CALCULATED STUFF (position, E1+E2, E1+E2+E3) do i=1,NANODES if (pev(151).le.2400) pev(158) = pev(158) + PEV(150+i)/2.0 enddo if( ((pev(151).ge.10).and.(pev(151).le.2400)) & .and.((pev(152).ge.10).and.(pev(152).le.2400)) & .and.((pev(153).ge.10).and.(pev(153).le.2400)))then pev(160) = pev(157) PEV(161) = nint( float( PEV(151)+PEV(152) ) /2.0) PEV(162) = nint( float( PEV(151)+PEV(152)+pev(153) ) /2.0) endif c..E * T**2 c if (pev(162).gt.1 .and. pev(140).gt.1) then c pev(145) = nint(float(pev(162)) c 1 * float(pev(140))**2 / float(xet2gain)) c endif endif user=.true. return ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc entry user1(et,np,ev,INZVECTOR,W2VECTOR,W1VECTOR,CONVECTOR) ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c getting atomic number ... c z=0 if (convector(2*z1_con_n-1).eq.1) then z=1 elseif (convector(2*z2_con_n-1).eq.1) then z=2 elseif (convector(2*z3_con_n-1).eq.1) then z=3 elseif (convector(2*z4_con_n-1).eq.1) then z=4 elseif (convector(2*z5_con_n-1).eq.1) then z=5 elseif (convector(2*z5_con_n-1).eq.1) then z=6 endif c type *,'----------' c type *,'z= ',z c c getting mass ... c mass=0 if (convector(2*m1_con_n-1).eq.1) then mass=1 elseif (convector(2*m2_con_n-1).eq.1) then mass=2 elseif (convector(2*m3_con_n-1).eq.1) then mass=3 elseif (convector(2*m4_con_n-1).eq.1) then mass=4 elseif (convector(2*m5_con_n-1).eq.1) then mass=5 endif c type *,'m= ',mass c c getting neutron fold ... c c c incrementing gamma spectra gated with Z, M/Q and neutron fold ... c spn=mass*24+z*4 c type *,'nrge= ',nrge if (nrge.eq.1) then ii=pev(101) call h2inc(gpart_h_n,ii,spn) else do i=1,nrge ii=pev(100+i) call h2inc(ggpart_h_n,ii,spn) enddo endif user1=.true. return ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc entry userex ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc userex=.true. return ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc entry fixflt ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c--- c Entry FixFlt is called each time the fix/flt parameters c are being changed. In this way the doppler shifts always c have the appropriate values c--- gamma = 1./sqrt(1. - beta*beta) dps1_5 = (1. - beta*cos(ang1_5/degrad))*gamma dps6_10 = (1. - beta*cos(ang6_10/degrad))*gamma dps11_15 = (1. - beta*cos(ang11_15/degrad))*gamma dps16_20 = (1. - beta*cos(ang16_20/degrad))*gamma dps(1) = dps1_5 dps(2) = dps1_5 dps(3) = dps1_5 dps(4) = dps1_5 dps(5) = dps1_5 dps(6) = dps6_10 dps(7) = dps6_10 dps(8) = dps6_10 dps(9) = dps6_10 dps(10) = dps6_10 dps(11) = dps11_15 dps(12) = dps11_15 dps(13) = dps11_15 dps(14) = dps11_15 dps(15) = dps11_15 dps(16) = dps16_20 dps(17) = dps16_20 dps(18) = dps16_20 dps(19) = dps16_20 dps(20) = dps16_20 fixflt=.true. return end