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	CHAREX.FOR   MAIN PROGRAM FOR CONVERTING A FSA FILE
C                    TO A TY4 FILE.
C
C ***********************************************************************
C ***********************************************************************
C
C WRITTEN BY:  SUE COOK, DOUGLAS BOHRER
C	   PERSONNEL DEPARTMENT, THE FIRST NATIONAL BANK OF CHICAGO
C	   1 FIRST NATIONAL PLAZA, 22ND FLOOR
C	   CHICAGO, ILLINOIS 60670
C
C DATE:	       17-MAR-81
C REVISED:     11-JAN-83	RAISED OUTPUT RECORD LIMIT TO 8388607
C
C PURPOSE: A PROGRAM TO READ FILES OF CHARACTER DATA WRITTEN IN FORTRAN ASCII
C          SEQUENTIAL FORMAT AND CONVERT THE DATA TO SINGLE PRECISION FLOATING
C          POINT NUMBERS WITH APL STRUCTURAL DATA IN THE FIRST 24 BYTES ON
C          THE OUTPUT FILE.
C
C************************************************************************
C
	REAL*8 FTYP,ROWS,COLS
	REAL*4 BUFS(40),WBUF(128)
	REAL*8 BUFD(20)
C EQUIVALENT SINGLE AND DOUBLE PRECISION VERSIONS OF THE SAME INFORMATION
	EQUIVALENCE(BUFD,WBUF)
	LOGICAL*1 INF(16), FILNAM(16), FMAT(134)
C ASK THE USER FOR INPUT
	TYPE *, ' INPUT FILE NAME'
	READ(5,113) (INF(I), I=1,14)
113	FORMAT(14A1)
	OPEN(UNIT=2, NAME=INF, ACCESS='SEQUENTIAL', FORM='FORMATTED',
	1TYPE='OLD')
C READ IN EACH FIELD'S FORMAT SPECIFICATION.  EACH F WILL BE COUNTED
C TO FIND THE NUMBER OF COLUMNS.
	TYPE *,' FORMAT SPECIFICATION (DO NOT USE REPEAT COUNTS)'
	READ(5,213) (FMAT(I),I=1,130)
 213	FORMAT(130A1)
	TYPE *, ' OUTPUT FILE NAME'
	READ(5,113) (FILNAM(I),I=1,14)
C COUNT THE NUMBER OF FORMATS.  THE TOTAL, LENOUT, IS THE LENGTH    .
C OF THE OUTPUT RECORD.
	LENOUT=0
	DO 100 L100=1,130
	IF (FMAT(L100).EQ.'F') LENOUT=LENOUT+1
 100	CONTINUE
	IF(LENOUT.GT.40) TYPE *,'MORE THAN 40 FIELDS ARE NOT ALLOWED'
C OPEN THE OUTPUT FILE AND GET THE LOGICAL UNIT NUMBER
C AND SET THE INITIAL BLOCK AT 0.
	OPEN(UNIT=1,NAME=FILNAM,TYPE='NEW')
	ICH=ILUN(1)
	IBLK=0
C SET UP THE FILE TYPE, ROWS AND COLLUMNS.
	FTYP=4.0
	ROWS=0.0
	COLS=DBLE(FLOAT(LENOUT))
	BUFD(1)=FTYP
	BUFD(2)=ROWS
	BUFD(3)=COLS
C THE FIRST 24 BYTES HOLD THREE REAL*8 AND SIX REAL*4 INFORMATION
C THE FIRST SIX POSITIONS OF WBUF ARE NOW FILLED.
	IWBUF=7
 200	READ(2,FMAT,END=299)(BUFS(I),I=1,LENOUT)
C KEEP TRACK  OF HOW MANY RECORDS ARE READ.
	ROWS=ROWS+1.0
	DO 210 J=1,LENOUT
C MOVE DATA TO THO OUTPUT BUFFER.
	WBUF(IWBUF)=BUFS(J)
	IWBUF=IWBUF+1
C IF THE BUFFER IS FULL, WRITE IT TO DISK.
	IF(IWBUF.LE.128) GO TO 210
	CALL IWRITW(256,WBUF,IBLK,ICH)
	IBLK=IBLK+1
	IWBUF=1
 210	CONTINUE
	GO TO 200
 299	CONTINUE
C CLEAR ANY REMAINING DATA FROM THE BUFFER. WRITE IT TO THE FILE.
	IF (IWBUF.EQ.1) GO TO 310
	DO 300 J=IWBUF,128
	WBUF(J)=0.0
 300	CONTINUE
	CALL IWRITW(256,WBUF,IBLK,ICH)
 310	CALL IREADW(256,WBUF,0,ICH)
C PUT THE CORRECT NUMBER OF RECORDS INTO THE STRUCTURAL INFORMATION
C  AT THE FRONT OF THE FILE.
	BUFD(2)=ROWS
	CALL IWRITW(256,WBUF,0,ICH)
	CLOSE(UNIT=1,DISP='SAVE')
	CLOSE(UNIT=2, DISP='SAVE')
	STOP
	END
����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������