      subroutine ERASE
      include 'SIZE.INC'
      include 'INPAR.INC'
      include 'UNITS.INC'
      real RESULT
      integer CC,INUNIT,WHICH,IREC,II,NUSED,J,I,IMBED,EOF
      character CBUFF(VARCEC)*1, REQFMT*50
      data REQFMT
     &/'(1X,''Please enter the Store Access Password-> ''  )'/
      INUNIT = TTYIN(MACHNO)
      call DECOD1 (3,WHICH,CC,RESULT)
      if (CC.gt.1) go to 140
      IREC = ifix(RESULT)
      call DECOD2 (IREC,CC,WHICH,II,CBUFF)
      if (CC.eq.3) go to 140
      read (RANUNT(MACHNO),rec=II) CBUFF
      NUSED = 50
      do 100 J = 1, 6
         WPASS(WHICH)(J:J) = CBUFF(NUSED+2)
         NUSED = NUSED+2
100   continue
      if (WPASS(WHICH).eq.'GLOBAL') go to 110
      write (TTYOUT(MACHNO),5000)
5000  format (' This entry is protected from unauthorized erasure.')
      REQFMT(48:49) = CRSTOP(MACHNO)
      write (TTYOUT(MACHNO),REQFMT)
      call INREC (EOF,INUNIT,INPUT)
      if (EOF.eq.1) then
         write (TTYOUT(MACHNO),5010)
5010     format (' End-of-file while reading password; ERASE aborted.')
         go to 140
      endif
      START = IMBED(INPUT,0)
      if (START.eq.-999) then
         write (TTYOUT(MACHNO),5020)
5020     format (' ERASE command cancelled.')
         go to 140
      endif
      if (INPUT(START:START+5).eq.WPASS(WHICH).or.INPUT(START:START+5)
     &   .eq.SYSPAS) go to 110
      write (TTYOUT(MACHNO),5030)
5030  format (' Password does not match.  Please check your records;'/' 
     &The ERASure has been cancelled.')
      go to 140
110   continue
      RPASS(WHICH) = 'GLOBAL'
      WPASS(WHICH) = 'GLOBAL'
      do 120 I = 1, 50
         CBUFF(I) = ' '
120   continue
      NUSED = 50
      do 130 I = 1, 6
         CBUFF(NUSED+1) = RPASS(WHICH)(I:I)
         CBUFF(NUSED+2) = WPASS(WHICH)(I:I)
         NUSED = NUSED+2
130   continue
      write (RANUNT(MACHNO),rec=II) CBUFF
      if (WHICH.eq.1) write (TTYOUT(MACHNO),5040) IREC
5040  format (/1X,'Chemical ',I5,' erased.')
      if (WHICH.eq.2) write (TTYOUT(MACHNO),5050) IREC
5050  format (/1X,'Environment ',I5,' erased.')
      if (WHICH.eq.3) write (TTYOUT(MACHNO),5060) IREC
5060  format (/1X,'Load ',I5,' erased.')
      if (WHICH.eq.4) write (TTYOUT(MACHNO),5070) IREC
5070  format (/1X,'Product ',I5,' erased.')
      write (TTYOUT(MACHNO),5080)
5080  format (' Password protections for this entry have been removed.')
      go to 140
140   continue
      return
      end
