!known bug: tabs are not being found with the ZZ option
!
!
!CoNVert a file to some other form.  COMMAND SYNTAX:
!
!cnv [-u -l -kc -K<x> -tc -Xc -ki -mi -ri<n> -B<x> -n -%x -eI -em -mI 
!                     -s -v? -v?p -V? -Xb -zz -a77] infile [outfile]
!
!infile = input file to be converted (required input)
!outfile = output file (default: infile.cnv) -- outfile must come AFTER infile.
!
!OPTIONS:
!
!-a77  convert to ansi standard 77. This is equivalent to running with the
!      options -u -nl -ri -B\* -K\* -%\$
!
!-A<string> Append <string> at the end of the line (line length defined by
!      the -<n> option.
!
!-B<x> Insert user-specified character <x> into column 1 of blank lines,
!      (for example, -Bc will put a "c" in column 1 of all blank lines)
!
!-eI   Empty include blocks. If "*-" is found, subsequent lines will be removed
!      until another *- is found (aborts if includes improperly arranged).
!
!-EM   Convert email list of the form Joe Blow <joe@blow.com> to
!      the gobag-style form  joe@blow.com ! Joe Blow
!
!-em   Convert email list of the form Joe Blow <joe@blow.com> to
!      the To-style form  joe@blow.com; 
!
!-h    Help: show a brief reminder of cnv options. (To get DETAILED help,
!      execute cnv with no arguments at all.
!
!-ib   show if-block level
!
!-kc   Keep comments unconverted [default]
!
!-ki   Keep in-line comments. [default]
!
!-K<x> Keep comments unconverted, but start them with user-specified character
!      <x>.  For example, -KC will start all comments with "C" and -K\* will 
!      start all comments with "*" (the back slash is needed to escape the 
!      shell meaning of the asterisk).
!
!-l   Translate upper to lower case         (default = no case conversion)
!      Alternatives: -L and -Aa will do the same thing as -l
!
!-mi   Move in-line comments to preceed the line they were originally in.
!
!-mI   Make an include file: First include encountered has priority.
!
!-nl   Name limit. Replace long variable names by names 6 or fewer characters.
!      (-nl8 will use 8 characters.  In general, -nl<n>). 
!      At present, this option merely alerts you to invalid variable names.
!
!-<n>  Limit line length to n characters, where <n> is an integer
!      [DEFAULT: n=400, use -80 for nicer screen output]
!      (for example, -72 will truncate lines to no more than 72 characters, as
!      would be useful if the listing contains annotations beyond column 72)
!
!-ri   Remove in-line comments altogether. (-ri<n> will remove only those
!      in-line comments that begin at or beyond column n.)
!
!-s    Silent operation
!
!-tc   Translate comments. (i.e., apply all specified options to 
!      comment lines as well as regular lines)
!
!-u   Translate lower to upper case         (default = no case conversion)
!      Alternatives: -U and -aA will do the same thing as -u
!
!-v<n> Create version <n>, where n is any single character.  This will search
!      for all lines ending in !nx, where x is any character and replace 
!      the first character with x. It will also search for any line ending in
!      !my, where m is any character different from x and y is any character; 
!      the first character of those lines will be replaced with a "C". For 
!      prettier output, append "p" to the -v<n> command (as in -v3p) and all of
!      the processing commands will be moved to the far right side of the card.
!
!-V<n> Same as -v<n> except that any lines ending in -my, where m is different
!      from n, will be deleted.
!
!-Xb   Remove all blanks (useful with diff). <-- makes very weird output!
!
!-Xc   Remove ALL comments (including in-line comments and include boundaries).
!
!-zz   Write output until first non-alphanumeric found.  Tabs permitted.
!      The last line output will be the "bad" line.
!
!-ZZ   Write output until first non-alphanumeric found.  Tabs NOT permitted.
!
!-%<x> Change continuation characters (located in column 6 of non-comment lines)
!      to the character <x>.  If the character x is a shell character, preceed 
!      it with a back slash (\); for example: -%\& will make all continuation
!      characters ampersands.
!
! NOTE: Executing cnv using no options will do nothing to the file EXCEPT
!       remove trailing blanks and (if applicable) remove the ^M character
!       from files imported from Microsoft Windows. Sometimes this
!       removal of ^M characters will not work. In that case, you can
!       used the unix command "dos2unix <filename>".
c---.----1----.----2----.----3----.----4----.----5----.----6----.----7--
c COMPILE STATEMENT:
c f77 -o cnv cnv.f

      program getEmail
c     Currently, this is identical to the "cnv" program
c     Eventually, I want to modify this to process text files that contain
c     names and emails in the format
c        Joe Blow <joe@blow.com>
c     and convert the lines to
c        joe@blow.com !Joe Blow
      implicit none
      character Myself*80
      integer mxlen,NumberOfCommentCharacters,MaxUniqInc
      character*1 TIC,DTIC,SP,bang
      parameter (
     &          TIC='''',    ! single quote
     &          DTIC='"',    ! double quote
     &          SP=' ',      ! space
     &          bang = '!'   ! in-line comment
     &          )
      parameter (
     &          mxlen=400,
     &          NumberOfCommentCharacters = 6,
     &          MaxUniqInc = 1000
     &          )
      character*1 pound/'#'/
      character*1 CommentCharacter(NumberOfCommentCharacters)
     &            /'C','c','*','$','!','#'/

      integer iargc, number_of_arguments
      character*60 argv
      character*80 infile/'iNpUt_FiLe'/, outfile
      character JNKstr*90
      character*15 INCnam(MaxUniqInc), LASTincNAM
      character*20 str
      character*80 blank/'               '/,jnkblank/'               '/

      integer i,Ncard,Ncomnt,riPOSN/0/,indx,index,KNTinc,ichr,
     &    shift,aLpHa,ZeTa,II,length,lengthFORT,BangLocation,
     &    maxln/mxlen/,poundLocation,i1,i2,
     &    NumUniqInc/0/,KNTcard/0/,LincNam,LASTincPOSN/0/,idum,iflag,
     &    nLIM/6/,ierr,lenAs,k,vpknt,maxcard,ka,kAx
      parameter (ka=97,kAx=65) ! ASCII codes for 'a' and 'A'
      parameter (maxcard=2000)
      integer vpp(maxcard)
      integer lnblnk
      character*2 option
      integer levelib

      character*(mxlen) card
      character*1 chr(mxlen)
      equivalence (card,chr)

      character*1 Bchr/SP/, Cchr/SP/, CONTchr/SP/, vnCHR/SP/
      character*5 Astring
      character*72 form11,form22
      logical
     &   aA /.false./,   Aax /.false./,   vn /.false./,   Vnx /.false./,
     &   kc /.true./ ,   Kx /.false./,   tc /.false./,   Xc /.false./,
     &   ki /.true./ ,   mi /.false./,   ri /.false./,   eI /.false./,
     &   nl /.false./,   As /.false./, zzbgs/.false./, ib /.false./,
     &   mIx /.false./, Xb /.false./, scan /.false./, Bx/.false./,
     &   coment  /.false./, vnp /.false./, verbos/.true./,EM/.false./,
     &   quotes  /.false./, tabOKAY /.true./, email/.false./,
     &   squote  /.false./, dquote /.false./,
     &   INclude /.false./, prntINC /.true./,vpdata/.false./
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      Myself='cnv.f' !Do not edit this one. Edit the next Myself
      Ncard=0
      Ncomnt=0
      KNTinc=0
      shift=0
      aLpHa=0
      lenAs=0
      levelib=0

      number_of_arguments = iargc()

c If there are no arguments on the command line, print out help
      if(number_of_arguments.eq.0)then
        outfile = infile(1:lnblnk(infile))//'.cnv'
        open (3,file=Myself,status='old',err=91)
        go to 71
   91   Myself='/home/rmbrann/Fort/Apps/StandAlonePrograms/cnv.f'
        print*,'opening ',Myself
        open (3,file=Myself,status='old',err=98)
C ___________________________________________________(INFINITE LOOP)___
   71   read (3,'(81a)',end=75) JNKstr!                                \
            if(JNKstr(1:1).ne.bang) then                               !
               close(3)                                                !
               print*                                                  !
               print 1,'D E F A U L T    S E T T I N G S:'             !
               goto 75                                                 !
            else                                                       !
               print *,JNKstr(2:81)                                    !
            endif                                                      !
        GO TO 71!______________________________________________________/
      end if

      do II=1,number_of_arguments
        call getarg(II,argv)

        IF (argv(1:1).eq.'-') THEN
c
c       THE ARGUMENT IS AN OPTION
c
          option = argv(2:3)
          if (option.eq.'aA' .or. option.eq.'U'. or. option.eq.'u') then
            aA = .true.
          else if (option.eq.'Aa'.or.option.eq.'L'.or.option.eq.'l')then
            Aax = .true.
          else if (option.eq.'kc') then
            kc = .true.                 ! default
          else if (option.eq.'kC') then
            Kx=.true.
            kc = .false.
            Cchr='C'
          else if (option(1:1).eq.'K') then
            Kx=.true.
            kc = .false.
            Cchr=option(2:2)
          else if (option.eq.'tc') then
            tc = .true.
            kc = .false.
          else if (option.eq.'Xc') then
            Xc = .true.
            kc = .false.
            ri = .true.
            ki = .false.
          else if (option.eq.'ki') then
            ki = .true.                 ! default
          else if (option.eq.'mi') then
            mi = .true.
            ki = .false.
          else if (option.eq.'ri') then
            ri = .true.
            ki = .false.
c           Read next characters as an integer
c           (This feature permits deletion of only those in-line
c           comments which begin beyond a certain point.  For example,
c           -ri72 will remove all inline comments that begin beyond
c           column 72)
            read(argv,'(T4,I4)',err=97)riPOSN
            riPOSN = riPOSN - 1
          else if (option(1:1).eq.'v') then
            vn=.true.
            vnCHR=option(2:2)
            vnp=(argv(4:4).eq.'p')
          else if (option(1:1).eq.'V') then
            Vnx=.true.
            vnCHR=option(2:2)
            vnp=(argv(4:4).eq.'p')
          else if (option(1:1).eq.'B') then
            Bx=.true.
            Bchr=option(2:2)
          else if (option(1:1).eq.'A') then
            As=.true.
            lenAs=lnblnk(argv)-2
            Astring=argv(3:lenAs+2)
          else if (option(1:1).eq.'%') then
            CONTchr=option(2:2)
          else if (option.eq.'eI') then
            eI = .true.
          else if (option.eq.'EM') then
            EM = .true.
          else if (option.eq.'em') then
            email = .true.
          else if (option.eq.'mI') then
            mIx = .true.
          else if (option.eq.'s') then
            verbos = .false.
          else if (option.eq.'Xb') then
            Xb = .true.
          else if (option.eq.'zz') then
            scan=.true.
            tabOKAY=.true.
          else if (option.eq.'ZZ') then
            scan=.true.
            tabOKAY=.false.
          else if (option.eq.'nl')then
            nl=.true.
            read(argv,'(T4,I4)',err=97)nLIM
            if(nLIM.le.0)nLIM=6
          else if (option(1:2).eq.'a7')then
c            ansi 77 standard
c            cnv -u -nl6 -ri -K\* -BC -%\$
            aA=.true.
            nl=.true.
            nLIM=6
            ri=.true.
            ki=.false.
            riPOSN=-1
            Kx=.true.
            Bx=.true.
            Bchr='*'
            Cchr='*'
            CONTchr='$'
          else if (option(1:2).eq.'ib')then
            ib=.true.
          else
c           Try to read the option as an integer:
            read(argv,'(T2,I4)',err=97)maxln
            if(maxln.gt.mxlen)then
              print*,'Sorry, the option ', argv(1:lnblnk(argv)),
     &               ' is invalid'
              print*,'Max allowable value for line length is ', mxlen
              go to 9998
            end if
          end if
        ELSE
c
c       THE ARGUMENT IS A FILE NAME
C
          if (infile.eq.'iNpUt_FiLe') then
            infile = argv
            outfile = infile(1:lnblnk(infile))//'.cnv'
          else
            outfile = argv
          end if

        END IF
      end do
      
c###############    11 format(a<maxln>)
          write(form11,*)'(a',maxln,')'
c###############    11 format(a<maxln>)
      if(verbos)print1,  '    I N P U T    S U M M A R Y :'

   75 continue
      IF(verbos)THEN ! - - - - - - - - - - - - - - - - - - - - - - - - -
          if    (vn)     print2,'Toggle to version '//vnCHR//'.'
          if    (Vnx)     print2,'CREATE FINAL VERSION '//vnCHR//'.'
          if    (vnp.and.(.not.ri))    
     &                   print2,'pretty processing alignment'
      if(aA.or.Aax)then
          if    (aA)     print2,'Convert from lower to upper case.'
          if    (Aax)     print2,'Convert from upper to lower case.'
          if (kc.or.Kx)  print2,'No case conversion for comments.'
          if    (Kx)     print2,'(Start comments with "'//Cchr//'")'
      else
                         print2,'No case conversion.'
      end if

          if    (tc)     print2,'Translate comments.'
          if    (Xc)     print2,'REMOVE ALL COMMENTS!'
          if    (ki)     print2,'Keep in-line comments in the line.'
          if    (mi)     print2,'Move in-line comments to preceed line.'
          if    (ri)     print2,'Remove in-line comments.'
          if (riPOSN.ne.0) print4,'   (at or beyond column',riPOSN+1,')'
          if (.not.Xc) then
            if (Bx) then
                print3,'Put "',Bchr,'" in col 1 of blank lines.'
            else
                print2,'Keep blank lines blank.'
            end if
          end if
          if (CONTchr.ne.SP)then
             print3,'Use "',CONTchr,'" for continuations.'
          else
             print2,'Don''t touch continuation characters.'
          end if
          if(nl)print4,'Limit variable names to ',nLIM,' characters.'
          if (EM) then
             print2,'convert a To-style email list'
          endif
          if (email) then
             print2,'convert a gobag-style email list'
          endif
          if (eI) then
             print2,'Empty out include blocks.'
          else if (mIx) then
             print2,'Make an include file.'
          else
             print2,'Retain the body of include blocks.'
          end if
          if    (Xb)     print2,'REMOVE BLANKS!'
          if    (As)     then
             JNKstr='Append lines with "'//Astring(1:lenAs)//'"'
             print2,JNKstr(1:lnblnk(JNKstr))
          end if
          if    (ib)     print2,'mark if-block levels'
          print2,'Remove trailing blanks.'
          print4,'Limit line length to ',maxln,' characters.'
          i=lnblnk(infile)
          if(i.lt.30)then
            print5,'INPUT:  ',infile(1:i)
          else
            print55,'INPUT:  ',infile(1:i)
          end if
          i=lnblnk(outfile)
          if(i.lt.30)then
            print5,'OUTPUT: ',outfile(1:i)
          else
            print55,'OUTPUT: ',outfile(1:i)
          end if
          print6
      print*
      if (number_of_arguments.eq.0) stop

    1 format(/,T12,  ' _________________________________________ '/
     &         T12,  '|  ',                A,              T54,'|'/
     &         T12,  '|  ',                                T54,'|')
    2 format(  T12,  '|  ',                A,              T54,'|')
    3 format(  T12,  '|  ',        A,      A1,     A,      T54,'|')
    4 format(  T12,  '|  ',        A,      I3,     A,      T54,'|')
    5 format(  T12,  '|  ',            A,      A,          T54,'|')
    6 format(  T12,  '|_________________________________________|')
    
   55 format(  T12,  '|  ',            A,      A                 )

      END IF ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 

      if(infile.eq.outfile)then
         if(mi.or.Xc.or.Xb.or.eI.or.mIx)then
           print*
           print*,'Sorry, output and input must be different',
     &           ' whenever mi.or.Xc.or.Xb.or.eI.or.mI'
           go to 9998
         end if
         print*
         print*,'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!'
         print*,'OUTPUT FILE HAS SAME NAME AS INPUT FILE'
         if(.NOT.verbos)then
            print*,'This causes abort in silent mode'
            go to 9998
         end if
         print*,'Do you want to continue?'
         print*,'  y[es]  (replace input file with converted file)'
         print*,'  n[o],  (abort this program)'
         read(*,*)option
         if(option(1:1).ne.'y') go to 9998
         print*,'Sorry, new Fortran compiler won''t do this right'
         go to 9998
      endif

      open(1,file=infile,status='old',err=99)
      read(1,form11,end=110)card
      rewind(1)
      if(card.eq.
     $ '>>>>>>>>>>>>>>> MODIFICATION HISTORY <<<<<<<<<<<<<<<<<')then
         vpdata=.true.
         print*
         print*,'_____________________ converting vpdata file'
         open(2,file='#junk',status='unknown')
      else
         vpdata=.false.
         open(2,file=outfile,status='unknown')
      end if

      if(verbos)print*,'Conversion takes a while for large files...'
      print*,' '
      print*,' '
      print*,' '


c Translating case is accomplished by adding an integer, called 'shift',
c to the integer equivalents of the letters that are to be changed.

      if (Aax) then
        aLpHa=kAx
        shift=ka-aLpHa
      else if (aA) then
        aLpHa=ka
        shift=kAx-aLpHa
      endif
      ZeTa=aLpHa+25

      if ( (eI.or.mIx).AND.verbos) then
        print*
        print*,'Includes that were empty to begin with (if any) are ',
     &         'listed below:'
        print*,'==================='
      end if
      
      vpknt=0
!################################################### BEGIN INFINITE LOOP
77777 read(1,form11,end=110) card
      KNTcard=KNTcard+1
      if(vpdata)then
        if(Ncard+1.gt.maxcard)then
          print*,'#############################'
          print*,'increase dimension of maxcard'
          stop
        else
         vpp(Ncard+1)=1
        end if
      end if

c.....Find card length
      length=lnblnk(card)         !length
      if(mxlen-length.lt.5)then
        print*,'################## warning: might be truncating line(s)'
      endif

C.....Look for version processing commands
      if (vpdata) then
        idum=index(card,'''')
        if (idum.gt.0)then
          vpknt=0
        else
          vpknt=vpknt+1
        end if
      end if
      if (vn.or.Vnx) then
         call vncom(vnCHR,card,idum,iflag)
         if(iflag.lt.0)then
            if(Vnx)then
               if(vpdata)then
                 if(vpknt.gt.0)then
                   if(iflag.eq.-1)then
                     do i=Ncard-vpknt+1,Ncard
                       vpp(i)=0
                     end do
                   end if
                   vpknt=0
                 end if
               end if
               go to 77777
            else
               chr(1)='C'
            end if
         end if
         if(iflag.ne.0)then
            i=length-idum
           if (vnp.and.i.gt.0)then
            k=lnblnk(card(1:idum-1))
            str=card(idum:length)
            card(idum:length)='   '

c           str contains the bang and the version string command
c           k is the length of the statement before the bang
c           i is the length of the version string (not incl. bang)
c           Thus, lnblnk(str) is equal to i+1.
c
c           Since we want AT LEAST one space between the end of
c           the statement and the beginning of the version command, 
c           the final length of the card will be AT LEAST (k+1)+(i+1).
c           If possible, we want the bang for the version command to 
c           be placed so that the version string is right justified 
c           against column 72.  Thus, we want str to start at
c           column 72-i, as long as this is at least k+2.

            k=max(72-i,k+2)
            card(k:k+i)=str
            length=lnblnk(card)
           elseif(Vnx.and.ri.and.chr(1).ne.'C'.and.chr(1).ne.'*')then
             card=card(1:idum-1)
             length=lnblnk(card)
           end if
         end if
      end if

c.....Check if card is part of an include block.........................
      if((eI.or.mIx).and. card(1:2).eq.'*-') then
         coment = .true.
         INclude = .not.INclude
         JNKstr = card
         idum=index(card,bang)
         if(idum.eq.0)idum=73
         call chng_case(card(1:idum-1),1)
         if(card.ne.JNKstr.AND.verbos.AND.(.not.(vn.or.Vnx)))print*,
     &                        'line',KNTcard,' converted to UPPER case.'
         indx = index(card(1:72),'INCLUDE')
         if(vn.or.Vnx)card=JNKstr
c     /  Verify that beginning and ending of includes alternate.   \
c     |  If INclude is true, the card should contain the string    |
c     |  'INCLUDE' (i.e., indx should be non-zero).  If it doesn't,|
c     |  there must be two or more "end-include" lines in a row.   |
c     |  this is not a fatal error, but the extra "end-includes"   |
c     \  will not be written to the output.                        /
         if(INclude .and. indx.eq.0)then
            print*,'end-include at line',KNTcard,
     &      ' removed because it has no begin-include.'
            INclude = .false.
            go to 77777
         end if
c     /  If INclude is false, the card should not contain the      \
c     |  string 'INCLUDE'  (i.e., indx should be zero).  If it     |
c     |  does, that means the preceeding include did not have      |
c     \  an "end-include" line - this is fatal.                    /
         if(.not.INclude .and. indx.ne.0) then
            print*
            print*,'                 ----- (abort) -----'
            print*,'The include ',LASTincNAM(1:LincNam),
     &      ' (line',LASTincPOSN,') has no end-of-include.'
            print*,'The output file ', outfile(1:lnblnk(outfile)),
     &              ' terminates at the offending line.'
            print*,'                 ----- (abort) -----'
            write(2,12)'ABORT!MISSING END OF INCLUDE!'
            close(1)
            close(2)
            stop
         end if
c        Count the number of lines in the body of the include.
c        The user will be alerted if an include block was already
c        empty to start out with. (This is useful to find out when
c        cmpcopy is not filling all of the includes in that it should)
         if (INclude) then
            LASTincPOSN = KNTcard
            KNTinc = 0
            call word1(card(indx+8:min(72,length)),LASTincNAM,LincNam)
            if(mIx)then
              prntINC=.false.
              do II = 1,NumUniqInc    ! check if this is a new include
               if(LASTincNAM.eq.INCnam(II))go to 77777
              end do
              prntINC=.true.
              NumUniqInc = NumUniqInc + 1
              if(NumUniqInc.gt.MaxUniqInc)then
               print*,'             ----- (abort) -----'
               print*,'  There are more includes than cnv can store.'
               print*,'      Redimension with larger MaxUniqInc.'
               print*,'             ----- (abort) -----'
               stop
              end if
              INCnam(NumUniqInc) = LASTincNAM
            else
              INCnam(1) = LASTincNAM
            end if
         else if (KNTinc.eq.0.AND.verbos) then
            print81,LASTincNAM(1:LincNam),LASTincPOSN
         end if
cxxxxxxx if(Xc)goto 77777 ! uncoment to remove incl boundaries
         if(prntINC) then
            write(2,12) card(1:length)  ! write card
            Ncard=Ncard+1
            Ncomnt=Ncomnt+1
         end if
         go to 77777 ! read next card
      end if
      
c.......................................................................

      if (INclude) then
         KNTinc = KNTinc + 1
         if(mIx .and. prntINC)go to 73
         go to 77777 ! read next card
      else
         if(mIx)go to 77777 ! read next card
         go to 73
      end if

   73 continue
c If the previous line was a comment, set quotes to .false.
      if(coment.and.(.not.tc))then
         quotes = .false.
         dquote = .false.
         squote = .false.
      endif
      coment = .false.

c     Special treatment is required if the card begins with #
c     indicating that it is a preprocessor directive. These cards
c     need to appear unchanged in the output.
      poundLocation = index(card,pound)
      if(poundLocation.gt.1)then
         jnkblank=blank
         jnkblank=card(1:poundLocation-1)
         if(jnkblank.ne.blank)poundLocation=0
      endif
      if(poundLocation.gt.0)then
        write(2,12) card(1:length) ! write the card unchanged
        Ncard=Ncard+1
        go to 77777
      endif

      BangLocation = maxln+1                               !BangLocation
      lengthFORT = lnblnk(card(1:72))

c  For now, don't translate comments unless option -tc was requested.
c  Keep in mind that card is equivalenced to chr; ie, chr(i)=card(i:i).

c-----Check if card is blank in the FORTRAN sense:
      if(lengthFORT.eq.0)then
        if (Xc) go to 77777 ! read next card
        coment=.true.
        Ncomnt=Ncomnt+1
        if(Bx) then ! put Bchr in column 1
          chr(1)=Bchr
          length = max(1,length)                                 !length
          lengthFORT = 1
        end if
        go to 78 ! write the card
      end if

c-----Check if card is a non-trivial comment
      do II=1,NumberOfCommentCharacters
         if(chr(1).eq.CommentCharacter(II))then
            if (Xc) go to 77777 ! read next card
            if (ri .and. chr(1).eq.bang .and. riPOSN.lt.0) go to 77777
            coment=.true.
            Ncomnt=Ncomnt+1
            if (.not.tc) go to 78 ! write the card
         end if
      end do
      
      if(ri.and.tc)coment=.false.
      
c   _________________________________________________________________
c  /                    LOOP OVER CHARACTERS                         \
c /                                                                   \
      do II=1,length                                                   !
                                                                       !
c scan the line for non-alphanumeric characters                        !
        if(II.eq.length.and.ICHAR(chr(II)).eq.13)then                  !
c           Note: bgs stands for "Bill Gates Sucks"                    !
            zzbgs=.true.                                               !
            length=length-1                                            !
        elseif(scan.and.(ICHAR(chr(II)).lt.32.or.ICHAR(chr(II)).gt.127)!
     &    .and.                                                        !
     &    .not.(ICHAR(chr(II)).eq.9.and.tabOKAY)                       !
     &    )then                                                        !
          if(verbos)then                                               !
          print*,'######################'                              !
          print*,'NON-ALPHANUMERIC FOUND'                              !
          print*,'######################'                              !
          ichr=ICHAR(chr(II))                                          !
          print*,'ichr(bad_chr) = ',ichr                               !
          end if                                                       !
          write(2,12)card(1:II-1)                                      !
          go to 110                                                    !
        end if                                                         !
c Detect start of an in-line comment                                   !
        if(chr(II).eq.bang .and. (.not.quotes) .and. (.not.coment))then!
           if(II.gt.riPOSN)BangLocation=II                !BangLocation!
           lengthFORT=lnblnk(card(1:BangLocation-1))                   !
           if (ri) length = lengthFORT                          !length!
           if (.not.tc) go to 78 ! write the card                      !
        endif                                                          !
                                                                       !
c Detect start or end of quoted string                                 !
c If a quote of one type is embedded within a quote of the other type  !
c then do not change the quote value. This will permit, for example,   !
c a single appostrophe to be embedded within a double-quoted string    !
c (e.g., "It's a string")                                              !
        if(.not.dquote.and.chr(II).eq.TIC                              !
     &     .and.(.not.coment).and.BangLocation.gt.maxln)               !
     &       squote = .not.squote                                      !
        if(.not.squote.and.chr(II).eq.DTIC                             !
     &     .and.(.not.coment).and.BangLocation.gt.maxln)               !
     &       dquote = .not.dquote                                      !
        quotes=(squote.or.dquote)
                                                                       !
c DECIDE IF THIS CHARACTER SHOULD BE TRANSLATED                        !
        if(             ! case conversion was requested.               !
     |  ((aA).or.(Aax))                                                !
     |  .AND.           ! character is one that gets changed.          !
     |  (ICHAR(chr(II)).ge.aLpHa .and. ICHAR(chr(II)).le.ZeTa)         !
     |  .AND.           ! character is not in a quoted string.         !
     |  .not.quotes                                                    !
     |  .AND.           ! character lies in columns 1 to 72            !
     |  II.le.72.                                                      !
     |     )  chr(II) = char(ICHAR(chr(II))+shift)                     !
c \                                                                    /
        end do!                                                       /
c   \________________________________________________________________/

   78 continue   !!!!!!!!!!!  NOW WRITE THE CARD  !!!!!!!!!!!!

      if(As)then
         length=maxln+lenAs                                      !length
         card(maxln+1:maxln+lenAs)=Astring
      end if
c Check if card is a continuation card
      if(CONTchr.ne.SP.and.(.not.coment).and.chr(6).ne.SP)chr(6)=CONTchr
      if(mi.and.chr(1).eq.bang)chr(1)='c'
      if(Kx.and.(chr(1).eq.'c'.or.chr(1).eq.'C'.or.chr(1).eq.'*'))
     &   chr(1)=Cchr

c.....Check if card is beginning of an if-block.........................
      if(ib.and.(.not.coment))then
        JNKstr=card(7:length)
        idum=length
        call chng_case(JNKstr,1)
        call compress(JNKstr,idum)
        idum=index(JNKstr,')THEN')
        if(JNKstr(1:1).eq.bang)idum=0
        if(idum.gt.0)then
          if(JNKstr(1:6).ne.'ELSEIF')then
             if(JNKstr(1:2).eq.'IF')then
                levelib=levelib+1
                str=' '
                write(str,'(I5)')levelib
                idum=5
                call compress(str,idum)
                card(73:73)=bang
                card(74:74)='('
                card(75:76)=str(1:2)
                length=lnblnk(card)
             else
               print*,'##########################################'
               print*,'-ib not supported for multi-line if blocks'
               print*,'##########################################'
               print*,card
               stop
             endif
          endif
        elseif(JNKstr(1:5).eq.'ENDIF')then
           write(str,*)bang,levelib,')'
           idum=7
           call compress(str,idum)
           card(73:76)=str
           length=lnblnk(card)
           levelib=levelib-1
           if(levelib.lt.0)then
               print*,'###################################'
               print*,'  if-block nesting error'
               print*,'###################################'
           endif
        endif
      endif
      if(EM)then
         i1=index(card,'<')
         if(i1.gt.0)then
           i2=index(card,'>')
           if(i2.eq.0)go to 77777
           jnkstr=card(i1+1:i2-1)//'; '
           length=lnblnk(jnkstr)+1
           card=jnkstr
           call compress(card,length)
         else
           go to 77777 ! read next card
         endif
      endif
      if(email)then
         i1=index(card,'<')
         if(i1.gt.0)then
           i2=index(card,'>')
           if(i2.eq.0)go to 77777
           jnkstr=card(i1+1:i2-1)//SP//bang//card(1:i1-1)
           card=jnkstr
         else
           go to 77777 ! read next card
         endif
      endif


c            write the card
      if(ki.or.BangLocation.gt.maxln)then
        if (Xb) call compress(card,length)
        if(nl.and.(.not.coment))call nlchk(nLIM,card,length,ierr)
        write(2,12) card(1:length)
      else
        if(mi)then
c          22 format(a1,T<BangLocation>,a<length-BangLocation+1>)
           write(form22,*)'(a1,T',BangLocation,'a',
     &                     length-BangLocation+1,')'
           if(Kx)then
              write(2,form22)Cchr,card(BangLocation:length)
           else
              write(2,form22)'c',card(BangLocation:length)
           end if
           Ncomnt = Ncomnt+1
           Ncard=Ncard+1
        end if
        if (Xb) call compress(card,lengthFORT)
        if(nl.and.(.not.coment))call nlchk(nLIM,card,length,ierr)
        write(2,12) card(1:lengthFORT)
      end if
      Ncard=Ncard+1

      GO TO 77777 ! read next card
!##################################################### END INFINITE LOOP

  110 close(1)
c     If eI is true, check that the last include block indeed had an
c     end-include line.  That is, make sure that INclude is false at
c     this point.
      if ((eI.or.mIx) .and. INclude) then
         print*
         print*,'                 ----- (abort) -----'
         print*,'The last include block, ',
     &   INCnam(1)(1:LincNam),', did not have an end-include.'
         write(2,12)'ABORT!MISSING END OF INCLUDE!'
         print*,'                 ----- (abort) -----'
         close(2)
         stop
      end if
      close(2)
      
      if(vpdata)then
        open(1,file='#junk',status='unknown')
        open(2,file=outfile,status='unknown')
        do i=1,KNTcard
          read(1,form11,end=111) card
          if(vpp(i).gt.0)write(2,12)card(1:lnblnk(card))
        end do
        close(1)
        open(1,file='#junk',status='unknown')
        write(1,*)'junk file -- okay to delete'
        close(2)
      end if
      
  111 if(verbos)then
      if (eI.or.mIx) print*,'==================='
      print*
      print*,'CONVERSION COMPLETE'
      print*
      print*,'///////////////////////////////////'
      if (Ncard.ne.1) then
        print*,outfile(1:lnblnk(outfile)),' is ',Ncard,' lines long,'
      else
        print*,outfile(1:lnblnk(outfile)),' is 1 line long,'
      end if
      print*,nint(float(Ncomnt*100)/float(Ncard)),'% comments.'
      if(mIx)print*,NumUniqInc,' UNIQUE INCLUDE BLOCKS'
      print*,'///////////////////////////////////'
      end if
      if(zzbgs)then
        print*,' '
        print*,' '
        print*,'         ----------------------------------------------'
        print*,'         Your file contained the insidious microsoft ^M'
        print*,'         Converted output is sanitized.'
        print*,'         ----------------------------------------------'
      endif

      go to 9998
c
c  11 format(a<maxln>)
   12 format(a)
c  13 format(i)
c  22 format(a1,T<BangLocation>,a<length-BangLocation+1>)
   81 format(a,T16,'at line',i5)


   99 print*
      print*
      print*,'e r r o r   o p e n i n g   i n p u t'
      goto 9998
   98   print*,'Source code cnv.f, which is used to show help, is not'
        print*,'present here in the same directory where you are'
        print*,'executing cnv. Either make a copy of cnv.f locally or'
        print*,'modify the variable Myself in cnv.f to include the'
        print*,'full path to your copy of cnv.f'
        goto 9999
   97 print*
      if(argv.ne.'-h')then
         print*,'U N K N O W N   o p t i o n: ', argv(1:lnblnk(argv))
      else
         print*,'Quick Help:'
         print*,'(For detailed help, type "cnv" with no arguments)'
      end if
      go to 9998


 9998 continue
      if(verbos)then
      print*
      open (3,file=Myself,status='old',err=9999)
      read(3,'(//,100a)')JNKstr
      print*,JNKstr(2:90)
      read(3,'(100a)')JNKstr
      print*,JNKstr(2:90)
      close(3)
      end if
      go to 9999
      
 9999 stop
      end

c---.----1----.----2----.----3----.----4----.----5----.----6----.----7--

      subroutine compress (string,last)
c        This routine removes all blanks in a string from 
c        character 1 to last, and shifts the remainder of the
c        string to the left.
c
c     UPON INPUT
c     ----------
c     ~string.......a character string
c     ~last.........index of last character in the 
c                   "to be compressed" part of the string
c     UPON RETURN
c     -----------
c     ~string.......string with all blanks in the compression interval
c                   removed and all subsequent characters shifted to
c                   the left by an amount equal to the number of blanks
c                   removed.
c     ~last.........new index of the last character in the compressed
c                   part of the string
c 
      implicit none
      character*(*) string
      character*1 BL
      parameter (BL=' ')
      integer i,j,knt,nrb,length,last,   lnblnk
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      length = lnblnk(string)
      last = min(last,length)
            
      knt=0
      do i=1,last
         if(string(i:i).ne.BL) then
            knt = knt+1
            string(knt:knt)=string(i:i)
         end if
      end do
            
      nrb = last-knt  ! number of removed blanks
      
      do i=last+1,length
         j=i-nrb
         string(j:j)=string(i:i)
      end do
      
      j=length-nrb  ! this line has to be here in case last+1>length
      
      do i=j+1,length
         string(i:i)=BL
      end do
      
      last = last-nrb
            
      return
      end
c---.----1----.----2----.----3----.----4----.----5----.----6----.----7--
      
c     FUNCTION lnblnk(string)
c     ---- Sparc FORTRAN intrinsic function ---
c     lnblnk = length of string with trailing blanks removed

c---.----1----.----2----.----3----.----4----.----5----.----6----.----7--

c     FUNCTION index(string1,string2)
c     ---- FORTRAN intrinsic function ---
c     index = index of the first occurance of string1 in string2
c           = 0 if string1 not present

c---.----1----.----2----.----3----.----4----.----5----.----6----.----7--

      SUBROUTINE word1(string,wrd1,L1)
c     This routine gets the first word in string.
      implicit none
      character*1 BL,chr
      integer length,L1,i,j,    lnblnk
      parameter (BL=' ')
      character*(*) string,wrd1
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      wrd1=BL   ! ensures removal of extraneous characters
      length = lnblnk(string)
      L1=0
      do i=1,length
        if(string(i:i).ne.BL)go to 7
      end do
      wrd1=BL
      return
      
    7 do j=i,length
        chr=string(j:j)
        if(chr.eq.BL)return
        L1=L1+1
        wrd1(L1:L1)=chr
      end do
      return
      end

c---.----1----.----2----.----3----.----4----.----5----.----6----.----7--

      SUBROUTINE chng_case(string,iopt)
c     This routine capitalizes a string
      implicit none
      integer aLpHa,ZeTa,nchr,ichr,iopt,shift,lnblnk,kchr
      integer ka,kAx
      parameter (ka=97,kAx=65) ! ASCII codes for 'a' and 'A'
      character*1 chr
      character*(*) string
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      if(iopt.eq.1)then
c       CONVERT TO UPPER CASE
        aLpHa=ka
        shift=kAx-aLpHa
      else if(iopt.eq.-1)then
c       CONVERT TO LOWER CASE
        aLpHa=kAx
        shift=ka-aLpHa
      else
        print*,'unknown chng_case option:',iopt
        stop
      end if
      ZeTa=aLpHa+25
      
      nchr=lnblnk(string)
      do ichr=1,nchr
        chr = string(ichr:ichr)
        kchr=ICHAR(chr)
        if(kchr.ge.aLpHa .and. kchr.le.ZeTa)then
          chr = char(kchr+shift)
          string(ichr:ichr)=chr
        end if
      end do
      
      return
      end
c---.----1----.----2----.----3----.----4----.----5----.----6----.----7--

      subroutine vncom(verchr,line,Bposn,iflag)
c
c input
c -----
c  verchr: the version  character (i.e., the "n" in -vn or -Vn)
c  line: the card
c
c output
c ------
c  line: the card with character 1 replaced with appropriate substitute.
c  Bposn: index position of the bang
c  iflag: 0 no version commands were found
c         <0 some version commands were found, but none matched verchr
c         =-1 single line
c         =-2 in a block
c         >0 a version command matching verchr was found and executed.
c
c     This routine finds the last occurance of bang (!) in a line and
c     examines the remainder of the line for version commands.
c     A version command looks like this
c     ____
c    |
c    |card main text bla bla bla      !d ,p*,x#
c    |____
c
c     If verchr is d, this routine will return 
c     ____
c    |
c    | ard main text bla bla bla      !d ,p*,x#
c    |____
c
c     If verchr is p, this routine will return 
c     ____
c    |
c    |*ard main text bla bla bla      !d ,p*,x#
c    |____
c
c     If verchr is x, this routine will return 
c     ____
c    |
c    |#ard main text bla bla bla      !d ,p*,x#
c    |____
c  
c     In all of the above cases, iflag is returned with a value of 1
c     because a version command matching the verchr was found.
c
c     If verchr is none of the above, the card will be returned
c     unchanged and iflag will be set to -1.   
      implicit none
      
c     MAX LENGTH OF A COMMAND (NUMBER OF CHARACTERS)
      integer mxclen
      parameter (mxclen=2)
      
      logical alpha
      external alpha
      
      character*1 verchr
      character*(*) line
      integer iflag,Bposn
      
      character*1 ch1,verblk
      save ch1,verblk
      logical block/.false./
      save block
      
      integer lnblnk
      integer lendum,icom,ichr
      character*1 bang,comma
      character string*10
      parameter (bang='!',comma=',')
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc      
      Bposn=0
      lendum=lnblnk(line)
      
      do ichr=lendum,1,-1
         if(line(ichr:ichr).eq.bang)go to 7
      end do
      if(block)then
        iflag=-2
        if(verchr.eq.verblk)then
           iflag=1
           line(1:1)=ch1
        end if
        return
      else
        go to 999
      end if
      
    7 Bposn=ichr
c     To reach this point, a bang was found.

      iflag=-1
      string=line(Bposn+1:lendum)
            
c     The string may or may not contain version commands. 
C     Must examine it carefully.
c
    8 lendum=lnblnk(string)
      if(lendum.eq.0)go to 999
      if(.not.alpha(string(1:1)))go to 999
      icom=index(string,comma)
      if(icom.eq.0)icom=max(mxclen+1,lendum+1)
      if(.not.block)ch1=string(2:2)
      if(string(2:2).eq."{" .or. string(2:2).eq."}")then
         if(icom.gt.mxclen+2)go to 999
         verblk=string(1:1)
         if(string(2:2).eq."{")then
            block=.true.
            if(iflag.eq.-1)iflag=-2
         elseif(string(2:2).eq."}")then
            block=.false.
            iflag=-2
         end if
         ch1=string(3:3)
      else if(icom.ne.mxclen+1)then
         if(block)then
           iflag=-2
           if(verchr.eq.verblk)then
              iflag=1
              line(1:1)=ch1
           end if
           return
         else
           go to 999
         end if
      end if
      if(block)string=verblk//ch1
      if(string(1:1).eq.verchr)then
        iflag=1
        line(1:1)=ch1
        return
      end if
      if(icom+1.le.lendum)then
        string=string(icom+1:lendum)
        go to 8
      end if
      
      return

  999 continue
c     Card does not contain proper version command(s).
      iflag=0
      if(block)iflag=-2
      return
      end
c---.----1----.----2----.----3----.----4----.----5----.----6----.----7--

      SUBROUTINE nlchk(nl,line,length,ierr)
c
c     This routine checks for words that exceed nl characters
c     A word is a string of alphanumerics flanked by non-alphanumerics
c     If an overly long word is dicovered, a message is printed to the
c     screen and the name of the variable is stored for future reference.
c
c     REB: Later on, a substitution scheme may be added.
c
c.....PARAMETERS
      implicit none
      integer mxlen
      parameter (mxlen=200)
      character*1 under,TIC,DTIC,bang,star,comma
      parameter (under='_',TIC='''',DTIC='"',
     &           bang='!',star='*',comma=',')
      
      integer mw ! max number of oversize words
      parameter(mw=100)
      
      integer length,ierr,iwrd1,iwrd2,I,nl,iw,index,idum
      character*(*) line

      character*(mxlen) card
      character*1 chr(mxlen)
      equivalence (card,chr)
      
      character*20 word,werd
      dimension werd(mw) ! saved record of bad words
      
      logical  alpha,alphnumeric
      external alpha,alphnumeric
      
      logical quote,squote,dquote
      
      logical dejavu
      save dejavu
      data dejavu/.false./
      
      integer nw
      save nw
      data nw/0/

cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
      idum=index(line,bang)
      if(idum.le.0)idum=length
      card=line(1:idum)
      call chng_case(card,1)
      if(chr(1).eq.'C'.or.chr(1).eq.bang)return
      
      quote=.false.
      squote=.false.
      dquote=.false.
      iwrd1=0
      iwrd2=-1
      do 77 I=1,length
c       Check if at the beginning or end of a quote by looking for the
c       single tic or double tic mark.
c       If already inside of a quote, don't change squote or dquote
c       This will permit, for example, a single appostrope within
C       a larger double-quoted string, as in "It's a string"
        if(chr(I).eq.TIC.and.(.not.dquote))squote=.not.squote
        if(chr(I).eq.DTIC.and.(.not.squote))dquote=.not.dquote
        quote=(squote.or.dquote)
        if(quote)go to 77
c.......At this point, iwrd1 is the index of the 
c       beginning of the current word (or zero if there is no
c       current word.
        if(iwrd1.eq.0)then
c.........Look for beginning of a word
          if(alpha(chr(I)))then
             iwrd1=I
             iwrd2=I-1
          end if
        end if
        if(iwrd1.gt.0)then
c.........Look for end of a word
          if(I.eq.length.or.(.not.alphnumeric(chr(I+1))))then
            iwrd2=I
          end if
        end if
        
        if(iwrd2.ge.iwrd1)then
          word=card(iwrd1:iwrd2)
          if(iwrd2-iwrd1+1.le.nl.and.index(word,under).eq.0)go to 8
c.........To reach this point, word is either too long or it
c         contains an underscore.  Check if this word has been reported
c         earlier (or if word is okay)
          if(word.eq.'CHARACTER')go to 8
          if(word.eq.'CONTINUE')go to 8
          if(word.eq.'DIMENSION')go to 8
          if(word.eq.'EQUIVALENCE')go to 8
          if(word.eq.'EXTERNAL')go to 8
          if(word.eq.'FUNCTION')go to 8
          if(word.eq.'IMPLICIT')go to 8
          if(word.eq.'INTEGER')go to 8
          if(word.eq.'LOGICAL')go to 8
          if(word.eq.'PARAMETER')go to 8
          if(word.eq.'PRECISION')go to 8
          if(word.eq.'PROGRAM')go to 8
          if(word.eq.'SUBROUTINE')go to 8
          if(word(1:5).eq.'PRINT'.and.
     &       (card(iwrd2+1:iwrd2+2).eq.'*,'.or.chr(iwrd2+1).eq.comma)  
     &       )go to 8
          do iw=1,nw
            if(word.eq.werd(iw))go to 8
          end do
          if(.not.dejavu)then
            dejavu=.true.
            print*
            print*,'################################'
            print*,'THE FOLLOWING WORDS ARE TOO LONG'
            print*,'OR CONTAIN UNDERSCORE(S)'
            print*
          end if
c.........To reach this point, this is the first time the bad word 
c         has been encountered.
          nw=nw+1
          if(nw.gt.mw)return
          print*,word
          werd(nw)=word
    8     continue
          iwrd1=0
          iwrd2=-1
        end if
    
   77 continue
      
      
      return
      end

c---.----1----.----2----.----3----.----4----.----5----.----6----.----7--

      LOGICAL FUNCTION alpha(ch) 
      implicit none   
c     logical  alpha
      character*1 ch,chdum
      character*1 alpha_lo,alpha_hi
      parameter(alpha_lo='A')
      parameter(alpha_hi='Z')
      chdum=ch
      call chng_case(chdum,1)
      alpha = alpha_lo.le.chdum .and. chdum.le.alpha_hi
      return 
      end
      
c---.----1----.----2----.----3----.----4----.----5----.----6----.----7--

      LOGICAL FUNCTION alphnumeric(ch) 
      implicit none   
c     logical  alphnumeric ! misspelling intentional (cuz incl _)
      character*1 ch,chdum
      character*1 alpha_lo,alpha_hi,number_lo,number_hi,under
      parameter(alpha_lo='A',number_lo='0')
      parameter(alpha_hi='Z',number_hi='9')
      parameter(under='_')
      chdum=ch
      call chng_case(chdum,1)
      alphnumeric = chdum.eq.under
     & .or. ( alpha_lo.le.chdum .and. chdum.le.alpha_hi)
     & .or. (number_lo.le.chdum .and. chdum.le.number_hi)
      return 
      end