dc. DO SPLIT Èc. Splits a FORTRAN file based on PROGRAM etc. statements. ,c. Xc. Split a file based on the following statement types: ¼c. c. C/ELT, BLOCK DATA, END, FUNCTION, PROGRAM, SUBROUTINE „c. èc. The program will prompt for an Input File? to be split. Lc. The data from that file will be read and then written to other files °c. based on the existance of the control statements in the file, e.g. c. C/ELT.... The Alpha-numberic following this will be used to create xc. a file of type .SPL and the input will be written to the file Üc. until an END statement. @c. ¤c. The program will suppress comment cards between the start of c. the file and the first SUBROUTINE..., or non comment card, or between lc. END and the next such card. Ðc. 4c. If no such file name is found when the program must write ˜c. it will create a files, Annn.SPL, and put the records on the file. üc. ` c. Restrictions: Only 1 blank in BLOCK DATA, No Typed FUNCTIONs. Ä c.-end.of.info- ( c. Œ c. Feb 02, 1980 -- correct no name skip problem ð c. Mar 20, 1980 -- correct upper case problem T c. Apr 03, 1980 -- Better c/elt and Annn.slp processing ¸ c.  c.Origin: Systems Control Inc, 1801 Page Mill Rd., Palo Alto, Ca. 94304 € c. (415) 494-1165, x217 Mike Liveright ä c. H c. z Program split ¬ parameter iin=1, iou = 99 c. t character xin*80, xup*80 Øc. <c.........  91 format( 10a ) 92 format( q, 10a ) hc......... Ìc. 0100 continue ” type 91,'$File to be split? ' ø read( 5, 91 ) xin \ write(6,91)' ' À write(6,91)' Record, File_created' $ write(6,91)' ' ˆ open( unit=iin, name=xin, type='old' ) ìc. P200 continue ´ read( iin, 92, end=9000 ) ixl, xin  do 205 ii=1,80 | xup(ii:ii) = xin(ii:ii) à if( xup(ii:ii).ge. 'a' .and. xup(ii:ii) .le. 'z' ) D 1 xup(ii:ii) = char( 'A' + ichar(xup(ii:ii))-ichar('a') ) ¨205 continue c. p irec = irec+1 Ôc. 8c... find first non blank œc.  do 210 ib=1,ixl d if( xin(ib:ib).ne.' ' .and.xin(ib:ib).ne.' ' ) goto 300 È210 continue , goto 200 c. .... ôc. X300 continue ¼ inxx = 10  if( index(xup(ib:), 'SUBROUTINE') .eq. 1 ) goto 500 „ inxx=10 è if( index(xup(ib:), 'BLOCK DATA') .eq. 1 ) goto 500 L inxx = 8 ° if( index(xup(ib:), 'FUNCTION') .eq. 1 ) goto 500  inxx = 7 x if( index(xup(ib:), 'PROGRAM') .eq. 1 ) goto 500 Ü inxx = 5 @ if( index(xup(ib:), 'C/ELT') .eq. 1 ) goto 500 ¤ inxx = 3  if( index(xup(ib:), 'END') .eq. 1 ) goto 600 l c. Ð c... process normal card 4!c. ˜!400 continue ü! if( xup(1:1).eq.'C' .and. infile.eq.0 ) goto 200 `" if( infile.eq.0 ) then Ä" call dofile( infile, 1, irec, '.SPL' ) (# endif Œ# write( iou, 91 ) xin(1:ixl) ð# goto 200 T$c. .... ¸$c. %c... process subroutine, function €%c. ä%500 continue H& do 520 ist = ib+inxx,ixl ¬& if( xin(ist:ist).ne.' ' .and. xin(ist:ist).ne.' ' ) goto 525 '520 continue t'c. Ø'c. <(525 continue  ( do 540 ien = ist,ixl ) if( xin(ien:ien).eq.' ' .or. xin(ien:ien).eq.' ' h) 1 .or. xin(ien:ien).eq.'(' ) goto 545 Ì)540 continue 0*c. ”*545 continue ø* ien = ien-1 \+c. À+ if( infile.ne.0 .and. xup(1:6) .ne. 'C/ELT' ) then $, write( 6, 91 )' end,', xup(ibl:ibl+inxx) ˆ, endif ì, call dofile( infile, 1, irec, xin(ist:ien)//'.SPL' ) P- write( iou, 91 ) xin(1:ixl) ´- goto 200 .c. .... |.c. à.c... process end D/600 continue ¨/ if( xup(ib:ib+10).ne.'END' ) goto 400 0 write( iou, 91 ) xin(1:ixl) p0 call dofile( infile, 0, irec, 'END' ) Ô0 goto 200 81c. .... œ1c. 29000 continue d2 call dofile( infile, 0, irec, 'END' ) È2 end ,3c+++++++++ 3 subroutine dofile( infile, iflag, irec, fname ) ô3 character*(*) fname X4 character*40 crname ¼4c. 5c... infile, iflag == 0,close 1,open „5c. è593 format( i10, 10a ) L6c. °6 if( infile.eq.1 ) then 7 infile = 0 x7 if( iflag.ne.1 ) write( 6,93 ) irec, ' END' Ü7 close( unit=99 ) @8 endif ¤8 if( iflag.eq.1 ) then 9 infile = 1 l9 crname = fname Ð9 if( crname.eq.'.SPL' ) then 4: iname = iname+1 ˜: encode( 40, 210, crname ) iname ü:210 format( 'A',i3,'.spl' ) `; do 220 ii=2,3 Ä; if( crname(ii:ii).eq.' ' ) crname(ii:ii)='0' (<220 continue Œ< endif ð< lencr = jjlen(crname) T= write( 6 , 93 ) irec , ', ' , crname, etype ¸= open( unit=99,name=crname,type='new',carriagecontrol='list') > endif €>c. ä> return H? end