PAASS
Software suite to Acquire and Analyze Data from Pixie16
scanorux.f
Go to the documentation of this file.
1 C$PROG SCANOR - SCAN - Revised version (supports SCANU & CHIL modes)
2 C
3 C ******************************************************************
4 C From WT Milner, JR Beene, et al at HRIBF - last modified 02/03/99
5 C ******************************************************************
6 C
7  IMPLICIT NONE
8 C
9 C ------------------------------------------------------------------
10  common/lll/ mssg(28),namprog(2),logut,logup,lisflg,msgf
11  INTEGER*4 MSSG,NAMPROG,LOGUT,LOGUP
12  CHARACTER*4 LISFLG,MSGF
13  CHARACTER*112 CMSSG
14  equivalence(cmssg,mssg)
15 C ------------------------------------------------------------------
16  common/ml01/ iwd(20),lwd(2,40),ityp(40),nf,nter
17  INTEGER*4 IWD, LWD, ITYP, NF,NTER
18 C -----------------------------------------------------------------
19  common/ml02/ iwdraw(20)
20  INTEGER*4 IWDRAW
21 C ------------------------------------------------------------------
22  common/sc01/ namcmd(20)
23  INTEGER*4 NAMCMD
24  CHARACTER*4 CNAMCMD(20)
25  equivalence(cnamcmd,namcmd)
26 C ------------------------------------------------------------------
27  common/sc03/ luc(10)
28  INTEGER*4 LUC
29 C ------------------------------------------------------------------
30  common/sc04/ jcnf,ihedn,mbfl
31  INTEGER*4 IHEDN,MBFL
32  CHARACTER*4 JCNF
33 C ------------------------------------------------------------------
34  common/sc05/ nhwh,lstl,lnby,maxip,nskip,iswab,lform
35  INTEGER*4 NHWH,LSTL,LNBY,MAXIP,NSKIP
36  CHARACTER*4 ISWAB,LFORM
37 C ------------------------------------------------------------------
38  common/sc12/ mem_style,shmid
39  CHARACTER*80 MEM_STYLE
40  INTEGER*4 SHMID
41 C ------------------------------------------------------------------
42  common/sc13/ lcon,lcmd,lin,lban,lhep
43  INTEGER*4 LCON,LCMD,LIN,LBAN,LHEP
44 C ------------------------------------------------------------------
45  common/sc14/ nbred,nbtop,icnf
46  INTEGER*4 NBRED,NBTOP
47  CHARACTER*4 ICNF
48 C ------------------------------------------------------------------
49  common/sc16/ indir(8192),intyp,inreci,luinf
50  INTEGER*4 INDIR, INRECI,LUINF
51  CHARACTER*4 INTYP
52 C ------------------------------------------------------------------
53  common/sc25/ cnams !CNAMS contains SHM filename
54  CHARACTER*80 CNAMS
55 C ------------------------------------------------------------------
56  common/orphas/ strbufevt,numbufevts,buf_num,lastevt,sumevts,
57  & beginevt
58 C
59  REAL*8 STRBUFEVT,NUMBUFEVTS,BUF_NUM,LASTEVT,SUMEVTS,
60  & beginevt
61 C ------------------------------------------------------------------
62  INTEGER*4 NAMCMDS(20)
63 C
64  INTEGER*4 RETN,IERR,STAT,I
65 C
66  INTEGER*4 NSEC,ISTAT,KIND,KERR
67 C
68  REAL*4 XV
69 C
70  CHARACTER*4 IDONE,KMD,KOM
71 C
72  equivalence(kmd,lwd(1,1)),(kom,iwd(1))
73 C
74  INTEGER*4 LUT,LUH,LUD
75  equivalence(lut,luc(1)),
76  & (luh,luc(6)),
77  & (lud,luc(9))
78 C
79  CHARACTER*4 CNAMCMDS(20),CIWD(20)
80  equivalence(cnamcmds,namcmds),(ciwd,iwd)
81  DATA cnamcmds,ciwd/40*' '/
82 C
83 
84  SAVE
85 C
86 C ------------------------------------------------------------------
87 C Initialize things
88 C ------------------------------------------------------------------
89 C
90  CALL comset !Init some COMMON
91 C
92  CALL scanornit !Init for SCANOR
93 C
94  GO TO 100
95 C
96 C ------------------------------------------------------------------
97 C Test "continue flags", switch input file/dev, etc
98 C ------------------------------------------------------------------
99 C
100 C !We get here via Ctrl/c
101  20 icnf='YES ' !Set "continue flag"
102  WRITE(cmssg,25)nbred
103  25 FORMAT('NUMBER OF BUFFERS PROCESSED = ',i8)
104  CALL messlog(logut,logup)
105 C
106  IF(intyp.EQ.'SHM ') THEN !If SHM, report
107  CALL messlog(logut,logup)
108  WRITE(cmssg,26)
109  CALL messlog(logut,logup)
110  WRITE(cmssg,28)lastevt-beginevt, !#events sent
111  & sumevts, !#events seen
112  & lastevt-beginevt-sumevts !#events lost
113  CALL messlog(logut,logup)
114  ENDIF
115 C
116  26 FORMAT(' Total Events Seen Events Lost Events')
117  28 FORMAT(3f14.0)
118 C
119  CALL messlog(logut,logup)
120 
121  GO TO 50 !Switch to VDT input
122 C
123  30 lin=lcon
124  WRITE(cmssg,35)
125  CALL messlog(logut,logup)
126  35 FORMAT('Error reading cmd-file or cmd-file not assigned')
127  GO TO 100
128 C
129  40 WRITE(cmssg,45)
130  CALL messlog(logut,logup)
131  45 FORMAT('END OF COMMAND FILE')
132 C
133 C !We get here via ERROR
134  50 lin=lcon !Switch to VDT input
135  DO 52 i=1,20
136  cnamcmd(i)=' '
137  52 CONTINUE
138  cnamcmd(1)='CON:'
139  GO TO 100
140 C
141  55 IF(lin.NE.lcon) GO TO 1000 !Test for VDT input
142  backspace lcmd !Backspace cmd-file
143 C
144  60 lin=lcmd !Switch to cmd-file input
145  DO 65 i=1,6 !Restore cmd-file name
146  namcmd(i)=namcmds(i)
147  65 CONTINUE
148  GO TO 100
149 C
150  70 CALL nuinp(lcmd,ierr) !Define new cmd-file
151  DO 75 i=1,20 !Save file-name for later
152  namcmds(i)=namcmd(i)
153  75 CONTINUE
154 C
155  100 IF(lin.EQ.lcon) WRITE(logut,105) !Issue prompt if in VDT mode
156  105 FORMAT(' SCANOR->',$)
157  msgf=' '
158 C
159 C ------------------------------------------------------------------
160 C Read in and process the next command from LU "LIN"
161 C ------------------------------------------------------------------
162 C
163  READ(lin,110,err=30,end=40)iwd !Read next command from LIN
164  110 FORMAT(20a4)
165 C
166  WRITE(cmssg,115)(iwd(i),i=1,12),(namcmd(i),i=1,5)
167  IF(lin.NE.lcon) CALL messlog(logut,logup)
168  IF(lin.EQ.lcon) CALL messlog(0,logup)
169  115 FORMAT(12a4,' - FROM ',5a4)
170 C
171  CALL caseup1(iwd)
172 C
173  DO 120 i=1,20
174  iwdraw(i)=iwd(i)
175  120 CONTINUE
176 C
177  IF(kom.EQ.'CMDF') GO TO 70
178  IF(kom.EQ.'CMD ') GO TO 70
179  IF(kom.EQ.'CCON') GO TO 50
180  IF(kom.EQ.'CLCM') GO TO 55
181  IF(kom.EQ.'CCMD') GO TO 60
182 C
183  CALL caseup(iwd)
184 C
185  CALL gread(iwd,lwd,ityp,nf,1,80,nter)
186 C
187  IF(kmd.EQ.' ') GO TO 100 !Ignore blanks
188 C
189  CALL cmpsetup(idone,retn) !Check & do setup cmds
190  IF(idone.EQ.'YES ') THEN
191  IF(retn.EQ.50) GO TO 50
192  GO TO 100
193  ENDIF
194 C
195  CALL cmpinput(idone,retn) !Do tape, ldf, ipc open/close
196  IF(idone.EQ.'YES ') THEN !record-positions, reads, etc
197  IF(retn.EQ.50) GO TO 50
198  GO TO 100
199  ENDIF
200 C
201  CALL cmpread(idone,retn) !Check for read/display records
202  IF(idone.EQ.'YES ') THEN
203  IF(retn.EQ.50) GO TO 50
204  GO TO 100
205  ENDIF
206 C
207  IF(nter.NE.0) GO TO 1000
208 C
209  IF(kmd.EQ.'ZERO') GO TO 200
210  IF(kmd.EQ.'Z ') GO TO 210
211  IF(kmd.EQ.'SUM ') GO TO 220
212 C
213  IF(kmd.EQ.'WAIT') GO TO 230
214 C
215  IF(kmd.EQ.'GO ') GO TO 250
216  IF(kmd.EQ.'GOEN') GO TO 250
217 C
218  IF(kmd.EQ.'END ') then
219  call detectorend()
220  GO TO 300
221  endif
222 
223  IF(kmd.EQ.'HUP ') GO TO 320
224  IF(kmd.EQ.'KILL') then
225  call detectorend()
226  GO TO 340
227  endif
228 C
229  GO TO 1000
230 C
231 C ------------------------------------------------------------------
232 C Zero the histogram file and reset all pointers
233 C ------------------------------------------------------------------
234 C
235  200 CALL hisnit(luh,'ZOT ')
236  icnf='NO '
237  jcnf='NO '
238  nbred=0
239  GO TO 100
240 C
241 C ------------------------------------------------------------------
242 C Zero individual histograms
243 C ------------------------------------------------------------------
244 C
245  210 CALL zottum(iwd)
246  GO TO 100
247 C
248 C ------------------------------------------------------------------
249 C Display/log histogram sumsd
250 C ------------------------------------------------------------------
251 C
252  220 CALL hissum_vm
253  GO TO 100
254 C
255 C ------------------------------------------------------------------
256 C Wait for a specified number of seconds
257 C ------------------------------------------------------------------
258 C
259  230 CALL milv(lwd(1,2),nsec,xv,kind,kerr)
260  IF(kerr.NE.0) GO TO 1000
261  IF(nsec.LT.1) nsec=1
262  IF(nsec.GT.300) nsec=300
263  CALL wait(nsec,2,istat)
264  GO TO 100
265 C
266 C ------------------------------------------------------------------
267 C Read and process records until you hit an abnormal condition
268 C ------------------------------------------------------------------
269 C
270  250 CALL doscan(retn)
271 C
272  IF(msgf.NE.' ') GO TO 20
273  IF(retn.EQ.0) GO TO 100
274  IF(retn.EQ.20) GO TO 20
275  IF(retn.EQ.50) GO TO 50
276  GO TO 50
277 C
278 C ------------------------------------------------------------------
279 C Process - END command
280 C ------------------------------------------------------------------
281 C
282  300 IF(lut.LT.0) GO TO 320 !END - Tape not open
283  kmd='CLOT' !END - Dismount no-unload
284  CALL tapopen(ierr)
285 C
286 C ------------------------------------------------------------------
287 C Windup - Windup - Windup - Windup - Windup - Windup - Windup
288 C ------------------------------------------------------------------
289 C
290  320 CALL hisnit(luh,'HUP ')
291  IF(kmd.EQ.'HUP ') GO TO 100
292 C
293  340 OPEN(unit = 21, !Open & delete SHM-file
294  & file = cnams,
295  & status = 'UNKNOWN',
296  & iostat = stat)
297 C
298  IF((mem_style(1:5).NE.'LOCAL')) THEN !Test for & delete
299  CALL shm_delete(shmid, ierr) !shared memory segment
300  CLOSE(unit=21,status='DELETE')
301  ENDIF
302 C
303 CX IF(INTYP.EQ.'SHM ') THEN !Test for SHM assigned
304 CX CALL CLOSEIPC() !Detach from SHM and
305 CX ENDIF
306 C
307  stop
308 C
309 C ------------------------------------------------------------------
310 C List/log error messages
311 C ------------------------------------------------------------------
312 C
313  1000 WRITE(cmssg,1005)
314  CALL messlog(logut,logup)
315  1005 FORMAT('Syntax error or illegal command - ignored')
316  GO TO 50
317 C
318  END
messlog
subroutine messlog(LUA, LUB)
Definition: messlog.f:8