C     PROGRAM XTAB
C
C     DESCRIPTION
C	THIS PROGRAM CROSS-TABULATES PAIRS OF VARIABLES (WITH OR WITHOUT
C	A CONTROL VARIABLE) GIVING FREQUENCIES, PERCENTAGES, OR OTHER
C	STATISTICS DESIRED BY THE USER.
C
C     SOURCE
C	NORMAN W. JOHNSON, DEPARTMENT OF MATHEMATICS, WHEATON COLLEGE,
C	NORTON, MASS.
C
C     INSTRUCTIONS
C	THE USER MAY ENTER OR ANALYZE DATA BY GIVING ONE OF THE COMMANDS
C	"INPUT", "OUTPUT", OR "ZERO" OR MAY TERMINATE THE EXECUTION OF
C	THE PROGRAM BY TYPING "STOP".
C
C	THE COMMAND "INPUT" (OPTIONALLY FOLLOWED BY THE TABLE SIZE) EN-
C	ABLES THE USER TO ENTER A HYPOTHETICAL FREQUENCY TABLE FOR TWO
C	OR THREE VARIABLES TO BE CROSS-TABULATED.  ONE OR MORE OUTPUT
C	OPTIONS MUST BE SELECTED AND THE APPROPRIATE CODE NUMBERS EN-
C	TERED.  THE FOLLOWING OPTIONS ARE AVAILABLE:
C		1--FREQUENCY OF RESPONSES
C		2--PERCENTAGES ACROSS
C		3--PERCENTAGES DOWN
C		4--PERCENTAGES OF TOTAL
C		5--CHI-SQUARE, DEGREES OF FREEDOM, AND PROBABILITY
C		6--GOODMAN AND KRUSKAL'S TAU
C		7--YULE'S Q OR GOODMAN AND KRUSKAL'S GAMMA
C		8--PHI COEFFICIENT OR KENDALL'S TAU
C		9--SOMER'S D
C
C	THE COMMAND "OUTPUT" PERMITS THE USER TO KEEP THE DATA OF THE
C	LAST CROSS-TABULATION BUT TO CHANGE THE OUTPUT OPTIONS.
C
C	THE COMMAND "ZERO", GIVEN AFTER A CROSS-TABULATION INVOLVING A
C	CONTROL VARIABLE, PRODUCES THE CORRESPONDING ZERO-ORDER STATIS-
C	TICS.
C
C	AFTER ANY OF THE ABOVE COMMANDS IS CARRIED OUT, A NEW COMMAND
C	MAY BE GIVEN.  THE USER MAY SUPPRESS THE PRINTING OF TABLES OR
C	ANY OTHER OUTPUT IN ORDER TO GIVE A NEW COMMAND IMMEDIATELY BY
C	TYPING <CTRL>O AND PRESSING <RETURN>.  FURTHER EXECUTION OF A
C	COMMAND MAY BE HALTED AT ANY BREAK POINT BY TYPING "ABORT".
C
C	WHENEVER THE USER IS EXPECTED TO GIVE A COMMAND OR TO PROVIDE
C	CERTAIN INFORMATION NEEDED FOR THE EXECUTION OF A COMMAND, AN
C	EXPLANATION OF WHAT IS REQUIRED MAY BE OBTAINED BY TYPING THE
C	WORD "EXPLAIN" OR SIMPLY A QUESTION MARK.
C
C	THIS PROGRAM ASSUMES THAT OUTPUT IS TO THE USER TERMINAL.  IF
C	OUTPUT TO A FILE ON THE DISK IS DESIRED INSTEAD, THE DISK SHOULD
C	BE ASSIGNED LOGICAL UNIT 5 PRIOR TO RUNTIME.
C
C     REMARKS
C	THE COMPUTED VALUE OF CHI-SQUARE WITH ONE DEGREE OF FREEDOM
C	INCORPORATES A CORRECTION FOR CONTINUITY.  THE CALCULATION OF
C	CHI-SQUARE IS ACCOMPANIED BY A WARNING IF THE EXPECTED FREQUENCY
C	IS LESS THAN 1 IN ANY CELL OR LESS THAN 5 IN MORE THAN 20 PER
C	CENT OF THE CELLS.  KENDALL'S TAU HAS A CORRECTION FOR TIES.
C
C     REFERENCES
C	JAMES A. DAVIS, 'ELEMENTARY SURVEY ANALYSIS', PRENTICE-HALL,
C	    ENGLEWOOD CLIFFS, N.J., 1971.
C	JOHAN GALTUNG, 'THEORY AND METHODS OF SOCIAL RESEARCH', COLUMBIA
C	    UNIVERSITY PRESS, NEW YORK, 1967.
C	E. TERRENCE JONES, 'CONDUCTING POLITICAL RESEARCH', HARPER &
C	    ROW, NEW YORK, 1971.
C
C     ..................................................................
C
      INTEGER A(48),TODAY(2),BLANK,ROW,COL
      INTEGER L(0/3),H(0/3),R(9)
      INTEGER X(2),IA(10)
      REAL POS,NEG
      LOGICAL OPT(0/9),ERROR,ZERO,BLURB
      DIMENSION NUM(0/9,0/9,0/9),PCT(0/9,0/9)
      DIMENSION NSUB(0/2,0/9,0/9),PSUB(2,0/9)
      DIMENSION NTOT(0/9),TOT(0/9)
      DIMENSION J1A(10),J2A(10)
      EQUIVALENCE (Q,GAMMA)
      COMMON ENTRY(0/13),LIST
      DATA I1,I2 /1,2/, X /2*'     '/
      OPT(0) = .TRUE.
      BLANK  = 17315143744
      CALL TIME(NOW)
      LIST = NOW-851968
      CALL DATE(TODAY)
      TYPE 1, NOW,TODAY
    1 FORMAT (' XTAB  ',8X,A5,9X,2A5///)
    3 FORMAT (12A5)
   32 FORMAT (//A5)
   33 FORMAT (8X,A5)
   34 FORMAT ('+'/$)
   10 FORMAT (10I)
  101 FORMAT (9I1,9L1)
      GO TO 202
C
C     ENTER COMMAND.
  200 TYPE 201
  201 FORMAT ('1')
  202 TYPE 203
  203 FORMAT (' ENTER COMMAND: ',$)
      ACCEPT 3, (ENTRY(N),N=1,12)
      CALL DECODE
      READ (20,3) ANS,SAVE
      IF (ANS.EQ.' ')     GO TO 200
      IF (ANS.EQ.'XTAB')  GO TO 202
      IF (ANS.EQ.'DETAI') GO TO 210
      IF (ANS.EQ.'EXPLA' .AND. SAVE.GT.'IN') GO TO 220
      IF (ANS.EQ.'INPUT') GO TO 230
      IF (ANS.EQ.'OUTPU') GO TO 290
      IF (ANS.EQ.'ZERO')  GO TO 320
      IF (ANS.EQ.'STOP')  GO TO 2000
      TYPE 204
  204 FORMAT (
     1  ' ENTER ONE OF THE FOLLOWING:'/
     2  ' 	INPUT, OUTPUT, ZERO, STOP, OR DETAIL'/)
      GO TO 200
  210 TYPE 21
   21 FORMAT (
     1  ' 	TO ENTER A HYPOTHETICAL FREQUENCY TABLE, TYPE "INPUT".'/
     2  ' 	TO KEEP SAME DATA BUT CHANGE OPTIONS, TYPE "OUTPUT".'/
     3  ' 	TO OBTAIN ZERO-ORDER STATISTICS, TYPE "ZERO".'/
     4  ' 	TO TERMINATE THE PROGRAM, TYPE "STOP".'//
     5  ' 	TO HALT EXECUTION OF A COMMAND, TYPE "ABORT".'/
     6  ' 	TO GET HELP AT ANY POINT, TYPE "EXPLAIN" OR "?".'//
     7  ' 	FOR A MORE COMPLETE EXPLANATION OF ANY OF THE ABOVE'/
     8  ' 	COMMANDS, TYPE "EXPLAIN" AND THE NAME OF THE COMMAND.'/)
      GO TO 200
  220 REREAD 33, ANS
      IF (ANS.EQ.'ABORT') TYPE 221
  221 FORMAT (
     1  ' 	FURTHER EXECUTION OF A COMMAND MAY BE HALTED AT ANY'/
     2  ' 	BREAK POINT BY TYPING "ABORT".  TO SUPPRESS THE PRINT-'/
     3  ' 	ING OF TABLES OR OTHER OUTPUT, TYPE <CTRL>O AND PRESS'/
     4  ' 	<RETURN>.'/)
      IF (ANS.EQ.'EXPLA' .OR. ANS.EQ.'?') TYPE 222
  222 FORMAT (
     1  ' 	IF YOU NEED AN EXPLANATION OR FURTHER INSTRUCTIONS,'/
     2  ' 	YOU MAY RESPOND TO ANY REQUEST FOR INPUT BY TYPING'/
     3  ' 	"EXPLAIN" OR A QUESTION MARK.'/)
      IF (ANS.EQ.'INPUT') TYPE 231
      IF (ANS.EQ.'OUTPU') TYPE 291
      IF (ANS.EQ.'ZERO')  TYPE 321
      IF (ANS.EQ.'STOP')  TYPE 2002
      GO TO 200
C
C     INPUT:  ENTER NUMBER OF CATEGORIES.
  230 ZERO = ENTRY(0).NE.ANS .OR. ENTRY(1).EQ.' '
      IF (ZERO) TYPE 23
   23 FORMAT (' TABLE SIZE? ',$)
      IF (ZERO) ACCEPT 3, (ENTRY(N),N=1,12)
      IF (ENTRY(1).EQ.'ABORT') GO TO 200
      IF (ENTRY(1).EQ.'STOP')  GO TO 2000
      IF (ENTRY(1).EQ.'EXPLA' .OR. ENTRY(1).EQ.'?') TYPE 231
  231 FORMAT (
     1  ' 	ENTER THE NUMBER OF CATEGORIES FOR THE INDEPENDENT AND'/
     2  ' 	DEPENDENT VARIABLES AND FOR THE CONTROL VARIABLE, IF'/
     3  ' 	ANY.  TABLE HEADINGS WILL THEN BE PRINTED.  DEFINE A'/
     4  ' 	HYPOTHETICAL FREQUENCY DISTRIBUTION BY FILLING IN THE'/
     5  ' 	TABLE.'//
     6  ' 	WHEN THE TABLE SIZE IS LISTED ON THE SAME LINE AS THE'/
     7  ' 	COMMAND (E.G., "INPUT 2,2"), THE OUTPUT OPTIONS WILL'/
     8  ' 	BE THE SAME AS IN THE LAST PREVIOUS CROSS-TABULATION.'/)
      CALL DECODE
      READ (20,10) J1,J2,J3
      IF (J1.EQ.0 .OR. J2.EQ.0) GO TO 230
      ERROR = J1.LT.2 .OR. J1.GT.10 .OR. J2.LT.2 .OR. J2.GT.10 .OR.
     1  J3.LT.0 .OR. J3.EQ.1 .OR. J3.GT.10
      IF (ERROR) TYPE 232
  232 FORMAT ('+INVALID ENTRY--VARIABLES MAY HAVE 2 TO 10 CATEGORIES'/)
      IF (ERROR) GO TO 230
      L(I1) = (J1.EQ.10)+1
      H(I1) = (J1.EQ.10)+J1
      L(I2) = (J2.EQ.10)+1
      H(I2) = (J2.EQ.10)+J2
      I3 = -3*(J3.NE.0)
      IF (I3.EQ.0) GO TO 290
      L(I3) = (J3.EQ.10)+1
      H(I3) = (J3.EQ.10)+J3
      GO TO 290
C
C     OUTPUT:  ENTER OUTPUT OPTIONS.
  280 TYPE 28
   28 FORMAT (
     1  ' ENTER (WITHOUT PUNCTUATION) ONE OR MORE OPTIONS FOR OUTPUT:')
  281 FORMAT (
     2  ' 	1--FREQUENCY OF RESPONSES'/
     3  ' 	2--PERCENTAGES ACROSS'/
     4  ' 	3--PERCENTAGES DOWN'/
     5  ' 	4--PERCENTAGES OF TOTAL'/
     6  ' 	5--CHI-SQUARE'/
     7  ' 	6--NOMINAL TAU'/
     8  ' 	7--YULE''S Q / GAMMA'/
     9  ' 	8--PHI / ORDINAL TAU'/
     /  ' 	9--SOMER''S D'/)
  290 IF (SAVE.GT.' ' .AND. .NOT.OPT(0)) GO TO 300
      TYPE 29
   29 FORMAT (' OUTPUT OPTIONS? ',$)
      ACCEPT 3, (ENTRY(N),N=1,4)
      IF (ENTRY(1).EQ.'NONE' .OR. ENTRY(1).EQ.'ABORT') GO TO 200
      IF (ENTRY(1).EQ.'STOP') GO TO 2000
      BLURB = ENTRY(1).EQ.'EXPLA' .OR. ENTRY(1).EQ.'?'
      IF (BLURB) TYPE 28
      IF (BLURB) TYPE 281
      IF (BLURB .OR. ENTRY(1).EQ.' ') GO TO 290
  291 FORMAT (
     1  ' 	THIS COMMAND ENABLES YOU TO KEEP THE DATA OF THE LAST'/
     2  ' 	CROSS-TABULATION BUT TO CHANGE THE OUTPUT OPTIONS.'/)
      CALL DECODE
      READ (20,101,ERR=280) (R(I),I=1,9),(OPT(J),J=1,9)
      DO 295  I=1,9
  295 OPT(R(I)) = .TRUE.
      OPT(0) = .NOT.(OPT(1) .OR. OPT(2) .OR. OPT(3) .OR. OPT(4) .OR.
     1   OPT(5) .OR. OPT(6) .OR. OPT(7) .OR. OPT(8) .OR. OPT(9))
      IF (OPT(0)) GO TO 290
      IF (ANS.EQ.'OUTPU') GO TO 400
  300 DO 310  J3=L(I3),H(I3)
      DO 310  J2=L(I2),H(I2)
      DO 310  J1=L(I1),H(I1)
  310 NUM(J1,J2,J3) = 0
      GO TO 1360
C
C     ZERO:  CONSTRUCT ZERO-ORDER TABLE.
  320 IF (ANS.NE.'ZERO') GO TO 335
  321 FORMAT (
     1  ' 	THIS COMMAND, GIVEN AFTER A CROSS-TABULATION INVOLVING'/
     2  ' 	A CONTROL VARIABLE, PRODUCES THE CORRESPONDING ZERO-'/
     3  ' 	ORDER STATISTICS.'/)
      DO 330  J1=L(I1),H(I1)
      DO 330  J2=L(I2),H(I2)
      NSUB(0,J1,J2) = 0
      DO 325  J3=L(I3),H(I3)
  325 NSUB(0,J1,J2) = NSUB(0,J1,J2)+NUM(J1,J2,J3)
  330 NUM(J1,J2,J3X) = NSUB(0,J1,J2)
      I3 = 0
  335 CONTINUE
      DO 360  J3=L(I3),H(I3)
      DO 340  J1=L(I1),H(I1)
  340 NSUB(1,J1,J3) = 0
      DO 350  J2=L(I2),H(I2)
  350 NSUB(2,J2,J3) = 0
  360 NTOT(J3) = 0
      NTAB = 0
      DO 390  J3=L(I3),H(I3)
      DO 380  J2=L(I2),H(I2)
      DO 370  J1=L(I1),H(I1)
      NSUB(1,J1,J3) = NSUB(1,J1,J3)+NUM(J1,J2,J3)
  370 NSUB(2,J2,J3) = NSUB(2,J2,J3)+NUM(J1,J2,J3)
  380 NTOT(J3) = NTOT(J3)+NSUB(2,J2,J3)
      TOT(J3) = NTOT(J3)
      TOT(J3) = AMAX1(TOT(J3),.0001)
  390 NTAB = NTAB+NTOT(J3)
      NOUT = LAST-NTAB
C     BEGIN OUTPUT LOOP.
  400 DO 1300  J3=L(I3),H(I3)
      IF (J3.NE.L(I3)) WRITE (5,34)
      IF (.NOT.(OPT(5) .OR. OPT(6) .OR. OPT(7) .OR. OPT(8) .OR. OPT(9)))
     1  GO TO 430
      NROW = 0
      NCOL = 0
      DO 410  J1=L(I1),H(I1)
      IF (NSUB(1,J1,J3).EQ.0) GO TO 410
      NROW = NROW+1
      J1A(NROW) = J1
  410 CONTINUE
      NROW = MAX0(NROW,1)
      DO 420  J2=L(I2),H(I2)
      IF (NSUB(2,J2,J3).EQ.0) GO TO 420
      NCOL = NCOL+1
      J2A(NCOL) = J2
  420 CONTINUE
      NDF = (NROW-1)*(NCOL-1)
      NADF = (H(I1)-L(I1))*(H(I2)-L(I2))
  430 WRITE (5,43)
   43 FORMAT (///
     1  ' DOWN:     VARIABLE  X'/
     2  ' ACROSS:   VARIABLE  Y')
      IF (I3.NE.0) WRITE (5,431) J3
  431 FORMAT (
     3  ' CONTROL:  VARIABLE  T  =  CATEGORY  ',I1)
      IF (OPT(1)) GO TO 440
      IF (OPT(2)) GO TO 500
      IF (OPT(3)) GO TO 600
      IF (OPT(4)) GO TO 700
      IF (OPT(5)) GO TO 800
      IF (OPT(6)) GO TO 900
      IF (OPT(7)) GO TO 1000
      IF (OPT(8)) GO TO 1100
      IF (OPT(9)) GO TO 1200
C     OPTION 1--FREQUENCY OF RESPONSES
  440 WRITE (5,44)
   44 FORMAT (///' FREQUENCY OF RESPONSES:')
  450 WRITE (5,45) (J2,X(I2),J2=L(I2),H(I2))
   45 FORMAT (//5X,$/('+',1X,I4,A1,$))
  460 WRITE (5,46)
   46 FORMAT ('+',4X,'TOT'/)
      DO 480  J1=L(I1),H(I1)
  470 WRITE (5,47) J1,X(I1),(NUM(J1,J2,J3),J2=L(I2),H(I2))
   47 FORMAT (' ',I1,A1,2X,$/('+',1X,I4,1X,$))
  480 WRITE (5,48) NSUB(1,J1,J3)
   48 FORMAT ('+',3X,I4)
  490 WRITE (5,49) (NSUB(2,J2,J3),J2=L(I2),H(I2))
   49 FORMAT (/' TOT ',$/('+',1X,I4,1X,$))
      WRITE (5,48) NTOT(J3)
      IF (OPT(2)) GO TO 500
      IF (OPT(3)) GO TO 600
      IF (OPT(4)) GO TO 700
      IF (OPT(5)) GO TO 800
      IF (OPT(6)) GO TO 900
      IF (OPT(7)) GO TO 1000
      IF (OPT(8)) GO TO 1100
      IF (OPT(9)) GO TO 1200
      GO TO 1300
C     OPTION 2--PERCENTAGES ACROSS
  500 DO 510  J1=L(I1),H(I1)
      SUB1 = NSUB(1,J1,J3)
      SUB1 = AMAX1(SUB1,.0001)
      DO 510  J2=L(I2),H(I2)
  510 PCT(J1,J2) = NUM(J1,J2,J3)/SUB1+.0005
      DO 530  J2=L(I2),H(I2)
  530 PSUB(2,J2) = NSUB(2,J2,J3)/TOT(J3)+.0005
  540 WRITE (5,54)
   54 FORMAT (///' PERCENTAGES ACROSS:')
  550 WRITE (5,45) (J2,X(I2),J2=L(I2),H(I2))
  560 WRITE (5,46)
      DO 580  J1=L(I1),H(I1)
  570 WRITE (5,57) J1,X(I1),(PCT(J1,J2),J2=L(I2),H(I2))
   57 FORMAT (' ',I1,A1,2X,$/('+',1X,2PF5.1,$))
  580 WRITE (5,48) NSUB(1,J1,J3)
  590 WRITE (5,59) (PSUB(2,J2),J2=L(I2),H(I2))
   59 FORMAT (/' TOT ',$/('+',1X,2PF5.1,$))
      WRITE (5,48) NTOT(J3)
      IF (OPT(3)) GO TO 600
      IF (OPT(4)) GO TO 700
      IF (OPT(5)) GO TO 800
      IF (OPT(6)) GO TO 900
      IF (OPT(7)) GO TO 1000
      IF (OPT(8)) GO TO 1100
      IF (OPT(9)) GO TO 1200
      GO TO 1300
C     OPTION 3--PERCENTAGES DOWN
  600 DO 610  J2=L(I2),H(I2)
      SUB2 = NSUB(2,J2,J3)
      SUB2 = AMAX1(SUB2,.0001)
      DO 610  J1=L(I1),H(I1)
  610 PCT(J1,J2) = NUM(J1,J2,J3)/SUB2+.0005
      DO 620  J1=L(I1),H(I1)
  620 PSUB(1,J1) = NSUB(1,J1,J3)/TOT(J3)+.0005
  640 WRITE (5,64)
   64 FORMAT (///' PERCENTAGES DOWN:')
  650 WRITE (5,45) (J2,X(I2),J2=L(I2),H(I2))
  660 WRITE (5,46)
      DO 680  J1=L(I1),H(I1)
  670 WRITE (5,57) J1,X(I1),(PCT(J1,J2),J2=L(I2),H(I2))
  680 WRITE (5,68) PSUB(1,J1)
   68 FORMAT ('+',3X,2PF5.1)
  690 WRITE (5,49) (NSUB(2,J2,J3),J2=L(I2),H(I2))
      WRITE (5,48) NTOT(J3)
      IF (OPT(4)) GO TO 700
      IF (OPT(5)) GO TO 800
      IF (OPT(6)) GO TO 900
      IF (OPT(7)) GO TO 1000
      IF (OPT(8)) GO TO 1100
      IF (OPT(9)) GO TO 1200
      GO TO 1300
C     OPTION 4--PERCENTAGES OF TOTAL
  700 DO 710  J1=L(I1),H(I1)
      DO 710  J2=L(I2),H(I2)
  710 PCT(J1,J2) = NUM(J1,J2,J3)/TOT(J3)+.0005
      DO 720  J1=L(I1),H(I1)
  720 PSUB(1,J1) = NSUB(1,J1,J3)/TOT(J3)+.0005
      DO 730  J2=L(I2),H(I2)
  730 PSUB(2,J2) = NSUB(2,J2,J3)/TOT(J3)+.0005
  740 WRITE (5,74)
   74 FORMAT (///' PERCENTAGES OF TOTAL:')
  750 WRITE (5,45) (J2,X(I2),J2=L(I2),H(I2))
  760 WRITE (5,46)
      DO 780  J1=L(I1),H(I1)
  770 WRITE (5,57) J1,X(I1),(PCT(J1,J2),J2=L(I2),H(I2))
  780 WRITE (5,68) PSUB(1,J1)
  790 WRITE (5,59) (PSUB(2,J2),J2=L(I2),H(I2))
      WRITE (5,48) NTOT(J3)
      IF (OPT(5)) GO TO 800
      IF (OPT(6)) GO TO 900
      IF (OPT(7)) GO TO 1000
      IF (OPT(8)) GO TO 1100
      IF (OPT(9)) GO TO 1200
      GO TO 1300
C     OPTION 5--CHI-SQUARE
  800 WRITE (5,32)
      IF (NDF-1) 810,820,830
  810 WRITE (5,81)
   81 FORMAT (/' CHI-SQUARE IS UNDEFINED.')
      IF (OPT(6)) GO TO 900
      IF (OPT(7)) GO TO 1010
      IF (OPT(8)) GO TO 1110
      IF (OPT(9)) GO TO 1210
      GO TO 1300
  820 PROD1 = NSUB(1,J1A(1),J3)*NSUB(1,J1A(2),J3)
      PROD2 = NSUB(2,J2A(1),J3)*NSUB(2,J2A(2),J3)
      PROD = PROD1*PROD2
      DET = IABS(NUM(J1A(1),J2A(1),J3)*NUM(J1A(2),J2A(2),J3)
     1          -NUM(J1A(1),J2A(2),J3)*NUM(J1A(2),J2A(1),J3))
      COR = AMIN1(TOT(J3),DET)/2
      CS = TOT(J3)*(DET-COR)**2/PROD
  830 IF (NDF.GT.1) CS = 0.0
      IERR = 0
      DO 840  ROW=1,NROW
      DO 840  COL=1,NCOL
      ENUM = NSUB(1,J1A(ROW),J3)*NSUB(2,J2A(COL),J3)/TOT(J3)
      IF (ENUM.LT.1.0) IERR = -100
      IF (NDF.EQ.1) GO TO 840
      CS = CS+(NUM(J1A(ROW),J2A(COL),J3)-ENUM)**2/ENUM
  840 CONTINUE
  860 IF (IERR.EQ.0) CALL CHISQ(CS,NDF,PR)
  870 WRITE (5,87) CS,NDF
   87 FORMAT (/' CHI-SQUARE  =',F7.2,'  WITH ',I2,' D.F.')
      IF (IERR.NE.0) GO TO 890
  880 WRITE (5,88)
   88 FORMAT (' PROBABILITY OF CHI-SQUARE THIS LARGE IS ',$)
      IF (PR.GE..9995) WRITE (5,881)
  881 FORMAT ('+1.')
      IF (PR.GE..001 .AND. PR.LT..9995) WRITE (5,882) PR
  882 FORMAT ('+',F4.3)
      IF (PR.LT..001) WRITE (5,883)
  883 FORMAT ('+LESS THAN .001')
      GO TO 895
  890 WRITE (5,89)
   89 FORMAT (' NOTE:  EXPECTED FREQUENCY IS LESS THAN ',$)
      IF (IERR.LT.0) WRITE (5,891)
  891 FORMAT ('+1 IN ONE OR MORE CELLS.')
      IF (IERR.EQ.1) WRITE (5,892)
  892 FORMAT ('+5 IN ONE CELL.')
      IF (IERR.GT.1 .AND. IERR.LT.10) WRITE (5,893) IERR
  893 FORMAT ('+5 IN ',I1,' CELLS.')
      IF (IERR.GE.10) WRITE (5,894) IERR
  894 FORMAT ('+5 IN ',I2,' CELLS.')
  895 IF (OPT(6)) GO TO 900
      IF (OPT(7)) GO TO 1000
      IF (OPT(8)) GO TO 1100
      IF (OPT(9)) GO TO 1200
      GO TO 1300
C     OPTION 6--NOMINAL TAU
  900 IF (.NOT.OPT(5)) WRITE (5,32)
      IF (NCOL-2) 910,920,930
  910 WRITE (5,91)
   91 FORMAT (/' GOODMAN AND KRUSKAL''S TAU IS UNDEFINED.')
      IF (OPT(7)) GO TO 1010
      IF (OPT(8)) GO TO 1110
      IF (OPT(9)) GO TO 1210
      GO TO 1300
  920 POS = 2.*NSUB(2,J2A(1),J3)*NSUB(2,J2A(2),J3)/TOT(J3)
      NEG = 0.0
      DO 925  ROW=1,NROW
      SUB1 = NSUB(1,J1A(ROW),J3)
  925 NEG = NEG+2.*NUM(J1A(ROW),J2A(1),J3)*NUM(J1A(ROW),J2A(2),J3)/SUB1
      TAU = (POS-NEG)/POS
      GO TO 960
  930 SUM = 0.0
      DO 935  COL=1,NCOL
  935 SUM = SUM+NSUB(2,J2A(COL),J3)*(NTOT(J3)-NSUB(2,J2A(COL),J3))
      POS = SUM/TOT(J3)
  940 NEG = 0.0
      DO 950  ROW=1,NROW
      SUM = 0.0
      NSUB1 = NSUB(1,J1A(ROW),J3)
      DO 945  COL=1,NCOL
  945 SUM = SUM+NUM(J1A(ROW),J2A(COL),J3)*
     1   (NSUB1-NUM(J1A(ROW),J2A(COL),J3))
      SUB1 = NSUB1
  950 NEG = NEG+SUM/SUB1
      TAU = (POS-NEG)/POS
  960 PTAU = TAU+.0005
  965 R(3) = 0
      IF (PTAU.GE..1) R(3) = BLANK
  970 WRITE (5,97) TAU
   97 FORMAT (/' GOODMAN AND KRUSKAL''S TAU  = ',F6.3)
  980 WRITE (5,98)
   98 FORMAT (' (KNOWING VARIABLE X',$)
      IF (TAU.LT..0005) WRITE (5,981)
  981 FORMAT ('+ DOES NOT REDUCE ERROR',
     1  ' IN PREDICTING VARIABLE Y)')
      IF (TAU.GE..0005.AND.TAU.LT..9995) WRITE (5,982) R(3),PTAU
  982 FORMAT ('+ REDUCES ERROR',
     1  ' IN PREDICTING VARIABLE Y BY',A1,2PF4.1,'%)')
      IF (TAU.GE..9995) WRITE (5,883)
  983 FORMAT ('+ ELIMINATES ERROR',
     1  ' IN PREDICTING VARIABLE Y)')
      IF (OPT(7)) GO TO 1000
      IF (OPT(8)) GO TO 1100
      IF (OPT(9)) GO TO 1200
      GO TO 1300
C     OPTION 7--YULE'S Q / GAMMA
 1000 IF (.NOT.(OPT(5) .OR. OPT(6))) WRITE (5,32)
      IF (NDF-1) 1010,1020,1030
 1010 IF (NADF.EQ.1) WRITE (5,1011)
      IF (NADF.NE.1) WRITE (5,1012)
 1011 FORMAT (/' YULE''S Q IS UNDEFINED.')
 1012 FORMAT (/' GOODMAN AND KRUSKAL''S GAMMA IS UNDEFINED.')
      IF (OPT(8)) GO TO 1110
      IF (OPT(9)) GO TO 1210
      GO TO 1300
 1020 POS = NUM(J1A(1),J2A(1),J3)*NUM(J1A(2),J2A(2),J3)
      NEG = NUM(J1A(1),J2A(2),J3)*NUM(J1A(2),J2A(1),J3)
      Q = (POS-NEG)/(POS+NEG)
      SUM = 0.0
      DO 1025  ROW=1,2
      DO 1025  COL=1,2
 1025 SUM = SUM+1.0/AMAX0(NUM(J1A(ROW),J2A(COL),J3),1)
      SIGMA = (1.0-Q*Q)*SQRT(SUM)/2.
      QMAX = AMIN1(Q+1.960*SIGMA, 1.)
      QMIN = AMAX1(Q-1.960*SIGMA,-1.)
      R(5) = (1+(QMAX.GE.0.0))*BLANK
      R(6) = (1+(QMIN.GE.0.0))*BLANK
      GO TO 1060
 1030 POS = 0.0
      NEG = 0.0
      DO 1040  MROW=1,NROW-1
      DO 1040  MCOL=1,NCOL-1
      DO 1040  ROW=MROW+1,NROW
      DO 1040  COL=MCOL+1,NCOL
 1040 POS = POS+NUM(J1A(MROW),J2A(MCOL),J3)*NUM(J1A(ROW),J2A(COL),J3)
      DO 1050  MROW=1,NROW-1
      DO 1050  MCOL=2,NCOL
      DO 1050  ROW=MROW+1,NROW
      DO 1050  COL=1,MCOL-1
 1050 NEG = NEG+NUM(J1A(MROW),J2A(MCOL),J3)*NUM(J1A(ROW),J2A(COL),J3)
      IF (OPT(8) .AND. .NOT.OPT(7)) GO TO 1130
      IF (OPT(9) .AND. .NOT.OPT(7)) GO TO 1230
      GAMMA = (POS-NEG)/(POS+NEG)
 1060 CONTINUE
      J1 = J1A(1)
      IF (Q.GT.0.0) J2 = J2A(1)
      IF (Q.LT.0.0) J2 = J2A(NCOL)
 1070 IF (NDF.EQ.1) WRITE (5,1071) Q
      IF (NDF.GT.1) WRITE (5,1072) GAMMA
 1071 FORMAT (/' YULE''S Q  = ',F6.3)
 1072 FORMAT (/' GOODMAN AND KRUSKAL''S GAMMA  = ',F6.3)
 1080 IF (ABS(Q).GE..0005) WRITE (5,108) J1,J2
  108 FORMAT (
     1  ' (VARIABLE X = CATEGORY ',I1,')  TENDS WITH ',
     2  ' (VARIABLE Y = CATEGORY ',I1,')')
      IF (ABS(Q).LT..0005) WRITE (5,1081)
 1081 FORMAT (
     1  ' VARIABLES X AND Y ARE NOT ASSOCIATED')
 1090 IF (NDF.EQ.1 .AND. ABS(Q).NE.1.) WRITE (5,109) R(5),QMAX,R(6),QMIN
  109 FORMAT (' 95% CONFIDENCE LIMITS FOR Q ARE',A1,F6.3,' AND',A1,F6.3)
      IF (OPT(8)) GO TO 1100
      IF (OPT(9)) GO TO 1200
      GO TO 1300
C     OPTION 8--PHI / ORDINAL TAU
 1100 IF (.NOT.(OPT(5) .OR. OPT(6) .OR. OPT(7))) WRITE (5,32)
      IF (NDF.GT.1 .AND. .NOT.OPT(7)) GO TO 1030
      IF (NDF-1) 1110,1120,1130
 1110 IF (NADF.EQ.1) WRITE (5,1111)
      IF (NADF.NE.1) WRITE (5,1112)
 1111 FORMAT (/' PHI IS UNDEFINED.')
 1112 FORMAT (/' KENDALL''S TAU IS UNDEFINED.')
      IF (OPT(9)) GO TO 1210
      GO TO 1300
 1120 POS = NUM(J1A(1),J2A(1),J3)*NUM(J1A(2),J2A(2),J3)
      NEG = NUM(J1A(1),J2A(2),J3)*NUM(J1A(2),J2A(1),J3)
      PROD1 = NSUB(1,J1A(1),J3)*NSUB(1,J1A(2),J3)
      PROD2 = NSUB(2,J2A(1),J3)*NSUB(2,J2A(2),J3)
      ROOT = SQRT(PROD1*PROD2)
      PHI = (POS-NEG)/ROOT
      GO TO 1150
 1130 PROD1 = 0.0
      PROD2 = 0.0
      DO 1135  MROW=1,NROW-1
      DO 1135  ROW=MROW+1,NROW
 1135 PROD1 = PROD1+NSUB(1,J1A(MROW),J3)*NSUB(1,J1A(ROW),J3)
      DO 1140  MCOL=1,NCOL-1
      DO 1140  COL=MCOL+1,NCOL
 1140 PROD2 = PROD2+NSUB(2,J2A(MCOL),J3)*NSUB(2,J2A(COL),J3)
      TAU = (POS-NEG)/SQRT(PROD1*PROD2)
      GO TO 1170
 1150 MROW = (NSUB(1,J1A(1),J3).LT.NSUB(1,J1A(2),J3))+2
      MCOL = (NSUB(2,J2A(1),J3).LT.NSUB(2,J2A(2),J3))+2
      IF (NSUB(1,J1A(MROW),J3).GT.NSUB(2,J2A(MCOL),J3)) GO TO 1155
      ALLPOS = NSUB(1,J1A(MROW),J3)*NSUB(2,J2A(3-MROW),J3)
      ALLNEG = NSUB(1,J1A(MROW),J3)*NSUB(2,J2A(MROW),J3)
      GO TO 1160
 1155 ALLPOS = NSUB(2,J2A(MCOL),J3)*NSUB(1,J1A(3-MCOL),J3)
      ALLNEG = NSUB(2,J2A(MCOL),J3)*NSUB(1,J1A(MCOL),J3)
 1160 PHIMAX =  ALLPOS/ROOT
      PHIMIN = -ALLNEG/ROOT
 1170 IF (NDF.EQ.1) WRITE (5,1171) PHI
      IF (NDF.GT.1) WRITE (5,1172) TAU
 1171 FORMAT (/' PHI  = ',F6.3)
 1172 FORMAT (/' KENDALL''S TAU  = ',F6.3)
 1180 IF (NDF.EQ.1) WRITE (5,1181) PHIMAX,PHIMIN
      IF (NDF.GT.1) WRITE (5,1182)
 1181 FORMAT (' UPPER AND LOWER BOUNDS FOR PHI ARE',F6.3,' AND ',F6.3)
 1182 FORMAT (' (RANK CORRELATION CORRECTED FOR TIES)')
      IF (OPT(9)) GO TO 1200
      GO TO 1300
C     OPTION 9--SOMER'S D
 1200 IF (.NOT.(OPT(5) .OR. OPT(6) .OR. OPT(7) .OR. OPT(8)))
     1  WRITE (5,32)
      IF (NDF.GT.1 .AND. .NOT.(OPT(7) .OR. OPT(8))) GO TO 1030
      IF (NDF-1) 1210,1220,1230
 1210 WRITE (5,121)
  121 FORMAT (/' SOMER''S D IS UNDEFINED.')
      GO TO 1300
 1220 POS = NUM(J1A(1),J2A(1),J3)*NUM(J1A(2),J2A(2),J3)
      NEG = NUM(J1A(1),J2A(2),J3)*NUM(J1A(2),J2A(1),J3)
      PROD1 = NSUB(1,J1A(1),J3)*NSUB(1,J1A(2),J3)
      D = (POS-NEG)/PROD1
      GO TO 1260
 1230 IF (OPT(8)) GO TO 1240
      PROD1 = 0.0
      DO 1235  MROW=1,NROW-1
      DO 1235  ROW=MROW+1,NROW
 1235 PROD1 = PROD1+NSUB(1,J1A(MROW),J3)*NSUB(1,J1A(ROW),J3)
 1240 D = (POS-NEG)/PROD1
 1260 CONTINUE
 1270 WRITE (5,127) D
  127 FORMAT (/' SOMER''S D  = ',F6.3)
 1280 IF (NDF.EQ.1) WRITE (5,1281)
      IF (NDF.GT.1) WRITE (5,1282)
 1281 FORMAT (' (PERCENTAGE DIFFERENCE',$)
 1282 FORMAT (' (PROPORTION DIFFERENTIAL',$)
      WRITE (5,1283)
 1283 FORMAT ('+ FOR VARIABLE X RELATIVE TO VARIABLE Y)')
C     REPEAT OR CONCLUDE.
 1300 CONTINUE
      IF (L(I3).NE.H(I3)) WRITE (5,34)
      IF (.NOT.OPT(7)) GO TO 1350
      IF (NADF.NE.1 .OR. L(I3).EQ.H(I3)) GO TO 1350
      NLL = 0
      NLH = 0
      NHL = 0
      NHH = 0
 1310 DO 1315  J3=L(I3),H(I3)
      NLL = NLL+NUM(L(I1),L(I2),J3)
      NLH = NLH+NUM(L(I1),H(I2),J3)
      NHL = NHL+NUM(H(I1),L(I2),J3)
      NHH = NHH+NUM(H(I1),H(I2),J3)
 1315 CONTINUE
      POS = NLL*NHH
      NEG = NLH*NHL
      IF (POS+NEG.EQ.0.0) GO TO 1350
      QZERO = (POS-NEG)/(POS+NEG)
      POS = 0.0
      NEG = 0.0
 1320 DO 1325  J3=L(I3),H(I3)
      POS = POS+NUM(L(I1),L(I2),J3)*NUM(H(I1),H(I2),J3)
      NEG = NEG+NUM(L(I1),H(I2),J3)*NUM(H(I1),L(I2),J3)
 1325 CONTINUE
      IF (POS+NEG.EQ.0.0) GO TO 1350
      QPART = (POS-NEG)/(POS+NEG)
      POS = 0.0
      NEG = 0.0
 1330 DO 1335  J3=L(I3),H(I3)
      POS = POS+NUM(L(I1),L(I2),J3)*(NHH-NUM(H(I1),H(I2),J3))
      NEG = NEG+NUM(L(I1),H(I2),J3)*(NHL-NUM(H(I1),L(I2),J3))
 1335 CONTINUE
      IF (POS+NEG.EQ.0.0) GO TO 1350
      QDIFF = (POS-NEG)/(POS+NEG)
 1340 WRITE (5,134) QZERO,QPART,QDIFF
  134 FORMAT (///
     1  ' ZERO ORDER    Q  = ',F6.3/
     2  ' PARTIAL       Q  = ',F6.3/
     3  ' DIFFERENTIAL  Q  = ',F6.3)
 1350 TYPE 34
      WRITE (5,201)
      GO TO 202
C     ENTER HYPOTHETICAL FREQUENCY TABLE.
 1360 TYPE 136
  136 FORMAT (///' HYPOTHETICAL FREQUENCIES:')
      DO 1390  J3=L(I3),H(I3)
 1370 TYPE 137, (J2,J2=L(I2),H(I2))
  137 FORMAT (//5X,$/('+',1X,I4,1X,$))
      IF (L(I3).NE.H(I3)) TYPE 1371, J3
 1371 FORMAT ('+    (',I1,')',$)
      TYPE 34
      TYPE 34
      DO 1390  J1=L(I1),H(I1)
 1380 TYPE 138, J1
  138 FORMAT ('+',I1,6X,$)
      ACCEPT 3, (ENTRY(N),N=1,12)
      IF (ENTRY(1).EQ.'ABORT') GO TO 200
      IF (ENTRY(1).EQ.'DELET') GO TO 1360
      IF (ENTRY(1).EQ.'STOP')  GO TO 2000
      BLURB = ENTRY(1).EQ.'EXPLA' .OR. ENTRY(1).EQ.'?'
      IF (BLURB) TYPE 1381
 1381 FORMAT (
     1  ' 	DEFINE A HYPOTHETICAL FREQUENCY DISTRIBUTION FOR YOUR'/
     2  ' 	VARIABLES BY FILLING IN THIS TABLE.  TO START OVER,'/
     3  ' 	TYPE "DELETE".  TO QUIT, TYPE "ABORT".'//)
      IF (BLURB .OR. ENTRY(1).EQ.' ') GO TO 1380
      CALL DECODE
      READ (20,10) (NUM(J1,J2,J3),J2=L(I2),H(I2))
 1390 CONTINUE
      GO TO 320
C
C     STOP:  TERMINATE EXECUTION.
 2000 END FILE 5
      TYPE 34
      CALL OFIL(20,LIST,'.TMP')
      END FILE 20
 2002 FORMAT (
     1  ' 	THE COMMAND "STOP" MAY BE GIVEN AS A RESPONSE TO ANY'/
     2  ' 	REQUEST FOR INFORMATION.  EXECUTION OF THE PROGRAM IS'/
     3  ' 	TERMINATED, AND THE DATA FILE REVERTS TO ITS ORIGINAL'/
     4  ' 	FORM.'/)
      STOP
      END
C
      FUNCTION JK(N)
      JK = N/536870912-48
      IF (JK.GE.0) RETURN
      JK = 10-(JK-3)/6
      RETURN
      END
C
      FUNCTION NK(J)
      IF (J.GE.10) J = (13-J)*(J-7)-J-3*(J/12)
      NK = (J+48)*536870912
      RETURN
      END
C
      SUBROUTINE DECODE
      COMMON ENTRY(0/13),LIST
      CALL OFIL(20,LIST,'.TMP')
      WRITE (20,3) (ENTRY(N),N=1,12)
    3 FORMAT (12A5)
      END FILE 20
      CALL IFIL(20,LIST,'.TMP')
      IF (ENTRY(1).LT.'MAP 0' .OR. ENTRY(1).GT.'MAP Z') GO TO 50
      READ (20,4) (ENTRY(N),N=0,12)
    4 FORMAT (A4,12A5)
      CALL OFIL(20,LIST,'.TMP')
      WRITE (20,3) (ENTRY(N),N=0,11)
      END FILE 20
      CALL IFIL(20,LIST,'.TMP')
      RETURN
   50 DO 55  N=0,12
   55 ENTRY(N) = ENTRY(N+1)
      RETURN
      END
C
      SUBROUTINE CHISQ(CS,NDF,PR)
      PR = 1.
      IF (CS.EQ.0) RETURN
      DF = NDF
      IF (CS.LT.DF) GO TO 100
      A = DF
      B = 10000.
      F = CS/DF
      GO TO 200
  100 A = 10000.
      B = DF
      F = DF/CS
  200 A1 = 2./(9.*A)
      B1 = 2./(9.*B)
      Y = ((1.-B1)*F**(1./3.)-1.+A1)/SQRT(B1*F**(2./3.)+A1)
      Z = ABS(Y)
      IF (B.LT.4.) Z = Z*(1+.08*Z**4/B**3)
      PR = .5/(1+Z*(.196854+Z*(.115194+Z*(.000344+Z*.019527))))**4
      IF (CS.LT.DF .AND. Y.GE.0) PR = 1.-PR
      RETURN
      END