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