PAASS
Software suite to Acquire and Analyze Data from Pixie16
scanof.f
Go to the documentation of this file.
1 C$PROG SCANOF - Off-line version of SCANOR
2 C
3 C ******************************************************************
4 C From WT Milner, JR Beene, et al at HRIBF - last modified 11/29/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  CHARACTER*4 IDONE,KMD,KOM
67 C
68  equivalence(kmd,lwd(1,1)),(kom,iwd(1))
69 C
70  INTEGER*4 LUT,LUH,LUD
71  equivalence(lut,luc(1)),
72  & (luh,luc(6)),
73  & (lud,luc(9))
74 C
75  character*4 cnamcmds(20), ciwd(20)
76  equivalence(cnamcmds, namcmds), (ciwd,iwd)
77  DATA cnamcmds,ciwd/40*' '/
78 C
79 C ------------------------------------------------------------------
80  SAVE
81 C ------------------------------------------------------------------
82 C Initialize things
83 C ------------------------------------------------------------------
84 C
85  CALL comset !Init some COMMON
86 C
87  CALL scanornit !Init for SCANOR
88 C
89  GO TO 100
90 C
91 C ------------------------------------------------------------------
92 C Test "continue flags", switch input file/dev, etc
93 C ------------------------------------------------------------------
94 C
95 C !We get here via Ctrl/c
96  20 icnf='YES ' !Set "continue flag"
97  WRITE(cmssg,25)nbred
98  25 FORMAT('NUMBER OF BUFFERS PROCESSED =',i8)
99  CALL messlog(logut,logup)
100 C
101  IF(intyp.EQ.'SHM ') THEN !If SHM, report
102  CALL messlog(logut,logup)
103  WRITE(cmssg,26)
104  CALL messlog(logut,logup)
105  WRITE(cmssg,28)lastevt-beginevt, !#events sent
106  & sumevts, !#events seen
107  & lastevt-beginevt-sumevts !#events lost
108  CALL messlog(logut,logup)
109  ENDIF
110 C
111  26 FORMAT(' Total Events Seen Events Lost Events')
112  28 FORMAT(3f14.0)
113 C
114  CALL messlog(logut,logup)
115 
116  GO TO 50 !Switch to VDT input
117 C
118  30 lin=lcon
119  WRITE(cmssg,35)
120  CALL messlog(logut,logup)
121  35 FORMAT('Error reading cmd-file or cmd-file not assigned')
122  GO TO 100
123 C
124  40 WRITE(cmssg,45)
125  CALL messlog(logut,logup)
126  45 FORMAT('END OF COMMAND FILE')
127 C
128 C !We get here via ERROR
129  50 lin=lcon !Switch to VDT input
130  DO 52 i=1,20
131  cnamcmd(i)=' '
132  52 CONTINUE
133  cnamcmd(1)='CON:'
134  GO TO 100
135 C
136  55 IF(lin.NE.lcon) GO TO 1000 !Test for VDT input
137  backspace lcmd !Backspace cmd-file
138 C
139  60 lin=lcmd !Switch to cmd-file input
140  DO 65 i=1,6 !Restore cmd-file name
141  namcmd(i)=namcmds(i)
142  65 CONTINUE
143  GO TO 100
144 C
145  70 CALL nuinp(lcmd,ierr) !Define new cmd-file
146  DO 75 i=1,20 !Save file-name for later
147  namcmds(i)=namcmd(i)
148  75 CONTINUE
149 C
150  100 IF(lin.EQ.lcon) WRITE(logut,105) !Issue prompt if in VDT mode
151  105 FORMAT(' SCANOF->',$)
152  msgf=' '
153 C
154 C ------------------------------------------------------------------
155 C Read in and process the next command from LU "LIN"
156 C ------------------------------------------------------------------
157 C
158  READ(lin,110,err=30,end=40)iwd !Read next command from LIN
159  110 FORMAT(20a4)
160 C
161  WRITE(cmssg,115)(iwd(i),i=1,12),(namcmd(i),i=1,5)
162  IF(lin.NE.lcon) CALL messlog(logut,logup)
163  IF(lin.EQ.lcon) CALL messlog(0,logup)
164  115 FORMAT(12a4,' - FROM ',5a4)
165 C
166  CALL caseup1(iwd)
167 C
168  DO 120 i=1,20
169  iwdraw(i)=iwd(i)
170  120 CONTINUE
171 C
172  IF(kom.EQ.'CMDF') GO TO 70
173  IF(kom.EQ.'CMD ') GO TO 70
174  IF(kom.EQ.'CCON') GO TO 50
175  IF(kom.EQ.'CLCM') GO TO 55
176  IF(kom.EQ.'CCMD') GO TO 60
177 C
178  CALL caseup(iwd)
179 C
180  CALL gread(iwd,lwd,ityp,nf,1,80,nter)
181 C
182  CALL cmpsetup(idone,retn) !Check & do setup cmds
183  IF(idone.EQ.'YES ') THEN
184  IF(retn.EQ.50) GO TO 50
185  GO TO 100
186  ENDIF
187 C
188  CALL cmpinput(idone,retn) !Do tape, ldf, ipc open/close
189  IF(idone.EQ.'YES ') THEN !record-positions, reads, etc
190  IF(retn.EQ.50) GO TO 50
191  GO TO 100
192  ENDIF
193 C
194  CALL cmpread(idone,retn) !Check for read/display records
195  IF(idone.EQ.'YES ') THEN
196  IF(retn.EQ.50) GO TO 50
197  GO TO 100
198  ENDIF
199 C
200  IF(nter.NE.0) GO TO 1000
201 C
202  IF(kmd.EQ.'ZERO') GO TO 200
203  IF(kmd.EQ.'Z ') GO TO 210
204  IF(kmd.EQ.'SUM ') GO TO 220
205 C
206  IF(kmd.EQ.'GO ') GO TO 250
207  IF(kmd.EQ.'GOEN') GO TO 250
208 C
209  IF(kmd.EQ.'END ') GO TO 300
210  IF(kmd.EQ.'HUP ') GO TO 320
211  IF(kmd.EQ.'KILL') GO TO 340
212 C
213  GO TO 1000
214 C
215 C ------------------------------------------------------------------
216 C Zero the histogram file and reset all pointers
217 C ------------------------------------------------------------------
218 C
219  200 CALL hisnit(luh,'ZOT ')
220  icnf='NO '
221  jcnf='NO '
222  nbred=0
223  GO TO 100
224 C
225 C ------------------------------------------------------------------
226 C Zero individual histograms
227 C ------------------------------------------------------------------
228 C
229  210 CALL zottum(iwd)
230  GO TO 100
231 C
232 C ------------------------------------------------------------------
233 C Display/log histogram sumsd
234 C ------------------------------------------------------------------
235 C
236  220 CALL hissum_vm
237  GO TO 100
238 C
239 C ------------------------------------------------------------------
240 C Read and process records until you hit an abnormal condition
241 C ------------------------------------------------------------------
242 C
243  250 CALL doscan(retn)
244 C
245  IF(msgf.NE.' ') GO TO 20
246  IF(retn.EQ.0) GO TO 100
247  IF(retn.EQ.20) GO TO 20
248  IF(retn.EQ.50) GO TO 50
249  GO TO 50
250 C
251 C ------------------------------------------------------------------
252 C Process - END command
253 C ------------------------------------------------------------------
254 C
255  300 IF(lut.LT.0) GO TO 320 !END - Tape not open
256  kmd='CLOT' !END - Dismount no-unload
257  CALL tapopen(ierr)
258 C
259 C ------------------------------------------------------------------
260 C Windup - Windup - Windup - Windup - Windup - Windup - Windup
261 C ------------------------------------------------------------------
262 C
263  320 CALL hisnit(luh,'HUP ')
264  IF(kmd.EQ.'HUP ') GO TO 100
265 C
266  340 continue
267 C
268  IF((mem_style(1:5).NE.'LOCAL')) THEN !Test for & delete
269  CALL mmap_close(ierr) !terminate the memory map
270  ENDIF
271 C
272 CX IF(INTYP.EQ.'SHM ') THEN !Test for SHM assigned
273 CX CALL CLOSEIPC() !Detach from SHM and
274 CX ENDIF
275 C
276  stop
277 C
278 C ------------------------------------------------------------------
279 C List/log error messages
280 C ------------------------------------------------------------------
281 C
282  1000 WRITE(cmssg,1005)
283  CALL messlog(logut,logup)
284  1005 FORMAT('Syntax error or illegal command - ignored')
285  GO TO 50
286 C
287  END
288 C$PROG OPENIPC - Dummy OPENIPC for SCANOF
289 C
290  SUBROUTINE openipc(KIND,IPCNAM,LNBY,IERR)
291 C
292  IMPLICIT NONE
293 C
294 C ------------------------------------------------------------------
295  common/lll/ mssg(28),namprog(2),logut,logup,lisflg,msgf
296  INTEGER*4 MSSG,NAMPROG,LOGUT,LOGUP,LISFLG,MSGF
297  CHARACTER*112 CMSSG
298  equivalence(cmssg,mssg)
299 C ------------------------------------------------------------------
300  INTEGER*4 KIND,IPCNAM,LNBY,IERR
301 C ------------------------------------------------------------------
302  SAVE
303 C ------------------------------------------------------------------
304 C
305  WRITE(cmssg,10)
306  10 FORMAT('----------------------------------------------')
307  CALL messlog(logut,0)
308 C
309  WRITE(cmssg,20)
310  20 FORMAT('This is an off-line version of SCANOR')
311  CALL messlog(logut,0)
312 C
313  CALL messlog(logut,0)
314 C
315  WRITE(cmssg,30)
316  30 FORMAT('Connection to IPC data-stream is not supported')
317  CALL messlog(logut,0)
318 C
319  WRITE(cmssg,10)
320  CALL messlog(logut,0)
321 C
322  ierr=1
323 C
324  RETURN
325  END
326 C$PROG READIPC - Dummy READIPC for SCANOF
327 C
328  SUBROUTINE readipc(IBUF,NBYT,NBYRED,IERR,MSGF)
329 C
330  IMPLICIT NONE
331 C
332  INTEGER*4 IBUF,NBYT,NBYRED,IERR,MSGF
333 C
334  RETURN
335  END
336 C
337 C$PROG CLOSEIPC - Dummy CLOSEIPC for SCANOF
338 C
339  SUBROUTINE closeipc
340 C
341  RETURN
342  END
openipc
subroutine openipc(KIND, IPCNAM, LNBY, IERR)
Definition: scanof.f:291
closeipc
subroutine closeipc
Definition: scanof.f:340
readipc
subroutine readipc(IBUF, NBYT, NBYRED, IERR, MSGF)
Definition: scanof.f:329
messlog
subroutine messlog(LUA, LUB)
Definition: messlog.f:8