c EXAMPLE OF OUTPUT (looks better if you choose IBM PC line graphics):
 
c     +--------- pro Sample,a,b,c                               |   1
c     |          a=indgen(15)^2                                 |   2
c     |+-------- if a eq b then begin                           |   3
c     ||           print,'A equals B'                           |   4
c     ||           c=0                                          |   5
c     |+-------- else begin                                     |   6
c     ||           print,'A does not equal B'                   |   7
c     ||           c=1                                          |   8
c     |+-------- endif                                          |   9
c     +--------- end                                            |  10
 
c Diagrams IDL and PV-Wave begin(or case)-end constructs, functions
c  and procedures, places a * next to goto and return statements.
 
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 -----------------------------------------------------
c This program was written in FORTRAN, for historic reasons.
c This was written in Fortran 77 (with common extensions) for
c  portability.  It should also compile under Fortran 90 and Fortran 95,
c  provided you tell the compiler it is in card format.
c---------------------------------------------------------------------
 
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 diagrami                        ! Diagrammer for IDL and
                                                !  PV-WAVE
        character*80 filnam,filnam2
 
        print*,'IDL 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*,'Use IBM PC graphics characters (0=no):'
        iGraphics=0
        read*,iGraphics
        print*,iGraphics
 
        print*,'Should I warn if "end" ends if, for... (0=no):'
        iWarnEnd=1                             ! Drop warnings on 'end' for 'endif...'
        read*,iWarnEnd
        print*,iWarnEnd
 
        call diagram(filnam,filnam2,LCol,iGraphics,iWarnEnd)
        end
c-----------------------------------------------------------------------
        subroutine diagram(filnam,filnam2,LCol,iGraphics,iWarnEnd)
c Program by Mitchell R Grunes, (grunes@yahoo.com).
        character*80 filnam,filnam2
        character*160 a,b
        character*5 form
        character*8 fm
        character*1 c
        logical find
        external find
        common icol,icol1
        logical fout
 
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....,....'
 
        i1=0                                    ! # nest levels before
                                                !  current line
        i2=0                                    ! # nest levels on
                                                !  current line
        i3=0                                    ! # of nest levels after
                                                !  current line
        i4=0                                    ! not 0 to flag start or end
                                                !  of block
        InSub=0                                 ! Inside a subroutine or
                                                !  function?
        nMain=0                                 ! no mainline program yet
        InCase=0                                ! not inside case
        iContinue=0                             ! not continued from prior line
        nline=0
10      a=' '
        read(1,'(a160)',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:160)
          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.160)b(j:j)=a(i:i)
            j=j+1
                if(a(i:i).ne.' '.and.j.ge.160-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
 
        i=1
        j=1
        a=' '                                   ! Pre-processing
        iquote=0                                ! no ' yet
        idquote=0                               ! no " yet
        j=1
        do i=1,LenA(b)
          c=b(i:i)
          if(c.ge.'A'.and.c.le.'Z')c=char(ichar(c)+32)
          if(c.eq.';')goto 15                   ! comment
          if(c.eq.'@'.and.i.eq.1)goto 15        ! other procedure includes
          if(c.eq.''''.and.idquote.eq.0)then
            iquote=1-iquote
            c=' '
          endif
          if(c.eq.'"' .and.iquote .eq.0)idquote=1-idquote
          if(iquote.ne.0.or.idquote.ne.0)c=' '
          if(j.gt.1)then                        ! (kill multiple spaces)
            if(c.eq.' '.and.a(j-1:j-1).eq.' ')j=j-1
          endif
          if(c.eq.':')then                      ! (put space after :)
            if(j.le.160) a(j:j)=':'
            j=j+1
            c=' '
          endif
          if(j.le.160) a(j:j)=c
          j=j+1
        enddo
 
15      i2=i1
        i3=i1
        i4=0
        igoto=0                                 ! no goto on line
 
        if(a.ne.' '.and.InSub.eq.0..and..not.
     &   (find(a,'function ',2).or.find(a,'pro ',2)))then       ! mainline
          InSub=InSub+1
          nMain=nMain+1
          if(fout)print*,'Line ',form,' ',b(1:LenA(b))
          if(nMain.gt.1)then
            print*,'***ERROR--TOO MANY MAINLINES***'
            if(fout)print*,b
            if(fout)write(2,*)'***ERROR--TOO MANY MAINLINES!***'
            print*,char(7)
          endif
          i2=i2+1
          i3=i3+1
        endif
 
        if(find(a,'goto',8+32).or.find(a,'return',1+128))igoto=1
 
        if(find(a,'endif ',2).or.find(a,'endfor ',2)
     &  .or.find(a,'endelse ',2).or.find(a,'endwhile ',2)
     &  .or.find(a,'endcase ',2).or.find(a,'endrep ',2))then
          i3=i3-1
          if(find(a,'begin  ',1))i3=i3+1
          i4=max(i4,1)
          if(i3.lt.InCase)InCase=0
        elseif(find(a,'case ',1).or.find(a,'begin  ',1))then
          InCase=i1
          i2=i2+1
          i3=i3+1
          i4=max(i4,1)
          if(find(a,': begin  ',0))i4=max(i4,2)
          if(find(a,'end ',1))i3=i3-1
        elseif(find(a,'end ',2))then
          if(i3.gt.0.or.Insub.gt.0)then         ! Problem: IDL end may
            i3=i3-1                             !  actually be an endif,
                                                !  endelse, etc.
            if(i3.eq.0.and.InSub.ne.0)InSub=0
            if(i3.ne.0.and.iWarnEnd.ne.0)then
              print*,'WARNING end at line ',form
              print*,' "end" ends non-program!***'
              if(fout)print*,b
              if(fout)write(2,*)'***WARNING--"end" ends non-program!***'
              print*,char(7)
            endif
          endif
          if(i3.lt.InCase)InCase=0
        elseif(find(a,'function ',2).or.find(a,'pro ',2))then
          if(fout)print*,'Line ',form,' ',b(1:LenA(b))
          InSub=InSub+1
          i2=i2+1
          i3=i3+1
          if(InSub.ne.1.or.i3.ne.1)then
            print*,'***ERROR--INVALID DIAGRAMMING INDEX line',form
            if(fout)print*,b
            if(fout)write(2,*)'***ERROR--INVALID DIAGRAMMING INDEX!***'
            print*,char(7)
            i3=1
            InSub=1
          endif
        elseif((find(a,':  ',0).or.find(a,':',256)).and.
     &   InCase.ne.0)then                       ! simple case instances
          i4=max(i4,1)
        elseif((find(a,':',0).and.InCase.ne.0))then      !other case instances
          ileft=0
          iright=0
          ileft2=0
          iright2=0
          do i=1,icol1
            if(a(i:i).eq.'(')ileft=ileft+1
            if(a(i:i).eq.')')iright=iright+1
            if(a(i:i).eq.'[')ileft2=ileft+1
            if(a(i:i).eq.']')iright2=iright+1
          enddo
          if(ileft.eq.iright.and.ileft2.eq.iright2.and.icontinue.eq.0)
     &     i4=max(i4,1)
        endif
 
        icontinue=0
        if(find(a,'$  ',0))icontinue=1
 
        a=' '
 
        if(i1.lt.0.or.i2.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!***'
          print*,char(7)
          i1=max(i1,0)
          i2=max(i2,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:160)=b                             !  (must match column header)
 
        LastUse=1                               ! Last usable diagram col
        dowhile(LastUse.lt.160.and.a(LastUse:LastUse).eq.' ')
          LastUse=LastUse+1
        enddo
        LastUse=LastUse-2
 
        if(igoto.ne.0)a(1:1)='*'                ! Place * next to jumps
 
        if(i2.gt.0)then                         ! Draw one vertical line per
          do i=2,min(i2+1,LastUse)              !  nest level.
            a(i:i)=BlockContinue(iBlock)
          enddo
        endif
 
        if(i4.ne.0)then                         ! Draw horizontal lines inward
          do i=i2+2,LastUse                     !  from above.
            a(i:i)=BlockHoriz(iBlock)
          enddo
        endif
 
        do i=0,i4-1                             ! May need to replace some
                                                !  vertical lines with
          c=              BlockElse(iBlock)     !       else  symbol
          if(i1+i.lt.i3)c=BlockBegin(iBlock)    !  or   begin symbol
          if(i1+i.gt.i3)c=BlockEnd   (iBlock)   !  or   end   symbol
          j=max(2,min(LastUse,i2+1-i))
          a(j:j)=c
          if(a(j+1:j+1).eq.BlockElse  (iBlock)) ! Continue horizontal lines
     &       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):160).eq.' ')then       ! line #
          if(form(1:1).eq.' ')form(1:1)=BlockContinue(iBlock)
          a(LCol+11:160)=form
        endif
 
        n=LenA(a)                               ! Output diagrammed line
        if(fout)     write(2,'(80a1,80a1)')(a(i:i),i=1,n)
        if(.not.fout)write(*,'(1x,80a1,80a1)')(a(i:i),i=1,n)
 
        i1=i3
        goto 10
99      if(i3.gt.0.or.InSub.ne.0)then
          print*,'***WARNING--SOME NEST LEVELS LEFT HANGING AT END***'
          if(fout)print*,b
          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:  Prior, if exists, must
                                                !     be blank
                                                ! 2:  Must be first non-blank
                                                ! 4:  Prior character, if
                                                !     present, must not be
                                                !     alphanumeric.
                                                ! 8:  Prior character, if
                                                !     present, must be blank
                                                !     or )
                                                ! 16: Prior character, if
                                                !     present, must be blank
                                                !     or ,
                                                ! 32: Next character not
                                                !     alphanumeric
                                                ! 64: Next character not
                                                !     alphabetic
                                                ! 128:Next character must be
                                                !     blank or (
                                                ! 256:1st non-blank, possibly
                                                !     except for numeric
                                                !     labels
c Program by Mitchell R Grunes, (grunes@yahoo.com).
c Revision date: 8/25/96.
        character*(*) a,b
        character*1   c,cNext,c2
        common icol,icol1
        logical result
 
        ii=len(a)
        jj=len(b)
        result=.false.
        do i=1,ii-jj+1
          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,1).ne.0.and.icol1.gt.1)then
              result=c.eq.' '
            endif
 
            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,4).ne.0)
     &       result=(c.lt.'0'.or.c.gt.'9').and.(c.lt.'a'.or.c.gt.'z')
 
            if(result.and.iand(icond,8).ne.0)result=c.eq.' '.or.c.eq.')'
 
            if(result.and.iand(icond,16).ne.0)result=
     &       c.eq.' '.or.c.eq.','
 
            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,128).ne.0)
     &       result=cNext.eq.' '.or.cNext.eq.'('
 
            if(result.and.iand(icond,256).ne.0.and.icol1.gt.1)then
              ii=1
              do iii=1,icol1-1
                c2=a(iii:iii)
                if(c2.ge.'0'.and.c2.le.'9')ii=iii+1
                if(c2.ne.' '.and.(c2.lt.'0'.or.c2.gt.'9'))goto 20
              enddo
20            if(ii.lt.icol1)then
                result=a(ii:icol1-1).eq.' '
              endif
            endif
 
            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