! BEARUN SUBROUTINE ORBIT C.ORBIT SBP 93.04.19 !TPL call bearun(raw(4,120),comd(16),termout) !TERMOUT=-1 =>NOASK ! Integer*4 comd(16) - commands from user ! Integer*4 raw(4,120) - raw button data returned to user ! Integer*4 termout 0 >> terminal input -1 >> use comd commands ! comd(3)= res !resistance measurement if 1 ! comd(4)= sub !e+/e- subtraction wanted if not 0 ! comd(5)= csrtrn !cesr turn # ! comd(6)= gain !0 =gains from det ! comd(7)= nsamp !# samples per button ! comd(8)= yes this is the gate 22 may 2000 ! comd(9)= rate !0=400 khz; else inj'n rate ! comd(10, 11) !1st,2nd requested detector; #10 =0 =>all ! CSRBPM COMD (7)=GATE CSRBPM COMD (8)=POLARITY ! BUNCH NUMBER IS CHOSEN INDIRECTLY FROM DETEC VIA 'TIM ALL REF ' #31 ! Input: USE_PROGRMIN -- Allow use of PROGRMIN knobs. subroutine bearun(raw,comd,termout, use_progrmin) use orb_t_b_mod use ampatt_mod use cesr_utils_struct implicit none ! logical range(6) !true if relay is within proc.range logical okdet(6) !true if good detector there logical, save :: rev !reverse for e+/e- subtraction logical atten_set_flag ! real fnorm integer(4) footprint(8), bpm_data(7,120) integer(4) k1,k2,raw(4,numdets),comd(16) integer(4) i,idull,j,termout,idum,mask,itry,hms,n,jb,loc integer(4) timdat(220) !time settings (='detectim') integer(4) setdat(10) !setting info for amplifiers &c integer(4) comman(16) !command vector integer(4) cumdat(4,numdets) !cumulative output data integer(4), save :: pn(6) !item # for pos. processors integer(4) olrela(6) integer(4), save :: pospat(6,0:15) !position processors footprints ! fdet dimensioned by 100, not 120 (data in db dtime 21- 220) ! so no room for dets 101-120 in extended range integer(4) fdet(100,2) !fine trim delays for each detector integer(4), save :: rg174_dly(8) !delay for proc. input filter cable. ! fdet(n,1) is for e-, fdet(n,2) for e+,n=99,100 are spares integer(4) proc_atten(numdets) !Analog out gain for detector electronic attenuators character(120), save :: attn_file = '' common /att_acc/ proc_atten, atten_set_flag integer(4) nn(2) !up to 2 detectors requested integer(4) posatt,genamp,posamp,gen6db,reldel,trgdel integer(4) proc,sub,plrty,ipol,fatt,famp,higain,lpol integer(4) epol,eloc integer(4) mode,rate, csrtrn,savtrn,integr,gate,nsamp integer(4) ppmin,ppmax,ip,idist,dist,rela,m,minn,maxx integer(4), save :: pp,ii, tsum ,fcorr ,prgr,ib,but,irela,k integer(4) bmdta,bedet,nd,ft,refrsh,reprat,dels(2),res integer(4) bald !baldpate, for fine bunch-timing integer(4) i_cesrv ! equivalence (timdat(21),fdet(1,1)) ! other timdat assignments are: ! 1-8=processors (fine units) ! 9=master fine, 10=master bunch, 11=master turns, 12=cesr turns equivalence (dels(1),reldel),(dels(2),trgdel) equivalence (setdat(1),refrsh) !refresh flag for "det" equivalence (setdat(2),reprat) !transfer repetition rate equivalence (setdat(5),posatt) !attenuator for position procs equivalence (setdat(6),posamp) !amplifiers for above equivalence (setdat(8),plrty) !-1=e-, +1=e+ equivalence (comman(3),res) !resistance measurement equivalence (comman(4),sub) !e+/e- subtraction wanted equivalence (comman(5),csrtrn) !cesr turn # equivalence (comman(7),nsamp) !# samples per button equivalence (comman(8),gate) !rf gate requirement equivalence (comman(9),rate) !0=400 khz; else inj'n rate equivalence (comman(10),nn(1)) !1st requested detector; ! !0 = complete turn equivalence (comman(11),nn(2)) !2nd detector address ! logical, save :: init logical use_progrmin data init /.true./ !flag to readin attenuation table ! data pospat/96*0/ data pn /1, 2, 4, 5, 7, 8/ !3, 6 are intensity processors data fcorr /0/ data rev/.false./ !5/30/01data rg174_dly/500,459,0,481,476,0,494,497/ !Delay of RG-174 cable data rg174_dly/510,449,0,491,486,0,504,497/ !Delay of RG-174 cable ! ! ------------------------- stuff for DSP control and data acq include 'cbpm_cesr_interface.inc' integer(4), save :: acq_typ(120) !0 relay, 1, 2 new, -1 does not exist. integer(4) data_stat(120) ! integer species_list(cbpm_mx_bunch_list) integer train_list(cbpm_mx_bunch_list) integer bunch_list(cbpm_mx_bunch_list) integer send_stat,send_cbpm_request,send_cbpm_request3 logical :: has_relay ! -------------------------------------------------------------------- comman=comd data_stat=CBPM_NO_DATA !need a vectors worth call vxputn ('CSRBPM DSTAT', 1, 120,data_stat) ! Clear status if (len_trim(attn_file) == 0) attn_file='DEFAULT' if (res == 0) call get_bpm_attn (attn_file) call vxgetn('CSRBPM TYPE ',1,120,acq_typ) bunch_list(1)=bunsel ! use orb_t_b.inc value TRAIN_list(1)=trnsel ! has_relay =(any(acq_typ == 0)) if (has_relay) then print *, 'HAS_RELAY NO LONGER SUPPORTED!! PLEASE GET HELP!' endif ! ___________________________begin_____________________________ ! ! if(res == 1) then ! resistance measurment comman(4:16)=0 ii=1 !assure species non-zero ipol=1 species_list(1)=CESR_ELECTRON endif 40 continue if(termout == 0) then type*,' using input commnds below, note your assignments ' type 444,(comman(j),j=1,11),comman(16) 444 format( & /,i5,'= command(1) >> value irrevelant; set @ used by sub ', & /,i5,'= command(2) >> value irrevelant; set @ used by sub ', & /,i5,'= command(3) >> 0 get orbit; 1 get button resistance ', & /,i5,'= command(4) >> 0 no e+/e- subtract; 1 for subtract ', & /,i5,'= command(5) >> # for cesr turns delay value ', & /,i5,'= command(6) >> 0 gains from det: 1 for default gains ', & /,i5,'= command(7) >> # for number of samples/meas ', & /,i5,'= command(8) >> 0 no rf gate ; 1 for rf gate ', & /,i5,'= command(9) >> 0 400khz rate; 1 for injection rate ', & /,i5,'= command(10) >> 0 complete turn; #=address of 1st det', & /,i5,'= command(11) >> # if(comd(10) == 0) #=address of 2nd det', & /,i5,'= command(16) >> 0 not inj normalised; 1 to normalize ') idum=0 call in4get1(' to use the above comds,1 to use default ',idum) if(idum == 1) then comman=0 goto 40 endif endif ! termout == 0 ! --------------------------end-set-commands-------------------------- call vmgetn( 'CSRBPM COMD ' ,1,10,setdat) ipol=2 !make sure has legal val for resistance if(plrty == -1) then ipol=1 !electron timing array index species_list(1)=CESR_ELECTRON elseif(plrty == 1) then ipol=2 !positron timing array index species_list(1)=CESR_POSITRON !tells DSP what species endif lpol=(ipol-1)*400 !offset to data store for e- or e+ epol=(ipol-1)*80 !extended data store for e- or e+ ! if(nsamp > 10000) then print *, 'WARNING FROM BEARUN: NSAMP (AVERAGE #) TOO LARGE. SET TO 10000' nsamp=10000 endif if(nsamp <= 0) nsamp=1 !default do i=1,4 do j=1,numdets cumdat(i,j)=0 !clean slate enddo enddo ! ----------------- ask DSP sys for data ------------------------- if(rate /= 0) then !inj rate specified send_stat=send_cbpm_request3(cbpm_turns_orbit_flag,cbpm_process_wait, & 1, species_list,train_list,bunch_list,1,1,nsamp,1) ! elseif(res == 0) then send_stat=send_cbpm_request(cbpm_orbit_flag,cbpm_process_wait,1, & species_list,train_list,bunch_list) endif ! ________________________________end_________________________________ !call vxgetn( 'CSRBPM DDATA' ,lpol+1,lpol+400,datar) !call vxgetn( 'CSRBPM EDATA',epol+1,epol+80,edata) call vxgetn ('BPM ORB DATA', 1, 840, bpm_data) call vxgetn( 'CSRBPM DSTAT' ,1,120,data_stat) !DSP status IF(TERMOUT /= -1) type 22 22 format('+ fetched-results / '$) raw = 0 do n=1,120 if(data_stat(n) == CBPM_GOOD_DATA) then !output only good data raw(1,n)=bpm_data(2,n) raw(2,n)=bpm_data(3,n) raw(3,n)=bpm_data(1,n) raw(4,n)=bpm_data(4,n) else if((res == 0).and.(acq_typ(n) > 0)) then !cbpm 1 or 2 i_cesrv = cesrv_det_idx(n) print *,' Bad CBPM orbit data for ',n,' stat=',data_stat(n), ' Datum ',raw(1,n), ' cesrv idx: ', i_cesrv endif endif enddo call set_dstat_stale !mark as stale ! ------------------------end-call-program-beam----------------------- ! Before returning let DETEC run freely again ! call vxputn('PROGRAMPULSE',9,9,0) end subroutine