Free source code diagramming programs
in [Fortran]
|
From: mitch grunes on 10 Apr 2006 15:52 For people who have trouble reading that web page, see the folowing message I just posted this message to alt.sources: My source code diagramming programs Last revised 4/9/2006 This post to alt.sources is for anyone who has trouble reading my website http://www.geocities.com/grunes/diagram.html INTRODUCTION These programs diagram source code in the following languages: C and C++ FORTRAN HTML (very incomplete) IDL, PV-WAVE, GDL and FL They do things like draw lines showing the start and end of routines and blocks, put * next to jumps, and = next to commented out sections, and can warn you of certain classes of error. They can help you find problems in your own code, or help you look at other people's long complicated legacy code. For example: +----------- subroutine a(x) | 1 |+---------- do i=1,5 | 2 ||+----------- if(i/2*2.eq.i)then | 3 ||| x=x*i | 4 ||+----------- else | 5 ||| x=x/i | 6 ||+----------- endif | 7 |+---------- enddo | 8 +----------- end | 9 The VAX and MS-DOS procedures have not recently been tested. If you like or dislike these programs, send e-mail to username grunes at domain yahoo.com. Bug reports must include sample code on which it failed. The programs themselves are in FORTRAN. I know that is a problem for users of other programming languages, but FORTRAN is freely available as g77 or g95 under Cygwin (under Windows) or Linux, and is available as f77, f90 or f95 on many other platforms. Compilation is simple, e.g. g77 diagramf.f -o diagramf The files are at http://www.geocities.com/grunes/diagram.html, and are also included below. If you request it, I will email you a diagram.tar.gz archive containing everything. Included files: diagramc: Diagrams C, C++ diagramc.f Fortran language source code Procedures to run diagramc without answering questions: diagramc.sh Unix csh procedure diagramc.bat MS-DOS procedure diagramc.vax VAX VMS DCL procedure diagramf: Diagrams FORTRAN diagramf.f Fortran language source code Procedures to run diagramf without answering questions on card format code: diagramf.sh Unix csh procedure diagramf.bat MS-DOS procedure diagramf.vax VAX VMS DCL procedure Procedures to run diagramf without answering questions on free format code: diagram9.sh Unix csh procedure diagram9.bat MS-DOS procedure diagram9.vax VAX VMS DCL procedure diagramh: Diagrams HTML (Very Incomplete) diagramh.f Fortran language source code Procedures to run diagramh without answering questions: diagramh.sh Unix csh procedure diagramh.bat MS-DOS procedure diagramh.vax VAX VMS DCL procedure diagrami: Diagrams IDL, PV-WAVE, GDL, FL diagrami.f Fortran language source code Procedures to run diagrami without answering questions: diagrami.sh Unix csh procedure diagrami.bat MS-DOS procedure diagrami.vax VAX VMS DCL procedure undiagram: Try to derive source code from diagram undiagram.f Fortran language source code My Home Page: http://www.geocities.com/grunes -----------------BEGIN diagramc.f------------------- c EXAMPLE OF OUTPUT (looks better if you choose IBM PC line graphics): c +------ I_Hate_C() { | 1 c |+------- if (You_Like(C)) { | 2 c || BoyOrGirl=Bad; | 3 c +-|| #ifdef SMART | 4 c | || ReEducate(); | 5 c +-|| #endif | 6 c |+------- } else { | 7 c || BoyOrGirl=Good; | 8 c |+------- } | 9 c +------ } | 10 c Diagrams C language {} constructs, case and default, c and puts a * next to goto, break, continue, exit and return. It can c place = next to comment blocks. c Up to 2 levels of preprocessor constructs (#if--#elif--#endif) are c diagrammed separately, on the outside. 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 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 diagramc ! Diagrammer for C character*80 filnam,filnam2 print*,'C 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 at domain yahoo.com). character*80 filnam,filnam2 character*160 a,b,bsave character*5 form character*8 fm character*1 c logical fout logical find external find common icol 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 i3pp=0 ! same for pre-processor nline=0 icomment=0 ! not inside comment 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=b bsave=b b=' ' i1=i3 ! # nest levels before ! current line i1pp=i3pp ! same for pre-processor i4=0 ! not 0 to flag start or end ! of block i4pp=0 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.160) ! 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.eq.0.and.icomment.eq.0)then iquote=1-iquote if(i.gt.1)then ! char(92) is \ if(iquote.eq.0.and.a(i-1:i-1).eq.char(92)) & iquote=1-iquote endif endif if(c.eq.'"' .and.iquote .eq.0.and.icomment.eq.0)then idquote=1-idquote if(i.gt.1)then if(idquote.eq.0.and.a(i-1:i-1).eq.char(92)) & idquote=1-idquote endif endif if(c.eq.'/'.and.i.lt.160.and.iquote.eq.0.and.idquote.eq.0) ! / * ? & then if(a(i+1:i+1).eq.'/')icomment3=1 ! // is C++ comment line if(a(i+1:i+1).eq.'/')go to 15 if(a(i+1:i+1).eq.'*')then if(icomment.ne.0)then PRINT*,'***WARNING--nested comment line',form if(fout)print*,a print*,char(7) endif icomment=1 icomment3=1 c=' ' i=i+1 endif endif if(c.eq.'*'.and.i.lt.160.and.iquote.eq.0.and.idquote.eq.0) ! * / ? & then if(a(i+1:i+1).eq.'/')then if(icomment.eq.0)then PRINT*,'***WARNING--*/ without /* clause line',form if(fout)print*,a print*,char(7) endif icomment=0 c=' ' i=i+1 endif endif if(icomment.ne.0)c=' ' if(c.ne.' ')icomment2=1 if(c.eq.'{')then if(fout.and.i3.eq.0)print*,'Line ',form,' ',a(1:LenA(a)) i3=i3+1 elseif(c.eq.'}')then i3=i3-1 i4=max(i4,i1-i3) if(i3.lt.0)then PRINT*,'***ERROR--INVALID DIAGRAMMING INDEX line', & form if(fout) & WRITE(2,*)'***ERROR--INVALID DIAGRAMMING INDEX!***' if(fout)print*,a print*,char(7) i3=max(i3,0) endif endif if(j.le.160) 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 AT LINE ',form if(fout)WRITE(2,*)'***ERROR--UNCLOSED QUOTE AT LINE ',form if(fout)print*,a print*,char(7) endif 15 if(find(b,'#if',2).or.find(b,'# if',2))then i3pp=i3pp+1 i4pp=1 elseif(find(b,'#else',2).or.find(b,'# else',2) & .or.find(b,'#elif',2).or.find(b,'# elif',2))then i4pp=1 elseif(find(b,'#endif',2).or.find(b,'# endif',2))then i3pp=i3pp-1 i4pp=1 endif igoto=0 ! no goto on line if(find(a,'go to',64+512).or.find(a,'goto',64+512) & .or.find(a,'return',32+512) & .or.find(a,'break',32+512).or.find(a,'continue',32+512) & .or.find(a,'exit',32+512))igoto=1 if(find(b,'case',32+512).or. & 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.or. & i1pp.lt.0.or.i3pp.lt.0.or.i4pp.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) i3=max(i3,0) i4=max(i4,0) i1pp=max(i1pp,0) i3pp=max(i3pp,0) i4pp=max(i4pp,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 i2pp=max(i1pp,i3pp) i4pp=max(i4pp,iabs(i3pp-i1pp)) 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(icomment2.eq.0.and.icomment3.ne.0..and.inotate.ne.0) & a(1:1)='=' if(i2pp.gt.0)then ! Draw one vertical line per do i=2,min(i2pp+1,3) ! nest level. a(i:i)=BlockContinue(iBlock) enddo endif if(i4pp.ne.0)then ! Draw horizontal lines inward do i=i2pp+2,3 ! from above. a(i:i)=BlockHoriz(iBlock) enddo endif do i=0,i4pp-1 ! May need to replace some ! vertical lines with ! else symbol c= BlockElse(iBlock) ! or begin symbol if(i1pp+i.lt.i3pp)c=BlockBegin(iBlock)! or end symbol if(i1pp+i.gt.i3pp)c=BlockEnd (iBlock) j=max(2,min(3,i2pp+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(i2.gt.0)then ! Same for non-pre-processor do i=4,min(i2+3,LastUse) a(i:i)=BlockContinue(iBlock) enddo endif if(i4.ne.0)then do i=i2+4,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(4,min(LastUse,i2+2+1-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):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 i1pp=i3pp goto 10 99 if(iunit.eq.3)then iunit=1 i1=i1-1 i1pp=i1pp-1 close(3) goto 10 endif if(i3.gt.0.or.i3pp.gt.0)then PRINT*,'***WARNING--SOME NEST LEVELS LEFT HANGING AT END***' print*,char(7) endif end c----------------------------------------------------------------------- logical function find(a,b,icond) ! find b in a, subject to ! conditions: ! icond=sum of the following: ! 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 at domain 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. 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,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 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 ------------------END diagramc.f-------------------- -----------------BEGIN diagramc.sh------------------- #!/bin/csh # ---diagramc.sh--- #Unix csh procedure to diagram a C language program. #On some unix systems $1 should be replaced by %1. # by Mitchell R Grunes. # for his own use, in his own time #I assume that the executable and this procedure are in the search path, # and that this procedure has execute permission. #Syntax: # diagramc.sh #to be prompted for input parameters. #Alternate Syntax: # diagramc.sh filename(s) #to append diagram of file(s) into diagram.out if (${?noclobber}) then unset noclobber set noclobbersave endif if $1a == a then diagramc goto quit endif loop: echo ========================-- $1 --======================== #Prompt answers: input from $1, output to diagram2.sc (for now), # place numbers in column 67, notate comments with =, # don't use IBM PC graphics. echo $1 > diagram.sc echo diagram2.sc >> diagram.sc echo 67 >> diagram.sc echo 1 >> diagram.sc echo 0 >> diagram.sc diagramc < diagram.sc cat diagram2.sc >> diagram.out rm -f diagram.sc rm -f diagram2.sc shift if ! ($1a == a) then goto loop endif quit: echo Note--This does not delete diagram.out before appending to it. if (${?noclobbersave}) then set noclobber unset noclobbersave endif ------------------END diagramc.sh-------------------- -----------------BEGIN diagramc.bat------------------- rem ---diagramc.bat--- rem MS-DOS procedure to diagram a C language program. rem by Mitchell R Grunes. rem I assume that the executable is in directory c:\grunes on rem your PC. rem Syntax: rem diagramc rem to be prompted for input parameters. rem Alternate Syntax: rem diagramc filename(s) rem to append diagram of file(s) into diagram.out if %1a == a c:\grunes\diagramc if %1a == a goto quit echo off :loop echo ========================-- %1 --======================== rem Prompt answers: input from %1, output to diagram2.sc (for now), rem place numbers in column 67, notate comments with =, rem diagram pre-processor blocks, use IBM PC graphics. echo %1 > diagram.sc echo diagram2.sc >> diagram.sc echo 67 >> diagram.sc echo 1 >> diagram.sc echo 1 >> diagram.sc echo 1 >> diagram.sc c:\grunes\diagramc < diagram.sc type diagram2.sc >> diagram.out del diagram.sc del diagram2.sc shift if not %1a == a goto loop :quit echo Note--This does not delete diagram.out before appending to it. ------------------END diagramc.bat-------------------- -----------------BEGIN diagramc.vax------------------- $! ---diagramc.vax--- $!VAX VMS procedure to diagram a C language program $! $! by Mitchell R Grunes. $! $!I assume that the executable and this procedure are in the search path, $! and that this procedure has execute permission. $! $!Syntax: $! @diagramc.vax $!to be prompted for input parameters. $! $!Alternate Syntax: $! @diagramc.vax filename(s) $!to append diagram of file(s) into diagram.out $ $ if P1 .EQS. "" $ then $ define/user sys$input sys$command $ run diagramc $ goto quit $ endif $ $ write sys$output "========================-- "+P1+" --========================" $ $! Must pre-create diagram.out if does not exist $ open/append/error=noSkip diagram.out diagram.out $ goto Skip $noSkip: $ open/write diagram.out diagram.out $Skip: $ close diagram.out $ $! Must pre-create diagram2.sc with same file attributes $ open/write diagram2.sc diagram2.sc $ close diagram2.sc $ $ !Prompt answers: input from P1, output to diagram2.sc (for now), $ ! place numbers in column 67, notate comments with =, $ ! don't use IBM PC graphics. $ $ open/write diagram.sc diagram.sc $ write diagram.sc "$Run diagramc" $ write diagram.sc P1 $ write diagram.sc "diagram2.sc" $ write diagram.sc "67" $ write diagram.sc "1" $ write diagram.sc "0" $ close diagram.sc $ @diagram.sc $ append diagram2.sc diagram.out $ delete diagram.sc;* $ delete diagram2.sc;* $ $ if (P2 .NES. "") then @diagramc.vax 'P2' 'P3' 'P4' 'P5' 'P6' 'P7' 'P8' $ write sys$output "Note--This does not delete diagram.out before appending to it." $quit: ------------------END diagramc.vax-------------------- -----------------BEGIN diagramf.f------------------- 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 ------------------END diagramf.f-------------------- -----------------BEGIN diagramf.sh------------------- #!/bin/csh # ---diagramf.sh--- #Unix csh procedure to diagram a (card format) Fortran language program. #On some unix systems $1 should be replaced by %1. # by Mitchell R Grunes. # for his own use, in his own time #I assume that the executable and this procedure are in the search path, # and that this procedure has execute permission. #Syntax: # diagramf.sh #to be prompted for input parameters. #Alternate Syntax: # diagramf.sh filename(s) #to append diagram of file(s) into diagram.out if (${?noclobber}) then unset noclobber set noclobbersave endif if $1a == a then diagramf goto quit endif loop: echo ========================-- $1 --======================== #Prompt answers: input from $1, output to diagram2.sc (for now), # place numbers in column 73, embed include files, don't use free # format, don't use IBM PC graphics. echo $1 > diagram.sc echo diagram2.sc >> diagram.sc echo 73 >> diagram.sc echo 1 >> diagram.sc echo 0 >> diagram.sc echo 0 >> diagram.sc diagramf < diagram.sc cat diagram2.sc >> diagram.out rm -f diagram.sc rm -f diagram2.sc shift if ! ($1a == a) then goto loop endif quit: echo Note--This does not delete diagram.out before appending to it. if (${?noclobbersave}) then set noclobber unset noclobbersave endif ------------------END diagramf.sh-------------------- -----------------BEGIN diagramf.bat------------------- rem ---diagramf.bat--- rem MS-DOS procedure to diagram a (card format) FORTRAN language program. rem (use diagram9.bat to diagram free format Fortran programs) rem by Mitchell R Grunes. rem I assume that the executable is in directory c:\grunes on rem your PC. rem Syntax: rem diagramf rem to be prompted for input parameters. rem Alternate Syntax: rem diagramf filename(s) rem to append diagram of file(s) into diagram.out if %1a == a c:\grunes\diagramf if %1a == a goto quit echo off :loop echo ========================-- %1 --======================== rem Prompt answers: input from %1, output to diagram2.sc (for now), rem place numbers in column 73, embed include files, don't use free rem format, use IBM PC graphics. echo %1 > diagram.sc echo diagram2.sc >> diagram.sc echo 73 >> diagram.sc echo 1 >> diagram.sc echo 0 >> diagram.sc echo 1 >> diagram.sc c:\grunes\diagramf < diagram.sc type diagram2.sc >> diagram.out del diagram.sc del diagram2.sc shift if not %1a == a goto loop :quit echo Note--This does not delete diagram.out before appending to it. ------------------END diagramf.bat-------------------- -----------------BEGIN diagramf.vax------------------- $! ---diagramf.vax--- $!VAX VMS procedure to diagram a (card format) Fortran language program $! $! by Mitchell R Grunes. $! $!I assume that the executable and this procedure are in the search path, $! and that this procedure has execute permission. $! $!Syntax: $! @diagramf.vax $!to be prompted for input parameters. $! $!Alternate Syntax: $! @diagramf.vax filename(s) $!to append diagram of file(s) into diagram.out $ $ if P1 .EQS. "" $ then $ define/user sys$input sys$command $ run diagramf $ goto quit $ endif $ $ write sys$output "========================-- "+P1+" --========================" $ !Prompt answers: input from P1, output to diagram2.sc (for now), $ ! place numbers in column 73, embed include files, don't use free $ ! format, don't use IBM PC graphics. $ $! Must pre-create diagram.out if does not exist $ open/append/error=noSkip diagram.out diagram.out $ goto Skip $noSkip: $ open/write diagram.out diagram.out $Skip: $ close diagram.out $ $! Must pre-create diagram2.sc with same file attributes $ open/write diagram2.sc diagram2.sc $ close diagram2.sc $ $ open/write diagram.sc diagram.sc $ write diagram.sc "$Run diagramf" $ write diagram.sc P1 $ write diagram.sc "diagram2.sc" $ write diagram.sc "73" $ write diagram.sc "1" $ write diagram.sc "0" $ write diagram.sc "0" $ close diagram.sc $ @diagram.sc $ append diagram2.sc diagram.out $ delete diagram.sc;* $ delete diagram2.sc;* $ $ if (P2 .NES. "") then @diagramf.vax 'P2' 'P3' 'P4' 'P5' 'P6' 'P7' 'P8' $quit: $ write sys$output "Note--This does not delete diagram.out before appending to it." ------------------END diagramf.vax-------------------- -----------------BEGIN diagram9.sh------------------- #!/bin/csh # ---diagram9.sh--- #Unix csh procedure to diagram a (free format) FORTRAN language program. #On some unix systems $1 should be replaced by %1. # by Mitchell R Grunes, for his own use, in his own time. #I assume that the executable and this procedure are in the search path, # and that this procedure has execute permission. #Syntax: # diagram9.sh #to be prompted for input parameters. #Alternate Syntax: # diagram9.sh filename(s) #to append diagram of file(s) into diagram.out if (${?noclobber}) then unset noclobber set noclobbersave endif if $1a == a then diagramf goto quit endif loop: echo ========================-- $1 --======================== #Prompt answers: input from $1, output to diagram2.sc (for now), # place numbers in column 73, embed include files, use free # format, don't use IBM PC graphics. echo $1 > diagram.sc echo diagram2.sc >> diagram.sc echo 73 >> diagram.sc echo 1 >> diagram.sc echo 1 >> diagram.sc echo 0 >> diagram.sc diagramf < diagram.sc cat diagram2.sc >> diagram.out rm -f diagram.sc rm -f diagram2.sc shift if ! ($1a == a) then goto loop endif quit: echo Note--This does not delete diagram.out before appending to it. if (${?noclobbersave}) then set noclobber unset noclobbersave endif ------------------END diagram9.sh-------------------- -----------------BEGIN diagram9.bat------------------- rem ---diagram9.bat--- rem MS-DOS procedure to diagram a (free format) FORTRAN language program. rem (use diagramf.bat to diagram card format Fortran programs) rem by Mitchell R Grunes. rem I assume that the executable is in directory c:\grunes on rem your PC. rem Syntax: rem diagramf rem to be prompted for input parameters. rem Alternate Syntax: rem diagramf filename(s) rem to append diagram of file(s) into diagram.out if %1a == a c:\grunes\diagramf if %1a == a goto quit echo off :loop echo ========================-- %1 --======================== rem Prompt answers: input from %1, output to diagram2.sc (for now), rem place numbers in column 73, embed include files, use free rem format, use IBM PC graphics. echo %1 > diagram.sc echo diagram2.sc >> diagram.sc echo 73 >> diagram.sc echo 1 >> diagram.sc echo 1 >> diagram.sc echo 1 >> diagram.sc c:\grunes\diagramf < diagram.sc type diagram2.sc >> diagram.out del diagram.sc del diagram2.sc shift if not %1a == a goto loop :quit echo Note--This does not delete diagram.out before appending to it. ------------------END diagram9.bat-------------------- -----------------BEGIN diagram9.vax------------------- $! ---diagram9.vax--- $!VAX VMS
From: Keith Thompson on 10 Apr 2006 16:32 "mitch grunes" <idlwizard-1(a)yahoo.com> writes: > For people who have trouble reading that web page, see the folowing > message I just posted this message to alt.sources: [snip] I suggest that anyone who has trouble reading the web page should contact you directly. Posting serveral thousand lines of Fortran to comp.lang.c and comp.lang.c++ is not a good idea. -- Keith Thompson (The_Other_Keith) kst-u(a)mib.org <http://www.ghoti.net/~kst> San Diego Supercomputer Center <*> <http://users.sdsc.edu/~kst> We must do something. This is something. Therefore, we must do this.
From: Ben Pfaff on 10 Apr 2006 17:56 "mitch grunes" <idlwizard-1(a)yahoo.com> writes: > +----------- subroutine a(x) | 1 > |+---------- do i=1,5 | 2 > ||+----------- if(i/2*2.eq.i)then | 3 > ||| x=x*i | 4 > ||+----------- else | 5 > ||| x=x/i | 6 > ||+----------- endif | 7 > |+---------- enddo | 8 > +----------- end | 9 Do you actually find it easier to follow the lines or to look at the indentation? I'd take indentation over a snaking maze of lines any day. -- "Give me a couple of years and a large research grant, and I'll give you a receipt." --Richard Heathfield
From: Brooks Moses on 11 Apr 2006 04:58 Ben Pfaff wrote: > "mitch grunes" <idlwizard-1(a)yahoo.com> writes: > >>+----------- subroutine a(x) | 1 >>|+---------- do i=1,5 | 2 >>||+----------- if(i/2*2.eq.i)then | 3 >>||| x=x*i | 4 >>||+----------- else | 5 >>||| x=x/i | 6 >>||+----------- endif | 7 >>|+---------- enddo | 8 >>+----------- end | 9 > > Do you actually find it easier to follow the lines or to look at > the indentation? I'd take indentation over a snaking maze of > lines any day. If you print out the text with the lines, and trace over them in colored markers of various colors, they're pretty easy to follow. :) - Brooks -- The "bmoses-nospam" address is valid; no unmunging needed.
From: Richard Bos on 11 Apr 2006 08:38
Brooks Moses <bmoses-nospam(a)cits1.stanford.edu> wrote: > Ben Pfaff wrote: > > "mitch grunes" <idlwizard-1(a)yahoo.com> writes: > > > >>+----------- subroutine a(x) | 1 > >>|+---------- do i=1,5 | 2 > >>||+----------- if(i/2*2.eq.i)then | 3 > >>||| x=x*i | 4 > >>||+----------- else | 5 > >>||| x=x/i | 6 > >>||+----------- endif | 7 > >>|+---------- enddo | 8 > >>+----------- end | 9 > > > > Do you actually find it easier to follow the lines or to look at > > the indentation? I'd take indentation over a snaking maze of > > lines any day. > > If you print out the text with the lines, and trace over them in colored > markers of various colors, they're pretty easy to follow. :) Well yeah, but it's a lot of hard work to trace over 3914 lines of useless Usenet post... Richard |