MINICERN/packlib/kernlib/kerngen/tcgenc/unlinkf.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 #if defined(CERNLIB_QMVAX)
  11 #include "vaxsys/unlinkf.F"
  12 #else
  13       SUBROUTINE UNLINKF (CHNAME)
  14 C
  15 C CERN PROGLIB# Z265    UNLINKF         .VERSION KERNFOR  4.34  930114
  16 C ORIG. 20/10/92, JZ
  17 C
  18       CHARACTER    CHNAME*(*)
  19       LOGICAL      THERE
  20
  21 C--           Does the file exist?
  22
  23       INQUIRE (FILE=CHNAME,EXIST=THERE)
  24       IF (.NOT.THERE)              RETURN
  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       RETURN
  33
  34 C--           Delete the file
  35
  36    21 OPEN (LUN,FILE=CHNAME,STATUS='OLD'
  37      +,        FORM='FORMATTED', IOSTAT=ISTAT)
  38       IF (ISTAT.EQ.0)              GO TO 49
  39
  40       OPEN (LUN,FILE=CHNAME,STATUS='OLD'
  41      +,        FORM='UNFORMATTED', IOSTAT=ISTAT)
  42       IF (ISTAT.EQ.0)              GO TO 49
  43       CLOSE (LUN)
  44       RETURN
  45
  46    49 CLOSE (LUN, STATUS='DELETE')
  47       RETURN
  48       END
  49 #endif