c EXAMPLE OF OUTPUT (looks better if you choose IBM PC line graphics):
c +---------------- subroutine a(x) | 1
c |+--------------- do i=1,5 | 2
c ||+---------------- if(i/2*2.eq.i)then | 3
c ||| x=x*i | 4
c ||+---------------- else | 5
c ||| x=x/i | 6
c ||+---------------- endif | 7
c |+--------------- enddo | 8
c +---------------- end | 9
c Diagrams FORTRAN if-else-elseif-endif, do-enddo and case constructs,
c start and end of routines, type definitions, modules and interfaces;
c puts a * next to goto, return, cycle, exit, stop, end= and err=.
c Designed by mitch grunes, in his own time.
c Program by Mitchell R Grunes, (grunes at domain yahoo.com).
c Revision date: 8/25/96.
c If you find it useful, or find a problem, please send me e-mail.
c -----------------------------------------------------
c It is VERY IMPORTANT that you select the right FORTRAN
c format. In CARD format, a C in column 1 marks a
c comment, and anything in column 6 marks a continuation
c line. That is not true in FREE format. Most traditional
c FORTRAN code is in card format.
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 It can be confused if an INCLUDE block contains a structure that
c begins inside and ends outside (or vice-versa).
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
c questions, 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 diagramf ! Diagrammer for Fortran
character*80 filnam,filnam2
print*,'FORTRAN 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 ',
& '(0 for none; 67 for 80 col screen; 73 to show card format):'
LCol=0
read*,LCol
print*,LCol
print*,'Embed include files (0=no; 1?):'
iembed=1
read*,iembed
print*,iembed
print*,' '
print*,'-----------------------------------------------------'
print*,'It is VERY IMPORTANT that you select the right FORTRAN'
print*,'format. In CARD format, a C in column 1 marks a'
print*,'comment, and anything in column 6 marks a continuation'
print*,'line. That is not true in FREE format.'
print*,'-----------------------------------------------------'
print*,'0=Card format (cols 1-6 special, warnings past 72)'
print*,'1=Free format'
print*,'2=Card format (same as 0, ignore cols past 72)'
print*,'Format # (0?):'
ifree=0
read*,ifree
print*,ifree
print*,'Use IBM PC graphics characters (0=no):'
igraphics=0
read*,igraphics
print*,igraphics
call diagram(filnam,filnam2,LCol,iembed,ifree,igraphics)
end
c-----------------------------------------------------------------------
subroutine diagram(filnam,filnam2,LCol,iembed,ifree,igraphics)
c Program by Mitchell R Grunes, (grunes at domain yahoo.com).
character*80 filnam,filnam2
character*160 a,b,AfterSemi
character*5 form
character*8 fm
character*1 c,c2
logical find
external find
common iCol,iCol1
character*10 label(100)
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 ! # of nest levels before
! current line
i2=0 ! # of 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,
! function or mainline
InMod=0 ! Inside module or
! contains
nMain=0 ! no mainline program yet
InElse=0 ! Found elseif, but not then
nlabel=0 ! # of labels for do loop
! ends
iAlphaNum=0 ! Last char of line is
! alpha-numeric
iContinueOld=0 ! next line not continued line
nline=0
iunit=1
10 a=' '
read(iunit,'(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(j.le.160.and.a(i:i).ge.' '.and.a(i:i).lt.char(128))then
b(j:j)=a(i:i)
j=j+1
endif
enddo
a=' ' ! Pre-processed output
i=1 ! Basic pre-processing
j=1
i72flag=0 ! nothing over column 72
! yet
iOldAlphaNum=iAlphaNum ! last line ended in
! alpha-numeric?
iAlphaNum=0
iContinue=iContinueOld ! This line continued line?
if(find(b,'&',2,0))iContinue=1 ! will be changed to 2 after
! first non/blank.
if(iContinue.eq.0)then
iquote=0 ! no ' yet
idquote=0 ! no " yet
endif
j=1
! comment line
if((b(1:1).eq.'c'.or.b(1:1).eq.'C').and.ifree.ne.1)goto 15
if(b(1:1).eq.'*'.or.b(1:2).eq.'??')goto 15
do i=1,LenA(b)
c=b(i:i)
! handle upper case
if(c.ge.'A'.and.c.le.'Z')c=char(ichar(c)+32)
! ASCII 33 is '!'
if(c.eq.char(33).and.iquote.eq.0.and.idquote.eq.0)goto 15
if(i.gt.72.and.c.ne.' ')then
if(ifree.eq.0.and.i72flag.eq.0)then
i72flag=1
PRINT*,'***WARNING--PAST COLUMN 72 at line',form
if(fout)print*,b
print*,char(7)
elseif(ifree.eq.2)then
c=' '
endif
endif
if(c.eq.''''.and.(i.ne.6.or.ifree.ne.0).and.idquote.eq.0)
& iquote=1-iquote
if(c.eq.'"' .and.(i.ne.6.or.ifree.ne.0).and.iquote .eq.0)
& idquote=1-idquote
if(iquote.eq.1)then
if(find(a,'include ',2,0).and.iembed.ne.0)then
iquote=0
idquote=0
endif
endif
if(iquote.ne.0.or.idquote.ne.0)c=' '
if(j.gt.1)then ! (kill multiple spaces,
! and spaces around =)
c2=a(j-1:j-1)
if(c.eq.' '.and.c2.eq.' ')j=j-1
if(c.eq.'='.and.c2.eq.' ')j=j-1
if(c.eq.' '.and.c2.eq.'=')j=j-1
if(c.eq.' '.and.c2.eq.'=')c='='
endif
! Look for
! identifiers that wrap
! around lines.
if((i.gt.6.or.ifree.ne.0).and.c.ne.' '.and.c.ne.'&')then
iAlphaNum=0
if((c.ge.'a'.and.c.le.'z').or.
& (c.ge.'0'.and.c.le.'9'))then
iAlphaNum=1
if(iContinue.eq.1)then
if(iOldAlphaNum.ne.0)then
PRINT*,'***POSSIBLE SPLIT IDENTIFIER across line',form
print*,char(7)
endif
endif
endif
iContinue=2
endif
if(j.le.160)a(j:j)=c
j=j+1
enddo
15 iContinueOld=0
if(a(LenA(a):LenA(a)).eq.'&')iContinueOld=1
i2=i1
i3=i1
i4=0
igoto=0 ! no goto on line
Main1=0 ! (Not mainline)
! Possible mainline start
16 AfterSemi=' ' ! Break line at semicolons
if(find(a,';',0,160-1))then
AfterSemi=' '//a(icol:160)
a=a(1:icol1-1)
endif
if(a.ne.' '.and.InSub.eq.0.and.InMod.eq.0)Main1=1
! Mark various types of jump
if(find(a,'go to',8+64,0).or.find(a,'goto',8+64,0).or.
& find(a,'end=',16,0) .or.find(a,'err=',16,0) .or.
& find(a,'return',8+64,0).or.find(a,'cycle ',8,0).or.
& find(a,'exit ',8,0) .or.find(a,'stop ',8,0))
& igoto=1
if(find(a,')1',64,0).or.find(a,')2',64,0).or.
& find(a,')3',64,0).or.find(a,')4',64,0).or.
& find(a,')5',64,0).or.find(a,')6',64,0).or.
& find(a,')7',64,0).or.find(a,')8',64,0).or.
& find(a,')9',64,0))
& igoto=1
if(find(a,') 1',64,0).or.find(a,') 2',64,0).or.
& find(a,') 3',64,0).or.find(a,') 4',64,0).or.
& find(a,') 5',64,0).or.find(a,') 6',64,0).or.
& find(a,') 7',64,0).or.find(a,') 8',64,0).or.
& find(a,') 9',64,0))
& igoto=1
if(find(a,'::',0,0))then ! To distinguish
iDeclare=iCol ! declarations from
! keywords
else
iDeclare=999
endif
if(find(a,'include ''',2,0).and.iembed.ne.0)then
filnam=a(iCol:160)
if(.not.find(filnam,'''',0,0))goto 20
filnam(iCol-1:80)=' '
if(fout)print*,'including file ',filnam(1:50)
close(3)
open(3,file=filnam,status='old',err=17)
iunit=3
nlinesave=nline
nline=0
i2=i2+1
i3=i3+1
goto 20
17 PRINT*,'***WARNING--Missing include file***'
print*,char(7)
elseif(find(a,'end module ',2,0).or.
& find(a,'endmodule ',2,0).or.
& find(a,'end interface',2,0).or.
& find(a,'endinterface',2,0).or.
& find(a,'end type ',2,0).or.
& find(a,'endtype ',2,0))then
i3=i3-1
InMod=InMod-1
if(find(a,'endmodule ',2,0).or.
& find(a,'end module ',2,0))then
InMod=0
if(InSub.gt.0.or.i3.ne.0)then
PRINT*,'***ERROR--INVALID DIAGRAMMING INDEX line',form
if(fout)WRITE(2,*)
& '***ERROR--INVALID DIAGRAMMING INDEX!***'
if(fout)print*,b
print*,char(7)
endif
endif
InElse=0
elseif(find(a,'enddo ',256,0).or.
& find(a,'end do ',256,0))then
i3=i3-1
nlabel=max(0,nlabel-1)
InElse=0
elseif(find(a,'endif ',256,0).or.
& find(a,'end if ',256,0).or.
& find(a,'endselect ',256,0).or.
& find(a,'end select ',256,0).or.
& find(a,'endforall ',256,0).or.
& find(a,'end forall ',256,0).or.
& find(a,'endforall ',256,0).or.
& find(a,'end where ',256,0).or.
& find(a,'endwhere ',256,0))then
i3=i3-1
InElse=0
elseif(find(a,'end ',256,0).or.
& find(a,'end function ',256,0).or.
& find(a,'endfunction ',256,0).or.
& find(a,'end subroutine ',256,0).or.
& find(a,'endsubroutine ',256,0).or.
& find(a,'end program ',256,0).or.
& find(a,'endprogram ',256,0).or.
& find(a,'end block',256,0).or.
& find(a,'endblock',256,0))then
i3=i3-1
InSub=InSub-1
if(InSub.lt.0.or.(InSub.gt.0.and.InMod.le.0))then
if(InSub.lt.0.and.InMod.gt.0.and.find(a,'end ',256,0))then
InSub=0
InMod=InMod-1
else
PRINT*,'***ERROR--INVALID DIAGRAMMING INDEX line',form
if(fout)
& WRITE(2,*)'***ERROR--INVALID DIAGRAMMING INDEX!***'
if(fout)print*,b
print*,char(7)
endif
endif
if(i3.eq.0)InSub=0
InElse=0
elseif(find(a,'elseif',128+256,0).or.
& find(a,'else if',128+256,0))then
i4=max(i4,1)
InElse=0
if(.not.find(a,'then ',8,0))InElse=1
elseif(find(a,'then ',8,0))then
i2=i2+1
if(InElse.eq.0)i3=i3+1
InElse=0
elseif( find(a,'selectcase',256,0).or.
& find(a,'select case',256,0))then
i2=i2+1
i3=i3+1
i4=max(i4,1)
InElse=0
elseif(find(a,'else ',256,0).or.
& find(a,'entry ',4,0).or.
& find(a,'case ',256,0).or.
& find(a,'case(',256,0).or.
& find(a,'contains ',2,0).or.
& find(a,'elsewhere ',256,0).or.
& find(a,'else where ',256,0))then
i4=max(i4,1)
InElse=0
if(find(a,'contains ',2,0))then
if(fout)print*,'Line ',form,' ',b(1:LenA(b))
InMod=InMod+1
endif
elseif( find(a,'selectcase',256,0).or.
& find(a,'select case',256,0).or.
& find(a,'for all (',256,0).or.
& find(a,'forall (',256,0).or.
& find(a,'for all(',256,0).or.
& find(a,'forall(',256,0))then
i2=i2+1
i3=i3+1
InElse=0
elseif( find(a,'where (',256,0).or.
& find(a,'where(',256,0))then
if(find(a,'(',0,0))iCol=iCol
iCntParen=1
do i=iCol,LenA(a)
if(a(i:i).eq.'(')iCntParen=iCntParen+1
if(a(i:i).eq.')')iCntParen=iCntParen-1
if(iCntParen.eq.0)then
if(a(i:160).eq.')')then
i2=i2+1
i3=i3+1
InElse=0
endif
goto 20
endif
enddo
elseif((find(a,'module ',2,iDeclare).and.
& .not.find(a,'module procedure',2,iDeclare)).or.
& find(a,'interface ',2,iDeclare).or.
& (find(a,'type ',2,iDeclare).and.
& .not.find(a,'(',0,iDeclare)).or.
& (find(a,'type,',2,iDeclare).and.
& .not.find(a,'(',0,iDeclare)))then
if(fout)print*,'Line ',form,' ',b(1:LenA(b))
i2=i2+1
i3=i3+1
Main1=0
if(find(a,'module ',2,iDeclare).and.InMod.ne.0)then
PRINT*,'***ERROR--NESTED MODULES***'
if(fout)WRITE(2,*)'***NESTED MODULES***'
if(fout)print*,b
print*,char(7)
endif
InMod=InMod+1
InElse=0
elseif(find(a,'do while',128+256,0).or.
& find(a,'dowhile',128+256,0))then
i2=i2+1
i3=i3+1
nlabel=min(100,nlabel+1)
label(nlabel)='####'
InElse=0
elseif(find(a,' do ',256,0).or.
& (ifree.ne.0.and.a(1:3).eq.'do '))then
if(ifree.ne.0.and.a(1:3).eq.'do ')iCol=4
if(iCol1.lt.7.or.a(7:max(7,iCol1)).eq.' '.or.
& (ifree.ne.0.and.a(1:3).eq.'do '))then
i2=i2+1
i3=i3+1
iCol2=iCol
dowhile(iCol2.lt.160.and.a(iCol2:iCol2).ge.'0'.and.
& a(iCol2:iCol2).le.'9')
iCol2=iCol2+1
enddo
iCol2=iCol2-1
nlabel=min(100,nlabel+1)
if(iCol2.ge.iCol)then
label(nlabel)=a(iCol:iCol2)
else
label(nlabel)='####'
endif
endif
InElse=0
elseif(find(a,': do ',0,0).or.find(a,':do ',0,0))then
i2=i2+1
i3=i3+1
InElse=0
elseif(find(a,'function ',4,iDeclare).or.
& find(a,'subroutine ',4,iDeclare).or.
& find(a,'program ',2,iDeclare) .or.
& find(a,'block data ',2,iDeclare).or.
& find(a,'blockdata ',2,iDeclare))then
if(fout)print*,'Line ',form,' ',b(1:LenA(b))
if(InSub.ne.0.and.InMod.eq.0)then
PRINT*,'***ERROR--ROUTINE INSIDE ROUTINE***'
if(fout)WRITE(2,*)'***ERROR--ROUTINE INSIDE ROUTINE***'
if(fout)print*,b
print*,char(7)
endif
Main1=0
InSub=InSub+1
i2=i2+1
i3=i3+1
if(InSub.eq.1.and.i3.ne.1.and.InMod.le.0)then
PRINT*,'***ERROR--INVALID DIAGRAMMING INDEX line',form
if(fout)
& WRITE(2,*)'***ERROR--INVALID DIAGRAMMING INDEX!***'
if(fout)print*,b
print*,char(7)
i3=1
endif
InElse=0
endif
20 if(Main1.ne.0)then ! Was start of mainline
if(fout)print*,'Line ',form,' ',b(1:LenA(b))
if(nMain.gt.0)then
PRINT*,'***ERROR--TOO MANY MAINLINES***'
if(fout)WRITE(2,*)'***ERROR--TOO MANY MAINLINES!***'
if(fout)print*,b
print*,char(7)
endif
InSub=InSub+1
nMain=nMain+1
i2=i2+1
i3=i3+1
endif
21 if(b(1:5).ne.' '.or.ifree.ne.0)then ! Search for DO labels
istart=1
dowhile(istart.lt.160.and.b(istart:istart).eq.' ')
istart=istart+1
enddo
iend=istart
dowhile(iend.lt.160.and.
& (b(iend:iend).ge.'0'.and.b(iend:iend).le.'9'))
iend=iend+1
enddo
iend=iend-1
if(iend.ge.1.and.b(1:max(1,iend)).ne.' ')then
do i=1,nlabel
j=nlabel+1-i ! (in reverse order)
if(b(istart:iend).eq.label(j))then
i3=i3-1
nlabel=max(0,j-1)
goto 21
endif
enddo
endif
endif
if(AfterSemi.ne.' ')then
a=AfterSemi
goto 16
endif
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)WRITE(2,*)'***ERROR--INVALID DIAGRAMMING INDEX!***'
if(fout)print*,b
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(iunit.eq.3)then
iunit=1
i1=i1-1
close(3)
nline=nlinesave
goto 10
endif
if(i3.gt.0.or.InSub.ne.0)then
PRINT*,'***WARNING--SOME NEST LEVELS LEFT HANGING AT END***'
print*,char(7)
endif
end
c-----------------------------------------------------------------------
logical function find(a,b,icond,jcol) ! find b in a, subject
! to conditions:
! Column is prior to jcol
! (if jcol.ne.0)
! 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
! 512 Prior character, if present,
! must be blank or ) or }
! or { or ;
c Program by Mitchell R Grunes, (grunes at domain 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.
jjcol=999
if(jcol.gt.0)jjcol=jcol
do i=1,min(ii-jj+1,jjcol)
if(a(i:i+jj-1).eq.b)then ! Found--Now do tests
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
do iii=1,iCol1-1
c2=a(iii:iii)
if((c2.lt.'0'.or.c2.gt.'9').and.c2.ne.' ')result=.false.
enddo
endif
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
end
c-----------------------------------------------------------------------
function LenA(a) ! Length of string, at
! least 1
c Program by Mitchell R Grunes, (grunes at domain 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