program bumset use sim_utils use str_find_first_substring_module implicit none integer :: istat,minslow,ierr,len,tottim,leng integer :: ii,m1,m2,jerr,sltim,goodnf,iter,ltchnm(8) integer, parameter :: nv = 4 integer :: index,itms,i,j,k,l,m,n,zeros(10),iloc,dummy,len_trim data zeros /10*0/ character :: stamp*20, typ*10 character :: name(nv)*12, line*80, symb(8)*11, labl*16 character :: pname*3, logout*1 ! ----------------end_declare--------------------------- integer :: n1(nv),n2(nv),dest(7,nv),got(7,nv),inc(7),slowco(7,nv) real :: t0,t1,err(7,nv),fac,ave(7,nv),kcon(7,nv) data KCON /7*60., 10.,6*1.,7*60.,10.,6*1./ real :: maxerr,maxabs,delt,abdelt,slowreg,deltsave(8) logical :: noping,ok,hung,veto(7,nv),dowest,doeast,log common /l/logout,pname ! data SLOWREG /10./ data LTCHNM/31,32,33,38,34,35,36,37/ !LOC FOR LATCHES IN DATABASE data symb/'WEST KICKER','WEST SEPTUM','WEST BUMP','PINGER', & 'EAST KICKER','EAST SEPTUM','EAST BMP1 ','EAST BMP2 '/ data name /'WXF BUMP HV ','EXF PING HV ','EXF BUMP HV ', & 'WXF PING HV '/ data n1,n2 /1,1,1,1, 4,1,7,1/ data veto /14*.false., & .false.,.false.,.true.,.true.,.false.,.true.,.false.,7*.false./ ! logical, save:: frset call mnet_connectf('INJ') !get in touch with hardware t0=secnds(0.0) tottim=0 ! istat=lib$get_foreign(line,,len,) !get trig invocation line call cesr_getarg(0,line) ! 0 => get whole line len=len_trim(line) if(len.gt.0) call str_upcase(line,line) !standardise upper if(len.le.0) line='E' !default log=str_find_first_substring(line,index,dummy,'LOG') noping=str_find_first_substring(line,index,dummy,'NOPING') m1=1 m2=4 !assume do all dowest=.true. doeast=.false. if((line(1:1).eq.'W').or.(line(2:2).eq.'W')) then continue elseif((line(1:1).eq.'B').or.(line(2:2).eq.'B')) then doeast=.true. else dowest=.false. doeast=.true. m1=2 !starting mnem m2=3 !ending endif print *,' do e w ',doeast,dowest len=len_trim(line) istat=str_find_first_substring(line,index,dummy,'FROM') frset=.false. if(istat) then frset=.true. typ=line(index+5:len) print *,' ',typ do m=m1,m2 print *, name(m),typ,dest(1,m),n2(m) !from save set call mnem_fr_sty(name(m),typ,dest(1,m),n2(m)) !from save set enddo endif ! call vmputn('XFR PAN BOX ',2,2,'200'o) !INJ TRIG OFF (TO INJCTL) call vmputn('XFR PAN BOX ',3,3,'177400'o)!TRIG OFF INDIVIDUAL (TO INJCTL) ! jerr=.false. !clear error flg hung=.false. itms=0 ! if(dowest) call vstput('INTERPROCON ',3,3,'SETTING WEST ') if(doeast) call vstput('INTERPROCON ',3,3,'SETTING EAST ') call vxincn('INTERPROCON ',3,3,1) ! !call memclr(slowco,7,0) slowco(:,:) = 0 do while ((.not.hung).and.(.not.ok)) if(itms.gt.15000) then !stop adj masters veto(4,1)=.true. veto(7,1)=.true. endif hung=itms.gt.30000 !30 sec ok=.true. !assume success maxerr=0 maxabs=0 !call memclr(ave,M2*7,0.0) ave(:,:) = 0.0 !init average sltim=100 !normally sleep 50ms do m=m1,m2 !# variables if(.not.frset) then call vmgoldn(name(m),1,n2(m),dest(1,m)) !allow change on the fly endif do i=1,4 !average 4 readings call vxgetn(name(m),1,n2(m),got(1,m)) do j=1,n2(m) ave(j,m)=ave(j,m)+float(got(j,m))*.25 enddo call csr_sleep(30) enddo do i=n1(m),n2(m) slowco(i,m)=slowco(i,m)+1 !assum endgame in progress goodnf=1. !error criterion if(tottim .gt.15000) goodnf=2.0 !gradually weken requirements if(tottim .gt.20000) goodnf=3.0 if(m.eq.2) then goodnf=20*goodnf !noisy pinger if(noping) goodnf=1000 !ignore pinger altogether endif if((m.eq.3).and.(.not.doeast)) goodnf=1000 !ignore east bump only if not doeast inc(i)=0 !clear cmds delt=dest(i,m)-ave(i,m) !dist to go deltsave(i)=delt if(veto(i,m)) delt=0 !ignore this one err(i,m)=delt !save for typeout abdelt=abs(delt) !save max of all error, if((.not.noping).or.(m.ne.2)) then if(abdelt.gt.maxabs) then !new peak maxabs=abdelt !absolute val maxerr=delt !signed val endif endif if(abdelt.gt.goodnf) then !not yet done if(abdelt.gt.slowreg) slowco(i,m)=0 !test for endgame if(abdelt.gt.(goodnf*2.)) ok=.false. ! fac=1. !long range rate factor if(abdelt.lt.25.) fac=.6 !short range fac is less if((inc(i)*delt).lt.0.) fac=fac*.7 !overshot implies was to big inc(i)=kcon(i,m)*delt*fac !find teco counts inc(i)=min0(255,max0(-255,inc(i))) !limit their range if(abdelt.lt.30) then !use small nudges at end inc(i)=min(30,max(-30,inc(i))) endif endif if((delt.gt.25).and.(tottim .gt.20000))then if(ave(i,m) .lt. 25.)then call csr_bell call vstget(Name(m),i,i,labl,leng) !get label print *,' '//labl(1:leng)//' Not working, Give up!' call say('Bumset','BUMP RESET FAILED ') logout = 'Y' call say('Bumset',labl(1:leng)//' Failed') logout = 'N' call vstput('INTERPROCON ',3,3,'BUMSET FAILED ') call vxincn('INTERPROCON ',3,3,1) goto 909 endif endif enddo call vxincn(name(m),n1(m),n2(m),inc(n1(m))) !actual output if(abdelt.lt.slowreg) sltim=100 !not sleep more at end call csr_tstamp(stamp) if(log) then print 4000, stamp(13:20),name(m),n1(m),n2(m), & (inc(ii),ii=n1(m),n2(m)) 4000 format(1x,a,1x,a,2i3,6x,7i4) print 4005, (deltsave(ii),ii=n1(m),n2(m)) 4005 format(1x,8f8.2) endif enddo tottim=tottim+sltim+120 !last is readin sleep itms=itms+sltim +120 call csr_sleep(sltim) enddo call vxincn(name(1),1,3,zeros) !actual output call vxincn(name(2),1,1,zeros) !actual output call vxincn(name(3),1,7,zeros) !actual output if (ok) then if(dowest) call say('Bumset','WEST BUMPS RESET') if(doeast) call say('Bumset','EAST BUMPS RESET') if(dowest) call vstput('INTERPROCON ',3,3,'WEST BUMPS SET ') if(doeast) call vstput('INTERPROCON ',3,3,'EAST BUMPS SET ') call vxincn('INTERPROCON ',3,3,1) t1=secnds(t0) print 1235,maxerr,t1 1235 format(' Bumps set: err=',f7.1,' et =',f6.1) else logout = 'Y' call say('Bumset','BUMSET FAILED') logout = 'N' call vstput('INTERPROCON ',3,3,'BUMSET FAILED ') call vxincn('INTERPROCON ',3,3,1) call csr_bell print 1233 do m=m1,m2 print 1237, (dest(i,m),i=n1(m),n2(m)) print 1234, name(m),(i,i=n1(m),n2(m)) print 1236, (ave(i,m),i=n1(m),n2(m)) enddo 1233 format(' BUMSET failed! desired above, actual below ') 1234 format(10x,a12,7(5x,'#',i1)) 1237 format(22x, 7i7) 1236 format(24x, 7f7.1) endif 909 call goodbye call exit end program bumset