SUBROUTINE PARSE (FILESPEC,FIELD,OUTSPEC,LENGTH)
      CHARACTER FILESPEC*(*),FIELD*(*),OUTSPEC*(*)

      IF (FIELD.EQ.'DEVICE') THEN

        NC1 = 1
        NC2 = INDEX(filespec,':')
        OUTSPEC = FILESPEC(NC1:NC2)
        LENGTH = NC2 - NC1 + 1

      ELSE IF (FIELD.EQ.'DIRECTORY') THEN

        NC1 = index(filespec,'[')
        NC2 = index(filespec,']')
        OUTSPEC = FILESPEC(NC1:NC2)
        LENGTH = NC2 - NC1 + 1

      ELSE IF (FIELD.EQ.'NAME') THEN

        NC1 = index(filespec,']')
        NC2 = index(filespec,'.')
        OUTSPEC = FILESPEC(NC1+1:NC2-1)
        LENGTH = NC2 - NC1 - 1

      ELSE IF (FIELD.EQ.'TYPE') THEN

        NC1 = index(filespec,'.')
        NC2 = index(filespec,';')
        OUTSPEC = FILESPEC(NC1:NC2-1)
        LENGTH = NC2 - NC1

      ELSE IF (FIELD.EQ.'VERSION') THEN

        NC1 = index(filespec,';')
        NC2 = index(filespec,' ')
        OUTSPEC = FILESPEC(NC1+1:NC2-1)
        LENGTH = NC2 - NC1 - 1

      ELSE

        OUTSPEC = 'INVALID FILE SPECIFICATION'
        LENGTH = 26

      END IF

      RETURN
      END
      

      subroutine str_trim(nl,str,nch)
      character*(*) str
      
      nch = nl
      do while (str(nch:nch).eq.' '.and.nch.gt.0)
        nch = nch - 1
      end do
      
      return
      end    
        

        SUBROUTINE OPEN_FILE(NUNIT,FSTAT,FNME,ASK,PROMPT)
        INTEGER NUNIT
        CHARACTER*(*) FSTAT,FNME,PROMPT
        CHARACTER*1 ANS
        LOGICAL ASK, MORE

        MORE = .TRUE.

        DO WHILE (MORE)
          IF (ASK) THEN
           WRITE(*,'(T25,A,$)') PROMPT
            READ(*,'(A)') FNME
          END IF
          
          NCH=1
          DO WHILE (FNME(NCH:NCH).NE.' ')
            NCH = NCH + 1
          END DO
          NCH = NCH - 1

          IF (FSTAT.EQ.'IN'.OR.FSTAT.EQ.'in') THEN
            OPEN (NUNIT,IOSTAT=IERR,FILE=FNME,STATUS='OLD')
            IF (IERR.EQ.0) THEN
              MORE=.FALSE.
            ELSE
              WRITE(*,*)'*** ',FNME(1:NCH),' DOES NOT EXIST***'
            END IF

          ELSE IF(FSTAT.EQ.'OUT'.OR.FSTAT.EQ.'out') THEN
            OPEN (NUNIT,IOSTAT=IERR,FILE=FNME,STATUS='NEW')
            IF (IERR.EQ.0) THEN
              MORE=.FALSE.
            ELSE
              WRITE(*,*)'***',FNME(1:NCH),' ALREADY EXISTS***'
              WRITE(*,'(T25,''DO YOU WANT TO OVERWRITE? '',$)')
              READ(*,'(A)') ANS
              IF (ANS.EQ.'Y'.OR.ANS.EQ.'y') THEN
                OPEN(NUNIT,FILE=FNME,STATUS='OLD')
                CLOSE(NUNIT,STATUS='DELETE')
                OPEN(NUNIT,FILE=FNME,STATUS='NEW')
                MORE = .FALSE.
              ELSE
                WRITE(*,'(T25,''New file name: '',$)')
                READ(*,'(A)') FNME
              END IF
            END IF
          END IF

       END DO

       RETURN
       END

*23456789012345678901234567890123456789012345678901234567890123456789012
        SUBROUTINE IOFILE(NUNIT,FSTAT,DNME,DASK,DPROM,FNME,ASK,PROM)
        INTEGER NUNIT
        CHARACTER*(*) FSTAT,FNME,PROM,DPROM,DNME
        CHARACTER*40 TNME
        CHARACTER*1 ANS
        LOGICAL ASK, MORE, DASK, TASK

        IF (DASK) THEN
          LP = LEN(DPROM)
          LD = LEN(DNME)
          WRITE(*,'(T25,A,A,A,A,$)') DPROM(1:LP),'[',DNME(1:LD),']: '
          READ(*,'(A)') TNME
          IF (TNME.EQ.' ') THEN
            FNME = DNME
          ELSE
            FNME = TNME
          END IF
        END IF
        
        MORE = .TRUE.
        TASK = ASK

        DO WHILE (MORE)
          IF (TASK) THEN
           WRITE(*,'(T25,A,$)') PROM
            READ(*,'(A)') FNME
          END IF
          
          NCH=1
          DO WHILE (FNME(NCH:NCH).NE.' ')
            NCH = NCH + 1
          END DO
          NCH = NCH - 1

          IF (FSTAT.EQ.'IN'.or.fstat.eq.'in') THEN
            OPEN (NUNIT,iostat=ierr,FILE=FNME,STATUS='OLD')
            if (ierr.eq.0) then
              more=.false.
            else
              WRITE(*,*)'***',FNME(1:NCH),' DOES NOT EXIST***'
              if (.not.ask) task = .true.
            end if

          ELSE IF(FSTAT.EQ.'OUT'.or.fstat.eq.'out') THEN
            OPEN (NUNIT,iostat=ierr,FILE=FNME,STATUS='NEW')
            if (ierr.eq.0) then
              more=.false.
            else
              WRITE(*,*)'***',FNME(1:NCH),' ALREADY EXISTS***'
              write(*,'(''       Do you want to OVERWRITE? '',$)')
              read(*,'(a)') ans
              if (ans.eq.'y'.or.ans.eq.'Y') then
                open(nunit,file=fnme,status='old')
                close(nunit,status='delete')
                open(nunit,file=fnme,status='new')
                more = .false.
              else         
                WRITE(*,'(T25,''New file name: '',$)')
                READ(*,'(A)') FNME
              end if
            end if

          ELSE
            OPEN(NUNIT,iostat=ierr,STATUS='SCRATCH')
            if (ierr.eq.0) then
              more=.false.
            else
              WRITE(*,*)'***SCRATCH FILE ALREADY EXISTS***'
              write(*,'(''       Do you want to OVERWRITE? '',$)')
              read(*,'(a)') ans
              if (ans.eq.'y'.or.ans.eq.'Y') then
                open(nunit,file=fnme,status='old')
                close(nunit,status='delete')
                open(nunit,file=fnme,status='new')
                more = .false.
              end if
            end if

          END IF

       end do

       return
       END

        LOGICAL FUNCTION YES(QUESTION)

*  Prompts question on 'stdout', checks for valid answer on 'stdin'
*  Returns true if answer valid and affirmative. Else false.

        CHARACTER QUESTION*(*),LETTER*1
        LOGICAL MORE

        MORE = .TRUE.
        DO WHILE (MORE)

          WRITE(*,'(T25,A,'' [Y/N] '',$)') QUESTION
          READ (*,'(A)') LETTER
          IF (LETTER.EQ.'Y'.OR.LETTER.EQ.'y') THEN
            YES = .TRUE.
            MORE = .FALSE.
          ELSE IF (LETTER.EQ.'N'.OR.LETTER.EQ.'n') THEN
            YES = .FALSE.
            MORE = .FALSE.
          ELSE
            WRITE(*,'('' **** INVALID ANSWER **** '')')
          END IF
        END DO

        RETURN
        END