      PROGRAM MAKEITIC_TITLE  MAKEIT  Program to create an XX-type file with a standard header
C_DESCRIPTIONHC   MAKEIT may be used for a type 1 spare column file, array file, etc.,5C   optional header items, vid info, zeroing of file.,C   See  XXORG.TXT for a header description..C_CALLS  DSOPEN,DSWRIT,DSCLOS,A2AN,FILL,DATIMELC_HISTORY  82May25  R.Mehlman  UCLA  DEC version, blocks of 256  INT*2 wordsDC      2/28/83 new  DS rtnes replace  GP disk rtnes, general rewriteC_END!      INTEGER*2 NAME(3),IBUF(256))      EQUIVALENCE (LREC,NCOL),(NROW,NREC)(      DATA IIN,IOUT,IFC,LBUF,LVID,NVIDPB)     1    /  5,   6, 50, 256,   8,    32/CC  REQUEST INPUT 10   WRITE (IIN,910). 910  FORMAT (' READY TO MAKE STANDARD FILE:'/?     1 ' ENTER TYPE,SUBTYPE,LUN,NAME (3I5,3A2) OR EOF TO EXIT')7      READ (IIN,911,ERR=10,END=80) ITYPE,JTYPE,LUN,NAME 911  FORMAT (3I5,3A2)      IF (ITYPE.EQ.1) GO TO 14C  FILES OTHER THAN TYPE 1      WRITE (IOUT,912)= 912  FORMAT (' ENTER RECORD SIZE, # RECORDS (POINTS) (2I7)')      READ (IIN,913) LREC,NREC 913  FORMAT (2I7)      NBLK=NREC*(LBUF/LREC)
      NBVID=0      NVAR=0      GO TO 15C  TYPE 1 FILES 14   WRITE (IOUT,914)/ 914  FORMAT (' ENTER # COLUMNS, # ROWS (2I7)'/,     1 '  NEGATIVE # COLUMNS FOR VID INPUT')      READ (IIN,913) INCOL,NROW      NCOL=IABS(INCOL)      NBLK=NROW*NCOL      NVAR=0
      NBVID=0      IF (INCOL.GT.0) GO TO 15      NVAR=NCOL"      NBVID=(NVAR+NVIDPB-1)/NVIDPBC  CREATE FILE 15   NBLK=NBLK+NBVID+1.      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)=NROW      IBUF(3)=NCOL      IBUF(4)=1'      IF (ITYPE.NE.1) IBUF(4)=LBUF/LREC      IBUF(5)=ITYPE      IBUF(6)=1+NBVID      IBUF(7)=JTYPE      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))      IF (NVAR.EQ.0) GO TO 21      IBUF(17)=2      IBUF(18)=NBVID      IBUF(19)=LVIDC  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,913,END=25) LOC,IVAL      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 70      IF (NVAR.EQ.0) GO TO 402C  REQUEST VID INFO AND WRITE VID SECTORS (2 TO ?)
      L1=1
      L2=LVID      CALL FILL(IBUF,LBUF,0)      DO 30 K=1,NCOL 28   WRITE (IOUT,928) K8 928  FORMAT (' ENTER VARIABLE ID INFO FOR COL/VAR ',I3/0     1 '  TITLE, UNITS, STORAGE & PRINT SCALES'/,     2 '  (A6,1X,A6,1X,2I7) OR EOF TO SKIP')4      READ (IIN,929,ERR=28,END=40) (IBUF(L),L=L1,L2)  929  FORMAT (3A2,1X,3A2,1X,2I7)
      L1=L2+1      L2=L2+LVID,      IF (L2.LE.LBUF.AND.K.NE.NCOL) GO TO 30      IBLK=IBLK+1(      CALL DSWRIT(IFC,IBLK,IBUF,LBUF,IR)      IF (IR.NE.0) GO TO 70      CALL FILL(IBUF,LBUF,0)
      L1=1
      L2=LVID 30   CONTINUEC  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