SUBROUTINE ANAACT INCLUDE 'common.f' INTEGER ierr,mxsize,istat,l2 REAL blxmin,blxmax,mrymin,mrymax,bandmin,bandmax CHARACTER viewpid*80,ftype*132,fitopt*10 INTEGER CUTID,NBINS,BF CHARACTER cutname*40 c For HGIVE INTEGER TMPNX,TMPXMI,TMPXMA INTEGER TMPNY,TMPYMI,TMPYMA INTEGER TMPNWT,TMPLOC CHARACTER temptitle*80 REAL TMPRXMI,TMPRXMA REAL TMPRYMI,TMPRYMA Call KUPATH(CMD,NCMD,NPAR) Call HIDALL(AIDALL,AMAXHST) CURRHID = AIDALL(CURNUM) If(CMD(2) .EQ. 'DEFINITION')Then If(CMD(3) .EQ. 'BOOK') Then Call KUGETF(ANAFNAME,L) If (ANAFNAME .EQ. ' ') Goto 999 Call KUINQF(ANAFNAME,ALUN) If (ALUN.NE.-1) Then Call ANAINIT(ANAFNAME) Else Write(*,*)' ' Write(*,*)' ANAPAW-E : File does not exist.' Write(*,*)' ' Goto 998 EndIf ElseIf(CMD(3) .EQ. 'ANAADD') Then Call ANAADD ElseIf(CMD(3) .EQ. 'AWRITE') Then Call ANAWRITE ElseIf(CMD(3) .EQ. 'CHGATE') Then Call KUGETI(GID) Call CHANGE_GATE(GID) ElseIf(CMD(3) .EQ. 'CHHST') Then Call KUGETI(HID) Call KUGETC(CKEY,L) Call CHANGE_HIST(HID,CKEY) ElseIf (CMD(3) .EQ. 'HST1') Then Call HST1 ElseIf (CMD(3) .EQ. 'HST2') Then Call HST2 ElseIf (CMD(3) .EQ. 'LISTPROF') Then Call KUGETI(HID) Call LISTPROF(HID) ElseIf (CMD(3) .EQ. 'LIST1D') Then Call KUGETI(HID) Call LIST1D(HID) ElseIf (CMD(3) .EQ. 'LIST2D') Then Call KUGETI(HID) Call LIST2D(HID) ElseIf (CMD(3) .EQ. 'LISTGATE') Then Call KUGETC(CKEY,L) Call LISTGATE(CKEY,0) ElseIf (CMD(3) .EQ. 'AVIEW') Then Call KUGETC(CKEY,L) Call GETVIEWSTAT If(CKEY.EQ.'O' .and. WinFlag.EQ.0)Then WinFlag = 1 Call KUEXEC('shell $VIEWANA_SOURCE/viewana &') Call AVIEW(1) ElseIf(CKEY.EQ.'C' .and. WinFlag.EQ.1)Then Call AVIEW(0) ElseIf(CKEY.EQ.'O' .and. WinFlag.EQ.1)Then Write(*,*)' ' Write(*,*)' ANAPAW-W : Window is already opened.' Write(*,*)' ' Goto 998 ElseIf(CKEY.EQ.'C' .and. WinFlag.EQ.0)Then Write(*,*)' ' Write(*,*)' ANAPAW-W : Window is not opened.' Write(*,*)' ' Goto 998 Else Write(*,*)' ' Write(*,*)' ANAPAW-E : No such option.' Write(*,*)' ' Goto 998 EndIf ElseIf (CMD(3) .EQ. 'HCUT') Then Call KUGETI(HID) Call KUGETF(HCUTNAME,L) Call KUGETC(CKEY,L) Call HISTCUT(HID,CKEY) ElseIf (CMD(3) .EQ. 'LISTEFF') Then Call KUGETI(GID) Call LISTEFF(GID) ElseIf (CMD(3) .EQ. 'CLEAR') Then Call KUGETC(CKEY,L) NUM = 0 LOOP = 0 BATCHFL = .FALSE. LPFIRST = .TRUE. FILEEND = .FALSE. BLKREAD = .TRUE. AIFIRST = 1 c CKEY = 'n' If(CKEY.EQ.' ')Then CKEY = 'n' ElseIf(CKEY.EQ.'F')Then CKEY = 'y' Goto 333 EndIf Write(*,*)' ' Call KUPROS(' Realy Clear!? >',CKEY,L) 333 If(CKEY.EQ.'Y' .or. CKEY.EQ.'y') Then Call CLEARALL Write(*,*)' ' Write(*,*)' ANAPAW-M : All definitions were cleared.' Write(*,*)' ' ElseIf(CKEY.EQ.'N' .or. CKEY.EQ.'n') Then Write(*,*)' ' Write(*,*)' ANAPAW-M : Clear canceled.' Write(*,*)' ' EndIf EndIf ElseIF(CMD(2) .EQ. 'HISTOGRAM')THEN If (CMD(3) .EQ. 'HSTORE') Then Call KUGETF(HBKFILENAME,L) 1 If (HBKFILENAME .EQ. ' ')HBKFILENAME = 'anapaw.hbk' Call KUINQF(HBKFILENAME,ALUN) If (ALUN.EQ.-1) Then Call ANASTORE(HBKFILENAME) ElseIf (ALUN.NE.-1) Then If (BATCHFL) Then Write(*,*)' ' Write(*,*)' ANAPAW-W : This filename is already used.' Write(*,*)' Store to batch.hbk.' Write(*,*)' ' HBKFILENAME = 'batch.hbk' Call KUINQF(HBKFILENAME,ALUN) If (ALUN.NE.-1) Then Call KUEXEC('shell mv -f batch.hbk batch.hbk.bak') EndIf Goto 1 Else Write(*,*)' ' Write(*,*)' ANAPAW-W : This filename is already used.' Write(*,*)' ' 2 Call KUINPS('OverWrite? (y/n/q)',CKEY,L) If (CKEY.EQ.'y' .or. CKEY.EQ.'Y') Then Call ANASTORE(HBKFILENAME) ElseIf (CKEY.EQ.'n' .or. CKEY.EQ.'N') Then Call KUINPS('New FileName >',HBKFILENAME,L) Goto 1 ElseIf (CKEY.EQ.'q' .or. CKEY.EQ.'Q') Then Write(*,*)' ' Write(*,*)' ANAPAW-M : Quit store.' Write(*,*)' ' Goto 998 Else Goto 2 EndIf EndIF EndIf ElseIf (CMD(3) .EQ. 'FETCH') Then Call KUGETF(HBKFILENAME,L) Call KUGETI(HID) 3 If (HBKFILENAME .EQ. ' ')HBKFILENAME = 'anapaw.hbk' Call KUINQF(HBKFILENAME,ALUN) If (ALUN.NE.-1) Then Call ANAFETCH(HBKFILENAME,HID) ElseIf (ALUN.EQ.-1) Then Write(*,*)' ' Write(*,*)' ANAPAW-E : This filename does not exist.' Write(*,*)' To EXIT type q!.' Write(*,*)' ' Call KUINPS('HBOOK FileName >',HBKFILENAME,L) If(HBKFILENAME .EQ. 'q!')GOTO 998 Goto 3 EndIf ElseIf (CMD(3) .EQ. 'HT') Then Call KUGETI(HID) Call KUGETC(CKEY,L) If(L .EQ. 0)L=1 Call PLOTHIST(HID,CKEY,L) ElseIf (CMD(3) .EQ. 'HNT') Then Call KUGETC(CKEY,L) If(L .EQ. 0)L=1 Call NEXTHIST(CKEY,L) ElseIf (CMD(3) .EQ. 'HBT') Then Call KUGETC(CKEY,L) If(L .EQ. 0)L=1 Call PREVHIST(CKEY,L) ElseIf (CMD(3) .EQ. 'BLOW') Then Call KUGETR(BLXMIN) Call KUGETR(BLXMAX) Call KUGETR(BLYMIN) Call KUGETR(BLYMAX) Call BLOW(BLXMIN,BLXMAX,BLYMIN,BLYMAX) ElseIf (CMD(3) .EQ. 'XBLOW') Then Call XBLOW ElseIf (CMD(3) .EQ. 'XYBLOW') Then Call XYBLOW ElseIf (CMD(3) .EQ. 'PRX') Then Call PROJC(1) ElseIf (CMD(3) .EQ. 'PRY') Then Call PROJC(2) ElseIf (CMD(3) .EQ. 'BNX') Then Call KUGETR(BANDMIN) Call KUGETR(BANDMAX) Call BAND(1,BANDMIN,BANDMAX) ElseIf (CMD(3) .EQ. 'BNY') Then Call KUGETR(BANDMIN) Call KUGETR(BANDMAX) Call BAND(2,BANDMIN,BANDMAX) ElseIf (CMD(3) .EQ. 'SLX') Then Call KUGETI(SNX) Call SliceHist(1,SNX) ElseIf (CMD(3) .EQ. 'SLY') Then Call KUGETI(SNY) Call SliceHist(2,SNY) ElseIf (CMD(3) .EQ. 'MAMI') Then Call KUGETR(MRYMIN) Call KUGETR(MRYMAX) Call MAMI(MRYMIN,MRYMAX) ElseIf (CMD(3) .EQ. 'XSTATUS') Then Call XSTATUS ElseIf (CMD(3) .EQ. 'HSTATUS') Then Call HSTATUS ElseIf (CMD(3) .EQ. 'XFITG') Then Call XFITG ElseIf (CMD(3) .EQ. 'FIGA') Then Call FIGA c ElseIf (CMD(3) .EQ. 'HFIT') Then c Call KUGETC(FTYPE,L) c Call KUGETC(FITOPT,L2) c Call HistFIT(FTYPE,FITOPT) ElseIf (CMD(3) .EQ. 'HLIST') Then Call KUGETC(CKEY,L) Call ListDispID(CKEY) ElseIf (CMD(3) .EQ. 'HDELETE') Then Call KUGETI(HID1) Call KUGETI(HID2) Call MHDEL(HID1,HID2) ElseIf (CMD(3) .EQ. 'ERASE') Then Call ERASE ElseIf (CMD(3) .EQ. 'XVAL') Then Call XVALUES ElseIf (CMD(3) .EQ. 'XYVAL') Then Call KUGETC(CKEY,L) Call XYVALUES(CKEY) ElseIf (CMD(3) .EQ. 'CPRO') Then Call KUGETI(HID) Call KUGETC(CKEY,L) Call CUTPRO(HID,CKEY) ElseIf (CMD(3) .EQ. 'AVY') Then Call KUGETI(HID) Call KUGETC(CKEY,L) Call AVY(HID,CKEY) ElseIf (CMD(3) .EQ. 'CDRAW') Then Call KUGETI(CUTID) Call KUGETF(CUTNAME,L) Call KUGETC(CKEY,L) Call CUTDRAW(CUTID,CUTNAME,CKEY) ElseIf (CMD(3) .EQ. 'GPRO') Then Call KUGETI(CUTID) Call KUGETF(CUTNAME,L) Call KUGETC(CKEY,L) Call GCUTPRO(CUTID,CUTNAME,CKEY) ElseIf (CMD(3) .EQ. 'CHBIN') Then Call KUGETI(BF) c write(*,*)'bf ',bf If(BF.LT.1)BF=1 HID = DispID(DseqID) Call HGIVE(HID,temptitle, & TMPNX,TMPRXMI,TMPRXMA, & TMPNY,TMPRYMI,TMPRYMA, & TMPNWT,TMPLOC) c write(*,*)hid,tmpnx,tmprxmi,tmprxma, c & tmpny,tmprymi,tmpryma,tmpnwt,tmploc Call HXI(HID,TMPRXMI,TMPXMI) c write(*,*)'1 ',hid,tmprxmi,tmpxmi Call HXI(HID,TMPRXMA,TMPXMA) c write(*,*)'2 ',hid,tmprxma,tmpxma NBINS = int((TMPXMA-TMPXMI)/BF) c write(*,*)'nbins ',nbins Call CHBIN(BF,NBINS) cccccccccccccccccccccccc c adition ElseIF (CMD(3) .EQ. 'CID') Then Call DISPLAYCID() ccccccccccccccccccc EndIf ElseIf (CMD(2) .EQ. 'STATUS') Then Write(*,*)' ' Write(*,*)' ANAPAW-M : Current Status.' Write(*,*)' ' If(ONLINEFLAG) Write(*,*)' Online Mode ' If(.NOT.ONLINEFLAG) Write(*,*)' Offline Mode ' Write(*,*)' ' Write(*,*)' Blocks : ',blkc Write(*,*)' Total Trigger : ',trignum Write(*,*)' Valid Events : ',evtsca Write(*,'(A18,F7.2)')' Valid/Total(%): ', & float(evtsca)/float(trignum)*100. Write(*,*)' ' Write(*,501)' Last RDF : ',LASTRDFNAME Write(*,501)' Current RDF : ',RDFNAME Write(*,501)' ANA File : ',ANAFNAME If(DMPFIOFLAG)Then Write(*,501)' DMP : ',DMPNAME EndIf If(NtupleFlag)Then Write(*,502)' Ntuple : ',NTUPLEFILENAME EndIf 501 format(A16,A132) 502 format(A11,A132) Do i=1,iana c If(AnalyzerFlag(i))Then If(analyzerid(i).GT.0)Then Write(*,'(A13,I4)')' Analyzer : ',analyzerid(i) EndIf EndDo Write(*,*) If(DMPFIOFLAG)Then Write(*,'(A18,I4)')' Gate for RDMP : ',DMPGID EndIf Write(*,*)' ' If(NtupleFlag)Then Write(*,'(A20,I4)')' Gate for Ntuple : ',NTUPLEGID EndIf Write(*,*)' ' If(COMSTATUS.EQ.1)Then Write(*,*)' Now on Main Prompt.' ElseIf(COMSTATUS.EQ.2)Then Write(*,*)' Now on EVTLOOP.' EndIf Write(*,*)' ' Write(*,*)'Run Number : ',RNum Write(*,*)' ' ElseIf (CMD(2) .EQ. 'RDMP') Then Call KUGETC(CKEY,L) Call KUGETS(DMPNAME,DMPLEN) Call KUGETI(DMPGID) If( (CKEY.EQ.'O') .AND. (.NOT.DMPFIOFLAG) )Then DMPFIOFLAG = .TRUE. mxsize = EVTMAX 777 Call Open_Dumpfile(DMPNAME,DMPLEN,ierr,mxsize) If(ierr.EQ.1)Then Write(*,*)' ' Write(*,*)' ANAPAW-E : File already exists.' Write(*,*)' ' Call KUINPS('Input DUMP FileName >', & DMPNAME,DMPLEN) If(DMPNAME.EQ.' ')Then Write(*,*)' ' Write(*,*)' ANAPAW-M : Quit to open file.' Write(*,*)' ' Goto 998 EndIf Goto 777 EndIf ElseIf(CKEY.EQ.'M' .AND. (DMPFIOFLAG) )Then Call MkHeader_Dumpfile ElseIf(CKEY.EQ.'C' .AND. (DMPFIOFLAG) )Then DMPFIOFLAG = .FALSE. Call Close_Dumpfile EndIf ElseIf (CMD(2) .EQ. 'ANTUPLE') Then Call KUGETC(CKEY,L) Call KUGETI(NTUPLEGID) Call KUGETI(RunNumber) If(CKEY.EQ.'O')Then NtupleFlag = .True. Ntuple_First = 0 Call Ntuple_io(1) ElseIf(CKEY.EQ.'C')Then NtupleFlag = .False. Ntuple_First = 0 Call Ntuple_io(0) RunNumber = RunNumber + 1 EndIf ElseIf (CMD(2) .EQ. 'UFLAG') Then Call KUGETI(FLID) Call KUGETC(CKEY,L) Call KUGETI(GID) If(CKEY.EQ.'T')Then USERFLAG(FLID) = .TRUE. ElseIf(CKEY.EQ.'F')Then USERFLAG(FLID) = .FALSE. EndIf USERFGATE(FLID) = GID ElseIf (CMD(2) .EQ. 'SETNUMBER') Then Call KUGETI(RNUM) Write(*,*)' ' Write(*,*)' ANAPAW-M : Set Run Number to : ',RNUM Write(*,*)' ' ElseIf (CMD(2) .EQ. 'LOOP') Then If(COMSTATUS.EQ.1)Then NUM = 0 LOOP = 0 BATCHFL = .FALSE. LPFIRST = .TRUE. FILEEND = .FALSE. BLKREAD = .TRUE. AIFIRST = 1 Call KUGETS(RDFNAME,RDFLEN) Call KUGETC(CKEY,L) Call KUGETI(NUM) Call KUGETR(REFTIME) If(RDFNAME.EQ.'ONLINE' .OR. RDFNAME.EQ.'online')Then Call init_getdata ONLINEFLAG = .TRUE. Else ONLINEFLAG = .FALSE. EndIf If(.NOT.ONLINEFLAG)Then 997 Call OPEN_RAWDAT(RDFNAME,RDFLEN,FILEFLAG) If(FILEFLAG.EQ.0)Then If (CKEY.EQ.'B') Then BATCHFL = .TRUE. AIFIRST = 1 Call BATCHLOOP Else BATCHFL = .FALSE. AIFIRST = 1 Call EVTLOOP EndIf ElseIf(FILEFLAG.EQ.1)Then Write(*,*)' ' Write(*,*)' ANAPAW-E : File does not exist.' Write(*,*)' To EXIT type q!.' Write(*,*)' ' Call KUINPS('Input RAW-DATA FileName >', & RDFNAME,RDFLEN) IF(RDFNAME .EQ. 'q!')GOTO 998 Goto 997 EndIf ElseIf(ONLINEFLAG)Then AIFIRST = 1 Call EVTLOOP EndIf Else Write(*,*)' ' Write(*,*)' ANAPAW-W : Quit (@EVTLOOP)' Write(*,*)' ' EndIf EndIf 998 Return 999 Continue Write(*,*)' ANAPAW-ERR : error?!?' End