C**** FDELETE.S    DELETE records form dataFile     98/08/13
C****
C**** Compile: FCE90 FDELETE.S
C****
      PARAMETER (NRDIM=12*220+1, NBDIM=80+720*360*4)
      CHARACTER FILEIN*80,FILOUT*80,FILTEM*20, COMMAN*180, DATA*1
      LOGICAL*4 USEN(NRDIM)
      COMMON /DATACB/ DATA(NBDIM)
      DATA USEN /NRDIM*.TRUE./
C****
      NARGS = IARGC()
      IF(NARGS.lt.3)  GO TO 800
C****
C**** Determine number of REAL*4 words to be read in for each record
C****
      CALL GETARG (1,FILEIN)
      OPEN  (1,FILE=FILEIN,ACCESS='DIRECT',RECL=4,STATUS='OLD',ERR=810)
      READ  (1,REC=1) NBYTES
      CLOSE (1)
      IF(NBYTES.gt.NBDIM)  GO TO 820
C****
C**** Determine records to be deleted
C****
      DO 130 K=3,NARGS
      CALL GETARG (K,FILEIN)
      MINUS = INDEX (FILEIN,'-')
      IF(MINUS.gt.0)  GO TO 110
C**** Single number received
      READ (FILEIN,*,IOSTAT=IOSQ) N
      IF(IOSQ.ne.0 .or. N.le.0 .or. N.gt.NRDIM)  GO TO 830
      USEN(N) = .FALSE.
      GO TO 130
C**** Minimum and maximum numbers received, separated by minus sign
  110 READ (FILEIN(1:MINUS-1),*,IOSTAT=IOSQ) N1
      IF(IOSQ.ne.0 .or. N1.le.0 .or. N1.gt.NRDIM)  GO TO 830
      READ (FILEIN(MINUS+1:80),*,IOSTAT=IOSQ) NM
      IF(IOSQ.ne.0 .or. NM.le.N1 .or. NM.gt.NRDIM)  GO TO 830
      DO 120 N=N1,NM
  120 USEN(N) = .FALSE.
  130 continue
C****
C**** Loop to read in each record of input datafile, but write out only
C**** those records which have not been deleted.
C****
      CALL GETARG (1,FILEIN)
      FILTEM = 'FDELETE.TEMPORARY'
      OPEN (1,FILE=FILEIN,FORM='UNFORMATTED',STATUS='OLD',ERR=810)
      OPEN (2,FILE=FILTEM,FORM='UNFORMATTED')
C****
      NOUT = 0
      DO 220 NIN=1,NRDIM
      IF(USEN(NIN))  GO TO 210
C**** N-th record will not be used
      READ (1,END=230)
      GO TO 220
C**** N-th record will be used
  210 READ  (1,END=230) (DATA(N),N=1,NBYTES)
      WRITE (2)         (DATA(N),N=1,NBYTES)
      NOUT = NOUT+1
  220 continue
      WRITE (0,*) 'From FDELETE: number of records in input file ',
     *            'exceeds internal dimension  NRDIM =',NRDIM
  230 NINM = NIN-1
      WRITE (0,*) 'From FDELETE: number of records read in:',NINM
      WRITE (0,*) '              number of records written:',NOUT
      CLOSE (1)
      CLOSE (2)
C****
C**** Rename output datafile
C****
      CALL GETARG (2,FILOUT)
      IF(FILOUT(1:1).eq.'+')  FILOUT = FILEIN
      COMMAN = 'mv ' // FILTEM // ' ' // FILOUT
      CALL SYSTEM (COMMAN)
      WRITE (0,*) 'From FDELETE: file created = ',FILOUT
      GO TO 999
C****
  800 WRITE (0,*) 'Usage: FDELETE filx +    n1-n2 n3..   ',
     *            'DELETE records from filx        98/08/13'
      WRITE (0,*) '   or: FDELETE filx fily n1-n2 n3..   ',
     *            'copy filx to fily except DELETEd records'
      GO TO 999
  810 WRITE (0,*) 'Unable to access: ',FILEIN
      GO TO 999
  820 WRITE (0,*) 'Record length exceeds internal dimension  NBDIM =',
     *            NBDIM
      GO TO 999
  830 WRITE (0,*) K,'-th argument is not an integer within range.'
      WRITE (0,*) 'Desired record number may exceed internal dimension',
     *            '  NRDIM =',NRDIM
  999 END