C***********************************************************
C             DELETE - TO DELETE RECORDS
C***********************************************************
C
C
C
      SUBROUTINE DELETE
      COMMON INBUF(2048),IOUTBUF(8192),IWRK1(20),IWRK2(20),IFNAME1(3)
      COMMON ICMND,IFLAG1,IORG,INUM,IFORMT(20),IFLAG2
      IFLG=0
      IF(IORG.EQ.999) CALL ERROR(6); RETURN
      GO TO (10,40,50,60), IORG
10    OUTPUT '*CONSECUTIVE DELETE*'
      CALL OPENF(3,'SCRATCH ',3,0,0,1,1,7,0,0,0)
      CALL ERRSET2(IERR,9S,9S,IDCB)
      CALL OWNBRK(998S)
      GO TO 14
13    OUTPUT ' '
14    OUTPUT 'RECORD NO.:  '
      INPUT INUM
      REWIND 1
      REWIND 3
      IF(INUM.EQ.1) GO TO 18
      DO 15 I=1,INUM-1
      CALL GETR(1,INBUF,2048)
      CALL GETSIZ2(1,ISIZ)
      CALL PUTR(3,INBUF,-ISIZ)
15    CONTINUE
18    CALL GETR(1,INBUF,2048)
16    CALL GETSIZ2(1,ISIZ)
      ITKNT=0
      DO 21 J=1,ISIZ
      CALL CHRTYP(INBUF,J,ITYP,IVAL)
      IF(ITYP.EQ.5) ITKNT=ITKNT+1
21    CONTINUE
      IF(ISIZ.LE.70) IDLN=ISIZ
      IF(ISIZ.LE.35) IDLNX=ISIZ*2
      IF(ISIZ.GT.35) IDLNX=72
      IF(ISIZ.GT.70) IDLN=70
      IF(ITKNT.GT.3) GO TO 17
      CALL SOUT(' ',1)
      CALL SOUT(INBUF,IDLN)
      OUTPUT ' '
      WRITE(108,33) ISIZ
      GO TO 22
09    CALL ERROR(8)
      GO TO 14
17    ENCODE(IDLNX,20,IOUTBUF,NC)  INBUF
20    FORMAT(2048Z8)
      OUTPUT 'IN HEX - '
      CALL SOUT(' ',1)
      CALL SOUT(IOUTBUF,ISIZ*2)
      OUTPUT ' '
      WRITE(108,33) ISIZ
33    FORMAT(1X,'RECORD SIZE (BYTES) = ',I4)
22    IF(IFLG.EQ.1) GO TO 46
30    CALL ERRSET2(IERR,999S,999S,IDCB)
32    CALL GETR(1,INBUF,2048)
      CALL GETSIZ2(1,ISIZ)
      CALL PUTR(3,INBUF,-ISIZ)
      GO TO 32
999   ENDFILE 3
997   REWIND 3
      REWIND 1
      CALL OWNBRK(997S)
      CALL ERRSET2(IERR,9999S,9999S,IDCB)
      IRECS=0
34    CALL GETR(3,INBUF,2048)
      CALL GETSIZ2(3,ISIZ)
      CALL PUTR(1,INBUF,-ISIZ)
      IRECS=IRECS+1
      GO TO 34
9999  WRITE(108,36) IRECS
36    FORMAT(6X,'NEW FILE =',I6,' RECORDS')
37    REWIND 1
      OUTPUT ' '
998   CALL CLOSEF(3,1)
      RETURN
40    OUTPUT '*KEYED DELETE*'
      GO TO 42
41    OUTPUT ' '
42    CALL GETAKEY(IERR,IKLN,ISIZ)
      IF(IERR.EQ.1) GO TO 42
45    IFLG=1
      GO TO 16
46    CALL QUESTAR(' OK TO DELETE   ',16,47S,41S)
47    CALL DELREC(1,IWRK2,IKLN)
      OUTPUT '*EXPUNCTION COMPLETE*'
      RETURN
50    OUTPUT '*NOT VALID FOR RANDOM FILES*'
      RETURN
60    OUTPUT '*NOT VALID FOR INDEXED RANDOM FILES*'
      RETURN
      END
