home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / rcpm / filedocs / simcpm.ark / SIMCVT.FOR < prev    next >
Encoding:
Text File  |  1989-12-18  |  2.3 KB  |  78 lines
  1. C  SIMCVT.FOR
  2. C
  3. C  We do not have a BASIC complier on our VAX 8700. I found it
  4. C  very time comsuming to download SIMIBM.ARC to PC, run
  5. C  SIMCVT.BAS, upload SIMIBM.LST to VAX and print it. Therefore,
  6. C  I piece together a FORTRAN program which does the same thing
  7. C  as SIMCVT.BAS.
  8. C
  9. C  Please perform the following steps *BEFORE* running this program.
  10. C
  11. C   1. Use EDT to change ' (single quote) to '' (two single quotes)
  12. C      in file SIMIBM.IDX.
  13. C      EDT command:  s/'/''/ 1:50000 /notype
  14. C   2. Use EDT to change " (double quote) to ' (single quote)
  15. C      in files SIMIBM.IDX.
  16. C      EDT command:  s/"/'/ 1:50000 /notype
  17. C
  18. C  Please direct any questions or comments to me. I hope you find
  19. C  this program helpful.
  20. C
  21. C  Dustin Fu
  22. C  Computer Operator
  23. C  Academic Computing Services
  24. C  University of Texas at Arlington
  25. C  Bitnet: c015fdh@utarlg
  26. C  THEnet: UTARLG::C015FDH
  27. C  Internet: c015fdh@utarlg.arl.utexas.edu
  28. C
  29.       PROGRAM IDX2LST
  30.       INTEGER   LGTH2, BITS2, DT2, REV2
  31.       CHARACTER FS1*4, DIR1*20
  32.       CHARACTER FS2*4, DIR2*20, FLNM2*12, DESCR2*46
  33.       CHARACTER DT*9, STYLE*1
  34. C
  35.       FS1 = ' '
  36.       DIR1 = ' '
  37. C
  38.       OPEN(UNIT=1,FILE='SIMIBM.IDX',STATUS='OLD')
  39.       OPEN(UNIT=2,FILE='SIMIBM.LST',STATUS='NEW')
  40. C
  41.       CALL DATE(DT)
  42.       WRITE(2,*) 'WSMR-SIMTEL20.ARMY.MIL PUBLIC DOMAIN LISTING AS OF '
  43.      +           ,DT
  44.       WRITE(2,*) ' '
  45.       WRITE(2,*) 'NOTE: Type B is Binary, Type A is ASCII'
  46. C
  47. 111   READ(1,*,END=999) FS2,DIR2,FLNM2,REV2,LGTH2,BITS2,DT2,DESCR2
  48. C
  49.       IF ((FS1 .NE. FS2) .OR. (DIR1 .NE. DIR2)) THEN
  50.          WRITE(2,*) ' '
  51.          WRITE(2,*) 'Directory ', FS2, DIR2
  52.          WRITE(2,*) ' Filename   Type Length   Date    Description'
  53.          WRITE(2,*) '=============================================='
  54.          IF (BITS2 .EQ. 8) THEN
  55.              STYLE = 'B'
  56.          ELSE
  57.              STYLE = 'A'
  58.          ENDIF
  59.          WRITE(2,1001) FLNM2, STYLE, LGTH2, DT2, DESCR2
  60.          FS1 = FS2
  61.          DIR1 = DIR2
  62.       ELSE
  63.          IF (BITS2 .EQ. 8) THEN
  64.              STYLE = 'B'
  65.          ELSE
  66.              STYLE = 'A'
  67.          ENDIF
  68.          WRITE(2,1001) FLNM2, STYLE, LGTH2, DT2, DESCR2
  69.          FS1 = FS2
  70.          DIR1 = DIR2
  71.       ENDIF
  72.       GOTO 111
  73. 1001  FORMAT(1X, A, 2X, A, I8, I8, 2X, A)
  74. 999   CLOSE(UNIT=1)
  75.       CLOSE(UNIT=2)
  76.       STOP
  77.       END
  78.