c=======================================================================
c
c   PROGRAM FILE:  FORTCK.FOR
c
c   DATE:  August 17, 1990
c
c   VERSION:  4.05                      REVISION DATE: July 1, 1991
c
c   AUTHOR:  Scott D. Heavner 
c
c   LANGUAGE: MicroSoft FORTRAN 4.01
c
c   COPYRIGHT:  1991, Scott D. Heavner
c
c=======================================================================
c
c   DESCRIPTION:  FORTCK will check a program for anything that is not a
c                 FORTRAN readable character (ASCII [32 - 126] + CR/LF).
c                           !"#$%&'()*+,-./0123456789:;<=>?@
c                           ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`
c                           abcdefghijklmnopqrstuvwxyz{|}~   and SPACE
c                 It is designed to indicate embedded control 
c                 characters and also to detect a broken
c                 carriage return/line feed sequence, which my editor
c                 occasionally slips in.
c
c  COMMAND LINE OPTIONS: (none are case sensitive and they may
c                         begin with '-' or '/'):
c        /s###  : Skip ASCII value
c                 Where ### is a number corresponding to an ASCII character
c                 code.  The number may be up to 3 characters long.  If the
c                 last character is an 'H' then the number is assumed to be
c                 hexadecimal.  If more than one number is specified, they
c                 must be 3 characters long (the leading zeroes must be 
c                 entered).  If you only include one number, it may be from
c                 one to three characters.  This option may be called
c                 repeatedly.
c                 If the character specified is in the "legal" range of this
c                 program (SPACE to ~), the character is marked as bad and
c                 any occurrences of the character are displayed.  If a CR
c                 is specified, the CR/LF sequence check is not completed.
c       /a$     : Skip ASCII character
c                 Where $ is an ASCII character.  The characters are typed
c                 directly you may include up to MAXSKIP characters.  This
c                 option may be called repeatedly.
c                 This option may also be used to mark bad characters bad.
c       /f      : Fix on (+)
c                 The program will delete any bad characters (and fix
c                 any broken CR/LF sequence).  This is done in the file:
c                 FIXED.TXT, your original file is left intact.
c       /? /h   : Print help summary screen
c
c   CONTENTS:    Fortck - Main program
c                call INICOM(ffile, cfile, iskip, maxskip, skip, ichk, chk,
c                            fchk, fix, fcr)
c                       - Initializes flags/options from command line
c
c
c   APPRECIATION:  If you find this program instructive or helpful, a 
c                small (or large) donation would be greatly appreciated.
c
c                Send them to:    Scott Heavner
c                                 19 Pine Woods Drive
c                                 North Tonawanda, NY 14120
c
c   COMMENTS:   Send EMAIL to sdh@po.cwru.edu
c
c=======================================================================
      Program fortck
c
      integer      maxskip, chkfil, fixfil
      parameter    (maxskip = 10)
      parameter    (chkfile = 10)
      parameter    (fixfile = 11)
c
      integer      icount, i, iskip, ichk
      character*1  skip(maxskip), chk(maxskip)
      character*50 cfile
      logical      ffile, fix, fcr, fchk
c
      integer      inp
      character*1  cinp
      equivalence  (cinp, inp)
c
      data cfile / '                                                  '/
c
c   Check Command Line for options
c
      call INICOM(ffile, cfile, iskip, maxskip, skip, ichk, chk,
     +                  fchk, fix, fcr)
c
c   Check if filename given, if not then prompt user
c
      if (.NOT.ffile) then
          write(*,*) 'File name may also be entered as a command line ',
     +               'option . . .'
          write(*,*)
          write(*,*) 'Enter filename to be checked  (Include .FOR)'
100       format(A)
          read(*,100) cfile
        endif
c
c  Open file
c
101   format (1X,'Checking File: ',A)
      write(*,101) cfile
      write(*,*)
      open (unit=chkfile, file=cfile, form='BINARY',
     +      status='OLD', err=98)
      if (fix) open (unit=fixfile, file='FIXED.TXT',
     +      form='BINARY', err=98)
c
c  Checking loop
c
10    read(chkfile,END=99) cinp
      icount = icount + 1
20    if ((inp.GT.126).OR.(inp.LT.32)) then
          if (fcr.AND.(inp.EQ.13)) then
              icount = icount + 1
              if (fix) write(fixfile) char(13), char(10)
              read (chkfile,END=99) cinp
              if (inp.NE.10) then
103               format(' CR/LF not in sequence : Position =',I10)
                  write(*,103) icount
                  goto 20
                else
                  goto 10
                endif
            endif
c
c         Check if should skip character
c
          i = 0
30        i = i + 1
          if (cinp.EQ.skip(i)) then 
              if (fix) write(fixfile) cinp
              goto 10
            endif
          if (i.LT.iskip) goto 30
104       format (' Char(',I3,') at position',I10)
          write(*,104) inp, icount
        else
c
c         Check for characters marked bad
c
          if (fchk) then
              i = 0
40            i = i + 1
              if (cinp.EQ.chk(i)) then
                  write(*,104) inp, icount
                  goto 10
                endif
              if (i.LT.ichk) goto 40
            endif
          if (fix) write(fixfile) cinp
        endif
      goto 10
c
c  Exit program
c
99    close (chkfile)
      if (fix) close (fixfile)
      stop ''
98    stop 'Cannot open file.'      
      end
c----------------------------------------------------------------------
      Subroutine INICOM(ffile, cfile, iskip, maxskip, skip, ichk, chk,
     +                  fchk, fix, fcr)
c----------------------------------------------------------------------
      logical       ffile, fchk, fix, fcr
      integer       iskip, maxskip, ichk
      character*1   cfile(50), skip(*), chk(*)
c      
      integer       i, ii, j, k, kk, length, num
      character*1   c, s, ch, cnum(3)
      character*128 CIN
c      
100   format (1x,
     +'FORTCK  -- A Textfile check/fix program                    ')
101   format (1x,
     +'           Copyright 1991,  Scott D. Heavner               ')
102   format (1x,
     +'Options -- Toggle with +/- (shown are defaults)            ')     
103   format (1x,
     +'         /a@@@@@@@@ = Skip over ASCII characters (@= char) ')
104   format (1x,
     +'         /s###      = Skip over ASCII values  (# = number) ')
105   format (1x,
     +'         /f-        = Set Fix Flag               (+ = Fix) ')
106   format (1x,
     +'         /h or /?   = Print this Screen                    ')
107   format (1x,
     +'If you appreciate this program, a monetary donation is the ')
108   format (1x,
     +'best way to show appreciation to a poor college student.   ')     
109   format (1x,
     +'Mail any amount to Scott Heavner, 19 Pine Woods Drive,     ')
110   format (1x,
     +'North Tonawanda, NY 14120                                  ')
c
c  Initialize variables
c
      iskip = 0
      ichk = 0
      fchk  = .FALSE.
      ffile = .FALSE.
      fix   = .FALSE.
      fcr   = .TRUE.
      do 900 j = 1, maxskip
         skip(j) = ' '
         chk(j)  = ' ' 
900      continue
c
c  Get Command line string + check length
c
      call cline(CIN)
      length = ICHAR(CIN(1:1)) + 1
      if (length.EQ.1) return
      i = 1
c
c  Loop to check string for desired input
c
910   i = i + 1
      if (i.LE.length) then
         c = CIN(i:i)
         if (c.EQ.' ') goto 910
         if (c.EQ.char(13)) goto 999
c
c          Check for Dash/minus character
c        
         if ((c.EQ.'-').OR.(c.EQ.'/')) then
            i = i + 1
            if (i.GT.length) goto 999
            c = CIN(i:i)
c
c           Check Characters after dash
c
c                     Check for characters to skip or mark as bad
c
c                     Checks for ASCII characters
c
            if ((c.EQ.'a').OR.(c.EQ.'A')) then
                j = i
930             j = j + 1
                if ((j.LE.length)) then
                    s = CIN(j:j)
                    if ((s.EQ.' ').OR.(s.EQ.char(13))) goto 940
                    if ((s.LE.'~').AND.(s.GE.' ')) then
                        if (ichk.LT.maxskip) then
                            ichk = ichk + 1
                            chk(ichk) = s
                            fchk = .TRUE.
                          endif
                      else
                        continue
                        if (iskip.LT.maxskip) then
                            iskip = iskip + 1
                            skip(iskip) = s
                          endif
                      endif
                    goto 930
                  endif
940             i = j
                if (s.EQ.char(13)) goto 999
c
c                    Checks for ASCII values in hex or decimal
c
              elseif ((c.EQ.'s').OR.(c.EQ.'S')) then
                j = i + 1
c
c                    Copy number into string CNUM (up to 3 chars)
c
949             k = 0
                num = 0
950             if ((j.LE.length).AND.(k.LT.3)) then
                    s = CIN(j:j)
                    if ((s.EQ.' ').OR.(s.EQ.char(13))) goto 960
                    k = k + 1
                    j = j + 1
                    cnum(k) = s
                    goto 950
                  endif
960             i = j
                if (k.EQ.0) goto 963
c
c                    Convert Hex number
c
                if ((cnum(k).EQ.'h').OR.(cnum(k).EQ.'H')) then
                   k = k - 1
                   do 961 kk = 1, k
                      ch = cnum(kk)
                      if ((ch.GE.'A').AND.(ch.LE.'F')) then
                          num =num+(ichar(ch)-ichar('A')+10)*16**(k-kk)
                        elseif ((ch.GE.'a').AND.(ch.LE.'f')) then
                          num =num+(ichar(ch)-ichar('a')+10)*16**(k-kk)
                        elseif ((ch.GE.'0').AND.(ch.LE.'9')) then
                          num = num + (ichar(ch)-ichar('0'))*16**(k-kk)
                        endif
961                   continue
c
c                     Convert decimal number
c
                  else
                   do 962 kk = 1, k
                      num = num+(ichar(cnum(kk))-ichar('0'))*10**(k-kk)
962                   continue
                  endif
c
c                    Convert number to character and store in skip array
c
                if ((k.GT.0).AND.(num.GE.0).AND.(num.LE.255)) then
                    if (num.EQ.13) fcr = .FALSE.
                    if ((num.LE.126).AND.(num.GE.32)) then
                        if (ichk.LT.maxskip) then
                            ichk = ichk + 1
                            chk(ichk) = s
                            fchk = .TRUE.
                          endif
                      else
                        continue
                        if (iskip.LT.maxskip) then
                            iskip = iskip + 1
                            skip(iskip) = char(num)
                          endif
                      endif
                  endif
c
c                    Check return conditions
c
963             if (s.EQ.char(13)) goto 999
                if (j.GE.length) goto 999
                if (s.NE.' ') goto 949
c
c                Set Fix flag
c
              elseif ((c.EQ.'f').OR.(c.EQ.'F')) then
                j = i
                j = j + 1
                s = CIN(j:j)
                if (s.EQ.'+') fix = .TRUE.
                if (s.EQ.'-') fix = .FALSE.
                if ((s.EQ.char(13)).OR.(s.EQ.' ')) then
                    fix = .TRUE.
                  else
                    i = j
                  endif
c 
c                Show help screen
c
              elseif ((c.EQ.'H').OR.(c.EQ.'?').OR.(c.EQ.'h')) then
                write(*,100)
                write(*,101)
                write(*,*)
                write(*,102)
                write(*,103)
                write(*,104)
                write(*,105)
                write(*,106)
                write(*,*)
                write(*,107)
                write(*,108)
                write(*,109)
                write(*,110)
                write(*,*)
                stop 'EMAIL any comments to sdh@po.cwru.edu'
              endif
c
c                If not /- assume it's the filename (store in CFILE)
c
           else
             if (.NOT.ffile) then
                 ffile = .TRUE.
                 j = i
                 k = 1
970              if ((j.LE.length).AND.(k.LE.50)) then
                     s = CIN(j:j)
                     if ((s.EQ.' ').OR.(s.EQ.char(13))) then
                         if (k.EQ.1) ffile = .FALSE.
                         goto 980
                       endif
                     cfile(k) = s
                     j = j + 1
                     k = k + 1
                     goto 970
                   endif
980              i = j
                 if (s.EQ.char(13)) goto 999
               endif
           endif
          goto 910
        endif
999   return
      end
