Examples Internal Tools II (Outuser routine, Iprompt, Oprompt, clean_f debug1,debug2)
SusiQ test definition
============================================
gate gadc0 adc0 0 1000 "0
gate gadc1 adc1 0 1000 "0
and gadc gadc0 gadc1
dely asum adiff adc0 adc1 1. 1. 500.
and itstime -passall
user1
**
------------------------------------------------------------------------------------------
c***********************SUSIQ Data Analyser********
c"USER1.for"
c********************************************************
subroutine user1
parameter (pi=3.1415926)
include 'susictl.inc'
include 'susiacq.inc'
include 'susitst.inc'
include 'susicof.inc'
include 'susiequ.inc'
include 'susievt.inc'
call outuser
return
end
------------------------------------------------------------------------------------------
c***********************SUSIQ Data analyzer**********
c "outUSER.for"
c***********************************************************
include 'fgraph.fi'
subroutine outuser
include 'fgraph.fd'
include 'susictl.inc'
include 'susiacq.inc'
include 'susihis.inc'
include 'susitst.inc'
include 'susicof.inc'
include 'susiequ.inc'
include 'susievt.inc'
character bel/7/
character*12 string
integer*4 nchar,counter
record /rccoord/ curpos
if (debug1) then
call iprompt ('File name : ',nchar,string)
if (nchar.eq.0) return
call clean_f (string,nchar,'DDD','DAT',*99)
open (unit=8,file=string(1:nchar),status='NEW',err=99)
debug1 = .FALSE.
write (*,'(1x,a\)') bel
counter = 0
debug2 = .TRUE.
call oprompt('File name '//string(1:nchar)//' open!')
else if (debug2) then
if (counter .lt. INT(numout)) then
cccccc-------------------------------------------------------------------
c USER! place your variables (RAW/COMPUTED/...) in a WRITE
c format. DON'T forget the ERR= statement!!
cccccc-------------------------------------------------------------------
c
write (8,10,err=9999) adc0,tdc0
10 format (1x,i6,2x,i6)
c
cccccc-------------------------------------------------------------------
c USER! To change the number of event to be taken in that
file
c change the value of the variable NUMOUT in the *.CST definition
file.
c To get this routine started, Turn ON at any time during a
c running SusiQ the DEBUG1 flag.
c You will be prompted for a filename to be entered.
c After NUMOUT event, the file will be closed.
c But you HAVE TO CALL this routine through the USERX routine
c Like it is done in the USER1.FOR routine in that directory.
c Good LUCK, Pierre
cccccc-------------------------------------------------------------------
counter = counter + 1
else
call oprompt ('File name '//string(1:nchar)//' closed '
*//' ')
debug2 = .FALSE.
close (unit=8)
write (*,'(1x,a\)') bel
end if
end if
return
99 call Oprompt (' %Outuser-F- Error while file opening')
9999 return
end