      PROGRAM MAKEAF@C_TITLE  MAKEAF  Create  XX-type array file with standard header
C_DESCRIPTION*C   Optional header items, zeroing of file9C   see  XXORG.TXT and  ARUSER.TXT for header description.C_CALLS  DSOPEN,DSWRIT,DSCLOS,A2AN,FILL,DATIMECC_HISTORY  R.Mehlman 83Sept01  UCLA  VAX/VMS version - specialized C	from  MAKEIT OF 2/28/83C_END!      INTEGER*2 NAME(3),IBUF(256)      DATA IIN,IOUT,IFC,LBUF     1    /  5,   6, 50, 256/CC  REQUEST LUN, NAME, SIZE 10   WRITE (IIN,910)4 910  FORMAT (' READY TO MAKE STANDARD ARRAY FILE:'/?     1 ' ENTER LOGICAL UNIT, FILENAME (I5,6A1) OR EOF TO EXIT')+      READ (IIN,911,ERR=10,END=80) LUN,NAME 911  FORMAT (I5,3A2)      WRITE (IOUT,912)+ 912  FORMAT (' ENTER SIZE IN BLOCKS (I5)')      READ (IIN,911) NBLKC  CREATE FILE. 15   CALL DSOPEN(IFC,LUN,NAME,LBUF,NBLK,0,IR)      IF (IR.NE.0) GO TO 70@C  CREATE & WRITE STANDARD FILE HEADER - ASSUME NO WRITE-PROTECT 20   CALL FILL(IBUF,LBUF,0)      IBUF(1)=1      IBUF(2)=NBLK-1      IBUF(3)=LBUF      IBUF(4)=1      IBUF(5)=0      IBUF(6)=1      IBUF(7)=2      IBUF(10)=-1      IBUF(11)=0      IBUF(12)=16      IBUF(13)=LBUF      IBUF(16)=1       CALL A2AN(NAME,IBUF(61),3)       CALL FILL(IBUF(64),7,2H  )      CALL DATIME(IBUF(71))      CALL DATIME(IBUF(81))C  REQUEST FILE DESCRIPTION 21   WRITE (IOUT,921). 921  FORMAT (' ENTER FILE DESCRIPTION (60A)')'      READ (IIN,922) (IBUF(I),I=91,120) 922  FORMAT (30A2)C  REQUEST SPECIAL HEADER ITEMS 23   WRITE (IOUT,923)> 923  FORMAT (' ENTER ANY SPECIAL HEADER ITEMS BY LOCATION: '//     1 '  LOCATION,VALUE (2I7) OR 0 WHEN DONE')$      READ (IIN,924,END=25) LOC,IVAL 924  FORMAT (2I7)      IF (LOC.LE.0) GO TO 25      IBUF(LOC)=IVAL      GO TO 23C  WRITE FILE HEADER 25   IBLK=1(      CALL DSWRIT(IFC,IBLK,IBUF,LBUF,IR)      IF (IR.NE.0) GO TO 70C  ZERO THE REST OF THE FILE? 40   WRITE (IOUT,940)= 940  FORMAT (' WANT TO ZERO THE REST OF THE FILE?  1 = YES')$      READ (IIN,941,ERR=40,END=50) I 941  FORMAT (I1)      IF (I.EQ.0) GO TO 50      CALL FILL(IBUF,LBUF,0)      IBLK=IBLK+1      DO 45 I=IBLK,NBLK%      CALL DSWRIT(IFC,I,IBUF,LBUF,IR)      IF (IR.NE.0) GO TO 70 45   CONTINUE 50   CALL DSCLOS(IFC,0,IR)      WRITE (IOUT,950) 950  FORMAT (' FILE CREATED')      GO TO 10 70   WRITE (IOUT,970) IR) 970  FORMAT (' DISK I/O ERROR: CODE',I6)
 80   STOP	      END