PROGRAM CDCOPY C_TITLE CDCOPY Copy CDROM file to magnetic disk (VMS non-TAE version) C_USER CHARACTER*64 FROM ! Specification of file on CDROM C CHARACTER*64 TO ! Specification for output disk file (default: C current directory, same filename as input) C INTEGER*4 IQ ! Over-ride record length (bytes) for files C with bad attribute records (e.g. IDI disks) C_DESCR Copy CDROM file to disk preserving logical format, according to C the CDROM attribute record of the file. Fixed-length-record files C supported. Variable-length-record files not yet implemented. C Stream (text) files are copied to files of variable length records C with 'LIST' carriage control. (Program CDTYPE can do this too.) C Program uses 1/4 MB of internal buffer space, which can be reduced. C C User over-ride of record format and length provided due to attribute C block errors on both ISO and High Sierra versions of the IDI disk. C_FILES CDROM files and directories written according to either the 1988 C ISO or older High Sierra formats. C References: C VOLINFO.TXT in [DOCUMENT] directory of each CDROM of series C "Voyager 2 Images of Uranus" C ISO 9660 (Information processing -- Volume and file structure of C CD-ROM for information interchange), first edition, 1988-04-15 C (High Sierra ref?) C C Output disk files are written as VMS files with record type FIXED or C VARIABLE as appropriate. STREAM records are converted to VARIABLE ones. C_CALLS CDOPEN, CDATT, CDREAD, CDCLOSE, B2B (USGS/Flagstaff CDROM rtnes) C WTSREC (included below) C_LIMS Maximum attribute record size is 2048 bytes. C Variable-length-record files not yet supported. C_KEYS CDROM, DISK, FILE_I/O, VMS C_HIST 14aug87 R. Mehlman, UCLA/IGPP (RMX) ORIGINAL VMS (non-TAE) VERSION C 02sep87 RMX Stream (text) file conversion to EDT-type file added C 11dec87 RMX User over-ride of format & record-length to substitute C for incorrectly written attribute records on IDI disk. C 22mar88 RMX Fixed bug at label 30 (affected large files) C 17jan89 RMX Revised for ISO format and new USGS I/O routines C B2B replaces MOVE1 for byte transfer C 06feb89 RMX Revised to use new CDATT routine, and copy files from C both ISO and High Sierra CDs. User over-ride expanded C to include both record format and record length. C 07feb89 RMX Error msg for var-len-rec files corrected. C 01mar89 RMX Really fixes bug at label 30 -- extra recs in long file. C Also,copies even if no ext attr rec - asks for length. C_END CHARACTER*64 FLSPEC,FLOUT ! FROM and TO parameters BYTE IATTR(2048) ! CDROM attribute record BYTE IBUF(512,512),KBUF(262144) ! 1/4 MB buffer EQUIVALENCE (IBUF,KBUF) C IFMT,IRATT,IREC are ISO variables, JFMT,JRATT,JREC are High Sierra C LFMT,LRATT,LREC are working variables BYTE IFMT,IRATT,JFMT,JRATT,LFMT,LRATT ! record format, display attr. INTEGER*2 IREC,JREC ! VAX-format record-lengths INTEGER*4 LREC,LREC4 EQUIVALENCE (IFMT,IATTR(79)),(IRATT,IATTR(80)),(IREC,IATTR(81)) EQUIVALENCE (JFMT,IATTR(75)),(JRATT,IATTR(76)),(JREC,IATTR(77)) DATA IIN,IOUT,IDISK,LBLK,NBBUF 1 / 5, 6, 1, 512, 512/ C C Request input file spec 10 WRITE (IOUT,910) 910 FORMAT (' Enter CDROM filespec, or EOF to quit') READ (IIN,911,END=80) FLSPEC 911 FORMAT (A) C Open CDROM file CALL CDOPEN(FLSPEC,ICHAN,ISBLK,ISIZE,IERR) IF (IERR.NE.0) STOP ! CDOPEN writes own error msgs NBLKS=(ISIZE+LBLK-1)/LBLK WRITE (IOUT,912) ICHAN,ISBLK,ISIZE,NBLKS 912 FORMAT (' CHAN',I7,' SBLK',I7,' SIZE',I10,' BLKS',I7) IF (ISBLK.GT.0) GO TO 15 WRITE (IOUT,914) 914 FORMAT (' What?') GO TO 10 C Read attribute record, determine standard (High Sierra or ISO) 15 CALL CDATT(ICHAN,IATTR,NLEN,IDSTAND,IERR) IF (IERR.NE.0) THEN ! If error, CDATT writes msg IDSTAND=1 ! No attr rec - assume High Sierra JFMT=0 ! Trigger user request for rec length ENDIF IF (IDSTAND.EQ.1) THEN ! High Sierra standard LFMT=JFMT LRATT=JRATT LREC=JREC ELSE IF (IDSTAND.EQ.2) THEN ! ISO standard LFMT=IFMT LRATT=IRATT LREC=IREC ENDIF NRECS=0 IF (LFMT.GT.0) NRECS=(FLOAT(LBLK)/FLOAT(LREC))*FLOAT(NBLKS)+.5 WRITE (IOUT,915) LFMT,LRATT,LREC,NLEN,IDSTAND,NRECS 915 FORMAT (' REC FMT',I3,' REC ATTR',I3,' REC LEN',I6, 1 ' ATTR BLKS',I3,' STD ',I1,' RECS',I6) IF (LFMT.EQ.2.OR.LFMT.EQ.3) THEN WRITE (IOUT,9151) 9151 FORMAT (' File is variable-length-record type - not yet', 1 ' supported by CDCOPY') GO TO 10 ENDIF C Check for over-ride (due to IDI disk errors) IF (LFMT.EQ.0) WRITE (IOUT,9152) 9152 FORMAT ('0File appears to be in stream format.') IF (LFMT.EQ.1) WRITE (IOUT,9153) LREC 9153 FORMAT ('0File appears to be in fixed-length-record format'/ 1 ' with record length',I6,'.') IF (LFMT.EQ.0.OR.LFMT.EQ.1) WRITE (IOUT,916) 916 FORMAT (' If this is correct, enter zero. If incorrect, enter'/ 1 ' correct record length, or -1 to force stream format,'/ 2 ' or ctrl-Z to quit.') 161 READ (IIN,9161,ERR=161,END=80) IQ 9161 FORMAT (I7) IF (IQ.NE.0) THEN IF (IQ.GT.0) THEN LFMT=1 LREC=IQ NRECS=(FLOAT(LBLK)/FLOAT(LREC))*FLOAT(NBLKS)+.5 ENDIF IF (IQ.EQ.-1) LFMT=0 ENDIF LREC4=(LREC+3)/4 C Generate output filespec C WRITE (IOUT,917) C917 FORMAT (' Enter output disk filespec, or EOF to quit') C READ (IIN,911,END=10) FLOUT IBRACK=INDEX(FLSPEC,']') ICOLON=INDEX(FLSPEC,':') IF (IBRACK+ICOLON.EQ.0)THEN FLOUT=FLSPEC ELSE FLOUT=FLSPEC(MAX0(IBRACK,ICOLON)+1:) ENDIF C Open disk file (or quit, if variable-length-record file) IF (LFMT.EQ.1) THEN ! Fixed-length records OPEN (IDISK,FILE=FLOUT,STATUS='NEW',RECL=LREC4, 1 FORM='UNFORMATTED',RECORDTYPE='FIXED',INITIALSIZE=NBLKS) C ELSE IF (LFMT.EQ.2) THEN ! Variable-length recs C OPEN (IDISK,FILE=FLOUT,STATUS='NEW',RECL=LREC4, C 1 FORM='UNFORMATTED',RECORDTYPE='VARIABLE',INITIALSIZE=NBLKS) ELSE IF (LFMT.EQ.0.) THEN ! Stream OPEN (IDISK,FILE=FLOUT,STATUS='NEW',CARRIAGECONTROL='LIST', 1 INITIALSIZE=NBLKS) ENDIF C Copy blocks from CDROM to disk file IVBLK=1 NBLEFT=NBLKS KSTART=1 KREC=0 C Fill buffer with CDROM blocks 20 NBFREE=NBBUF-(KSTART+LBLK-2)/LBLK NVBLKS=MIN0(NBFREE,NBLEFT) CALL CDREAD(ICHAN,ISBLK,IVBLK,NVBLKS,KBUF(KSTART),IERR) IF (IERR.NE.0) STOP ! If error, CDREAD writes msg KTOP=KSTART+NVBLKS*LBLK-1 IF (LFMT.EQ.1) THEN C Fixed-length-record file: Write as many whole disk records as are in buffer K1=1 30 CALL WTSREC(IDISK,KBUF(K1),LREC,IR) ! rtne to avoid implicit DO loop KREC=KREC+1 IF (IR.NE.0) THEN WRITE (IOUT,935) KREC 935 FORMAT (' Disk write error in record',I7) STOP ENDIF IF (KREC.GE.NRECS) GO TO 50 K1=K1+LREC KLEFT=KTOP-K1+1 IF (KLEFT.LT.LREC) GO TO 40 ! more whole recs in buffer? GO TO 30 C Stream (text) file: search for s, write formatted record ELSE IF (LFMT.EQ.0) THEN K1=1 36 K=K1 37 IF (KBUF(K).EQ.13) GO TO 38 ! search for K=K+1 IF (K.GT.KTOP) GO TO 40 ! end of buffer? GO TO 37 38 WRITE (IDISK,938) (KBUF(I),I=K1,K) ! found it, copy line 938 FORMAT (132A1) K1=K+2 ! skip & GO TO 36 ! go get next ENDIF C Move unused data to beginning of buffer, prepare for next read 40 CALL B2B(KBUF(K1),KBUF(1),KLEFT) KSTART=KLEFT+1 IVBLK=IVBLK+NVBLKS NBLEFT=NBLEFT-NVBLKS IF (IVBLK.LE.NBLKS)GO TO 20 C Close CDROM file and disk file 50 CALL CDCLOSE(ICHAN,IERR) ! if error, CDCLOSE writes msg CLOSE (IDISK) IF (IERR.EQ.0) GO TO 10 C Termination 80 STOP END C C_TITLE: WTSREC: Write VAX-record to file open for sequential access C C_ARGS: IFU I [I] Fortran logical unit of open file C IBUF (*) BYTE [I] Buffer for record to be written (any spec ok) C LREC I [I] Record length C IR I [O] Return code (0 = ok, >0 = VAX/VMS error code) C C_KEYS: FILE_I/O, SYSTEM, VMS C C_DESCR: Write single VAX record in order to avoid implicit DO loop C generated by Fortran I/O in calling routine C C_FILES: Any with fixed length records open for unformatted sequential access C C_HIST: 14aug87 RMX ORIGINAL VERSION C C_END: C SUBROUTINE WTSREC(IFU,IBUF,LREC,IR) BYTE IBUF(LREC) C WRITE (IFU,IOSTAT=IR) IBUF RETURN END