c EXAMPLE OF OUTPUT (looks better if you choose IBM PC line graphics):
 
c ++-------- <html>                                    |   1
c |                                                    |   2
c ||--------   <head>                                  |   3
c |+--------     <title>My Title</title>               |   4
c |+--------   </head>                                 |   5
c |                                                    |   6
c |+--------   <body>                                  |   7
c |+--------     <a href="./doc.html">doc.html</a><br> |   8
c |+--------   </body>                                 |   9
c |                                                    |  10
c +--------- </html>                                   |  11
 
c Diagrams HTML language constructs,
c  and puts a * next to internal links.  It can
c  place = next to comment blocks.
 
c Designed by mitch grunes, in his own time.
 
c Program by Mitchell R Grunes, (grunes@yahoo.com).
c Revision date: 6/19/2015.
c If you find it useful, or find a problem, please send me e-mail.
 
c This program was written in FORTRAN, for historic reasons.
c (For this reason, people who mostly program in C will probably be
c  unwilling to use this program, even as a utility.)
 
c WARNING: The "/*" sequences will confuse compilers like SGI Fortran
c  that use a C pre-processor by default on Fortran programs, so you
c  must use a compiler switch like "-nocpp" to turn that off.
 
c It can be confused if an INCLUDE block contains a structure that
c  begins inside and ends outside (or vice-versa).
 
c  It also does not diagram IF, FOR, ELSE, WHILE, etc., unless you use
c   { and } to enclose the conditionally executed statement--
c   e.g. it will not draw any lines next to
 
c       if(condition)
c         for (i=0; i<10; i++)
c           a[i]=2;
c       else
c         b=3;
 
c I hope this works for you, but bear in mind that nothing short of
c  a full-fledged language parser could really do the job.  Perhaps
c  worth about what you paid for it.    (-:
 
c Versions: To diagram Fortran:     diagramf.f
c                      IDL/PV-WAVE: diagrami.f
c                      C:           diagramc.f
c MS-DOS procedures to call above programs without asking so many questions,
c  append output to file diagram.out:
c                      Fortran:     diagramf.bat (card format)
c                                   diagram9.bat (free format)
c                      IDL/PV-WAVE: diagrami.bat
c                      C:           diagramc.bat
c Similar Unix csh procedures:
c                      Fortran:     diagramf.sh  (card format)
c                                   diagram9.sh  (free format)
c                      IDL/PV-WAVE: diagrami.sh
c                      C:           diagramc.sh
c Similar Vax VMS DCL procedures:
c                      Fortran:     diagramf.vax (card format)
c                                   diagram9.vax (free format)
c                      IDL/PV-WAVE: diagrami.vax
c                      C:           diagramc.vax
 
        program diagramh                                ! Diagrammer for HTML
        character*80 filnam,filnam2
 
        print*,'HTML source filename?'
        read(*,'(a80)')filnam
        print*,filnam
 
        print*,'Output file (blank=screen)?'
        read(*,'(a80)')filnam2
        print*,filnam2
 
        print*,'Column in which to write line #''s ',
     &   '(67 for 80 col screen, 0 for none):'
        LCol=0
        read*,LCol
        print*,LCol
 
        print*,'Notate comments with = (0=no, 1=yes; 1?):'
        inotate=1
        read*,inotate
        print*,inotate
 
        print*,'Use IBM PC graphics characters (0=no):'
        iGraphics=0
        read*,iGraphics
        print*,iGraphics
 
        call diagram(filnam,filnam2,LCol,inotate,iGraphics)
        end
c-----------------------------------------------------------------------
        subroutine diagram(filnam,filnam2,LCol,inotate,
     &   iGraphics)
c Program by Mitchell R Grunes, (grunes@yahoo.com).
        character*80 filnam,filnam2
        character*360 a,b,bsave
        character*5 form
        character*8 fm
        character*1 c
        logical fout
        logical find
        external find
        common icol
 
c Type of block
        character*16 BlockType(1000)
 
c Symbols which will mark block actions:
        character*1 BlockBegin    (2) /'+','+'/  ! Start of block
        character*1 BlockEnd      (2) /'+','+'/  ! End of block
        character*1 BlockElse     (2) /'+','+'/  ! Else construct
        character*1 BlockContinue (2) /'|','|'/  ! Block continues w/o change
        character*1 BlockHoriz    (2) /'-','-'/  ! Horizontal to start of line
c Same, but allows horizontal line to continue through:
        character*1 BlockBeginH   (2) /'+','+'/  ! Start of block
        character*1 BlockEndH     (2) /'+','+'/  ! End of block
        character*1 BlockElseH    (2) /'+','+'/  ! Else construct
 
        if(iGraphics.ne.0)then
          iGraphics=1
 
          BlockBegin   (1)=char(218)            ! (1)=normal
          BlockEnd     (1)=char(192)
          BlockElse    (1)=char(195)
          BlockContinue(1)=char(179)
          BlockHoriz   (1)=char(196)
          BlockBeginH  (1)=char(194)
          BlockEndH    (1)=char(193)
          BlockElseH   (1)=char(197)
 
          BlockBegin   (2)=char(214)            ! (2)=DO/FOR loops (doubled)
          BlockEnd     (2)=char(211)            ! (not yet used)
          BlockEnd     (2)=char(211)
          BlockElse    (2)=char(199)
          BlockContinue(2)=char(186)
          BlockHoriz   (2)=char(196)
          BlockBeginH  (2)=char(209)
          BlockEndH    (2)=char(208)
          BlockElseH   (2)=char(215)
        endif
 
        open(1,file=filnam,status='old')
        fout=filnam2.gt.' '
        if(fout)open(2,file=filnam2,status='unknown')
                                                ! ASCII 12 is a form feed
        if(fout)write(2,*)char(12),
     &   '=============--',filnam(1:LenA(filnam)),'--============='
 
        if(fout)     write(2,'(11x,a50,a49,/)')  ! Write column header
     &   '....,....1....,....2....,....3....,....4....,....5',
     &   '....,....6....,....7....,....8....,....9....,....'
        if(.not.fout)write(*,'(11x,a50,a49,/)')' ',
     &   '....,....1....,....2....,....3....,....4....,....5',
     &   '....,....6....,....7....,....8....,....9....,....'
 
        i3=0                                    ! # nest levels after
                                                !  current line
        ltgt=0                                  ! < > nesting
        InHtml=0                                ! 0 Not in <html> block
                                                ! 1 In <html> block
                                                ! 2 <html> block has already occurred
        inhead=0                                ! same for <head>
        intitle=0                               ! same for <title>
        inscript=0                              ! same for <script>
        inbody=0                                ! same for <body>
        infont=0                                ! 0 Not in <html> block
                                                ! 1 In <html> block
        inspan=0                                ! same for <span>
        inh1=0                                  ! same for <h1>,<h2...> - but has value of size
        ina=0                                   ! same for <a ...>
        inb=0                                   ! same for <b>
        inu=0                                   ! same for <u>
        intable=0                               ! same for <table>
        inth=0                                  ! same for <th>
        intr=0                                  ! same for <tr>
        intd=0                                  ! same for <td>
        inp=0                                   ! same for <p>
        nline=0
        icomment=0                              ! not inside comment
        iunit=1
10      a=' '
        read(iunit,'(a360)',end=99)a
        nline=nline+1
        fm=' '
        write(fm,'(i5)')nline
        form=fm
 
        if(a(1:1).eq.char(12))then
          if(fout)write(2,'(a1,:)')char(12)
          if(.not.fout)print*,'------------FORM FEED------------'
          b=a(2:360)
          a=b
        endif
 
        b=' '                                   ! Turn tabs to spaces
        j=1
        do i=1,LenA(a)
          if(a(i:i).eq.char(9))then
            j=(j-1)/8*8+8+1
                                                ! Make sure is good ASCII char
          elseif(a(i:i).ge.' '.and.a(i:i).lt.char(128))then
            if(j.le.360)b(j:j)=a(i:i)
            j=j+1
                if(a(i:i).ne.' '.and.j.ge.360-10)then
              print*,'***WARNING---> Line too long to diagram: LINE ',
     &         form
              if(fout)print*,a
              if(fout)write(2,*)
     &         '***WARNING---> Line too long to diagram: ',a
              print*,char(7)
              endif
          endif
        enddo
 
        a=b
        bsave=b
        b=' '
        i1=i3                                   ! # nest levels before
                                                !  current line
        i4=0                                    ! not 0 to flag start or end
                                                !  of block
        iquote=0                                ! no ' yet
        idquote=0                               ! no " yet
        icomment2=0                             ! anything outside comment?
        icomment3=icomment                      ! no comment occurred?
        i=1
        j=1
        dowhile(i.le.360)                       ! handle upper case
          c=a(i:i)
          if(c.ge.'A'.and.c.le.'Z')c=char(ichar(c)+32)
          if(c.eq.''''.and.idquote.ne.1.and.icomment.ne.1
     &     .and.ltgt.ne.0)then
            iquote=1-iquote
            if(i.gt.1)then
                                                ! char(92) is \
              if(iquote.ne.1.and.a(i-1:i-1).eq.char(92))
     &         iquote=1-iquote
            endif
          endif
          if(c.eq.'"' .and.iquote .ne.1.and.icomment.ne.1
     &     .and.lgt.ne.0)then
            idquote=1-idquote
            if(i.gt.1)then
              if(idquote.ne.1.and.a(i-1:i-1).eq.char(92))
     &         idquote=1-idquote
            endif
          endif
          if(c.eq.'<'.and.i.lt.360-1.and.iquote.ne.1.and.idquote.ne.1)    ! <!-  ?
     &     then
            if(a(i+1:i+1).eq.'!'.and.a(i+2:i+2).eq.'-')then
              if(icomment.ne.0)then
                print*,'***WARNING--nested comment LINE',form
                if(fout)print*,a
                    if(fout)print*,a
                if(fout)WRITE(2,*)
     &       '***WARNING--nested comment LINE',form
                print*,char(7)
              endif
              icomment=1
              icomment3=1
              c=' '
              i=i+2
            endif
          endif
          if(c.eq.'-'.and.i.lt.360.and.iquote.ne.1.and.idquote.ne.1)    ! -> ?
     &     then
            if(a(i+1:i+1).eq.'>')then
              if(icomment.ne.1)then
                print*,'***WARNING---> without <!- clause LINE',form
                if(fout)print*,a
                if(fout)write(2,*)
     &           '***WARNING---> without <!- clause LINE',form
                print*,char(7)
              endif
              icomment=0
              c=' '
              i=i+2
            endif
          endif
          if(icomment.ne.0)c=' '
          if(c.ne.' ')icomment2=1
 
          if(c.eq.'<')then
            if(ltgt.ne.0)then
              print*,'***ERROR: nested < LINE ',form
              if(fout)print*,a
              if(fout)write(2,*)'***ERROR: nested < LINE ',form
            endif
            ltgt=1
          elseif(c.eq.'>')then
            if(ltgt.ne.1)then
              print*,'***ERROR-- > without < LINE ',
     &         form
              if(fout)print*,a
              if(fout)write(2,*)'***ERROR-- > without < LINE ',form
              print*,char(7)
              ltgt=max(ltgt,0)
            endif
            ltgt=0
          endif
          if(j.le.360) b(j:j)=c
          if(j.gt.1)then                        ! (kill multiple spaces)
            if(c.eq.' '.and.b(j-1:j-1).eq.' ')j=j-1
          endif
          j=j+1
          i=i+1
        enddo
        if(iQuote.ne.0.or.idquote.ne.0)then
          print*,'***ERROR--unclosed quote LINE ',form
          if(fout)print*,a
          if(fout)write(2,*)'***ERROR--unclosed quote LINE ',form
          print*,char(7)
        endif
 
        DO I=1,360
15      if(find(b(i:360),'<html>',1).or.
     &     find(b(i:360),'<html/',1).or.
     &     find(b(i:360),'<html ',1))then
          if(InHtml.eq.1)then
            print*,'***ERROR--nested <html> LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)'***ERROR--nested <html> LINE ',form
            print*,char(7)
            else
            i3=i3+1
            i4=1
            BlockType(i3)='<html>'
          endif
          if(InHtml.eq.2)then
            print*,'***ERROR--<html> has already occurred LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--<html>  has already occurred LINE ',form
            print*,char(7)
          endif
          InHtml=1
        elseif(find(b(i:360),'</html>',1).or.
     &         find(b(i:360),'</html/',1).or.
     &         find(b(i:360),'</html ',1))then
          if(InHtml.ne.1)then
            print*,'***ERROR--</html> without <html> LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)
     &   '***ERROR--</html> without <html> LINE ',form
            print*,char(7)
          else
            i3=i3-1
            i4=1
            dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<html>')
              print*,'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              if(fout)print*,a
              if(fout)write(2,*)'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              print*,char(7)
              i3=i3-1
            enddo
          endif
          InHtml=2
        elseif(find(b(i:360),'<head>',1).or.
     &         find(b(i:360),'<head/',1).or.
     &         find(b(i:360),'<head ',1))then
          if(InHtml.ne.1)then
            print*,'***ERROR--<head> not inside <html> LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--<head> not inside <html> LINE ',form
            print*,char(7)
          endif
          if(inhead.eq.1)then
            print*,'***ERROR--nested <head> LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)'***ERROR--nested <head> LINE ',form
            print*,char(7)
            else
            i3=i3+1
            i4=1
            BlockType(i3)='<head>'
          endif
          if(inhead.eq.2)then
            print*,'***ERROR--<head> has already occurred LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--<head> has already occurred LINE ',form
            print*,char(7)
          endif
          inhead=1
        elseif(find(b(i:360),'</head>',1).or.
     &         find(b(i:360),'</head/',1).or.
     &         find(b(i:360),'</head ',1))then
          if(inhead.ne.1)then
            print*,'***ERROR--</head> without <head> LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)
     &   '***ERROR--</head> without <head> LINE ',form
            print*,char(7)
          else
            i3=i3-1
            i4=1
            dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<head>')
              print*,'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              if(fout)print*,a
              if(fout)write(2,*)'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              print*,char(7)
              i3=i3-1
            enddo
          endif
          inhead=2
        elseif(find(b(i:360),'<title>',1).or.
     &         find(b(i:360),'<title/',1).or.
     &         find(b(i:360),'<title ',1))then
          if(inhead.ne.1)then
            print*,'***ERROR--<title> not inside <head> LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--<title> not inside <head> LINE ',form
            print*,char(7)
          endif
          if(intitle.eq.1)then
            if(fout)print*,a
            print*,'***ERROR--nested <title> LINE ',form
            if(fout)write(2,*)'***ERROR--nested <title> LINE ',form
            print*,char(7)
            else
            i3=i3+1
            i4=1
            BlockType(i3)='<title>'
          endif
          if(intitle.eq.2)then
             print*,'***ERROR--<title> has already occurred LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--<title>  has already occurred LINE ',form
            print*,char(7)
          endif
          intitle=1
        elseif(find(b(i:360),'</title>',1).or.
     &         find(b(i:360),'</title/',1).or.
     &         find(b(i:360),'</title ',1))then
          if(intitle.ne.1)then
            print*,'***ERROR--</title> without <title> LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)
     &   '***ERROR--</title> without <title> LINE ',form
            print*,char(7)
          else
            i3=i3-1
            i4=1
            dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<title>')
              print*,'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              if(fout)print*,a
              if(fout)write(2,*)'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              print*,char(7)
              i3=i3-1
            enddo
          endif
          intitle=2
        elseif(find(b(i:360),'<body>',1).or.
     &         find(b(i:360),'<body/',1).or.
     &         find(b(i:360),'<body ',1))then
          if(InHtml.ne.1)then
            print*,'***ERROR--<body> not inside <html> LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--<body> not inside <html> LINE ',form
            print*,char(7)
          endif
          if(inhead.eq.0)then
            print*,'***ERROR--<body> inside <head> LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--<body> inside <head> LINE ',form
            print*,char(7)
          endif
          if(inhead.eq.0)then
            print*,'***ERROR--<body> before <head> LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--<body> before <head> LINE ',form
            print*,char(7)
          endif
          if(inbody.eq.1)then
            print*,'***ERROR--nested <body> LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)'***ERROR--nested <body> LINE ',form
            print*,char(7)
            else
            i3=i3+1
            i4=1
            BlockType(i3)='<body>'
          endif
          if(inbody.eq.2)then
            print*,'***ERROR--<body> has already occurred LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)
     &   '***ERROR--<body> has already occurred LINE ',form
            print*,char(7)
          endif
          inbody=1
        elseif(find(b(i:360),'</body>',1).or.
     &         find(b(i:360),'</body/',1).or.
     &         find(b(i:360),'</body ',1))then
          if(inbody.ne.1)then
            print*,'***ERROR--</body> without <body> LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)
     &   '***ERROR--</body> without <body> LINE ',form
            print*,char(7)
          else
            i3=i3-1
            i4=1
            dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<body>')
              print*,'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              if(fout)print*,a
              if(fout)write(2,*)'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              print*,char(7)
              i3=i3-1
            enddo
          endif
          inbody=2
        elseif(find(b(i:360),'<font ',1))then
          if(inbody.ne.1)then
            print*,'***ERROR--<font> not inside <body> LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--<font> not inside <body> LINE ',form
            print*,char(7)
          endif
          if(infont.ne.0)then
            print*,'***ERROR--nested <font> LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)'***ERROR--nested <font> LINE ',form
            print*,char(7)
            else
            i3=i3+1
            i4=1
            BlockType(i3)='<font>'
          endif
          infont=1
        elseif(find(b(i:360),'</font>',1).or.
     &         find(b(i:360),'</font/',1).or.
     &         find(b(i:360),'</font ',1))then
          if(infont.ne.1)then
            print*,'***ERROR--</font> without <font> LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)
     &   '***ERROR--</font> without <font> LINE ',form
            print*,char(7)
          else
            i3=i3-1
            i4=1
            dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<font>')
              print*,'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              if(fout)print*,a
              if(fout)write(2,*)'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              print*,char(7)
              i3=i3-1
            enddo
          endif
          infont=0
        elseif(find(b(i:360),'<span ',1))then
          if(inbody.ne.1)then
            if(fout)print*,a
            print*,'***ERROR--<span> not inside <body> LINE ',form
            if(fout)write(2,*)
     &       '***ERROR--<span> not inside <body> LINE ',form
            print*,char(7)
          endif
          if(Inspan.ne.0)then
            print*,'***ERROR--nested <span> LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)'***ERROR--nested <span> LINE ',form
            print*,char(7)
            else
            i3=i3+1
            i4=1
            BlockType(i3)='<span>'
          endif
          inspan=1
        elseif(find(b(i:360),'</span>',1).or.
     &         find(b(i:360),'</span/',1).or.
     &         find(b(i:360),'</span ',1))then
          if(inspan.ne.1)then
            print*,'***ERROR--</span> without <span> LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)
     &   '***ERROR--</span> without <span> LINE ',form
            print*,char(7)
          else
            i3=i3-1
            i4=1
            dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<span>')
              print*,'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              if(fout)print*,a
              if(fout)write(2,*)'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              print*,char(7)
              i3=i3-1
            enddo
          endif
          inspan=0
        elseif(b(i:i+2).ge.'<h1'.and.b(i:i+2).le.'<h9')then
          if(inbody.ne.1)then
            print*,'***ERROR--',b(i:i+4),' not inside <body> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--',b(i:i+4),' not inside <body> LINE ',form
            print*,char(7)
          endif
          if(inh1.ne.0)then
            print*,'***ERROR--nested <h#> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)'***ERROR--nested <h#> LINE ',form
            print*,char(7)
            else
            i3=i3+1
            i4=1
            BlockType(i3)='<h#>'
          endif
          inh1=ichar(b(i+2:i+2))
        endif
        if(b(i:i+4).ge.'</h1'.and.b(i:i+4).le.'</h9')then
          if(ichar(b(i+3:i+3)).ne.inh1)then
            print*,'***Incorrect <h#> level***>',form
            if(fout)print*,a
            if(fout)write(2,*)'***Incorrect <h#> level LINE ',form
          endif
          if(inh1.eq.0)then
             print*,'***ERROR--</h#> without <h#> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)'***ERROR--</h#> without <h#> LINE ',form
            print*,char(7)
          else
            i3=i3-1
            i4=1
            dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<h#>')
              print*,'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              if(fout)print*,a
              if(fout)write(2,*)'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              print*,char(7)
              i3=i3-1
            enddo
          endif
          inh1=0
        elseif(find(b(i:360),'<a ',1))then
          if(inbody.ne.1)then
            print*,'***ERROR--<a> not inside <body> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--<a> not inside <body> LINE ',form
            print*,char(7)
          endif
          if(ina.ne.0)then
            print*,'***ERROR--nested <a> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)'***ERROR--nested <a> LINE ',form
            print*,char(7)
            else
            i3=i3+1
            i4=1
            BlockType(i3)='<a>'
          endif
          ina=1
        elseif(find(b(i:360),'</a>',1).or.
     &         find(b(i:360),'</a/',1).or.
     &         find(b(i:360),'</a ',1))then
          if(ina.ne.1)then
            print*,'***ERROR--</a> without <a> LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)'***ERROR--</a> without <a> LINE ',form
            print*,char(7)
          else
            i3=i3-1
            i4=1
            dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<a>')
              print*,'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              if(fout)print*,a
              if(fout)write(2,*)'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              print*,char(7)
              i3=i3-1
            enddo
          endif
          ina=0
        elseif(find(b(i:360),'<b>',1).or.
     &         find(b(i:360),'<b/',1).or.
     &         find(b(i:360),'<b ',1))then
          if(inbody.ne.1)then
            print*,'***ERROR--<b> not inside <body> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--<b> not inside <body> LINE ',form
            print*,char(7)
          endif
          if(inb.ne.0)then
            print*,'***ERROR--nested <b> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)'***ERROR--nested <b> LINE ',form
            print*,char(7)
            else
            i3=i3+1
            i4=1
            BlockType(i3)='<b>'
          endif
          inb=1
        elseif(find(b(i:360),'</b>',1).or.
     &         find(b(i:360),'</b/',1).or.
     &         find(b(i:360),'</b ',1))then
          if(inb.ne.1)then
            print*,'***ERROR--</b> without <b> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)'***ERROR--</b> without <b> LINE ',form
            print*,char(7)
          else
            i3=i3-1
            i4=1
            dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<b>')
              print*,'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              if(fout)print*,a
              if(fout)write(2,*)'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              print*,char(7)
              i3=i3-1
            enddo
          endif
          inb=0
        elseif(find(b(i:360),'<u>',1).or.
     &         find(b(i:360),'<u/',1).or.
     &         find(b(i:360),'<u ',1))then
          if(inbody.ne.1)then
            print*,'***ERROR--<u> not inside <body> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--<u> not inside <body> LINE ',form
            print*,char(7)
          endif
          if(inu.ne.0)then
            print*,'***ERROR--nested <u> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)'***ERROR--nested <u> LINE ',form
            print*,char(7)
            else
            i3=i3+1
            i4=1
            BlockType(i3)='<u>'
          endif
          inu=1
        elseif(find(b(i:360),'</u>',1).or.
     &         find(b(i:360),'</u/',1).or.
     &         find(b(i:360),'</u ',1))then
          if(inu.ne.1)then
            print*,'***ERROR--</u> without <u> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)'***ERROR--</u> without <u> LINE ',form
            print*,char(7)
          else
            i3=i3-1
            i4=1
            dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<u>')
              print*,'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              if(fout)print*,a
              if(fout)write(2,*)'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              print*,char(7)
              i3=i3-1
            enddo
          endif
          inu=0
        elseif(find(b(i:360),'<table>',1).or.
     &         find(b(i:360),'<table/',1).or.
     &         find(b(i:360),'<table ',1))then
          if(inbody.ne.1)then
            print*,'***ERROR--<table> not inside <body> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--<table> not inside <body> LINE ',form
            print*,char(7)
          endif
          if(intr.ne.0.or.inth.ne.0)then
            print*,'***ERROR--<table> is inside <tr> or <th> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--<table> is inside <tr> or <th> LINE ',form
            print*,char(7)
          endif
          if(intable.ne.0)then
            print*,'***ERROR--nested <table> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)'***ERROR--nested <table> LINE ',form
            print*,char(7)
            else
            i3=i3+1
            i4=1
            BlockType(i3)='<table>'
          endif
          intable=1
        elseif(find(b(i:360),'</table>',1).or.
     &         find(b(i:360),'</table/',1).or.
     &         find(b(i:360),'</table ',1))then
          if(intr.ne.0.or.inth.ne.0)then
            print*,'***ERROR--</table> is inside <tr> or <th> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--</table> is inside <tr> or <th> LINE ',form
            print*,char(7)
          endif
          if(intable.ne.1)then
             print*,'***ERROR--</table> without <table> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)
     &   '***ERROR--</table> without <table> LINE ',form
            print*,char(7)
          else
            i3=i3-1
            i4=1
            dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<table>')
              print*,'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
          if(fout)print*,a
              if(fout)write(2,*)'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              print*,char(7)
              i3=i3-1
            enddo
          endif
          intable=0
        elseif(find(b(i:360),'<th>',1).or.
     &         find(b(i:360),'<th/',1).or.
     &         find(b(i:360),'<th ',1))then
          if(intable.ne.1)then
            print*,'***ERROR--<th> not inside <table> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--<th> not inside <table> LINE ',form
            print*,char(7)
          endif
          if(intr.ne.1)then
            print*,'***ERROR--<th> is not inside <tr> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--<th> is notinside <tr> LINE ',form
            print*,char(7)
          endif
          if(inth.ne.0)then
            print*,'***ERROR--nested <th> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)'***ERROR--nested <th> LINE ',form
            print*,char(7)
            else
            i3=i3+1
            i4=1
            BlockType(i3)='<th>'
          endif
          inth=1
        elseif(find(b(i:360),'</th>',1).or.
     &         find(b(i:360),'</th/',1).or.
     &         find(b(i:360),'</th ',1))then
          if(intr.ne.1)then
            print*,'***ERROR--</th> not inside <tr> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--</th> inside <tr> LINE ',form
            print*,char(7)
          endif
          if(inth.ne.1)then
             print*,'***ERROR--</th> without <th> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)'***ERROR--</th> without <th> LINE ',form
            print*,char(7)
          else
            i3=i3-1
            i4=1
            dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<th>')
              print*,'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              if(fout)print*,a
              if(fout)write(2,*)'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              print*,char(7)
              i3=i3-1
            enddo
          endif
          inth=0
        elseif(find(b(i:360),'<tr>',1).or.
     &         find(b(i:360),'<tr/',1).or.
     &         find(b(i:360),'<tr ',1))then
          if(intable.ne.1)then
            print*,'***ERROR--<tr> not inside <table> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--<tr> not inside <table> LINE ',form
            print*,char(7)
          endif
          if(inth.ne.0)then
            print*,'***ERROR--<tr> inside <th> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--<tr> inside <th> LINE ',form
            print*,char(7)
          endif
          if(intr.ne.0)then
            print*,'***ERROR--nested <tr> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)'***ERROR--nested <tr> LINE ',form
            print*,char(7)
            else
            i3=i3+1
            i4=1
            BlockType(i3)='<tr>'
          endif
          intr=1
        elseif(find(b(i:360),'</tr>',1).or.
     &         find(b(i:360),'</tr/',1).or.
     &         find(b(i:360),'</tr ',1))then
          if(inth.ne.0)then
            print*,'***ERROR--</tr> inside <th> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--</tr> inside <th> LINE ',form
            print*,char(7)
          endif
          if(intr.ne.1)then
            print*,'***ERROR--</tr> without <tr> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)'***ERROR--</tr> without <tr> LINE ',form
            print*,char(7)
          else
            i3=i3-1
            i4=1
            dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<tr>')
              print*,'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              if(fout)print*,a
              if(fout)write(2,*)'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              print*,char(7)
              i3=i3-1
            enddo
          endif
          intr=0
        elseif(find(b(i:360),'<td>',1).or.
     &         find(b(i:360),'<td/',1).or.
     &         find(b(i:360),'<td ',1))then
          if(intr.ne.1)then
            print*,'***ERROR--<td> not inside <tr> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--<td> not inside <tr> LINE ',form
            print*,char(7)
          endif
          if(inth.ne.0)then
            print*,'***ERROR--<td> inside <th> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--<td> inside <th> LINE ',form
            print*,char(7)
          endif
          if(intd.ne.0)then
            print*,'***ERROR--nested <td> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)'***ERROR--nested <td> LINE ',form
            print*,char(7)
            else
            i3=i3+1
            i4=1
            BlockType(i3)='<td>'
          endif
          intd=1
        elseif(find(b(i:360),'</td>',1).or.
     &         find(b(i:360),'</td/',1).or.
     &         find(b(i:360),'</td ',1))then
          if(inth.ne.0)then
            print*,'***ERROR--</td> inside <th> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--</td> inside <th> LINE ',form
            print*,char(7)
          endif
          if(intd.ne.1)then
            print*,'***ERROR--</td> without <td> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)'***ERROR--</td> without <td> LINE ',
     &        form
            print*,char(7)
          else
            i3=i3-1
            i4=1
            dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<td>')
              print*,'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              if(fout)print*,a
              if(fout)write(2,*)'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              print*,char(7)
              i3=i3-1
            enddo
          endif
          intd=0
        elseif(find(b(i:360),'<p>',1).or.
     &         find(b(i:360),'<p/',1).or.
     &         find(b(i:360),'<p ',1))then
          if(inbody.ne.1)then
            print*,'***ERROR--<p> not inside <body> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)
     &       '***ERROR--<p> not inside <body> LINE ',form
            print*,char(7)
          endif
          if(inp.ne.0)then
            if(fout)print*,a
            print*,'***WARNING--prior <p> not closed',form
            if(fout)write(2,*)
     &       '***WARNING--prior <p> not closed LINE ',form
            print*,char(7)
          else
            i3=i3+1
          endif
          i4=1
          BlockType(i3)='<p>'
          inp=1
        elseif(find(b(i:360),'</p>',1).or.
     &         find(b(i:360),'</p/',1).or.
     &         find(b(i:360),'</p ',1))then
          if(inp.ne.1)then
             print*,'***ERROR--</p> without <p> LINE',form
            if(fout)print*,a
            if(fout)write(2,*)'***ERROR--</p> without <p> LINE ',form
            print*,char(7)
          else
            i3=i3-1
            i4=1
            dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<p>')
              print*,'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              if(fout)print*,a
              if(fout)write(2,*)'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              print*,char(7)
              i3=i3-1
            enddo
          endif
          inp=0
        elseif(find(b(i:360),'<script>',1).or.
     &         find(b(i:360),'<script/',1).or.
     &         find(b(i:360),'<script ',1))then
          if(inscript.eq.1)then
            if(fout)print*,a
            print*,'***ERROR--nested <script> LINE ',form
            if(fout)write(2,*)'***ERROR--nested <script> LINE ',form
            print*,char(7)
            else
            i3=i3+1
            i4=1
            BlockType(i3)='<script>'
          endif
          inscript=1
        elseif(find(b(i:360),'</script>',1).or.
     &         find(b(i:360),'</script/',1).or.
     &         find(b(i:360),'</script ',1))then
          if(inscript.ne.1)then
            print*,'***ERROR--</script> without <script> LINE ',form
            if(fout)print*,a
            if(fout)write(2,*)
     &   '***ERROR--</script> without <script> LINE ',form
            print*,char(7)
          else
            i3=i3-1
            i4=1
            dowhile(i3.gt.0.and.BlockType(i3+1).ne.'<script>')
              print*,'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              if(fout)print*,a
              if(fout)write(2,*)'***WARNING--unclosed ',
     &     BlockType(i3+1),' LINE ',form
              print*,char(7)
              i3=i3-1
            enddo
          endif
          inscript=2
c### ADD MORE SEARCH ITEMS HERE
        endif
        ENDDO
 
        igoto=0                                 ! no goto on line
c       if(find(a,'go to',64+512).or.find(a,'goto',64+512)
c    &   .or.find(a,'return',32+512)
c    &   .or.find(a,'break',32+512).or.find(a,'continue',32+512)
c    &   .or.find(a,'exit',32+512))igoto=1
 
c       if(find(b,'case',32+512).or.
c    &   find(b,'default ',512).or.find(b,'default:',512))i4=max(1,i4)
 
20      b=bsave
        a=' '
        if(i1  .lt.0.or.i3  .lt.0.or.i4  .lt.0)then
          print*,'***ERROR--INVALID DIAGRAMMING INDEX LINE ',form
          if(fout)print*,b
          if(fout)write(2,*)
     &     '***ERROR--INVALID DIAGRAMMING INDEX LINE',form
          print*,char(7)
          i1=max(i1,0)
          i3=max(i3,0)
          i4=max(i4,0)
        endif
 
        i2=max(i1,i3)                           ! # of nests on current line
        i4=max(i4,iabs(i3-i1))                  ! not 0, to flag start or
                                                !  end of block
        iBlock=1                                ! For the present version.
 
        a=' '                                   ! Leave space for diagram
        a(12:360)=b                             !  (must match column header)
 
        LastUse=1                               ! Last usable diagram col
        dowhile(LastUse.lt.360.and.a(LastUse:LastUse).eq.' ')
          LastUse=LastUse+1
        enddo
        LastUse=LastUse-2
 
        if(igoto.ne.0)a(1:1)='*'                ! Place * next to jumps
        if(icomment2.ne.1.and.icomment3.ne.0..and.inotate.ne.0)
     &   a(1:1)='='
 
 
        if(i2.gt.0)then                         ! Same for non-pre-processor
          do i=1,min(i2,LastUse)
            a(i:i)=BlockContinue(iBlock)
          enddo
        endif
 
        if(i4.ne.0)then
          do i=i2+1,LastUse
            a(i:i)=BlockHoriz(iBlock)
          enddo
        endif
 
        do i=0,i4-1
 
          c=              BlockElse(iBlock)
          if(i1+i.lt.i3)c=BlockBegin(iBlock)
          if(i1+i.gt.i3)c=BlockEnd  (iBlock)
          j=max(1,min(LastUse,i2-i))
          a(j:j)=c
          if(a(j+1:j+1).eq.BlockElse  (iBlock))
     &       a(j+1:j+1)  = BlockElseH (iBlock)
          if(a(j+1:j+1).eq.BlockBegin (iBlock))
     &       a(j+1:j+1)  = BlockBeginH(iBlock)
          if(a(j+1:j+1).eq.BlockEnd   (iBlock))
     &       a(j+1:j+1)  = BlockEndH  (iBlock)
        enddo
 
        if(LCol.gt.0.and.a(max(1,LCol+11):360).eq.' ')then       ! line #
          if(form(1:1).eq.' ')form(1:1)=BlockContinue(iBlock)
          a(LCol+11:360)=form
        endif
 
        n=LenA(a)                               ! Output diagrammed line
        if(fout)     write(2,'(128(128a1))')
     &   (a(i:i),i=1,n)
        if(.not.fout)write(*,'(128(128a1))')
     &   (a(i:i),i=1,n)
 
        i1=i3
        goto 10
99      if(iunit.eq.3)then
          iunit=1
          i1=i1-1
          close(3)
          goto 10
        endif
        if(i3.gt.0)then
          print*,'***WARNING--SOME NEST LEVELS LEFT HANGING AT END***'
          if(fout)write(2,*)
     &     '***WARNING--SOME NEST LEVELS LEFT HANGING AT END***'
          print*,char(7)
        endif
        if(inhead.eq.0)then
          print*,'***ERROR--<head> never occurred***'
          if(fout)write(2,*)'***ERROR--<head> never occurred!***'
          print*,char(7)
        endif
        if(intitle.eq.0)then
          print*,'***ERROR--<title> never occurred***'
          if(fout)write(2,*)'***ERROR--<title> never occurred!***'
          print*,char(7)
        endif
        if(inbody.eq.0)then
          print*,'***ERROR--<body> never occurred***'
          if(fout)write(2,*)'***ERROR--<body> never occurred!***'
          print*,char(7)
        endif
        end
c-----------------------------------------------------------------------
        logical function find(a,b,icond)        ! find b in a, subject to
                                                !  conditions:
                                                ! icond=sum of the following:
                                                ! 1:  Must be first character
                                                ! 2:  Must be first non-blank
                                                ! 32: Next character not alphanumeric
                                                ! 64: Next character not alphabetic
                                                ! 512  Prior character, if present,
                                                !      must be blank or ) or }
                                                !      or { or ;
c Program by Mitchell R Grunes, (grunes@yahoo.com).
c Revision date: 8/25/96.
        character*(*) a,b
        character*1   c,cNext
        common icol
        logical result
 
        ii=len(a)
        jj=len(b)
        result=.false.
        loopend=ii-jj+1
        if(iand(icond,1).ne.0)loopend=min(loopend,1)
        do i=1,loopend
          if(a(i:i+jj-1).eq.b)then
            icol1=i                             ! icol1=column of item found
            icol =i+jj                          ! icol =column after item
                                                !  found
            c=' '
            cNext=' '
            if(icol1.gt.1)c=a(icol1-1:icol1-1)
            if(icol .le.ii)cNext=a(icol:icol)
 
            result=.true.
 
            if(result.and.iand(icond,2).ne.0.and.icol1.gt.1)then
              result=a(1:icol1-1).eq.' '
            endif
 
            if(result.and.iand(icond,32).ne.0)
     &       result=(cNext.lt.'0'.or.cNext.gt.'9').and.
     &              (cNext.lt.'a'.or.cNext.gt.'z')
 
            if(result.and.iand(icond,64).ne.0)
     &       result=(cNext.lt.'a'.or.cNext.gt.'z')
 
            if(result.and.iand(icond,512).ne.0)result=c.eq.' '
     &       .or.c.eq.';'.or.c.eq.')'.or.c.eq.'{'.or.c.eq.'}'
 
            find=result
            if(result)return
          endif
        enddo
        find=result
        return
        end
c-----------------------------------------------------------------------
        function LenA(a)                        ! Length of string, at least 1
c Program by Mitchell R Grunes, (grunes@yahoo.com).
c Revision date: 8/25/96.
        character*(*) a
        n=len(a)
        dowhile(n.gt.1.and.a(n:n).eq.' ')
          n=n-1
        enddo
        LenA=n
        end