]>
Commit | Line | Data |
---|---|---|
0795afa3 | 1 | #include "isajet/pilot.h" |
2 | SUBROUTINE BUFIN(IL,IFLAG) | |
3 | C | |
4 | C INVERSE OF BUFOUT. | |
5 | C IF CDCPACK IS USED, READ INPUT RECORD INTO ZVOUT AND | |
6 | C UNPACK EACH ZVOUT WORD INTO TWO ZEVEL WORDS BY CALL EXPAIR. | |
7 | C OTHERWISE, READ ONE INPUT RECORD INTO ZEVEL. | |
8 | C | |
9 | #include "isajet/itapes.inc" | |
10 | #include "isajet/ita.inc" | |
11 | #include "isajet/zevel.inc" | |
12 | #include "isajet/zvout.inc" | |
13 | DIMENSION W(2),IW(2) | |
14 | EQUIVALENCE(W(1),IW(1)) | |
15 | DATA NPARR/0/ | |
16 | 1 CONTINUE | |
17 | #if defined(CERNLIB_CDCPACK) | |
18 | C USE CDC BUFFER IN TO READ PACKED RECORD. | |
19 | BUFFER IN(ITB,1) (ZVOUT(1),ZVOUT(512)) | |
20 | IF(UNIT(ITB,ZVOUT(1),ZVOUT(512))) 300,200,100 | |
21 | #endif | |
22 | #if defined(CERNLIB_STDIO) | |
23 | C STANDARD FORTRAN 77 READ. | |
24 | CALL ZEROL(ZEVEL,MAXLEN) | |
25 | READ(ITB,ERR=100,END=200) IZVL1,IZVL2,(ZEVEL(JJ),JJ=3,IZVL2) | |
26 | GO TO 300 | |
27 | #endif | |
28 | C TAPE READ ERROR | |
29 | 100 WRITE(ITLIS,10) ITB | |
30 | NPARR=NPARR+1 | |
31 | 10 FORMAT(1X,' TAPE READ ERROR ON TAPE',I3) | |
32 | IFLAG=1 | |
33 | IF(NPARR.LT.20) GOTO 1 | |
34 | C END OF FILE | |
35 | 200 IFLAG=-1 | |
36 | RETURN | |
37 | C GOOD RECORD | |
38 | 300 IFLAG=0 | |
39 | #if defined(CERNLIB_CDCPACK) | |
40 | C USE CDC ASSEMBLY LANGUAGE ROUTINE EXPAIR TO UNPACK 1 ZVOUT | |
41 | C WORDS INTO 2 ZEVEL WORDS. | |
42 | WOUT=ZVOUT(1) | |
43 | CALL EXPAIR(W(1),W(2),WOUT,IFL) | |
44 | IZEVEL(1)=IW(1) | |
45 | IZEVEL(2)=IW(2) | |
46 | IL=IW(2) | |
47 | NW=IL/2+MOD(IL,2) | |
48 | DO 310 I=2,NW | |
49 | WOUT=ZVOUT(I) | |
50 | II=2*I-1 | |
51 | CALL EXPAIR(W(1),W(2),WOUT,IFL) | |
52 | CALL MOVLEV(W,IZEVEL(II),2) | |
53 | 310 CONTINUE | |
54 | #endif | |
55 | IL=3 | |
56 | RETURN | |
57 | END |