C****************************************************************************** C C Neither First Chicago Corporation, the First National Bank of Chicago, C nor any of its employees makes any warranty, either expressed or implied, C assumes any legal liability, nor any responsibility for the accuracy, C completeness or usefulness of any information, product or process disclosed. C Neither does First Chicago Corportion, the First National Bank of Chicago,nor C any of its employees represent that use of this material would not infringe C privately owned rights. C C****************************************************************************** C C C C this is fixlen MAIN PROGRAM TO CONVERT A FSA FILE TO AN XSA FILE C C C*********************************************************************** C*********************************************************************** C written by:Russell Seward, Douglas Bohrer C Personnel Department, The First National Bank of Chicago C 1 First National Plaza, 22nd Floor C Chicago,Illinois 60670 C C*********************************************************************** C C C Purpose: FIXLEN changes a fortran sequntial ascii(fsa) file into a C fixed length sequential ascii (xsa) file. C C Date: 30-Nov-81 C C********************************************************************* C C C VARIABLES C lenrec is the number of characters per record for both input C and output files. C iloc is the next available free space in the buffer. C iflag indicates if the buffer has just been emptied. C (1 is yes & 0 is no) C iextra is the number of characters that have spilled over into the C second part of the buffer. C C VECTORS C inf(14) contains the name of the input file. C outf(15) contains the name of the output file. C in(1024) is the buffer. C C C**************************************************************** C C This program has three parts. C*****************************PART ONE************************** C C Reads in the input filename, outputfile name, and record C length of both files. C logical*1 inf(14),outf(15),in(1024) type *,' input file name' read(5,113) (inf(i),i=1,14) 113 format(14a1) C this opens the input file. open(UNIT=1,name=inf,type='OLD',access='SEQUENTIAL', 1form='FORMATTED') type *,' output file name' read(5,113) (outf(i),i=1,14) type *,' record length' read(5,213)lenrec 213 format(i4) DEFINE FILE 2 (32000,256,U,ipos2) C This opens the output file. OPEN(UNIT=2,NAME=outf,TYPE='NEW',ACCESS='DIRECT', 1FORM='UNFORMATTED',RECORDSIZE=128,INITIALSIZE=-1, 2ASSOCIATEVARIABLE=ipos2,CARRIAGECONTROL='NONE') find(2'1) C*****************************PART TWO************************** C Reads the data into a vector of 1024 items called 'in'. C 'Lenrec' is the number of items that are read in at a time. C As soon as the number of items read in equals or exceeds C 512, then 512 items are written to the output file. The C extra items are moved to the beginning of vector 'in' C and the reading in is resumed at the location next C to the extra items. C iloc is the first location that is read into. iloc=1 C lenrec is the length of each record. 300 read(1,313,end=800)(in(i),i=iloc,iloc+lenrec-1) C iflag is 0 as long as less than 512 items have been read in. iflag=0 313 format(200a1,200a1,112a1) if(iloc+lenrec.le.512) go to 430 C If buffer has 512 items in it, then write it out C on the file. 400 write(2'ipos2)(in(i),i=1,512) C iflag is 1 if the buffer has more than 512 items C and the buffer is then read out. iflag=1 C iextra is the number of characters that overflowed into the C second half of the buffer. iextra=iloc+lenrec-513 if(iextra.eq.0) go to 420 C Loop 410 puts the iextra characters into the beginning of the C first half of the buffer. do 410 i=1,iextra in(i)=in(i+512) 410 continue 420 iloc=iextra+1 430 if(iflag.eq.0)iloc=iloc+lenrec C iloc is now the location of the next available space to be read in. go to 300 C*****************************************PART THREE************************** C C Loop 850 fills the remainder of the buffer with blanks. 800 do 850 i=iloc,1024 in(i)=' ' 850 continue C Prints out contents of entire buffer. write(2'ipos2)(in(i),i=1,512) write(2'ipos2)(in(i),i=513,1024) 999 close(UNIT=1,DISP='SAVE') close(UNIT=2,DISP='SAVE') stop end