home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / LANGUAGS / FORTRAN / PALASM.LBR / FILENAME.FQR / FILENAME.FOR
Text File  |  2000-06-30  |  1KB  |  64 lines
  1.     SUBROUTINE GFNAME(NAME,UNIT,EXT)
  2.     LOGICAL NAME(11),EXT
  3.     INTEGER UNIT
  4.     LOGICAL COLON,FNAME(14),DOT
  5.     COLON = ':'
  6.     DOT   = '.'
  7. C
  8. C    READ A USER DATA FILE NAME
  9. C
  10. C    NAME:    RETURN PARAMETER OF FILE NAME
  11. C    UNIT:    RETURN PARAMETER OF UNIT
  12. C            0    DEFAULT DRIVE
  13. C            1    DRIVE A ETC
  14. C    EXT:    INPUT PARAMETER
  15. C        TRUE : EXTENSION REQUIRED
  16. C        FALSE: EXTENSION NOT PERMITTED
  17. C
  18. C
  19. C
  20.     UNIT = 0
  21.   10    IF(.NOT.EXT)WRITE(1,101)
  22.     IF(EXT) WRITE(1,100)
  23.     READ(1,104)FNAME
  24.     IF(FNAME(2).NE.COLON) GOTO 14
  25.     UNIT = FNAME(1) - 'A' + 1
  26.     DO 15 I= 1 , 12
  27.         FNAME(I)=FNAME(I+2)
  28.   15    CONTINUE
  29. C
  30. C    FIND AND REMOVE '.' IN FILE NAME
  31. C
  32.    14    DO 16 I=1,11
  33.     IF (FNAME(I).EQ.DOT) GO TO 17
  34.    16    CONTINUE
  35. C    NO PERIOD! ILLEGAL FILE NAME?
  36.     IF(.NOT. EXT) GO TO 20
  37.     WRITE(1,105)
  38.     GOTO 10
  39.  
  40.    17    M1 = I + 3
  41.     DO 33 J = I,M1
  42.    33    FNAME(J) = FNAME(J+1)
  43.     N=11
  44.     DO 18 J=1,3
  45.     M1=I+3 - J
  46.     FNAME(N)=FNAME(M1)
  47.    18    N=N-1
  48.     IF(I.GE.9)GOTO 20
  49.     DO 19 J=I ,8
  50.    19    FNAME(J)=' '
  51. C    
  52. C    FILE NAME IS O.K
  53. C    TRANSFER TO PARAMETER
  54. C
  55.    20    DO 25 I=1,11
  56.    25    NAME(I) = FNAME(I)
  57.     RETURN
  58.   100    FORMAT(' ENTER FILENAME (WITH EXTENSION) ---> ')
  59.   101    FORMAT(' ENTER FILENAME (WITHOUT EXTENSION -> ')
  60.   104    FORMAT(14A1)
  61.   105    FORMAT(' ILLEGAL FILENAME! PLEASE REENTER')
  62.     END
  63.  
  64. MAT(' ENTER FILEN