]>
Commit | Line | Data |
---|---|---|
0795afa3 | 1 | #include "isajet/pilot.h" |
2 | SUBROUTINE BUFOUT(IL) | |
3 | C | |
4 | C INVERSE OF BUFIN. | |
5 | C IF CDCPACK IS USED, PACK TWO ZEVEL WORDS INTO EACH ZVOUT WORD | |
6 | C BY CALL PAIRPAK AND BUFFER OUT ZVOUT ARRAY. | |
7 | C OTHERWISE WRITE OUT ZEVEL. | |
8 | C | |
9 | C NRECS INCREMENTED BY 1 | |
10 | C IL SET TO 3 | |
11 | ||
12 | ||
13 | #include "isajet/itapes.inc" | |
14 | #include "isajet/final.inc" | |
15 | #include "isajet/idrun.inc" | |
16 | #include "isajet/zevel.inc" | |
17 | #include "isajet/zvout.inc" | |
18 | DIMENSION W(2),IW(2) | |
19 | EQUIVALENCE(W(1),IW(1)) | |
20 | C THESE ARE NOW INITIALIZED IN BLOCK DATA | |
21 | ITA=IABS(ITEVT) | |
22 | #if defined(CERNLIB_CDCPACK) | |
23 | C USE CDC ASSEMBLY LANGUAGE ROUTINE PAIRPAK TO PACK 2 ZEVEL | |
24 | C WORDS INTO 1 ZVOUT WORD AND THEN CALL CDC BUFFER OUT. | |
25 | IW(1)=IZEVEL(1) | |
26 | IZEVEL(2)=IL | |
27 | IW(2)=IL | |
28 | CALL PAIRPAK(W(1),W(2),WOUT,IFL) | |
29 | ZVOUT(1)=WOUT | |
30 | NW=IL/2+MOD(IL,2) | |
31 | DO 1 I=2,NW | |
32 | II=2*I-1 | |
33 | CALL MOVLEV(IZEVEL(II),W,2) | |
34 | CALL PAIRPAK(W(1),W(2),WOUT,IFL) | |
35 | ZVOUT(I)=WOUT | |
36 | 1 CONTINUE | |
37 | IL=3 | |
38 | NRECS=NRECS+1 | |
39 | BUFFER OUT(ITA,1) (ZVOUT(1),ZVOUT(NW)) | |
40 | IF(UNIT(ITA,ZVOUT(1),ZVOUT(NW))) 10,10,11 | |
41 | #endif | |
42 | #if defined(CERNLIB_STDIO) | |
43 | C STANDARD FORTRAN 77 WRITE. | |
44 | IZEVEL(2)=IL | |
45 | WRITE(ITA,ERR=11) (ZEVEL(I),I=1,IL) | |
46 | IL=3 | |
47 | NRECS=NRECS+1 | |
48 | #endif | |
49 | 10 RETURN | |
50 | 11 WRITE(ITLIS,200) IEVT,IDG | |
51 | 200 FORMAT(//' BAD WRITE, EVENT NO.',I10,5X,'EVENT ID',2I10) | |
52 | RETURN | |
53 | END |