Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0137/freq/freq.for
There is 1 other file named freq.for in the archive. Click here to see a list.
C	WESTERN MICHIGAN UNIVERSITY
C	FREQ.FRE (FILENAME ON LIBRARY DECTAPE)
C	FREQ, 1.4.3 (CALLING NAME, SUBLST#)
C	F, I, AND A-TYPE FREQUENCY COUNT PROGRAM
C	PROGRAMMED AT WMU BY B. HOUCHARD, LATER MODIFIED 
C	 BY D. C. SCHULZ AND M. T. O'BRYAN
C	BNKLIB.FOR PROGRAMS USED:  GETFRI, BNKNAM,VARLST, INFO,
C	 SELECT, PAGE, IO, GETID, GETMOD
C	LIBRARY DECTAPE PROGS. USED:  USAGE.MAC
C	FORWMU PROGS. USED:  TTYPTY, ALLCOR, GES, EXIST
C	 DEVCHR, GETPPN, EXISTS, RUNUUO, PRINTS, JOBNUM
C	 INTERNAL SUBR. USED:  MAINL, OPTION, COUNT, 
C	PACK, SFLO, SALP, SFIX, SIZE
C	ABOVE COMMENTS AND RIGHT ADJUSTED COMMENTS PUT IN BY WG
C
c	variable DEVTMP changed from DSKC to DSK for DECUS conversion
c	to DEC-20.
c			Paul T. Robinson, Wesleyan Univ., Oct 1980
C
C	THIS IS PART OF THE BANK SYSTEM DESIGNED BY RICHARD A. HOUCHARD.
C	IT ACCEPTS DATA FROM A STRUCTURED DATA BANK FILE, THE TELETYPE
C	AS WELL AS AN UNSTRUCTURED DATA FILE.  A, I, F-TYPE VARIABLES
C	ARE EASILY HANDLED.  OPTIONS EXIST TO ENTER VARIABLE NAMES,
C	TO SUBSET THE DATA BY SPECIFYING CERTAIN CRITERIA, OR TO ENTER
C	USER'S OWN FORMAT.  MISSING DATA DEFINED IN A DATA BANK WILL BE
C	TREATED AS MISSING.  A SHORT DESCRIPTION WILL TYPE OUT IN
C	RESPONSE TO "HELP" FROM THE USER IN MAJOR KEY PLACES.
C
C
C	LOADING COMMAND:
C	.LOAD %'SEG:LOW' FREQ, BNKLIB/LIB, REL:APLB10/LIB,
C			 AGE [400,400], SYS:FORLIB/LIB
C
C
C	SUBROUTINES USED:
C
C	     TTYPTY  (*)  DETERMINE IF JOB IS ON TELETYPE OR PSEUDO-
C			  TELETYPE
C
C	     USAGE   (*)  COUNTER FOR LIBRARY PROGRAMS USAGE
C
C	     IO 	  INPUT/OUTPUT SUBROUTINE
C
C	     GETID	  HEADER SUBROUTINE
C
C	     GETFR1	  FORMAT SUBROUTINE
C
C	     GETMOD	  DETERMINE MODES OF VARIABLES FROM THE FORMAT
C
C	     OPTION	  DETERMINE WHICH OPTIONS TO USE
C
C	     BNKNAM	  DETERMINE WHICH VARIABLES FROM THE DATA BANK
C			  TO BE USED
C
C	     VARLST	  OBTAIN VARIABLE NAMES OR NUMBERS FROM NON-DATA
C			  BANK INPUT
C
C	     SELECT	  ALLOWS PROGRAM TO CONSIDER ONLY THOSE OBSERVA-
C			  TIONS MEETING USER SPECIFIED CRITERIA
C
C	     INFO	  WRITE A HEADER PAGE FOR NON-TTY OUTPUT
C
C	     ALLCOR  (*)  TO ALLOCATE CORE DYNAMICALLY
C
C	     MAINL	  MAIN SUBROUTINE FOR THE PROGRAM
C
C	     GES     (*)  SUBROUTINE TO READ IN ONE LINE OF INFORMATION
C
C	     EXIST   (*)  TO DETERMINE IF A FILE ALREADY EXISTS IN THE
C			  USER'S AREA
C
C	     PACK	  USED IN DATA BANK FILE ONLY; IT PACKS THE DATA
C			  VECTOR WITH VALID DATA
C
C	     COUNT	  SORTS THE SYMBOLS IN ASCENDING ORDER AND
C			  COUNTS THEIR FREQUENCY OF OCCURENCES
C
C	     SIZE	  USED IN THE OUTPUT; IT DETERMINES THE NUMBER
C			  OF SYMBOLS PER COLUMN
C
C	     SALP	  OUTPUT SUBROUTINE FOR A-TYPE VARIABLES
C
C	     SFIX	  OUTPUT SUBROUTINE FOR I-TYPE VARIABLES
C
C	     SFLO	  OUTPUT SUBROUTINE FOR F-TYPE VARIABLES
C
C	     PAGE	  OUTPUTS PAGE NUMBER AND HEADER
C
C	     (*)  MACRO SUBROUTINE
C
C
C***********************************************************************
C***********************************************************************
C
C
	DIMENSION SPACE(1),IDUM(125)
C---------------SUBR. GETID, BNKNAM, SELECT, INFO, PAGE, VARLST 
C--------------- (BNKLIB.FOR), AND SUBR. MAINL, OPTION, SFLO,
C--------------- SALP, SFIX, SIZE SHARE COMMON /IOBLK/
C--------------- IDEVO, NAMO, IPROG, IOUT, INP, IDEVI, NAMI, 
C--------------- IPROJ ARE IN IO SUBR. ARG.LIST
	COMMON/IOBLK/INP,IOUT,IDEVI,IDEVO,IBNK,NAMI,NAMO,IPROJ,IPROG
C---------------SUBR IO SHARES COMMON /IOB/
	COMMON/IOB/LFBR,IRTBR,IALT,MAXPAG,IPAGE,IPAGCT,IDLG,ICC,ICODE
     .	,NOUT

C---------------SUBR. GETMOD, BNKNAM, SELECT, INFO, VARLST,
C--------------- COMMON /SBNK/
C---------------SUBR. BNKNAM (P. 14 OF BNKLIB.FOR) SHOWS ITEMP(5000)
C--------------- ALLOCATED TO NOGOOD, IV, NOMAT, NAME, NUM, MODE
	COMMON/SBNK/NVBNK,NOBNK,NDBNK(2),NPBNK(2),ITEMP(5000)
C---------------SUBR. GETFR1 SHARES COMMON /SGETFR/
	COMMON/SGETFR/ISTD,ITYPE
C	COMMON/FMT/NOTF(48)	! MTO: EXPANDED 11-AUG-76 AS PER REQUEST
C---------------SUBR. INFO SHARES COMMON /FMT/
	COMMON/FMT/NOTF(80)
C---------------SUBR OPTION SHARES COMMON /SOPT/
	COMMON/SOPT/IOPT(4),MAXOPT,DEVTMP,DEVMOD
C---------------SUBR GETID, INFO, PAGE SHARE COMMON /SID/
	COMMON/SID/ID(16),ISTOP
	INTEGER OFFSET
	DOUBLE PRECISION NAMI,NAMO,DEVNAM
	EQUIVALENCE (ITEMP,IDUM)
C
C**********************************************************************
C
C	DEVICES USED:
C
C	IDLG--DEVICE USED TO COMMUNICATE WITH USER
C	      IT IS ALWAYS SET TO -1
C
C	ICC---DEVICE USED TO ACCEPT USER'S RESPONSE
C	      IT IS ALWAYS SET TO -4
C
C	INP---DEVICE USED TO READ DATA
C	      ITS LOGICAL NUMBER IS DETERMINED BY IO SUBROUTINE
C
C	IOUT--DEVICE TO WRITE OUT THE RESULT
C	      ITS LOGICAL NUMBER IS DETERMINED BY THE IO SUBROUTINE
C
C
C
C	AUXILIARY DEVICES USED IN SUBROUTINE MAINL TO WRITE TEMPORARY
C	FILES:
C
C	IDSK--IT IS ALWAYS SET TO 20
C	LDSK--IT IS ALWAYS SET TO 1
C	DEVMOD--MODE IN WHICH TEMPORARY FILES ARE WRIITEN
C	DEVTMP--STRUCTURE WHERE TEMPORARY FILES ARE WRITTEN
C
C***********************************************************************
C
	IDLG=-1
	ICC=-4
	INP=2
	IOUT=3
	IPAGCT=0
	MAXPAG=58
	OFFSET=0
C---------------SEE SUBR.MAINL ST. 38, ST. 31 + 2
	DEVMOD='DUMP'
c	devtmp changed from DSKC to DSK for DEC-20 conversion
	DEVTMP='DSK'
C
C
	ITYPE=3
	WRITE(IDLG,9977)
9977	FORMAT('-*** W.M.U. FREQUENCY COUNT PROGRAM V2 ***'//)
C	CALL USAGE('FREQ')
C---------------TTYPTY RETURNS ZERO - TTY JOB, MINUS ONE BATCH JOB.
	CALL TTYPTY(ICODE)
C---------------1,0, IOUT, INP ARE INPUT.  OTHER ARGS. ARE RETURNED.
C--------------- LFBR, IRTBR, IALT ARE RETURNED THRU COMMON /IOB/
	CALL IO(1,IOUT,DEVNAM,IDEVO,NAMO,IPROJ,IPROG,IBNK)
1	CALL IO(0,INP,DEVNAM,IDEVI,NAMI,IPROJ,IPROG,IBNK)
	IDEVO=NOUT
	IPAGE=0
	IF(IDEVO.EQ.'TTY') IPAGE=-999999
10	CALL OPTION
	DO 110 I=1,16
110	ID(I)=' '
	ISTOP=0
C---------------IOPT(I) RETURNED BY OPTION THRU COMMON /SOPT/
	IF (IOPT(2).EQ.1) CALL GETID
	GO TO (21,12) IBNK+1
C
C**********************************************************************
C
C	FOR DATA BANK ONLY
C
C	(1)  READ HEADER RECORD IN THE DATA BANK:
C	     NVBNK--NUMBER OF VARIABLES IN THE BANK
C	     NOBNK--NUMBER OF OBSERVATIONS IN THE BANK
C	     NDBNK--DATE THE BANK WAS CREATED
C	     NPBNK--PROJ-PROG NUMBER THAT CREATED THE BANK
C
C
C	(2)  DETERMINE WHICH VARIABLES FROM THE BANK TO BE USED
C
C************************************************************************
12	READ(INP#1) IDUM
	IF (IDUM(8).EQ.'V2') GO TO 101
	WRITE(IDLG,102)
102	FORMAT('-This BANK was created with an experimental version of
     1 the BANK.'/' Please update the Bank by running BANKUP from area
     2 220,220.'/' If you are not responsible for the BANK, contact
     3 the owner and'/' ask him to run the updating program.'/)
	CALL EXIT
101	NVBNK=IDUM(1)
	NOBNK=IDUM(2)
	NDBNK(1)=IDUM(4)
	NDBNK(2)=IDUM(5)
	NPBNK(1)=IDUM(6)
	NPBNK(2)=IDUM(7)
C---------------N=NO. OF VAR. RETURNED; ITYPE=4 SENT. SEE SUBR. BNKNAM
C--------------- ST. 51 THRU 52 INCL.
100	CALL BNKNAM(4,N)
	NOTF(1)='DATA'
	NOTF(2)='BANK'
	NOTF(3)='FORMA'
	NOTF(4)='T'
C	DO 103 I=5,48	! MTO: 11-AUG-76
	DO 103 I=5,80
103	NOTF(I)=' '
	GO TO 30
C
C************************************************************************
C
C	NON-DATA BANK ONLY
C
C	(1)  ACCEPTS VARIABLE NAMES AND DETERMINE HOW MANY VARIABLES
C	     TO BE USED OR ACCEPTS THE TOTAL NO OF VARS.
C
C	(2)  DETERMINE WHICH FORMAT TO USE AND OBTAIN THE MODES OF THE
C	     VARIABLES
C
C***********************************************************************
C
C---------------N= NO. OF VARS. RETURNED
21	CALL VARLST(N)
	IF (IOPT(4).NE.1) ISTD=1
C---------------IOPT(4)=1 MEANS USER CHOSE FORMAT OPTION ITYPE=3 SENT
C--------------- TO GETFR1 THRU COMMON /SGETFR/ SEE ST. 9977-2.
C--------------- ITYPE=3 MEANS 'ENTER FORMAT ENCLOSED IN PARENTHESIS'
C--------------- WILL PRINT;  ITYPE=0,1,2 MEANS IN ADDITION F,A, OR I
C--------------- 'TYPE ONLY' WILL PRINT.  SEE GETFR1 ST. 100 AND 101.
C	IF (IOPT(4).EQ.1) CALL GETFR1(IOPT(1),48,NOTF)	! MTO: 11-AUG-76
	IF (IOPT(4).EQ.1) CALL GETFR1(IOPT(1),80,NOTF)
	IF (ISTD.EQ.1) GO TO 24
C	CALL GETMOD(N,240,NOTF)		! MTO: 11-AUG-76
	CALL GETMOD(N,400,NOTF)
	GO TO 30
24	NOTF(1)='(80A1'
	NOTF(2)=')'
C	DO 25 I=3,48		! MTO: 11-AUG-76
	DO 25 I=3,80
25	NOTF(I)=' '
C---------------HERE USER CHOSE 80A1 FORMAT;  THEREFORE MODE=1 I.E.
C--------------- A FORMAT.
C---------------SUBR.BNKNAM(P.14 OF BNKLIB.FOR) SHOWS ITEMP(2601-3400)=
C--------------- NAME, ITEMP(3401-4200)=NUM, ITEMP(4201-5000)=MODE
	DO 26 I=4201,4200+N
26	ITEMP(I)=1
C
C**********************************************************************
C	ALLOCATE CORE
C**********************************************************************
C
30	MAX=4*N
	CALL ALLCOR(MAX,IERR,OFFSET,SPACE(1))
C	IF(OFFSET.NE.0) CALL LSCORE(SPACE(1),OFFSET)
C	OFFSET=0
C	CALL GTCORE(MAX,SPACE(1),OFFSET,IERR,1000)
	IF(IERR) 32,31,32
32	WRITE(IDLG,310) N
310	FORMAT('-ERROR:  Number of variables ',I6,' outside allowable
     1 range, Try again'/)
	IF (ICODE.LT.0) CALL EXIT
	GO TO (21,100), IBNK+1
C
C
31	I1=OFFSET
	I2=I1+N
	I3=I2+N
	I4=I3+N
	CALL MAINL(N,SPACE(I1),SPACE(I2),SPACE(I3),SPACE(I4))
C
C***********************************************************************
C	END OF ONE DATA SET AND GO TO 'INPUT?'
C***********************************************************************
C
	WRITE(IDLG,40)
40	FORMAT('-')
	GO TO 1
	END
C---------------N IS INPUT, OTHER ARGS. ARE SPACES RESERVED BY DYN.
C--------------- ALLOC.
C---------------IOUT, IDEVO, IDEVI, IBNK INPUT THRU COMMON /IOBLK/
C---------------IPAGCT, IPAGE, MAXPAGE ARE INPUT THRU COMMON /IOB/
C---------------ITEMP, NOBNK, INPUT THRU COMMON /SBNK/
C---------------ISTD IS INPUT THRU COMMON /SGETFR/
C---------------NOTF INPUT THRU COMMON /FMT/
C---------------IOPT, MAXOPT, DEVTMP, DEVMOD, ARE INPUT THRU COMMON /SOPT/
C---------------SEE MAIN PROG. ST. 9977-5,6
C---------------ID, ISTOP INPUT THRU COMMON /SID/
C---------------NVAR, NCON, VALUE, NVAL, NOR INPUT THRU COMMON /SELEC/
C---------------NSEC MADE AVAIL. THRU COMMON /SELEC/ BY SUBR. MAINL
C---------------IST, MISS, M MADE AVAIL. THRU COMMON /SCOUNT/ BY
C--------------- SUBR. MAINL
C---------------IACT, ISIZE, MADE AVAIL. THRU COMMON /SYMSZ/ BY SUBR.
C--------------- MAINL
C---------------NOMIS MADE AVAIL. THRU COMMON /RPT/ BY SUBR. MAINL
C---------------SUBR. CALLED BY SUBR. MAINL: INFO(BNKLIB.FOR), PACK,
C--------------- COUNT
C---------------SIZE, SALP, SFIX, SFLO, PAGE, SELECT
C---------------FORWMU PROGS. USED BY SUBR. MAINL: EXIST (ST.65+1)
	SUBROUTINE MAINL(N,NAME,NUM,MODE,NSIZE)
	DIMENSION NAME(1),NUM(1),MODE(1),NSIZE(1),NTYPE(0/2),ISYM(600),
     1 SYM(600),NCK(125),KOUNT(600),DUM(125),IDUM(125),PER(600),
     2 MTYPE(0/2),X(3750),IX(3750),KKOUNT(125),IVALUE(20,20),IY(125),
     3 Y(125),NAM1(2),NAM2(2)
C
C**********************************************************************
C
C	MAIN SUBROUTINE OF THE PROGRAM
C
C	N-------NUMBER OF VARIABLES
C	NAME----VECTOR CONTAINING NAMES OF THE VARIABLES
C	NUM-----VECTOR CONTAING THE VARIABLE NUMBERS
C	MODE----VECTOR CONTAINING MODES OF THE VARIABLES
C	NSIZE---VECTOR USED TO STORE SYMBOL SIZES
C	NTYPE---0  FLOAT
C	        1  ALPHA
C	        2  FIXED
C	ISYM----VECTOR CONTAINING THE SYMBOLS
C	KOUNT---VECTOR CONTAINING THE COUNTERS
C	PER-----VECTOR CONTAINING THE PERCENTAGES
C	X-------DATA VECTOR
C
C**********************************************************************
C
	DOUBLE PRECISION NFILE1,NFILE2
	COMMON/IOBLK/INP,IOUT,IDEVI,IDEVO,IBNK,NAMI,NAMO,IPROJ,IPROG
	COMMON/IOB/LFBR,IRTBR,IALT,MAXPAG,IPAGE,IPAGCT,IDLG,ICC,ICODE
	COMMON/SBNK/NVBNK,NOBNK,NDBNK(2),NPBNK(2),ITEMP(5000)
	COMMON/SGETFR/ISTD,ITYPE
C	COMMON/FMT/NOTF(48)	! MTO: 11-AUG-76
	COMMON/FMT/NOTF(80)
	COMMON/SOPT/IOPT(4),MAXOPT,DEVTMP,DEVMOD
	COMMON/SID/ID(16),ISTOP
C---------------SUBR. INFO, PAGE(BNKLIB.FOR) SHARE COMMON /SINFO/
	COMMON/SINFO/CALNAM,PROG(12)
C---------------SUBR. SELECT(BNKLIB.FOR)SHARES COMMON /SELEC/
	COMMON/SELEC/NSEC,NVAR(20),NCON(20),VALUE(20,20),NVAL(20),
     1 NOR(20)
C---------------SUBR COUNT IN CORL.COR SHARES COMMON /SCOUNT/
	COMMON/SCOUNT/IST,M,INC,MISS
C---------------SUBR. COUNT, SFLO, SALP, SFIX, SIZE IN FREQ.FRE
C--------------- SHARE COMMON /SYMSZ/
	COMMON/SYMSZ/ISIZE,IACT
C---------------SUBR. SIZE, SFIX, SALP, SFLO SHARE COMMON /SSIZE/
	COMMON/SSIZE/IR,NTIMES,N1,MS(4),NS(5)
C---------------SUBR. SFLO, SALP, SFIX, SHARE COMMON /RPT/
	COMMON/RPT/NOMIS
C
C
C
	DOUBLE PRECISION NAMI,NAMO
	EQUIVALENCE(ITEMP,ISYM,SYM),(ITEMP(601),KOUNT),(ITEMP(1201),
     1 PER,X,IX),(ITEMP(2000),NCK),(MISS,AMISS),(IDUM,DUM),
     2 (IVALUE,VALUE),(KKOUNT,IY,Y),(NFILE1,NAM1),(NFILE2,NAM2)
C
C
C
	DATA CALNAM,PROG/'FREQ','F, I, A-TYPE  FREQUENCY  COUNT
     1  PROGRAM ',4*' '/
	DATA MTYPE/'F','A','I'/
C
C
C
	IDSK=20
	LDSK=1
C
C**********************************************************************
C	TRANSFER THE NAMES, NUMBERS AND MODES INTO THE PROPER VECTORS
C**********************************************************************
C
	DO 1 I=1,N
	NAME(I)=ITEMP(2600+I)
	NUM(I)=ITEMP(3400+I)
1	MODE(I)=ITEMP(4200+I)
C
C***********************************************************************
C	WRITE OUT A HEADER PAGE FOR NON-TTY OUTPUT
C***********************************************************************
C
	IF (IDEVO.EQ.'TTY') GO TO 101
	IPAGCT=IPAGCT+1
C---------------PART OF HEADER PAGE PRINTING COMES FROM INFO THE
C--------------- REST COMES FROM THE NEXT 9 LINES.
	CALL INFO(N)
	DO 11 I=1,MAXOPT
	IDUM(I)='NO'
	IF(IOPT(I).NE.0) IDUM(I)='YES'
11	CONTINUE
	WRITE(IOUT,100) (IDUM(I),I=1,MAXOPT),(NAME(I),I=1,N)
100	FORMAT('-',29X,'OPTIONS AVAILABLE:',2X,'SELECT',3X,'HEADER',3X,
     .	'MISS',
     .	3X,'FORMAT'/30X,'OPTIONS USED',5X,':',4X,A3,6X,A3,5X,A3,5X,A3/
     .	'-',29X,'VARIABLES USED:'//((37X,A5),9(2X,A5)))
C
C***********************************************************************
C	SELECT OPTION
C***********************************************************************
C
101	IF (IOPT(1).NE.1) NSEC=0
	IF (IOPT(1).EQ.1) CALL SELECT(N)
C
C
C
102	DO 10 I=0,2
10	NTYPE(I)=0
	MISS="400000000000
C
C**********************************************************************
C	COUNT NUMBER OF FLOATING, ALPHA AND FIXED VARIABLES
C**********************************************************************
C
25	DO 26 I=1,N
	L=MODE(I)
26	NTYPE(L)=NTYPE(L)+1
C
C*****************************************************************
C	OUTPUT HEADING AND VARIABLE TYPE
C***************************************************************
C
	IF(IDEVO.EQ.'TTY') GOTO 12
	WRITE(IOUT,335)
335	FORMAT('-')
	DO 336 I=0,2
	IF(NTYPE(I).EQ.0) GOTO 336
	WRITE(IOUT,337) MTYPE(I),NTYPE(I)
337	FORMAT(30X,'NUMBER OF ',A1,'-TYPE VARIABLES =',I7)
	WRITE(IDLG,37) MTYPE(I),NTYPE(I)
336	CONTINUE
	GOTO 13
12	WRITE(IDLG,35) (ID(I),I=1,ISTOP)
35	FORMAT('-',16A5)
	DO 36 I=0,2
	IF (NTYPE(I).NE.0) WRITE(IDLG,37) MTYPE(I),NTYPE(I)
37	FORMAT(' Number of ',A1,'-type variables =',I7)
36	CONTINUE
13	GO TO (60,30),IBNK+1
C
C
30	NT=(NOBNK+124)/125
	NTT=NT-1
	WRITE(IDLG,600)
	IF (NSEC.LE.0) GO TO 40
C
C
C
	IF (NT.EQ.1) GO TO 310
	NAM1(1)='00000'
	NAM1(2)='.TMP'
C---------------NFILE1 INPUT, I RETURNED, I=0 FILE EXISTS AND NAME
C--------------- IS LEGAL, =-1 NAME IS ILLEGAL  I=1 FILE
C--------------- NOT FOUND OR NOT READABLE.
380	CALL EXIST(NFILE1,I)
	IF (I.EQ.1) GO TO 38
	NAM1(1)=NAM1(1)+1
	GO TO 380
38	OPEN (UNIT=LDSK,FILE=NFILE1,MODE=DEVMOD,ACCESS='SEQOUT',
     .	DEVICE=DEVTMP)
310	DO 31 I=1,NT
	DO 32 J=1,125
	NCK(J)=1
	I1=0
	IZ1=1
33	I1=I1+1
C---------------NSEC=# OF QUALIFIERS
	IF (I1.GT.NSEC) GO TO 32
	IZ=1+I+(NVAR(I1)-1)*NT
C---------------FIRST REC. IS HEADER AND WE START WITH IZ=2
C---------------IF VAR # OF QUALIFIER IS SAME AS VAR # OF PREVIOUS
C--------------- QUALIFIER, THEN BYPASS READ ST., OTHERWISE WE READ THE
C--------------- APPROPRIATE RECORD FROM RANDOM ACCESS FILE. NVAR(J1)=ID 
C--------------- OF VAR. ASSOCIATED WITH J1TH QUALIFIER.
	IF (IZ.EQ.IZ1) GO TO 330
C---------------READ BINARY UNFORMATTED
	READ(INP#IZ) IDUM
	IZ1=IZ
C---------------THERE ARE SIX POSSIBILITIES FOR EACH NCON(J1).  THEY
C--------------- ARE:  EQ, GT, GE, LT, LE, NE
330	J1=NCON(I1)
C---------------NVAL IS # OF VALS. AFTER = IN A SELECT OPTION FOR THE
C--------------- I1TH QUALIFIER
	DO 340 I4=1,NVAL(I1)
	GO TO (341,342,343,344,345,346), J1
C
C---------------VALUE (I,J) IS THE ITH VALUE FOR THE JTH QUALIFIER
C--------------- SEE EQUIVALENCE ST.
341	IF (IDUM(J).EQ.IVALUE(I4,I1)) 3410,3420
342	IF (IDUM(J).GT.IVALUE(I4,I1)) 3410,3420
343 	IF (IDUM(J).GE.IVALUE(I4,I1)) 3410,3420
344	IF (IDUM(J).LT.IVALUE(I4,I1)) 3410,3420
345	IF (IDUM(J).LE.IVALUE(I4,I1)) 3410,3420
346	IF (IDUM(J).EQ.IVALUE(I4,I1)) GO TO 3420
C
C
3410	NCK(J)=0
3411	IF (I1.EQ.NSEC) GO TO 32
C---------------NOR IS LINE # OF 'OR' QUALIFIERS
	IF (NOR(I1).NE.NOR(I1+1)) GO TO 33
	I1=I1+1
	GO TO 3411
C
C
3420	IF (I4.NE.NVAL(I1)) GO TO 340
	IF (I1.NE.NSEC) GO TO 3421
3422	NCK(J)=1
	GO TO 32
3421	IF (NOR(I1).NE.NOR(I1+1)) 3422,33
340	CONTINUE
C
32	CONTINUE
	IF ((I.EQ.NT).AND.(I.EQ.1)) GO TO 40
	WRITE(LDSK) NCK
31	CONTINUE
	CLOSE (UNIT=LDSK)
	OPEN (UNIT=LDSK,FILE=NFILE1,MODE=DEVMOD,ACCESS='SEQIN',
     .	DEVICE=DEVTMP)
C
C
C
C
40	INC=1
	M1=NOBNK-NTT*125
	DO 42 I=1,N
	NOB=0
	MT=125
	IZ=1+(NUM(I)-1)*NT
	ISIZE=0
	IACT=0
	IF (NT.LE.1) GO TO 47
	DO 43 J=1,NTT
	IST=1
	J1=IZ+J
	READ(INP#J1) IDUM
	IF (NSEC.EQ.0) GO TO 430
	READ(LDSK) NCK
C---------------PUT GOOD DATA INTO IY AS DETERMINED BY NCK.MT, IDUM, NCK
C--------------- SUPPLED M, IY RETURNED
	CALL PACK(M,MT,IY,IDUM,NCK)
	IF (M.LE.0) GO TO 43
	NOB=NOB+M
C---------------SORTS AND COUNTS SYMBOLS.  IY(SUPPLED BY PACK) INPUT,
C--------------- ISYM AND KOUNT RETURNED.
	CALL COUNT(IY,ISYM,KOUNT)
	GO TO 43
C
430	M=125
	NOB=NOB+M
	CALL COUNT(IDUM,ISYM,KOUNT)
43	CONTINUE
C
C
C
47	IST=1
	MT=M1
	J1=NT*NUM(I)+1
49	READ(INP#J1) IDUM
	IF (NSEC.LE.0) GO TO 492
	IF (NT.LE.1) GO TO 490
	READ(LDSK) NCK
	REWIND LDSK
C
490	CALL PACK(M,MT,IY,IDUM,NCK)
	IF (M.LE.0) GO TO 460
	NOB=NOB+M
	CALL COUNT(IY,ISYM,KOUNT)
	GO TO 460
492	M=MT
	NOB=NOB+M
	CALL COUNT(IDUM,ISYM,KOUNT)
C
C**********************************************************************
C	PERCENTAGE
C**********************************************************************
C
460	IF (I.NE.1) GOTO 464
	WRITE(IDLG,461) NOB
	IF(IDEVO.NE.'TTY') WRITE(IOUT,4461) NOB
4461	FORMAT(30X,'NUMBER OF OBSERVATIONS USED=',I7/)
	IF((NOB.GT.0).AND.(IDEVO.NE.'TTY')) CALL PAGE
461	FORMAT(' Number of observations used=',I7/)
464	IF (NOB.GT.0) GO TO 4610
	IF ((NSEC.NE.0).AND.(NT.NE.1)) CLOSE(UNIT=LDSK,DISPOSE='DELETE')
	RETURN
4610	OBS=100./NOB
	NOMIS=1
	IF (ISYM(1).NE.MISS) GO TO 463
	ISYM(1)='MISSI'
	IF((ISIZE.GT.1).AND.(IOPT(3).EQ.1))OBS=100./(NOB-KOUNT(1))
	NOMIS=2
	IF(IOPT(3).EQ.1) NOMIS=3
463	DO 46 J=1,ISIZE
46	PER(J)=KOUNT(J)*OBS
	S=' '
	IF (ISIZE.GT.1) S='S'
	IJMOD=MODE(I)
	CALL SIZE(IJMOD)
	IF(IPAGE+7.GT.MAXPAG) CALL PAGE
	IPAGE=IPAGE+4
	WRITE(IOUT,746) NAME(I),ISIZE,S
	IF (IACT.LE.600) GOTO 4611
	IF(IPAGE+4.GT.MAXPAG) CALL PAGE
	IPAGE=IPAGE+4
	 WRITE(IOUT,747) NAME(I)
4611	GO TO (52,50,51), IJMOD+1
C
50	CALL SALP(ISYM,KOUNT,PER)
	GO TO 53
C
51	CALL SFIX(ISYM,KOUNT,PER)
	GO TO 53
C
52	CALL SFLO(SYM,KOUNT,PER)
C
C
C
53	IF(N.EQ.I) GOTO 42
	IF(IPAGE+4.GT.MAXPAG) CALL PAGE
	IF(IPAGE.EQ.2) GOTO 42
	IPAGE=IPAGE+3
	WRITE(IOUT,54)
54	FORMAT('-')
42	CONTINUE
	IF ((NSEC.NE.0).AND.(NT.NE.1)) CLOSE(UNIT=LDSK,DISPOSE='DELETE')
	GO TO 90
C
C**********************************************************************
C	NON-DATA BANK ONLY
C**********************************************************************
C
60	IF (IDEVI.EQ.'TTY') GO TO 61
	WRITE(IDLG,600)
600	FORMAT('-Please wait, your data is being processed'//)
	GO TO 612
61	WRITE(IDLG,610)
610	FORMAT('-ENTER DATA')
	IF (ISTD.EQ.1) WRITE(IDLG,611)
611	FORMAT(' Format assumed: (80A1)')
C
C
C
612	NP=1
	IS=1
	NT=3750/N
	ISIZE=0
	IACT=0
	NOB=0
	NOBS=0
	INC=N
	DO 613 I=1,N
613	NSIZE(I)=0
630	NTT=0
	DO 63 I=1,NT
	I1=(I-1)*N+1
	I2=I*N
631	READ(INP,NOTF,ERR=632,END=64) (IX(JJ),JJ=I1,I2)
	GO TO 633
632	JJ=NOB+1
	WRITE(IDLG,63200) JJ
63200	FORMAT('-ERROR:  Illegal character in observation:',I7/
     1 9X,'Program proceeds ignoring the observation'///)
	GO TO 631
C
633	NOB=NOB+1
	IF (NSEC.LE.0) GO TO 6310
	J=0
	IA=1
C---------------SEE COMMENT FOR ST. 33+1 THRU ST. 3411+1 FOR
C--------------- NSEC, NCON(J), NVAL(J), IVALUE(I,J), NOR(J) AND 
C--------------- RELATED INFO.
6300	J=J+1
	IF (J.GT.NSEC) GO TO 6320
	JJ=I1+NVAR(J)-1
	J2=NCON(J)
	DO 6319 I3=1,NVAL(J)
	GO TO (6301,6302,6303,6304,6305,6306), J2
C
6301	IF (IX(JJ).EQ.IVALUE(I3,J)) 6311,6312
6302	IF (IX(JJ).GT.IVALUE(I3,J)) 6311,6312
6303	IF (IX(JJ).GE.IVALUE(I3,J)) 6311,6312
6304	IF (IX(JJ).LT.IVALUE(I3,J)) 6311,6312
6305	IF (IX(JJ).LE.IVALUE(I3,J)) 6311,6312
6306	IF (IX(JJ).EQ.IVALUE(I3,J))GO TO 6312
C
C
6311	IA=0
63110	IF (J.EQ.NSEC) GO TO 6320
	IF (NOR(J).NE.NOR(J+1)) GO TO 6300
	J=J+1
	GO TO 63110
C
6312	IF (I3.NE.NVAL(J)) GO TO 6319
	IF (J.NE.NSEC) GO TO 6313
63120	IA=1
	GO TO 631
C
6313	IF (NOR(J).NE.NOR(J+1)) 63120,6300
C
6319	CONTINUE
6320	IF (IA.EQ.1) GO TO 631
6310	NTT=NTT+1
63	CONTINUE
	M=NTT*N
	NOBS=NOBS+NTT
	IF (N.GT.1) GO TO 651
650	IST=1
	CALL COUNT(IX,ISYM,KOUNT)
	NSIZE(1)=IACT
	GO TO (630,70),NP
C
64	NP=2
	IF (NTT.LE.0) GO TO 70
	M=NTT*N
	NOBS=NOBS+NTT
	IF (N.LE.1) GO TO 650
651	NAM1(2)='.001'
	NAM1(1)='00001'
65	NAM1(1)=NAM1(1)+1
	CALL EXIST(NFILE1,I)
	IF (I.NE.1) GO TO 65
	OPEN(UNIT=IDSK,FILE=NFILE1,ACCESS='SEQOUT',MODE=DEVMOD,
     .	DEVICE=DEVTMP)
	IF (IS.EQ.2) OPEN(UNIT=LDSK,FILE=NFILE2,ACCESS='SEQIN',
     1 MODE=DEVMOD,DEVICE=DEVTMP)
660	DO 66 I=1,N
	IACT=NSIZE(I)
	ISIZE=MIN0(IACT,600)
	IST=I
	IF (IS.LE.1) GO TO 68
	I1=(ISIZE+124)/125
	K=0
	DO 670 J=1,I1
	READ(LDSK) IDUM
	READ(LDSK) KKOUNT
	DO 670 JJ=1,125
	K=K+1
	IF (K.GT.ISIZE) GO TO 68
	ISYM(K)=IDUM(JJ)
	KOUNT(K)=KKOUNT(JJ)
670	CONTINUE
68	CALL COUNT(IX,ISYM,KOUNT)
69	K=0
	DO 690 J=1,ISIZE
	K=K+1
	IF (K.GT.125) GO TO 691
	IDUM(K)=ISYM(J)
	KKOUNT(K)=KOUNT(J)
	GO TO 690
691	WRITE(IDSK) IDUM
	WRITE(IDSK) KKOUNT
	IDUM(1)=ISYM(J)
	KKOUNT(1)=KOUNT(J)
	K=1
690	CONTINUE
	NSIZE(I)=IACT
	IF (K.LE.0) GO TO 66
	WRITE(IDSK)IDUM
	WRITE(IDSK) KKOUNT
66	CONTINUE
	IF (IS.EQ.2) CLOSE(UNIT=LDSK,DISPOSE='DELETE')
	CLOSE(UNIT=IDSK,DISPOSE='RENAME',FILE=NFILE1)
	IS=2
	DO 6600 J=1,2
6600	NAM2(J)=NAM1(J)
	GO TO (630,70), NP
C
C
70	IF(IDEVO.NE.'TTY') WRITE(IOUT,4461) NOBS
	IF(IDEVO.NE.'TTY') CALL PAGE
	WRITE(IDLG,461) NOBS
	IF (NOBS.LE.0) RETURN
	IF (N.GT.1) OPEN (UNIT=LDSK,FILE=NFILE2,ACCESS='SEQIN',
     1 MODE=DEVMOD,DEVICE=DEVTMP)
	OBS=100./NOBS
	IF((ISYM(1).EQ.MISS).AND.(IOPT(3).EQ.1))OBS=100./(NOBS-KOUNT(1))
	NC=0
	DO 72 J=1,N
	IJ=MODE(J)
	NC=NC+1
	ISIZE=MIN0(NSIZE(J),600)
	IF (N.GT.1) GO TO 74
	DO 721 JJ=1,ISIZE
721	PER(JJ)=KOUNT(JJ)*OBS
	GO TO 744
74	KK=0
740	READ(LDSK) IDUM
	READ(LDSK) KKOUNT
7410	DO 741 JJ=1,125
	KK=KK+1
	IF (KK.GT.ISIZE) GO TO 744
	ISYM(KK)=IDUM(JJ)
	KOUNT(KK)=KKOUNT(JJ)
741	PER(KK)=KOUNT(KK)*OBS
	IF (KK.LT.ISIZE) GO TO 740
C
744	NOMIS=1
	S=' '
	IF (ISIZE.GT.1) S='S'
	IF (ISYM(1).NE.MISS) GO TO 745
	NOMIS=2
	ISYM(1)='MISSI'
	IF(IOPT(3).EQ.1) NOMIS=3
745	CALL SIZE(IJ)
	IF(IPAGE+7.GT.MAXPAG) CALL PAGE
	IPAGE=IPAGE+4
	WRITE(IOUT,746) NAME(J),ISIZE,S
746	FORMAT('-***** VARIABLE ',A5,' HAS ',I3,' VALUE',A1,' *****'/)
	IF (NSIZE(J).LE.600) GOTO 7411
	IF(IPAGE+4.GT.MAXPAG) CALL PAGE
	IPAGE=IPAGE+4
	WRITE(IOUT,747) NAME(J)
747	FORMAT(' NOTE: More than 600 symbols encountered in variable ',
     1 A5,','/8X,'No further symbols will be considered, but the
     2 counts for'/8X,'those symbols in the table will be accurate.'/)
7411	GO TO (75,76,77), IJ+1
75	CALL SFLO(SYM,KOUNT,PER)
	GO TO 78
76	CALL SALP(ISYM,KOUNT,PER)
	GO TO 78
77	CALL SFIX(ISYM,KOUNT,PER)
C
C
C
78	IF(J.EQ.N) GOTO 72
	IF(IPAGE+4.GT.MAXPAG) CALL PAGE
	IF(IPAGE.EQ.2) GOTO 72
	IPAGE=IPAGE+3
	WRITE(IOUT,54)
72	CONTINUE
90	IF (N.GT.1) CLOSE(UNIT=LDSK,DISPOSE='DELETE')
	RETURN
	END
C---------------IOPT AND MAXOPT ARE INPUT THRU COMMON /SOPT/
C---------------IDLG, ICODE, IALT INPUT THRU COMMON /IOB/
C---------------IBNK INPUT THRU COMMON /IOBLK/
	SUBROUTINE OPTION
C
C***********************************************************************
C	SUBROUTINE THAT DETERMINES WHICH OPTION IS ELECTED
C
C	     IOPT(I)=0  MEANS THAT PARTICULAR OPTION IS NOT ELECTED
C	            =1  OTHERWISE
C
C***********************************************************************
C
	DIMENSION IDUM(72),LIST(4),ISAVE(5)
C
C
C
	COMMON/IOBLK/INP,IOUT,IDEVI,IDEVO,IBNK,NAMI,NAMO,IPROJ,IPROG
	COMMON /IOB/LFBR,IRTBR,IALT,MAXPAG,IPAGE,IPAGCT,IDLG,ICC,ICODE
C---------------IOPT(1),...,IOPT(4) CORRESPONDS TO SELECT, HEADER, 
C--------------- MISS, FORMAT OPTIONS RESP.   IOPT(I), MAXOPT RETURNED
C--------------- TO MAINL BY SUBR. OPTION
	COMMON/SOPT/IOPT(4),MAXOPT
	DOUBLE PRECISION NAMI,NAMO
C
C
	DATA LIST/'SELEC','HEADE','MISS','FORMA'/
	DATA IDOL,MAXOPT/'$',4/
C
1	WRITE(IDLG,100)
100	FORMAT(' OPTIONS?'/)
C---------------IDUM, IRET ARE RETURNED GES IS IN FORWMU
	CALL GES(IDUM,72,IRET)
	IF (IRET.EQ.2) CALL EXIT
	IF ((IDUM(1).EQ.'S').AND.(IDUM(2).EQ.'A').AND.(IDUM(3).EQ.'M')
     1.AND.(IDUM(4).EQ.'E')) RETURN
	NPT=1
	DO 10 I=1,3
10	IOPT(I)=0
C
C
C
	DO 2 LAST=72,1,-1
	IF (IDUM(LAST).NE.' ') GO TO 200
2	CONTINUE
	RETURN
C
C
C
200	DO 20 I=1,5
20	ISAVE(I)=' '
	IS=0
	DO 21 I=1,LAST
	L=IDUM(I)
	IF (L.EQ.' ') GO TO 21
	IF ((L.EQ.',').OR.(L.EQ.IALT).OR.(L.EQ.IDOL)) GO TO 22
	IF (IS.GE.5) GO TO 21
	IS=IS+1
	ISAVE(IS)=L
	GO TO 21
C
C
22	K=' '
	ENCODE(5,220,K) ISAVE
220	FORMAT(5A1)
	IF (K.EQ.'HELP') GO TO 40
	IF (K.EQ.'NONE') RETURN
	IF ((K.EQ.'ALL').OR.(K.EQ.'*')) GO TO 26
	DO 23 J=1,MAXOPT
	IF (K.EQ.LIST(J)) GO TO 25
23	CONTINUE
	WRITE(IDLG,24) K
24	FORMAT('-ERROR:  Option code "',A5,'" does not exist, Try again'
     1 /)
	IF (ICODE.GE.0) GO TO 1
	CALL EXIT
C
C
C
25	IF ((IBNK.NE.1).OR.(J.NE.MAXOPT)) IOPT(J)=1
	IF ((IBNK.EQ.1).AND.(J.EQ.MAXOPT)) WRITE(IDLG,252)
252	FORMAT('-WARNING:  Cannot use FORMAT with a data BANK'/9X,'P
     .rogram will ignore this option'/)
253	IF ((NPT.GT.1).OR.((I.EQ.LAST).AND.((L.EQ.IALT).OR.(L.EQ.IDOL)))
     1) RETURN
	DO 250 J=1,5
250	ISAVE(J)=' '
	IS=0
21	CONTINUE
	IF (IS.LE.0) RETURN
	NPT=2
	GO TO 22
C
C
26	LAST=MAXOPT
	IF (IBNK.NE.1) GO TO 260
	LAST=MAXOPT-1
	WRITE(IDLG,252)
C
260	DO 27 J=1,LAST
27	IOPT(J)=1
30	RETURN
C
C
40	WRITE(IDLG,41)
41	FORMAT('-Options available are:'//' CODE     DESCRIPTION'/
     1 1X,4('-'),5X,11('-')/' SELECT   Option to consider only those
     2 observations meeting user'/10X,'specified criteria'/' HEADER
     3   A line of at most 80 columns to be used as HEADER'/
     4 ' FORMAT   Option to enter own format, Default: (80A1)'/
     .' MISS	 Missing data will not be in calculations of perc
     .entages'/
     5 1X,12('-')/' ALL      All of the options listed above'/
     6 ' NONE     None of the options listed'/' SAME     Maintain
     7 the options used in the previous run'//' Enter the desired
     8 options in a line separated by commas.'/)
	IF (ICODE.GE.0) GO TO 1
	CALL EXIT
	END
	SUBROUTINE PACK(M,MT,IY,IDUM,NCK)
C
C**********************************************************************
C
C	SUBROUTINE THAT PUTS ALL THE GOOD DATA IN IY AS DETERMINED
C	BY THE VECTOR NCK
C
C	ARGUMENTS COMING FROM CALLING PROGRAM:
C	   MT-----NUMBER OF OBSERVATIONS TO CONSIDER
C	   IDUM---VECTOR CONTAINING THE ACTUAL DATA
C	   NCK----VECTOR CONTAINING 1'S AND 0'S TO DETERMINE IF A
C	          PARTICULAR DATA POINT IS GOOD OR BAD
C
C
C	ARGUMENTS RETURN TO CALLING PROGRAM:
C	   M-----ACTUAL NUMBER OF OBSERVATIONS TO CONSIDER
C	   IY----VECTOR CONTAINING THE GOOD DATA
C
C***********************************************************************
C
	DIMENSION IY(125),IDUM(125),NCK(125)
	M=0
	DO 10 I=1,MT
	IF (NCK(I).EQ.1) GO TO 10
	M=M+1
	IY(M)=IDUM(I)
10	CONTINUE
	RETURN
	END
	SUBROUTINE COUNT(IX,ISYM,KOUNT)
C---------------IX INPUT, ISYM AND KOUNT RETURNED
C--------------- IACT INPUT THRU COMMON /SYMSZ/ AND MODIFIED
C--------------- ISIZE REURNED THRU COMMON /SYMSZ/
C---------------IST, M, MISS INPUT THRU COMMON /SCOUNT/AND IST IS MODIFIED
C
C*********************************************************************
C	SUBROUTINE THAT SORTS AND COUNTS THE SYMBOLS
C
C	IX------VECTOR CONTAINING THE DATA
C	ISYM----VECTOR CONTAINING THE SYMBOLS
C	KOUNT---VECTOR CONTAINING THE COUNTS ASSOCIATED WITH THE SYMBOLS
C	IST-----STARTING POINT IN IX
C	M-------NUMBER OF DATA POINTS IN IX TO CONSIDER
C	INC-----SIZE OF INCREMENT TO TAKE IN IX
C	MISS----MISSING DATA SYMBOL
C	ISIZE---SIZE OF SYMBOLS, COULD BE MORE THAN 600
C	IACT----ACTUAL SIZE OF THE SYMBOLS, CANNOT BE MORE THAN 600
C
C***********************************************************************
C
	DIMENSION IX(1),ISYM(1),KOUNT(1)
	COMMON/SCOUNT/IST,M,INC,MISS
	COMMON/SYMSZ/ISIZE,IACT
	ISIZE=MIN0(IACT,600)
	IF (ISIZE.GT.0) GO TO 20
	ISIZE=1
	IACT=1
	ISYM(1)=IX(IST)
	IF (ISYM(1).EQ.' ') ISYM(1)='BLANK'
	KOUNT(1)=1
	IF (M.LE.1) RETURN
	IST=IST+INC
	IF (IST.GT.M) RETURN
C
C
C
20	DO 21 I=IST,M,INC
	L=IX(I)
	I1=1
	IF (L.EQ.' ') L='BLANK'
	IF (L.NE.MISS) GO TO 210
	IF (ISYM(1).NE.MISS) GO TO 22
	KOUNT(1)=KOUNT(1)+1
	GO TO 21
210	IF (ISYM(1).EQ.MISS) I1=2
C
C	BUG FIX 4/28/77
C
C	IF WE SET I1=2 BECAUSE ((L .NE. MISS) .AND. (MISS.EQ.ISYM(1)))
C	I1 MAY BE GREATER THAN ISIZE, SO JUST COUNT THE NEW SYMBOL
C
	IF(I1.GT.ISIZE)GO TO 230
C
	IF (L.EQ.ISYM(I1)) GO TO 24
	IF (L.GT.ISYM(I1)) GO TO 25
22	IF (IACT.GE.600) GO TO 2100
	DO 23 J=ISIZE,I1,-1
	ISYM(J+1)=ISYM(J)
23	KOUNT(J+1)=KOUNT(J)
230	ISIZE=ISIZE+1
	IACT=IACT+1
	KOUNT(I1)=1
	ISYM(I1)=L
	GO TO 21
24	KOUNT(I1)=KOUNT(I1)+1
	GO TO 21
25	IF (L.LT.ISYM(ISIZE)) GO TO 30
	IF (L.GT.ISYM(ISIZE)) GO TO 27
26	KOUNT(ISIZE)=KOUNT(ISIZE)+1
	GO TO 21
27	IF (IACT.GE.600) GO TO 2100
	I1=ISIZE+1
	GO TO 230
30	L1=I1
	L2=ISIZE
31	I1=(L1+L2)/2
	IF (L.EQ.ISYM(I1)) GO TO 24
	IF (L.LT.ISYM(I1)) L2=I1
	IF (L.GT.ISYM(I1)) L1=I1
	K1=L2-L1
	IF (K1.GT.1) GO TO 31
	I1=L2
	IF (K1.LT.1) I1=I1+1
	GO TO 22
2100	IACT=601
21	CONTINUE
	RETURN
	END
	SUBROUTINE SFLO(SYM,KOUNT,PER)
C---------------SYM, KOUNT, AND PER ARE INPUT TO SFLO, MAXPAGE, IPAGE
C--------------- INPUT THRU COMMON /IOB/IOUT, IDEVO INPUT 
C--------------- THRU COMMON /IOBLK/  IR, NTIMES, N1, NS, INPUT THRU
C--------------- COMMON /SSIZE/ ISIZE INPUT THRU COMMON /SYMSZ/
C--------------- NOMIS INPUT THRU COMMON /RPT/

C
C**********************************************************************
C	SUBROUTINE THAT WRITES OUT THE REPORT FOR FLOATING POINT
C	     VARIABLES.
C
C	SYM----VECTOR CONTAINING THE SYMBOLS
C	KOUNT--VECTOR CONTAINING THE COUNTS ASSOCIATED WITH THE SYMBOLS
C	PER----VECTOR CONTAINING THE PERCENTAGES
C**********************************************************************
C
	DIMENSION SYM(1),KOUNT(1),PER(1)
	COMMON/IOBLK/INP,IOUT,IDEVI,IDEVO,IBNK,NAMI,NAMO,IPROJ,IPROG
	COMMON/IOB/LFBR,IRTBR,IALT,MAXPAG,IPAGE,IPAGCT,IDLG,ICC,ICODE
	COMMON/SYMSZ/ISIZE,IACT
	COMMON/SSIZE/IR,NTIMES,N1,MS(4),NS(5)
	COMMON/RPT/NOMIS
	DOUBLE PRECISION NAMO,NAMI
	DATA DASH,BLANK/'-',' '/
	IF(IPAGE+5.GT.MAXPAG) CALL PAGE
	IPAGE=IPAGE+2
	WRITE(IOUT,71) (BLANK,J=1,NTIMES*2)
71	FORMAT(4(2A5,'VALUE',4X,'FREQ PERCENT'))
	WRITE(IOUT,53) ((DASH, J=1,23),JJ=1,NTIMES)
53	FORMAT(4(8X,23A1))
	IS=1
	GO TO (73,720,62), NOMIS
720	WRITE(IOUT,72) ((SYM(1+NS(L)),KOUNT(1+NS(L)),PER(1+NS(L))),
     1 L=1,NTIMES)
72	FORMAT(8X,A5,'NG',I8,F7.2,'%',3(1X,F14.3,I8,F7.2,'%'))
	GOTO 63
62	IF(ISIZE.GT.1) GOTO 66
	WRITE(IOUT,64) SYM(1+NS(1)),KOUNT(1+NS(1))
	GOTO 63
66	WRITE(IOUT,64) SYM(1+NS(1)),KOUNT(1+NS(1)),(SYM(1+NS(L)),
     .	KOUNT(1+NS(L)),PER(1+NS(L)),L=2,NTIMES)
64	FORMAT(8X,A5,'NG',I8,8X,3(1X,F14.3,I8,F7.2,'%'))
63	IPAGE=IPAGE+1
	IF (NTIMES.EQ.ISIZE) RETURN
	IF (IS.EQ.N1) GO TO 76
	IS=2
73	IF (IDEVO.NE.'TTY') GOTO 65
	WRITE(IOUT,74) (((SYM(K+NS(L)),KOUNT(K+NS(L)),
     1 PER(K+NS(L))),L=1,NTIMES),K=IS,N1)
74	FORMAT(2(1X,F14.3,I8,F7.2,'%'))
	GOTO 76
65	DO 69 K=IS,N1
	IPAGE=IPAGE+1
	IF(IPAGE.LT.MAXPAG) GOTO 69
	CALL PAGE
	IPAGE=IPAGE+4
	WRITE(IOUT,71) (BLANK,J=1,NTIMES*2)
	WRITE(IOUT,53) ((DASH,J=1,23),JJ=1,NTIMES)
69	WRITE(IOUT,75) ((SYM(K+NS(L)),KOUNT(K+NS(L)),
     1 PER(K+NS(L))),L=1,NTIMES)
75	FORMAT(4(1X,F14.3,I8,F7.2,'%'))
76	IF (IR.EQ.0) RETURN
	WRITE(IOUT,75) ((SYM(NS(I)),KOUNT(NS(I)),PER(NS(I))),I=2,IR+1)
	IPAGE=IPAGE+1
	RETURN
	END
	SUBROUTINE SALP(ISYM,KOUNT,PER)
C---------------ISYM, KOUNT, AND PER ARE INPUT TO SALP
C--------------- IR, NTIMES, N1, NS ARE INPUT THRU COMMON /SSIZE/
C---------------IACT, ISIZE INPUT THRU COMMON /SYMSZ/
C---------------IPAGE, MAXPAGE, INPUT THRU COMMON /IOB/
C---------------IOUT, IDEVO INPUT THRU COMMON /IOBLK/
C
C**********************************************************************
C	SUBROUTINE THAT WRITES OUT THE REPORT FOR ALPHA-TYPE VARIABLES
C
C	ISYM---VECTOR CONTAINING THE SYMBOLS
C	KOUNT--VECTOR CONTAINING THE COUNTS ASSOCIATED WITH THE SYMBOLS
C	PER----VECTOR CONTAINING THE PERCENTAGES
C*********************************************************************
C
	DIMENSION ISYM(1),KOUNT(1),PER(1),ISAVE(5)
	COMMON/IOBLK/INP,IOUT,IDEVI,IDEVO,IBNK,NAMI,NAMO,IPROJ,IPROG
	COMMON /IOB/LFBR,IRTBR,IALT,MAXPAG,IPAGE,IPAGCT,IDLG,ICC,ICODE
	COMMON/SYMSZ/ISIZE,IACT
	COMMON/SSIZE/IR,NTIMES,N1,MS(4),NS(5)
	COMMON/RPT/NOMIS
	DOUBLE PRECISION NAMI,NAMO
	DATA DASH,BLANK,ITAB/'-----',' ','	'/
C
C	THIS SECTION IS FOR CHANGING TAB'S TO A SPACE
C	FOR OUTPUT
C
	DO 40 I=1,IACT
	J=ISYM(I)
	IF((J.AND."774000000000).EQ."044000000000) GOTO 41
	IF((J.AND."003760000000).EQ."000220000000) GOTO 41
	IF((J.AND."000017700000).EQ."000001100000) GOTO 41
	IF((J.AND."000000077400).EQ."000000004400) GOTO 41
	IF((J.AND."000000000376).EQ."000000000022) GOTO 41
	GOTO 40
41	DECODE(5,441,J) ISAVE
441	FORMAT(5A1)
	DO 42 L=1,5
	IF(ISAVE(L).EQ.ITAB) ISAVE(L)=' '
42	CONTINUE
	ENCODE(5,441,ISYM(I)) ISAVE
40	CONTINUE
C
C
C
	IF(IPAGE+5.GT.MAXPAG) CALL PAGE
	IPAGE=IPAGE+2
	WRITE(IOUT,51) (BLANK, J=1,NTIMES)
51	FORMAT(5(A1,'SYMBOL  FREQ PERCENT',2X))
	WRITE(IOUT,53) (DASH, J=1,NTIMES*4)
53	FORMAT(1X,4A5,4(3X,4A5))
	IS=1
	GO TO (58,56,62), NOMIS
56	WRITE(IOUT,57) (ISYM(1+NS(I)),KOUNT(1+NS(I)),PER(1+NS(I)),
     1 I=1,NTIMES)
57	FORMAT(1X,A5,'NG',I5,F7.2,'%',4(3X,A5,1X,I6,F7.2,'%'))
	GOTO 63
62	IF(ISIZE.GT.1) GOTO 662
	WRITE(IOUT,64) ISYM(1+NS(1)),KOUNT(1+NS(1))
	GOTO 63
662	WRITE(IOUT,64) ISYM(1+NS(1)),KOUNT(1+NS(1)),(ISYM(1+NS(I)),
     .	KOUNT(1+NS(I)),PER(1+NS(I)),I=2,NTIMES)
64	FORMAT(1X,A5,'NG',I5,8X,4(3X,A5,1X,I6,F7.2,'%'))
63	IPAGE=IPAGE+1
	IF (NTIMES.EQ.ISIZE) RETURN
	IF (IS.EQ.N1) GO TO 61
	IS=2
58	IF (IDEVO.NE.'TTY') GOTO 65
	DO 66 K=IS,N1
67	WRITE(IOUT,59) (ISYM(K+NS(I)),KOUNT(K+NS(I)),
     1 PER(K+NS(I)),I=1,NTIMES)
59	FORMAT(3(1X,A5,I7,F7.2,'%',2X))
66	CONTINUE
	GOTO 61
65	DO 68 K=IS,N1
	IPAGE=IPAGE+1
	IF(IPAGE.LT.MAXPAG) GOTO 69
	CALL PAGE
	IPAGE=IPAGE+4
	WRITE(IOUT,51) (BLANK,J=1,NTIMES)
	WRITE(IOUT,53) (DASH,J=1,NTIMES*4)
69	WRITE(IOUT,60) (ISYM(K+NS(I)),KOUNT(K+NS(I)),
     1 PER(K+NS(I)),I=1,NTIMES)
60	FORMAT(5(1X,A5,I7,F7.2,'%',2X))
68	CONTINUE
61	IF (IR.EQ.0) RETURN
	WRITE(IOUT,60) (ISYM(NS(I)),KOUNT(NS(I)),PER(NS(I)), I=2,IR+1)
	IPAGE=IPAGE+1
	RETURN
	END
	SUBROUTINE SFIX(ISYM,KOUNT,PER)
C---------------ISYM, KOUNT, AND PER ARE INPUT TO SFIX
C---------------IR, NTIMES, N1, NS ARE INPUT THRU COMMON /SSIZE/
C---------------IPAGE, MAXPAGE, INPUT THRU COMMON /IOB/
C---------------IOUT, IDEVO INPUT THRU COMMON /IOBLK/
C---------------NOMIS INPUT THRU COMMON /RPT/
C
C**********************************************************************
C	SUBROUTINE THAT WRITES OUT THE REPORT FOR FIXED POINT VARIABLES
C
C	ISYM---VECTOR CONTAINING THE SYMBOLS
C	KOUNT--VECTOR CONTAINING THE COUNTS ASSOCIATED WITH THE SYMBOLS
C	PER----VECTOR CONTAINING THE PERCENTAGES
C**********************************************************************
C
	DIMENSION ISYM(1),KOUNT(1),PER(1)
	COMMON/IOBLK/INP,IOUT,IDEVI,IDEVO,IBNK,NAMI,NAMO,IPROJ,IPROG
	COMMON /IOB/LFBR,IRTBR,IALT,MAXPAG,IPAGE,IPAGCT,IDLG,ICC,ICODE
	COMMON/SYMSZ/ISIZE,IACT
	COMMON/SSIZE/IR,NTIMES,N1,MS(4),NS(5)
	COMMON/RPT/NOMIS
	DOUBLE PRECISION NAMO,NAMI
	DATA DASH,BLANK/'-',' '/
	IF(IPAGE+5.GT.MAXPAG) CALL PAGE
	IPAGE=IPAGE+2
	WRITE(IOUT,61) (BLANK,J=1,NTIMES)
61	FORMAT(5(A4,'VALUE  FREQ PERCENT '))
	WRITE(IOUT,62) ((DASH, J=1,22),JJ=1,NTIMES)
62	FORMAT(5(2X,22A1))
	IS=1
	GO TO (67,65,71), NOMIS
65	WRITE(IOUT,66) ((ISYM(1+NS(I)),KOUNT(1+NS(I)),PER(1+NS(I))),
     1 I=1,NTIMES)
66	FORMAT(3X,A5,'NG',I6,F7.2,'% ',4(I9,I6,F7.2,'% '))
	GOTO 73
71	IF(ISIZE.GT.1) GOTO 666
	WRITE(IOUT,72) ISYM(1+NS(1)),KOUNT(1+NS(1))
	GOTO 73
666	WRITE(IOUT,72) ISYM(1+NS(1)),KOUNT(1+NS(1)),(ISYM(1+NS(I)),
     .	KOUNT(1+NS(I)),PER(1+NS(I)),I=2,NTIMES)
72	FORMAT(3X,A5,'NG',I6,9X,4(I9,I6,F7.2,'% '))
73	IPAGE=IPAGE+1
	IF (NTIMES.EQ.ISIZE) RETURN
	IF (IS.EQ.N1) GO TO 70
	IS=2
67	IF (IDEVO.NE.'TTY') GOTO 74
	WRITE(IOUT,68)(((ISYM(K+NS(I)),KOUNT(K+NS(I)),
     1 PER(K+NS(I))),I=1,NTIMES),K=IS,N1)
68	FORMAT(3(1X,I9,I6,F7.2,'%'))
	GOTO 70
74	DO 75 K=IS,N1
	IPAGE=IPAGE+1
	IF(IPAGE.LT.MAXPAG) GOTO 75
	CALL PAGE
	IPAGE=IPAGE+4
	WRITE(IOUT,61) (BLANK,J=1,NTIMES)
	WRITE(IOUT,62) ((DASH,J=1,21),JJ=1,NTIMES)
75	WRITE(IOUT,69) (ISYM(K+NS(I)),KOUNT(K+NS(I)),PER(K+NS(I)),
     .	I=1,NTIMES)
69	FORMAT(5(1X,I9,I6,F7.2,'%'))
70	IF(IR.EQ.0) RETURN
	WRITE(IOUT,69) ((ISYM(NS(I)),KOUNT(NS(I)),PER(NS(I))),I=2,IR+1)
	IPAGE=IPAGE+1
	RETURN
	END
	SUBROUTINE SIZE(MODE)
C---------------MODE IS INPUT IR, NTIMES, N1, NS ARE RETURNED THRU
C--------------- COMMON /SSIZE/
C---------------IDEVO INPUT THRU COMMON /IOBLK/; ISIZE INPUT THRU COMMON
C--------------- /SYMSZ/
C
C**********************************************************************
C	SUBROUTINE THAT DETERMINES THE NUMBER OF THE SYMBOLS PER COLUMN
C**********************************************************************
C
	COMMON /IOBLK/INP,IOUT,IDEVI,IDEVO,IBNK,NAMI,NAMO,IPROJ,IPROG
	COMMON/SYMSZ/ISIZE,IACT
	COMMON/SSIZE/IR,NTIMES,N1,MS(4),NS(5)
	IF (MODE.GT.0) GO TO 10
	NTIMES=2
	IF (IDEVO.NE.'TTY') NTIMES=4
	GO TO 20
10	NTIMES=3
	IF (IDEVO.NE.'TTY') NTIMES=5
20	IF (ISIZE.LT.NTIMES) NTIMES=ISIZE
	IR=MOD(ISIZE,NTIMES)
	N1=ISIZE/NTIMES
	N2=(ISIZE+NTIMES-1)/NTIMES
	DO 21 I=1,4
	MS(I)=N1
	IF (IR.GE.I) MS(I)=N2
21	CONTINUE
	NS(1)=0
	NS(2)=MS(1)
	IF (NTIMES.LE.2) RETURN
	DO 22 I=3,NTIMES
	NS(I)=0
	DO 22 J=1,I-1
22	NS(I)=NS(I)+MS(J)
	RETURN
	END