MINICERN/packlib/kernlib/kerngen/tcgenc/accessf.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/02/15 17:50:37  mclareni
   6 * Kernlib
   7 *
   8 *
   9 #include "kerngen/pilot.h"
  10       LOGICAL FUNCTION ACCESSF (FNAME, MODE)
  11 C
  12 C CERN PROGLIB# Z265    ACCESSF         .VERSION KERNFOR  4.39  940228
  13 C ORIG. 17/02/94, JZ
  14 C
  15       CHARACTER    FNAME*(*)
  16       LOGICAL      THERE
  17
  18 C--           Does the file exist?
  19
  20       INQUIRE (FILE=FNAME,EXIST=THERE)
  21       IF (.NOT.THERE)              GO TO 39
  22
  23       MRW = JBYT (MODE,1,2)
  24       IF (MRW.LT.2)                GO TO 49
  25
  26 C--           Find a free LUN
  27
  28       DO  17 LUN=8,49
  29       INQUIRE (UNIT=LUN,OPENED=THERE)
  30       IF (.NOT.THERE)              GO TO 21
  31    17 CONTINUE
  32       GO TO 39
  33
  34 C--           Try to open the file
  35
  36 C-        R_OK    4   test for read permission
  37 C-        W_OK    2   test for write permission
  38 C-        X_OK    1   test for execute (search) permission
  39 C-        F_OK    0   test for presence of file
  40
  41
  42    21 IF (MRW.LT.4)                GO TO 31
  43       OPEN (LUN,FILE=FNAME,STATUS='OLD'
  44      +,        FORM='FORMATTED', IOSTAT=ISTAT)
  45       IF (ISTAT.EQ.0)              GO TO 31
  46
  47       OPEN (LUN,FILE=FNAME,STATUS='OLD'
  48      +,        FORM='UNFORMATTED', IOSTAT=ISTAT)
  49       IF (ISTAT.NE.0)              GO TO 38
  50
  51    31 IF (MRW.EQ.4)                GO TO 48
  52       OPEN (LUN,FILE=FNAME,STATUS='UNKNOWN'
  53      +,        FORM='FORMATTED', IOSTAT=ISTAT)
  54       IF (ISTAT.EQ.0)              GO TO 48
  55
  56       OPEN (LUN,FILE=FNAME,STATUS='UNKNOWN'
  57      +,        FORM='UNFORMATTED', IOSTAT=ISTAT)
  58       IF (ISTAT.EQ.0)              GO TO 48
  59
  60    38 CLOSE (LUN)
  61    39 ACCESSF = .FALSE.
  62       RETURN
  63
  64    48 CLOSE (LUN)
  65    49 ACCESSF = .TRUE.
  66       RETURN
  67       END