C DIREC.FOR C SUBROUTINE DIREC(LUN,INPUT) C C---------------------------------------------------------------------- C C 'DIREC' OUTPUTS A DIRECTORY OF THE DEVICE NAMED BY THE STRING C 'INPUT' ON THE LOGICAL UNIT 'LUN'. FOR EXAMPLE, TO GET A C DIRECTORY OF DK: ON THE LINE PRINTER, CALL DIREC (6,'DK:') C NOTE: 'DIREC' CURRENTLY ONLY WORKS FOR FLOPPY DISK DIRECTORIES C C THIS ROUTINE IS PART OF THE PICAX PROGRAM C WRITTEN BY ROBERT WALRAVEN, UCD - APPLIED SCIENCE C VERSION 2.0, 6 FEB 80 C C---------------------------------------------------------------------- C INTEGER BUF(512),INPUT(1),OUT(7),LINE(32) REAL DATE(12) LOGICAL*1 NAME(10) DATA DATE/'JAN-','FEB-','MAR-','APR-','MAY-','JUN-','JUL-', 1 'AUG-','SEP-','OCT-','NOV-','DEC-'/ C C-------------------- INITIALIZATION ---------------------------------- C IF (LUN .NE. 5 .AND. LUN .NE. 6) RETURN DO 10 I=1,7 10 OUT(I)=0 CALL IRAD50 (4,INPUT,OUT) ICHAN = IGETC() IF (ICHAN .LT. 0) RETURN I = IFETCH(OUT) IF (I .NE. 0) GO TO 400 I = LOOKUP(ICHAN,OUT) IF (I .LT. 0) GO TO 400 NEXT = 1 NPTR = 1 NBUF = 512 NFILES = 0 NFBLKS = 0 NFREE = 0 C C-------------------- GET NEXT SEGMENT -------------------------------- C 100 IF (NEXT .EQ. 0) GO TO 300 NBLK = 2*NEXT + 4 J = IREADW(NBUF,BUF,NBLK,ICHAN) IF (J .LT. 0) GO TO 400 IF (NEXT .EQ. 1) NN = BUF(4) NEXT = BUF(2) IWORD = 6 C C-------------------- PROCESS ENTRIES --------------------------------- C 200 DO 205 I = 1,7 OUT(I) = BUF(IWORD) 205 IWORD = IWORD + 1 IWORD = IWORD + NN LEN = OUT(5) IF (OUT(1) .EQ. "4000) GO TO 100 IF (OUT(1) .NE. "1000) GO TO 220 NFREE = NFREE + OUT(5) ENCODE (34,210,LINE(NPTR)) LEN 210 FORMAT ('< UNUSED >',I5,15X' ') GO TO 260 220 NFILES = NFILES + 1 NFBLKS = NFBLKS + OUT(5) CALL R50ASC (6,OUT(2),NAME) NAME(7) = '.' CALL R50ASC (3,OUT(4),NAME(8)) IDATE = OUT(7) MO = IDATE/1024 IDATE = IDATE-MO*1024 IDAY = IDATE/32 IYR = IDATE-IDAY*32 + 72 IF (OUT(7) .EQ. 0) MO = 1 IF (OUT(1) .EQ. "400) GO TO 240 ENCODE (34,230,LINE(NPTR)) NAME,LEN,IDAY,DATE(MO),IYR 230 FORMAT (10A1,I5,I4,'-',A4,I2,' ') GO TO 260 240 JOB = OUT(6)/256 NCHAN = OUT(6)-JOB*256 ENCODE (34,250,LINE(NPTR)) NAME,LEN,IDAY,DATE(MO),IYR,NCHAN 250 FORMAT(10A1,I5,I4,'-'A4,I2' T'I3' ') 260 NSTART = NSTART + LEN IF (NPTR .EQ. 1) GO TO 280 WRITE (LUN,270) LINE 270 FORMAT (1X,32A2) NPTR = 1 GO TO 200 280 NPTR = 17 GO TO 200 C C-------------------- ALL DONE ---------------------------------------- C 300 IF (NPTR .EQ. 1) GO TO 320 WRITE (LUN,310) (LINE(I),I=1,16) 310 FORMAT (1X,16A2) 320 WRITE (LUN,330) NFILES, NFBLKS,NFREE 330 FORMAT(1X,I6' FILES,'I6' BLOCKS'/1X,I6' FREE BLOCKS') 400 CALL PURGE (ICHAN) CALL IFREEC (ICHAN) RETURN END