C     PROGRAM CROSS
C	(CORRELATION OF RESPONSES WITH OPTIONS FOR THE SOCIAL SCIENCES)
C
C     DESCRIPTION
C	THIS PROGRAM CORRELATES RESPONSES TO SELECTED QUESTIONS OF A
C	QUESTIONNAIRE TO PRODUCE A TABLE OF MARGINAL FREQUENCIES FOR
C	ANY VARIABLE OR CROSS-TABULATIONS OF PAIRS OF VARIABLES (WITH
C	OR WITHOUT A CONTROL VARIABLE) GIVING FREQUENCIES, PERCENTAGES,
C	OR OTHER STATISTICS DESIRED BY THE USER.  AN EXCLUSION ANALYSIS
C	IS MADE IN EVERY CASE.  AN ITEM ANALYSIS MAY BE CARRIED OUT ON A
C	SELECTED SET OF VARIABLES AND THE RESULTS TABULATED AS A MATRIX
C	OF ITEM INTERCORRELATIONS.  IN ADDITION, A MAPPING OPTION ALLOWS
C	RESPONSES TO BE GROUPED INTO NEW CATEGORIES, WHILE JOINING AND
C	POOLING OPTIONS LET THE USER CONSTRUCT NEW VARIABLES.  MODIFIED
C	VERSIONS OF THE DATA FILE MAY BE SAVED FOR USE IN SUBSEQUENT
C	RUNS OF THE PROGRAM.  THE USER HAS ACCESS AT ALL TIMES TO EVERY
C	VARIABLE IN THE SURVEY (AS MANY AS 128).
C
C	THE DATA ANALYSIS PART OF THIS PROGRAM IS AVAILABLE SEPARATELY
C	AS CROSS1.  THE DATA MANIPULATION PART CAN BE RUN SEPARATELY AS
C	CROSS2.
C
C     SOURCE
C	NORMAN W. JOHNSON, DEPARTMENT OF MATHEMATICS, WHEATON COLLEGE,
C	NORTON, MASS.
C
C     INSTRUCTIONS
C	THE CODED RESPONSES TO THE QUESTIONNAIRE SHOULD BE READ FROM
C	CARDS AND WRITTEN INTO AN ASCII DATA FILE BY THE PROGRAM SURVEY.
C	A PRELIMINARY TABULATION OF MARGINAL FREQUENCIES FOR ALL VARI-
C	ABLES THE USER INTENDS TO WORK WITH CAN BE OBTAINED BY RUNNING
C	THE PROGRAM SORTER.
C
C	THE PROGRAM WILL FIRST REQUEST THE USER TO ENTER THE NAME OF
C	THE DATA FILE.  AFTER THIS IS DONE, A DESCRIPTION OF THE SURVEY
C	WILL BE TYPED.  THE USER MAY THEN PROCEED TO ANALYZE THE DATA BY
C	GIVING ONE OF THE COMMANDS "XTAB" OR "ITEM", MAY REDEFINE OR RE-
C	STORE CATEGORIES WITH ONE OF THE COMMANDS "MAP" OR "UNMAP", MAY
C	CONSTRUCT OR DELETE VARIABLES WITH ONE OF THE COMMANDS "JOIN",
C	"POOL", OR "CUT", MAY TYPE "SAVE" TO PRESERVE THE CURRENT FORM
C	OF THE DATA AS A NEW FILE, MAY RESTORE THE ORIGINAL FORM OF THE
C	DATA WITH THE COMMAND "RESET", OR MAY TERMINATE THE EXECUTION OF
C	THE PROGRAM BY TYPING "STOP".
C
C	COMMANDS THAT TAKE VARIABLES AS ARGUMENTS MAY HAVE THE LIST OF
C	VARIABLES ENTERED ON THE SAME LINE AS THE COMMAND.
C
C	THE COMMAND "XTAB" ENABLES THE USER TO OBTAIN MARGINAL FREQUEN-
C	CIES FOR ANY ONE VARIABLE OR TO CROSS-TABULATE ANY PAIR OF VARI-
C	ABLES, USING A THIRD VARIABLE AS A CONTROL IF DESIRED.  THE
C	CONTROL VARIABLE MAY BE RESTRICTED TO ONE CATEGORY BY FOLLOWING
C	THE THIRD VARIABLE NUMBER WITH AN EQUALS SIGN (=) AND A CATEGORY
C	NUMBER (0 TO 9).  FOLLOWING THE THIRD VARIABLE NUMBER WITH AN
C	INEQUALITY SIGN (<>) AND A CATEGORY NUMBER HAS THE EFFECT OF
C	EXCLUDING RESPONDENTS IN THAT CATEGORY.  IF TWO OR THREE VARI-
C	ABLES ARE SPECIFIED, ONE OR MORE OUTPUT OPTIONS MUST BE SELECTED
C	AND THE APPROPRIATE CODE NUMBERS ENTERED.  THE FOLLOWING OPTIONS
C	ARE AVAILABLE:
C		0--EXCLUSION ANALYSIS ONLY
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 "ITEM" PRODUCES A MATRIX OF ITEM INTERCORRELATIONS
C	(GOODMAN AND KRUSKAL'S GAMMA) FOR AS MANY AS NINE VARIABLES.  A
C	VARIABLE PRECEDED BY A MINUS SIGN HAS ITS CATEGORIES REVERSED.
C	WHEN THE COMMAND IS GIVEN AS "ITEM PART", A CONTROL VARIABLE MAY
C	BE SPECIFIED.  CORRELATIONS MAY BE LIMITED TO A CERTAIN SET OF
C	RESPONDENTS BY FOLLOWING THE CONTROL VARIABLE WITH AN EQUALITY
C	OR INEQUALITY SIGN AND A CATEGORY NUMBER.
C
C	THE COMMAND "MAP" ENABLES THE USER TO REGROUP THE RESPONSES TO
C	ANY QUESTION.  FOR EACH VARIABLE OR BLOCK OF VARIABLES, THE USER
C	SPECIFIES HOW MANY NEW CATEGORIES ARE TO BE CREATED, THEN LISTS
C	THE CODE NUMBERS (0 TO 13) OF THE RESPONSES TO BE INCLUDED IN
C	EACH GROUP.  NUMBERS MAY BE LISTED INDIVIDUALLY, SEPARATED BY
C	COMMAS, OR TWO NUMBERS MAY BE JOINED BY A HYPHEN TO FORM A BLOCK
C	OF CONSECUTIVE RESPONSES.  BY TYPING "1" OR "KEEP" WHEN THE NUM-
C	BER OF NEW CATEGORIES IS REQUESTED, THE USER MAY PRESERVE THE
C	CURRENT GROUPING.  TYPING "0" OR "UNMAP" RESTORES THE ORIGINAL
C	CODING.  TYPING "-1" OR "REFLECT" REVERSES THE EXISTING CATE-
C	GORIES.  TYPING "X" OR "EXCLUDE" ELIMINATES ALL CATEGORIES.  A
C	LIST OF THE CURRENT CATEGORIES MAY BE OBTAINED BY TYPING "LIST".
C
C	AFTER EACH MAPPING THE USER MUST INDICATE WHETHER ANY CATEGORIES
C	ARE TO BE EXCLUDED.  IF NOT, AN EXCLUSION CODE OF 0 IS ENTERED.
C	OTHERWISE, THE EXCLUSION CODE IS 1 IF THE USER DESIRES TO OMIT
C	THE HIGHEST NUMBERED CATEGORY, 2 IF THE TWO HIGHEST CATEGORIES
C	ARE TO BE OMITTED, ETC.  LIKEWISE, AN EXCLUSION CODE OF -1 MAY
C	BE USED TO OMIT THE LOWEST NUMBERED CATEGORY, AND SO ON.  AN EX-
C	CLUSION CODE CANNOT LEAVE FEWER THAN TWO CATEGORIES.  HOWEVER,
C	THE USER MAY TYPE "X" TO ELIMINATE ALL CATEGORIES.
C
C	THE COMMAND "UNMAP" CANCELS THE EFFECT OF THE CURRENT MAPPING OF
C	THE VARIABLE OR VARIABLES SPECIFIED, THUS RESTORING THE ORIGINAL
C	CODING OF THE RESPONSES TO EACH QUESTION.  THE ORIGINAL CODING
C	IS ALSO RESTORED WHEN THE PROGRAM IS RUN FROM THE BEGINNING,
C	UNLESS A MODIFIED VERSION OF THE DATA FILE HAS BEEN SAVED.
C
C	THE COMMAND "JOIN" ALLOWS THE USER TO COMBINE TWO OR THREE VARI-
C	ABLES INTO ONE NEW VARIABLE.  ALL COMBINATIONS OF CATEGORIES
C	FOR THE GIVEN VARIABLES ARE ARRANGED IN A TABLE, WHICH THE USER
C	FILLS IN WITH THE NUMBERS (0 TO 9 WITH 11, 12, AND 13 FOR EX-
C	CLUSIONS) TO BE ASSIGNED TO THE CORRESPONDING CATEGORIES OF THE
C	NEW VARIABLE.  AS IN THE CASE OF THE "XTAB" COMMAND, WHEN THREE
C	VARIABLES ARE LISTED, THE USER MAY SELECT OR REJECT A PARTICULAR
C	CATEGORY OF THE THIRD VARIABLE.  THE "JOIN" COMMAND ALSO ALLOWS
C	SINGLE VARIABLES TO BE DUPLICATED AND PROVIDES A WAY OF HANDLING
C	VARIABLES WITH TWO- OR THREE-DIGIT CATEGORY NUMBERS.
C
C	THE COMMAND "POOL" MAY BE USED TO CONSTRUCT AN INDEX VARIABLE
C	FROM A BLOCK OF VARIABLES WITH SCALED RESPONSES, E.G., QUESTIONS
C	DESIGNED TO MEASURE RESPONDENTS' ATTITUDES.  THE TOTAL SCORE OF
C	EACH RESPONDENT FOR THE BLOCK OF QUESTIONS IS COMPUTED, DIVIDED
C	BY THE NUMBER OF QUESTIONS, AND ROUNDED TO THE NEAREST INTEGER.
C	THE RESULTING CATEGORY NUMBER PLACES THE RESPONDENT ON A SCALE
C	FOR THE INDEX VARIABLE COMPARABLE TO THE ONE EMPLOYED FOR THE
C	VARIABLES USED TO CONSTRUCT IT.
C
C	THE COMMAND "CUT" PERMITS THE DELETION OF THE HIGHEST NUMBERED
C	VARIABLE OR VARIABLES, EITHER TO MAKE ROOM FOR NEW VARIABLES TO
C	BE CREATED BY JOINING OR POOLING OR TO ELIMINATE ONE OR MORE OF
C	THOSE MOST RECENTLY CREATED.  THE USER SPECIFIES THE NUMBER OF
C	VARIABLES TO BE REMOVED BY ENTERING A DELETION CODE.
C
C	THE COMMAND "SAVE" ENABLES THE USER TO PRESERVE THE CURRENT FORM
C	OF THE DATA, INCORPORATING ALL MAPS, JOINS, POOLS, AND CUTS, AS
C	A NEW DATA FILE.  THIS FILE MUST BE GIVEN A NAME, DIFFERENT FROM
C	THAT OF ANY EXISTING DATA FILE, CONSISTING OF FROM ONE TO FIVE
C	CHARACTERS.  THE NAME MAY BE SPECIFIED IN THE "SAVE" COMMAND
C	(E.G., "SAVE FILNM") OR SEPARATELY.
C
C	THE COMMAND "RESET" RESTORES THE INITIAL STATE OF THE DATA, THUS
C	UNDOING THE EFFECTS OF ALL MAPS, UNMAPS, JOINS, POOLS, AND CUTS.
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,PRIME,STAR,DIFFER,EQUAL,ROW,COL
      INTEGER L(0/128),H(0/128),R(0/128)
      INTEGER MAP(0/128,0/13),X(128),IA(0/21),OLD(13)
      INTEGER JOIN(0/13,0/13,0/13)
      REAL POS,NEG
      LOGICAL OPT(0/9),GROUP,ERROR,ZERO,REJECT,BLURB,POOL,SWITCH
      DIMENSION NUM(0/13,0/13,0/13),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 G(9,9,0/9),GMEAN(9),AMEAN(9)
      DIMENSION J1A(10),J2A(10)
      EQUIVALENCE (JOIN,NUM),(R,PCT),(G,NSUB),(Q,GAMMA)
      COMMON ENTRY(0/13),LIST
      DATA TEMP1,TEMP2 /'TEMP1','TEMP2'/
      TEMP = 'TEMP2'
      OPT(0) = .TRUE.
      BLANK  = 17315143744
      PRIME  = 21073240128
      STAR   = 22548578304
      R(0)   = 25905078336
      DIFFER = 32472301568
      EQUAL  = 32749125632
      CALL TIME(NOW)
      LIST = NOW-851968
      CALL DATE(TODAY)
      TYPE 1, NOW,TODAY
    1 FORMAT (' CROSS ',8X,A5,9X,2A5//)
C
C     START:  LOCATE DATA FILE.
   20 TYPE 2
    2 FORMAT (/' NAME OF SURVEY? ',$)
C     ENTER FILE NAME.
   30 ACCEPT 3, ORIG
    3 FORMAT (12A5)
   31 FORMAT (/A5)
   32 FORMAT (//A5)
   33 FORMAT (8X,A5)
   34 FORMAT ('+'/$)
      IF (ORIG.EQ.' ') GO TO 20
      IF (ORIG.EQ.'STOP') GO TO 2000
      DATA = ORIG
      GROUP = RENAME(DATA,'.MAP',DATA,'.MAP')
      IF (GROUP) CALL IFIL(21,DATA,'.MAP')
      IF (GROUP) READ (21,31) DATA
      IF (RENAME(DATA,'.DAT',DATA,'.DAT')) GO TO 40
      TYPE 4, DATA
    4 FORMAT (' CANNOT FIND DATA FILE ',A5/)
      GO TO 20
   40 CALL IFILE(1,DATA)
C     INPUT DESCRIPTION OF SURVEY.
   50 READ (1,5) (A(I),I=1,48)
    5 FORMAT (/48A1)
      DO 60  I=48,1,-1
      IF (A(I).NE.BLANK) GO TO 70
   60 A(I) = 0
   70 TYPE 7, (A(I),I=1,48)
    7 FORMAT (9X,48A1////)
      LAST = 0
      IF (.NOT.GROUP) GO TO 100
C     GROUP RESPONSES TO EACH QUESTION.
   80 READ (21,10) M
      READ (21,14) (L(I),I=1,M)
      READ (21,14) (H(I),I=1,M)
      READ (21,16) (X(I),I=1,M)
      DO 85  J=0,13
      READ (21,16) (R(I),I=1,M)
      DO 85  I=1,M
   85 MAP(I,J) = JK(R(I))
      READ (1,10) MAX
      M = MIN0(M,MAX)
      READ (1,32) ID
      IF (LAST) 190,190,200
C     INPUT NUMBER OF QUESTIONS.
  100 READ (1,10) M
   10 FORMAT (20I)
  101 FORMAT (9I1,9L1)
  102 FORMAT (I2)
  103 FORMAT (3I,2A1)
  104 FORMAT (I,2A1)
C     INPUT LOWEST NUMBER USED AS CODED RESPONSE TO EACH QUESTION.
  120 READ (1,14) (L(I),I=1,M)
C     INPUT HIGHEST NUMBER USED AS CODED RESPONSE TO EACH QUESTION.
  140 READ (1,14) (H(I),I=1,M)
   14 FORMAT (5X,128I1)
C     INPUT MAPPING INDICATOR FOR EACH QUESTION.
  160 READ (1,16) (X(I),I=1,M)
   16 FORMAT (5X,128A1)
  180 DO 185  J=0,13
      DO 185  I=1,M
  185 MAP(I,J) = J
      IF (LAST.GT.0) GO TO 200
  190 READ (1,3) ID
      IF (ID.NE.BLANK) GO TO 190
C     INPUT NUMBER OF RESPONDENTS.
      READ (1,10) LAST
      TOTAL = LAST
      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.'START') GO TO 20
      IF (ANS.EQ.' ')     GO TO 200
      IF (ANS.EQ.'DETAI') GO TO 210
      IF (ANS.EQ.'EXPLA' .AND. SAVE.GT.'IN') GO TO 220
      IF (ANS.EQ.'XTAB')  GO TO 230
      IF (ANS.EQ.'ITEM')  GO TO 1400
      IF (ANS.EQ.'MAP')   GO TO 1500
      IF (ANS.EQ.'UNMAP') GO TO 1600
      IF (ANS.EQ.'JOIN')  GO TO 1700
      IF (ANS.EQ.'POOL')  GO TO 1800
      IF (ANS.EQ.'CUT')   GO TO 1890
      IF (ANS.EQ.'SAVE')  GO TO 1900
      IF (ANS.EQ.'RESET') GO TO 1990
      IF (ANS.EQ.'STOP')  GO TO 2000
      TYPE 204
  204 FORMAT (
     1  ' ENTER ONE OF THE FOLLOWING:'/
     2  ' 	XTAB, ITEM, MAP, UNMAP, JOIN, POOL, CUT, SAVE, RESET,'/
     3  ' 	STOP, OR DETAIL'/)
      GO TO 200
  210 TYPE 21
   21 FORMAT (
     1  ' 	TO OBTAIN MARGINAL FREQUENCIES FOR A VARIABLE OR'/
     2  ' 	TO CROSS-TABULATE 2 OR 3 VARIABLES, TYPE "XTAB".'/
     3  ' 	TO INTERCORRELATE 2 TO 9 VARIABLES, TYPE "ITEM".'/
     4  ' 	TO REGROUP RESPONSES TO A QUESTION, TYPE "MAP".'/
     5  ' 	TO RESTORE THE ORIGINAL CATEGORIES, TYPE "UNMAP".'/
     6  ' 	TO DUPLICATE A VARIABLE WITH CURRENT CATEGORIES OR'/
     7  ' 	TO COMBINE 2 OR 3 VARIABLES INTO ONE, TYPE "JOIN".'/
     8  ' 	TO MAKE A SINGLE VARIABLE OF A BLOCK, TYPE "POOL".'/
     9  ' 	TO DELETE HIGHEST NUMBERED VARIABLES, TYPE "CUT".'/
     /  ' 	TO SAVE CURRENT VERSION OF DATA FILE, TYPE "SAVE".'/
     1  ' 	TO RESTORE ALL DATA TO INITIAL STATE, TYPE "RESET".'/
     2  ' 	TO TERMINATE THE PROGRAM, TYPE "STOP".'//
     3  ' 	TO HALT EXECUTION OF A COMMAND, TYPE "ABORT".'/
     4  ' 	TO GET HELP AT ANY POINT, TYPE "EXPLAIN" OR "?".'//
     5  ' 	FOR A MORE COMPLETE EXPLANATION OF ANY OF THE ABOVE'/
     6  ' 	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.'XTAB')  TYPE 231
      IF (ANS.EQ.'ITEM')  TYPE 1402
      IF (ANS.EQ.'MAP')   TYPE 1501
      IF (ANS.EQ.'MAP')   TYPE 1502
      IF (ANS.EQ.'UNMAP') TYPE 1602
      IF (ANS.EQ.'JOIN')  TYPE 1702
      IF (ANS.EQ.'POOL')  TYPE 1802
      IF (ANS.EQ.'CUT')   TYPE 1891
      IF (ANS.EQ.'SAVE')  TYPE 1901
      IF (ANS.EQ.'RESET') TYPE 1991
      IF (ANS.EQ.'STOP')  TYPE 2002
      GO TO 200
C
C     XTAB:  CROSS-TABULATE VARIABLES.
  230 ZERO = ENTRY(0).NE.ANS .OR. ENTRY(1).EQ.' '
      IF (ZERO) TYPE 23
   23 FORMAT (' VARIABLES TO BE TABULATED? ',$)
      IF (ZERO) ACCEPT 3, (ENTRY(N),N=1,12)
      IF (ENTRY(1).EQ.'NONE' .OR. 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 ONE VARIABLE TO OBTAIN MARGINAL FREQUENCIES OR A'/
     2  ' 	PAIR OF VARIABLES TO BE CROSS-TABULATED.  ENTER THREE'/
     3  ' 	VARIABLES IF A CONTROL IS DESIRED.  THE THIRD VARI-'/
     4  ' 	ABLE MAY BE FOLLOWED BY AN EQUALS SIGN AND A CATEGORY'/
     5  ' 	NUMBER (0 TO 9).  AN ENTRY IN THE FORM ''V1,V2,V3=C'''/
     6  ' 	ASKS FOR A CROSS-TABULATION OF VARIABLES V1 AND V2 FOR'/
     7  ' 	RESPONDENTS BELONGING TO CATEGORY C OF VARIABLE V3.'/
     8  ' 	AN ENTRY IN THE FORM ''V1,0,V3=C'' REQUESTS MARGINAL'/
     9  ' 	FREQUENCIES FOR VARIABLE V1 FOR THOSE RESPONDENTS IN'/
     /  ' 	CATEGORY C OF VARIABLE V3.  IF THE THIRD VARIABLE IS'/
     1  ' 	FOLLOWED BY AN INEQUALITY SIGN (<>) AND A CATEGORY'/
     2  ' 	NUMBER, RESPONDENTS IN THAT CATEGORY WILL BE EXCLUDED.'/
     3  ' 	IF YOU DO NOT WANT TO HAVE ANY VARIABLES TABULATED,'/
     4  ' 	TYPE "NONE".'//
     5  ' 	WHEN VARIABLES TO BE CROSS-TABULATED ARE LISTED ON THE'/
     6  ' 	SAME LINE AS THE COMMAND (E.G., "XTAB 1,2"), THE OUT-'/
     7  ' 	PUT OPTIONS WILL BE THE SAME AS IN THE LAST PREVIOUS'/
     8  ' 	CROSS-TABULATION, IF ANY.'/)
      CALL DECODE
      READ (20,103) I1,I2,I3,N3,N3X
      IF (I1.EQ.0) GO TO 230
      ERROR = I1.LT.0 .OR. I1.GT.M .OR. I2.LT.0 .OR. I2.GT.M .OR.
     1  I3.LT.0 .OR. I3.GT.M
      IF (ERROR) TYPE 232, M
  232 FORMAT ('+INVALID ENTRY--VARIABLES RUN FROM  1  TO ',I3/)
      IF (ERROR) GO TO 230
      ERROR = L(I1).GT.H(I1) .OR. L(I2).GT.H(I2) .OR. L(I3).GT.H(I3)
      IF (ERROR) TYPE 233
  233 FORMAT ('+INVALID ENTRY--VARIABLE WITHOUT CATEGORIES'/)
      IF (ERROR) GO TO 230
      J3X = JK(N3X)
      IF (J3X.GT.9) J3X = -1
      REJECT = (N3.EQ.'<' .OR. N3.EQ.'>') .AND. J3X.GE.0
      J3 = JK(N3)
      IF (J3.GT.9) J3 = -1
      IF (J3.LT.0 .AND. .NOT.REJECT) J3 = J3X
      IF (I2.NE.0 .OR. J3.GE.0 .OR. J3X.GE.0) GO TO 235
      I2 = I3
      I3 = 0
  235 I3L = L(I3)
      I3H = H(I3)
      IF (J3.LT.0 .AND. I2.NE.0) GO TO 290
      IF (J3.LT.0 .AND. I2.EQ.0) GO TO 300
      L(I3) = J3
      H(I3) = J3
      IF (I2) 290,300,290
C     TABULATE MARGINAL FREQUENCIES.
  240 J3 = L(I3)
      DO 245  J1=L(I1),H(I1)
  245 PSUB(1,J1) = NSUB(1,J1,J3)/TOTAL+.0005
      PTAB = NTAB/TOTAL+.0005
  250 WRITE (5,25) I1
   25 FORMAT (///
     1  ' DOWN:     VARIABLE ',I3)
      R(3) = EQUAL
      IF (REJECT) R(3) = DIFFER
      IF (I3.NE.0) WRITE (5,252) I3,R(3),J3,X(I3)
  252 FORMAT (
     2  ' CONTROL:  VARIABLE ',I3,2X,A2,'  CATEGORY  ',I1,A1)
      WRITE (5,253)
  253 FORMAT (///9X,'FREQ',4X,'PCT'/)
      DO 260  J1=L(I1),H(I1)
  260 WRITE (5,26) J1,X(I1),NSUB(1,J1,J3),PSUB(1,J1)
   26 FORMAT (' ',I1,A1,5X,I4,4X,2PF5.1)
  270 WRITE (5,27) NTAB,PTAB
   27 FORMAT (/' TOT ',3X,I4,4X,2PF5.1)
      GO TO 1350
C     ENTER OUTPUT OPTIONS.
  280 TYPE 28
   28 FORMAT (
     1  ' ENTER (WITHOUT PUNCTUATION) ONE OR MORE OPTIONS FOR OUTPUT:')
  281 FORMAT (
     2  ' 	0--EXCLUSION ANALYSIS ONLY'/
     3  ' 	1--FREQUENCY OF RESPONSES'/
     4  ' 	2--PERCENTAGES ACROSS'/
     5  ' 	3--PERCENTAGES DOWN'/
     6  ' 	4--PERCENTAGES OF TOTAL'/
     7  ' 	5--CHI-SQUARE'/
     8  ' 	6--NOMINAL TAU'/
     9  ' 	7--YULE''S Q / GAMMA'/
     /  ' 	8--PHI / ORDINAL TAU'/
     1  ' 	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
      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))
C     COUNT RESPONSES IN EACH CATEGORY.
  300 MAX = MAX0(I1,I2,I3)
      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
      CALL IFILE(1,DATA)
      READ (1,32) ID
      READ (1,32) ID
      DO 315  K=1,LAST
      READ (1,16) (R(I),I=1,MAX)
      J1 = MAP(I1,JK(R(I1)))
      J2 = MAP(I2,JK(R(I2)))
      J3 = MAP(I3,JK(R(I3)))
  315 NUM(J1,J2,J3) = NUM(J1,J2,J3)+1
      IF (ANS.EQ.'ITEM' .AND. .NOT.REJECT) GO TO 1450
  320 IF (.NOT.REJECT) GO TO 335
      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)-NUM(J1,J2,J3X)
      IF (ANS.EQ.'ITEM') GO TO 1450
      L(I3) = J3X
      H(I3) = J3X
  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
      IF (I2.EQ.0) GO TO 240
      IF (OPT(0)) GO TO 1350
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) I1,I2
   43 FORMAT (///
     1  ' DOWN:     VARIABLE ',I3/
     2  ' ACROSS:   VARIABLE ',I3)
      R(3) = EQUAL
      IF (REJECT) R(3) = DIFFER
      IF (I3.NE.0) WRITE (5,431) I3,R(3),J3,X(I3)
  431 FORMAT (
     3  ' CONTROL:  VARIABLE ',I3,2X,A2,'  CATEGORY  ',I1,A1)
      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
      DO 965  I=1,3
  965 R(I) = 0
      IF (I1.GE.100) R(1) = BLANK
      IF (I2.GE.100) R(2) = BLANK
      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) R(1),I1
   98 FORMAT (' (KNOWING VARIABLE',A1,I3,$)
      IF (TAU.LT..0005) WRITE (5,981) R(2),I2
  981 FORMAT ('+ DOES NOT REDUCE ERROR',
     1  ' IN PREDICTING VARIABLE',A1,I3,')')
      IF (TAU.GE..0005.AND.TAU.LT..9995) WRITE (5,982) R(2),I2,R(3),PTAU
  982 FORMAT ('+ REDUCES ERROR',
     1  ' IN PREDICTING VARIABLE',A1,I3,' BY',A1,2PF4.1,'%)')
      IF (TAU.GE..9995) WRITE (5,883) R(2),I2
  983 FORMAT ('+ ELIMINATES ERROR',
     1  ' IN PREDICTING VARIABLE',A1,I3,')')
      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 DO 1065  I=1,4
 1065 R(I) = 0
      IF (I1.GE.100) R(1) = BLANK
      IF (X(I1).EQ.PRIME) R(2) = PRIME
      IF (I2.GE.100) R(3) = BLANK
      IF (X(I2).EQ.PRIME) R(4) = PRIME
      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) R(1),I1,J1,R(2),R(3),I2,J2,R(4)
  108 FORMAT (
     1  ' (VARIABLE',A1,I3,' = CATEGORY ',I1,A1,')  TENDS WITH ',
     2  ' (VARIABLE',A1,I3,' = CATEGORY ',I1,A1,')')
      IF (ABS(Q).LT..0005) WRITE (5,1081) R(1),I1,R(3),I2
 1081 FORMAT (
     1  ' VARIABLES',A1,I3,' AND',A1,I3,' 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 DO 1265  I=1,2
 1265 R(I) = 0
      IF (I1.GE.100) R(1) = BLANK
      IF (I2.GE.100) R(2) = BLANK
 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) R(1),I1,R(2),I2
 1283 FORMAT ('+ FOR VARIABLE',A1,I3,' RELATIVE TO VARIABLE',A1,I3,')')
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 WRITE (5,135) NTAB,NOUT,LAST
  135 FORMAT (///
     1  ' EXCLUSION ANALYSIS:'//
     2  ' 	TABLE TOTAL  ',I4/
     3  ' 	EXCLUDED     ',I4/
     4  ' 	SAMPLE SIZE  ',I4)
      TYPE 34
      L(I3) = I3L
      H(I3) = I3H
      WRITE (5,201)
      GO TO 202
C
C     ITEM:  INTERCORRELATE VARIABLES.
 1400 ZERO = ENTRY(0).NE.ANS
      IF (ENTRY(1).EQ.'PART') CALL DECODE
      ZERO = ZERO .OR. ENTRY(1).EQ.' '
      IF (ZERO) TYPE 1401
 1401 FORMAT (' VARIABLES TO BE CORRELATED? ',$)
      IF (ZERO) ACCEPT 3, (ENTRY(N),N=1,12)
      IF (ENTRY(1).EQ.'NONE' .OR. 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 1402
 1402 FORMAT (
     1  ' 	ENTER 2 TO 9 VARIABLES TO BE INTERCORRELATED.  ANY'/
     2  ' 	VARIABLE TO BE CORRELATED THAT IS PRECEDED BY A MINUS'/
     3  ' 	SIGN WILL BE REFLECTED.  IF YOU DO NOT WANT TO HAVE'/
     4  ' 	ANY VARIABLES CORRELATED, TYPE "NONE".'//
     5  ' 	WHEN THE COMMAND "ITEM PART" IS GIVEN, ANOTHER VARI-'/
     6  ' 	ABLE MAY BE ENTERED SEPARATELY AS A CONTROL.  IF THE'/
     7  ' 	CONTROL VARIABLE IS FOLLOWED BY AN EQUALS SIGN AND A'/
     8  ' 	CATEGORY NUMBER (0 TO 9), CORRELATIONS WILL BE LIMITED'/
     9  ' 	TO RESPONDENTS IN THAT CATEGORY ONLY.  IF THE CONTROL'/
     /  ' 	VARIABLE IS FOLLOWED BY AN INEQUALITY SIGN (<>) AND A'/
     1  ' 	CATEGORY NUMBER, RESPONDENTS IN THAT CATEGORY WILL BE'/
     2  ' 	EXCLUDED.'/)
      CALL DECODE
      READ (20,10) (IA(N),N=1,9)
      IA(10) = 0
      IF (IA(1).EQ.0) GO TO 1400
      DO 1410  N=1,9
      IF (IABS(IA(N)).LE.M) GO TO 1405
      TYPE 232
      GO TO 1400
 1405 IF (L(IA(N)).LE.H(IA(N))) GO TO 1410
      TYPE 233
      GO TO 1400
 1410 IF (IA(N+1).EQ.0) GO TO 1415
 1415 IF (N.LT.2) GO TO 1400
      NVAR = N
      I3 = 0
      I3L = 0
      I3H = 0
      IF (SAVE.NE.'PART') GO TO 1430
 1420 TYPE 142
  142 FORMAT (' CONTROL? ',$)
 1421 ACCEPT 3, (ENTRY(N),N=1,12)
      IF (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 1422
 1422 FORMAT (' ENTER CONTROL VARIABLE OR TYPE "NONE": ',$)
      IF (BLURB) GO TO 1421
      CALL DECODE
      READ (20,104) I3,N3,N3X
      IF (I3.GE.0 .AND. I3.LE.M) GO TO 1425
      TYPE 232, M
      GO TO 1420
 1425 J3X = JK(N3X)
      IF (J3X.GT.9) J3X = -1
      REJECT = (N3.EQ.'<' .OR. N3.EQ.'>') .AND. J3X.GE.0
      J3 = JK(N3)
      IF (J3.LT.0 .OR. J3.GT.9) J3 = J3X
      I3L = L(I3)
      I3H = H(I3)
      IF (J3.LT.0) GO TO 1430
      I3L = J3
      I3H = J3
 1430 DO 1490  MJ3=I3L,I3H
      IF (MJ3.NE.I3L) WRITE (5,34)
      WRITE (5,143)
  143 FORMAT (///' ITEM INTERCORRELATIONS:')
      R(3) = EQUAL
      IF (REJECT) R(3) = DIFFER
      IF (I3.NE.0) WRITE (5,1431) I3,R(3),MJ3,X(I3)
 1431 FORMAT (//
     1  ' CONTROL:  VARIABLE ',I3,2X,A2,'  CATEGORY  ',I1,A1)
 1440 WRITE (5,144) (IA(COL),X(IABS(IA(COL))),COL=1,NVAR)
  144 FORMAT (//10X,9(2X,I4,A1))
      WRITE (5,34)
      DO 1470  ROW=1,NVAR
      G(ROW,ROW,MJ3) = 1.0
      DO 1460  COL=ROW+1,NVAR
      IF (MJ3.NE.I3L .OR. ROW.EQ.NVAR) GO TO 1460
      I1 = IABS(IA(ROW))
      I2 = IABS(IA(COL))
      SGN = ISIGN(1,IA(ROW)*IA(COL))
      GO TO 300
 1450 DO 1460  J3=I3L,I3H
      POS = 0.0
      NEG = 0.0
      DO 1454  MJ1=L(I1),H(I1)-1
      DO 1454  MJ2=L(I2),H(I2)-1
      DO 1454  J1=MJ1+1,H(I1)
      DO 1454  J2=MJ2+1,H(I2)
 1454 POS = POS+NUM(MJ1,MJ2,J3)*NUM(J1,J2,J3)
      DO 1458  MJ1=L(I1),H(I1)-1
      DO 1458  MJ2=L(I2)+1,H(I2)
      DO 1458  J1=MJ1+1,H(I1)
      DO 1458  J2=L(I2),MJ2-1
 1458 NEG = NEG+NUM(MJ1,MJ2,J3)*NUM(J1,J2,J3)
      G(ROW,COL,J3) = 0.0
      IF (POS.NE.NEG) G(ROW,COL,J3) = SGN*(POS-NEG)/(POS+NEG)
      G(COL,ROW,J3) = G(ROW,COL,J3)
 1460 CONTINUE
      GSUM = 0.0
      ASUM = 0.0
      DO 1465  COL=1,NVAR
      GSUM = GSUM+G(ROW,COL,MJ3)
      ASUM = ASUM+ABS(G(ROW,COL,MJ3))
 1465 CONTINUE
      GMEAN(ROW) = (GSUM-1.)/(NVAR-1)
      AMEAN(ROW) = (ASUM-1.)/(NVAR-1)
 1470 WRITE (5,147) IA(ROW),X(IABS(IA(ROW))),(G(ROW,COL,MJ3),COL=1,NVAR)
  147 FORMAT (' ',I4,A1,4X,9F7.3)
 1480 WRITE (5,148) (GMEAN(COL),COL=1,NVAR)
  148 FORMAT (/' MEAN ',4X,9F7.3)
 1490 WRITE (5,149) (AMEAN(COL),COL=1,NVAR)
  149 FORMAT (' MEAN ABS ',9F7.3)
      TYPE 34
      WRITE (5,201)
      GO TO 202
C
C     MAP:  REGROUP CATEGORIES.
 1500 ZERO = ENTRY(0).NE.ANS .OR. ENTRY(1).EQ.' '
      IF (ZERO) TYPE 150
  150 FORMAT (' VARIABLES TO BE MAPPED? ',$)
      IF (ZERO) ACCEPT 3, (ENTRY(N),N=1,12)
      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 1501
      IF (BLURB) TYPE 1502
 1501 FORMAT (
     1  ' 	ENTER ONE OR MORE VARIABLES WHOSE RESPONSES ARE TO BE'/
     2  ' 	REGROUPED.  (IF YOU DO NOT WANT TO MAP ANY VARIABLES,'/
     3  ' 	TYPE "NONE".)  A BLOCK OF CONSECUTIVE VARIABLES (TWO'/
     4  ' 	NUMBERS JOINED BY A HYPHEN OR THE WORD "ALL") CAN BE'/
     5  ' 	MAPPED SIMULTANEOUSLY.  FOR EACH VARIABLE TO BE MAPPED')
 1502 FORMAT (
     6  ' 	SPECIFY THE NUMBER OF NEW CATEGORIES DESIRED.  THEN'/
     7  ' 	FOR EACH GROUP LIST THE CODE NUMBERS OF THE RESPONSES'/
     8  ' 	TO BE INCLUDED IN IT (TWO NUMBERS MAY BE JOINED BY A'/
     9  ' 	HYPHEN TO INDICATE A BLOCK OF CONSECUTIVE RESPONSES).'/
     /  ' 	EVERY CATEGORY MUST BE MAPPED.'//
     1  ' 	YOU CAN PRESERVE THE CURRENT GROUPING BY ENTERING "1"'/
     2  ' 	OR "KEEP" FOR THE NUMBER OF NEW CATEGORIES; ENTERING'/
     3  ' 	"0" OR "UNMAP" RESTORES THE ORIGINAL CODING (IN EITHER'/
     4  ' 	CASE EXCLUSIONS MAY STILL BE MADE).  ENTERING "-1" OR'/
     5  ' 	"REFLECT" REVERSES EXISTING CATEGORIES.  ENTERING "X"'/
     6  ' 	OR "EXCLUDE" ELIMINATES ALL CATEGORIES.  TO ASCERTAIN'/
     7  ' 	THE CURRENT MAPPING, TYPE "LIST".  IF YOU HAVE ENTERED'/
     8  ' 	MORE VARIABLES THAN YOU WANT TO MAP, TYPE "ABORT".'/)
      CALL DECODE
      READ (20,10) (IA(N),N=1,20)
      IF (ENTRY(0).EQ.'ALL') IA(1) = 1
      IF (ENTRY(0).EQ.'ALL') IA(2) = -M
      IF (IA(1).EQ.0) GO TO 1500
      DO 1505  N=1,20
      IF (IA(N).GE.0 .AND. IA(N).LE.M) GO TO 1505
      IF (IA(N-1).GT.0.AND.IA(N-1).LE.-IA(N).AND.-IA(N).LE.M) GO TO 1505
      TYPE 232, M
      GO TO 1500
 1505 CONTINUE
      NVAR = 1
      I = IA(1)
      GO TO 1520
 1510 TYPE 151
  151 FORMAT ('+DUPLICATE MAPPING--START OVER'/)
 1520 MIN = I
      MAX = MAX0(I,-IA(NVAR+1))
      IF (MAX.LE.I) TYPE 1521, I
 1521 FORMAT (//
     1  ' VARIABLE ',I3/)
      IF (MAX.GT.I) TYPE 1522, MIN,MAX
 1522 FORMAT (//
     1  ' VARIABLES ',I3,'  TO ',I3/)
      TYPE 152
  152 FORMAT (' HOW MANY NEW CATEGORIES? ',$)
      ACCEPT 3, ENTRY(1)
      IF (ENTRY(1).EQ.'ABORT') GO TO 200
      IF (ENTRY(1).EQ.' ')     GO TO 1520
      IF (ENTRY(1).EQ.'REFLE' .OR. ENTRY(1).EQ.'-1') GO TO 1650
      IF (ENTRY(1).EQ.'EXCLU' .OR. ENTRY(1).EQ.'X')  GO TO 1660
      IF (ENTRY(1).EQ.'LIST')  GO TO 1690
      IF (ENTRY(1).EQ.'STOP')  GO TO 2000
      IF (ENTRY(1).EQ.'EXPLA' .OR. ENTRY(1).EQ.'?')  TYPE 1502
      LOW = (ENTRY(1).EQ.'10')+1
      IF (ENTRY(1).EQ.'10')    ENTRY(1) = '9'
      IF (ENTRY(1).EQ.'UNMAP') ENTRY(1) = '0'
      IF (ENTRY(1).EQ.'KEEP')  ENTRY(1) = '1'
      CALL DECODE
      READ (20,101,ERR=1520) NCAT
      IF (NCAT.EQ.0 .AND. IA(NVAR+1).LT.0) GO TO 1610
      IF (NCAT.EQ.1) GO TO 1590
      CALL IFILE(1,DATA)
      READ (1,32) ID
      READ (1,14) (IL,N=1,I)
      READ (1,14) (IH,N=1,I)
      READ (1,16) (IX,N=1,I)
      IF (NCAT.EQ.0) GO TO 1580
      DO 1525  J=0,13
 1525 MAP(I,J) = 10
      TYPE 34
      DO 1570  K=LOW,NCAT
      GO TO 1540
 1530 TYPE 153
  153 FORMAT ('+INCORRECT GROUPING--REENTER'/$)
      DO 1535  J=0,13
 1535 IF (MAP(I,J).EQ.K) MAP(I,J) = 10
 1540 TYPE 154, K
  154 FORMAT ('+  GROUP ',I1,''': ',$)
      ACCEPT 3, (ENTRY(N),N=1,10)
      IF (ENTRY(1).EQ.'ABORT' .OR. ENTRY(1).EQ.'UNMAP') GO TO 1580
      IF (ENTRY(1).EQ.'STOP') GO TO 2000
      BLURB = ENTRY(1).EQ.'EXPLA' .OR. ENTRY(1).EQ.'?'
      IF (BLURB) TYPE 1541
 1541 FORMAT (
     1  ' 	ENTER THE ORIGINAL CODE NUMBERS OF THE RESPONSES TO BE'/
     2  ' 	INCLUDED IN EACH GROUP.  TO START OVER, TYPE "UNMAP".'/
     3  ' 	TO QUIT MAPPING, TYPE "ABORT".'//$)
      IF (BLURB .OR. ENTRY(1).EQ.' ') GO TO 1540
      IF (ENTRY(1).LT.'0') GO TO 1530
      CALL DECODE
      READ (20,10) (OLD(N),N=1,12)
      IF (OLD(1).GT.13) GO TO 1530
      IF (OLD(2).LT.0)  GO TO 1545
      J = OLD(1)
      IF (MAP(I,J).NE.10) GO TO 1510
      MAP(I,J) = K
 1545 DO 1570  N=2,12
      IF (IABS(OLD(N)).GT.13) GO TO 1530
      IF (OLD(N)) 1550,1570,1560
 1550 IF (OLD(N-1).LT.0 .OR. OLD(N-1).GT.-OLD(N)) GO TO 1530
      DO 1555  J=OLD(N-1),-OLD(N)
      IF (MAP(I,J).EQ.K)  GO TO 1530
      IF (MAP(I,J).NE.10) GO TO 1510
 1555 MAP(I,J) = K
      GO TO 1570
 1560 IF (OLD(N-1).NE.0 .OR. N.EQ.2) GO TO 1565
      IF (MAP(I,J).EQ.K)  GO TO 1530
      IF (MAP(I,0).NE.10) GO TO 1510
      MAP(I,0) = K
 1565 IF (OLD(N+1).LT.0)  GO TO 1570
      J = OLD(N)
      IF (MAP(I,J).EQ.K)  GO TO 1530
      IF (MAP(I,J).NE.10) GO TO 1510
      MAP(I,J) = K
 1570 CONTINUE
      DO 1575  J=IL,IH
      IF (MAP(I,J).NE.10) GO TO 1575
      TYPE 157
  157 FORMAT ('+INCOMPLETE MAPPING--START OVER'/$)
      ENTRY(1) = 'ERROR'
      GO TO 1580
 1575 CONTINUE
      L(I) = LOW
      H(I) = NCAT
      X(I) = PRIME
      GO TO 1590
 1580 L(I) = IL
      H(I) = IH
      X(I) = IX
      DO 1585  J=0,13
 1585 MAP(I,J) = J
      IF (ENTRY(1).NE.'ERROR') TYPE 161
      IF (ENTRY(1).EQ.'ABORT') GO TO 200
      IF (NCAT.NE.0) GO TO 1520
 1590 IF (L(I)+1.LT.H(I)) GO TO 1680
      TYPE 159
  159 FORMAT (' NO EXCLUSIONS'/$)
      K = 0
 1595 NVAR = NVAR+1
      I = IA(NVAR)
      IF (I) 1630,200,1520
C
C     UNMAP:  RESTORE ORIGINAL CATEGORIES.
 1600 ZERO = ENTRY(0).NE.ANS .OR. ENTRY(1).EQ.' '
      IF (ZERO) TYPE 1601
 1601 FORMAT (' VARIABLES TO BE UNMAPPED? ',$)
      IF (ZERO) ACCEPT 3, (ENTRY(N),N=1,12)
      IF (ENTRY(1).EQ.' ALL') ENTRY(1) = 'ALL'
      IF (ENTRY(1).EQ.'NONE' .OR. 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 1602
 1602 FORMAT (
     1  ' 	ENTER ONE OR MORE VARIABLES WHOSE ORIGINAL CATEGORIES'/
     2  ' 	ARE TO BE RESTORED.  (IF YOU DO NOT WANT ANY VARIABLES'/
     3  ' 	TO BE UNMAPPED, TYPE "NONE".)  A BLOCK OF CONSECUTIVE'/
     4  ' 	VARIABLES (TWO NUMBERS JOINED BY A HYPHEN OR THE WORD'/
     5  ' 	"ALL") CAN BE UNMAPPED SIMULTANEOUSLY.'/)
      CALL DECODE
      READ (20,10) (IA(N),N=1,20)
      IF (ENTRY(0).EQ.'ALL') IA(1) = 1
      IF (ENTRY(0).EQ.'ALL') IA(2) = -M
      IF (IA(1).EQ.0) GO TO 1600
      DO 1605  N=1,20
      IF (IA(N).GE.0 .AND. IA(N).LE.M) GO TO 1605
      IF (IA(N-1).GT.0.AND.IA(N-1).LE.-IA(N).AND.-IA(N).LE.M) GO TO 1605
      TYPE 232, M
      GO TO 1600
 1605 CONTINUE
      NVAR = 1
      I = IA(1)
 1610 TYPE 161
  161 FORMAT (' ORIGINAL CATEGORIES RESTORED'/)
 1620 MIN = I
      MAX = MAX0(I,-IA(NVAR+1))
      CALL IFILE(1,DATA)
      READ (1,32) ID
      READ (1,184) (IL,I=0,MIN-1),(L(I),I=MIN,MAX)
      READ (1,184) (IH,I=0,MIN-1),(H(I),I=MIN,MAX)
      READ (1,186) (IX,I=0,MIN-1),(X(I),I=MIN,MAX)
      DO 1625  I=MIN,MAX
      DO 1625  J=0,13
 1625 MAP(I,J) = J
      IF (IA(NVAR+1).LT.0) NVAR = NVAR+1
      IF (ANS.EQ.'MAP') GO TO 1595
      NVAR = NVAR+1
      I = IA(NVAR)
      IF (I) 200,200,1620
C     MAP BLOCK OF CONSECUTIVE VARIABLES.
 1630 IF (NCAT.GT.1) GO TO 1640
      DO 1635  I=MIN,MAX
      IF (K.LT.0) L(I) = MIN0(L(I)-K,H(I)-1)
      IF (K.GT.0) H(I) = MAX0(L(I)+1,H(I)-K)
 1635 CONTINUE
      GO TO 1595
 1640 DO 1645  I=MIN,MAX
      L(I) = L(MIN)
      H(I) = H(MIN)
      X(I) = PRIME
      DO 1645  J=0,13
 1645 MAP(I,J) = MAP(MIN,J)
      GO TO 1595
C     REFLECT BLOCK OF CONSECUTIVE VARIABLES.
 1650 TYPE 165
  165 FORMAT (' PREVIOUS CATEGORIES REVERSED'/)
      DO 1655  I=MIN,MAX
      X(I) = BLANK
      DO 1655  J=0,13
      IF (MAP(I,J).LT.L(I) .OR. MAP(I,J).GT.H(I)) GO TO 1655
      MAP(I,J) = L(I)+H(I)-MAP(I,J)
      IF (MAP(I,J).NE.J) X(I) = PRIME
 1655 CONTINUE
      IF (IA(NVAR+1).LT.0) NVAR = NVAR+1
      GO TO 1595
C     EXCLUDE BLOCK OF CONSECUTIVE VARIABLES.
 1660 TYPE 166
  166 FORMAT (' ALL CATEGORIES EXCLUDED'/)
      DO 1665  I=MIN,MAX
      L(I) = 9
      H(I) = 0
      X(I) = STAR
 1665 CONTINUE
      IF (IA(NVAR+1).LT.0) NVAR = NVAR+1
      GO TO 1595
C     EXCLUDE HIGHEST (OR LOWEST) CATEGORIES.
 1670 TYPE 167
  167 FORMAT (
     1  ' ENTER NUMBER OF GROUPS TO BE EXCLUDED:'/
     2  ' 	0--FOR NO EXCLUSIONS'/
     3  ' 	1--FOR EXCLUSION OF THE HIGHEST NUMBERED GROUP'/
     4  ' 	2--FOR EXCLUSION OF THE TWO HIGHEST GROUPS'/
     5  ' 	ETC.  (NEGATIVE CODES EXCLUDE LOWEST GROUPS.)'/)
 1680 TYPE 168
  168 FORMAT (' ENTER EXCLUSION CODE: ',$)
      ACCEPT 3, ENTRY(1)
      IF (ENTRY(1).EQ.'ABORT' .OR. ENTRY(1).EQ.'UNMAP') GO TO 1580
      IF (ENTRY(1).EQ.'X')    GO TO 1660
      IF (ENTRY(1).EQ.' ')    GO TO 1680
      IF (ENTRY(1).EQ.'STOP') GO TO 2000
      CALL DECODE
      READ (20,102,ERR=1670) K
      IF (K.GE.10) K = K/10
      IF (K.LT.0) L(I) = MIN0(L(I)-K,H(I)-1)
      IF (K.GT.0) H(I) = MAX0(L(I)+1,H(I)-K)
      GO TO 1595
C     LIST CURRENT CATEGORIES.
 1690 IF (L(I).GT.H(I)) TYPE 169
  169 FORMAT ('   NO CATEGORIES')
      TYPE 34
      DO 1695  J=0,13
      IF (MAP(I,J).LT.L(I) .OR. MAP(I,J).GT.H(I)) GO TO 1695
      TYPE 1691, J
 1691 FORMAT ('+',I3,$)
      IF (X(I).NE.BLANK) TYPE 1692, MAP(I,J),X(I)
 1692 FORMAT ('+ --> ',I1,A1/$)
 1695 CONTINUE
      IF (X(I).EQ.BLANK) TYPE 34
      GO TO 1520
C
C     JOIN:  DUPLICATE OR COMBINE VARIABLES.
 1700 IF (M.GE.128) GO TO 1790
      ZERO = ENTRY(0).NE.ANS .OR. ENTRY(1).EQ.' '
      IF (ZERO) TYPE 1701
 1701 FORMAT (' VARIABLES TO BE JOINED? ',$)
      IF (M.GE.128) GO TO 1790
      IF (ZERO) ACCEPT 3, (ENTRY(N),N=1,12)
      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 1702
 1702 FORMAT (
     1  ' 	ENTER ONE VARIABLE TO BE DUPLICATED (WITH THE CURRENT'/
     2  ' 	DEFINITION OF CATEGORIES) OR TWO OR THREE VARIABLES'/
     3  ' 	TO BE COMBINED INTO ONE NEW VARIABLE.  TABLE HEADINGS'/
     4  ' 	WILL BE PRINTED FOR EVERY COMBINATION OF CATEGORIES OF'/
     5  ' 	THE OLD VARIABLES.  DEFINE THE CATEGORIES OF THE NEW'/
     6  ' 	VARIABLE BY FILLING IN THE TABLE.  USE CATEGORY NUM-'/
     7  ' 	BERS 0 TO 9 OR EXCLUSION CATEGORIES 11, 12, AND 13.'//
     8  ' 	NOTE:  THE THIRD VARIABLE LISTED MAY BE FOLLOWED BY AN'/
     9  ' 	EQUALS SIGN AND A CATEGORY NUMBER (0 TO 9).  AN ENTRY'/
     /  ' 	IN THE FORM ''V1,V2,V3=C'' ALLOWS THE JOINING OF VARI-'/
     1  ' 	ABLES V1 AND V2 FOR RESPONDENTS BELONGING TO CATEGORY'/
     2  ' 	C OF VARIABLE V3, ALL OTHERS BEING EXCLUDED.  AN ENTRY'/
     3  ' 	IN THE FORM ''V1,0,V3=C'' PROVIDES FOR THE RESTRICTION'/
     4  ' 	OF VARIABLE V1 TO RESPONDENTS IN CATEGORY C OF VARI-'/
     5  ' 	ABLE V3.  A PARTICULAR CATEGORY OF RESPONDENTS MAY BE'/
     6  ' 	EXCLUDED BY FOLLOWING THE THIRD VARIABLE WITH AN IN-'/
     7  ' 	EQUALITY SIGN (<>) AND THE CATEGORY NUMBER.  IF YOU DO'/
     8  ' 	NOT WANT TO JOIN ANY VARIABLES, TYPE "NONE".'/)
      CALL DECODE
      READ (20,103) I1,I2,I3,N3,N3X
      IF (I1.EQ.0) GO TO 1700
      ERROR = I1.LT.0 .OR. I1.GT.M .OR. I2.LT.0 .OR. I2.GT.M .OR.
     1  I3.LT.0 .OR. I3.GT.M
      IF (ERROR) TYPE 232, M
      IF (ERROR) GO TO 1700
      ERROR = L(I1).GT.H(I1) .OR. L(I2).GT.H(I2) .OR. L(I3).GT.H(I3)
      IF (ERROR) TYPE 233
      IF (ERROR) GO TO 1700
      NEW = M+1
      L(NEW) = 9
      H(NEW) = 0
      X(NEW) = BLANK
      DO 1705  J=0,13
 1705 MAP(NEW,J) = J
      DO 1710  J3=0,13
      DO 1710  J2=0,13
      DO 1710  J1=0,13
 1710 JOIN(J1,J2,J3) = 10
      J3X = JK(N3X)
      IF (J3X.GT.9) J3X = -1
      REJECT = (N3.EQ.'<' .OR. N3.EQ.'>') .AND. J3X.GE.0
      J3 = JK(N3)
      IF (J3.GT.9) J3 = J3X
      IF (I2.NE.0 .OR. J3.GE.0) GO TO 1715
      I2 = I3
      I3 = 0
 1715 I3L = L(I3)
      I3H = H(I3)
      IF (J3.LT.0) GO TO 1720
      I3L = J3
      I3H = J3
 1720 IF (I2.NE.0) TYPE 34
      TYPE 172, NEW
  172 FORMAT (//
     1  ' NEW:      VARIABLE ',I3)
      IF (I2.EQ.0) TYPE 1721, I1
 1721 FORMAT (
     2  ' SOURCE:   VARIABLE ',I3)
      IF (I2.NE.0) TYPE 1722, I1,I2
 1722 FORMAT (
     2  ' DOWN:     VARIABLE ',I3/
     3  ' ACROSS:   VARIABLE ',I3)
      R(3) = EQUAL
      IF (REJECT) R(3) = DIFFER
      IF (I3L.NE.I3H) TYPE 1723, I3
 1723 FORMAT (
     4  ' CONTROL:  VARIABLE ',I3)
      IF (I3.NE.0 .AND. I3L.EQ.I3H) TYPE 1724, I3,R(3),J3,X(I3)
 1724 FORMAT (
     4  ' CONTROL:  VARIABLE ',I3,2X,A2,'  CATEGORY  ',I1,A1)
      IF (I2.NE.0) GO TO 1740
      TYPE 34
      DO 1730  J1=0,13
 1730 JOIN(J1,0,J3) = J1
      L(NEW) = L(I1)
      H(NEW) = H(I1)
      GO TO 1780
 1740 TYPE 174
  174 FORMAT (///' NEW CATEGORY NUMBERS:')
      R(3) = 0
      IF (X(I3).EQ.PRIME) R(3) = PRIME
      DO 1780  J3=I3L,I3H
 1750 TYPE 175, (J2,X(I2),J2=L(I2),H(I2))
  175 FORMAT (//5X,$/('+',I3,A1,$))
      IF (I3L.NE.I3H) TYPE 1751, J3,R(3)
 1751 FORMAT ('+   (',I1,A1,')',$)
      TYPE 34
      TYPE 34
      DO 1770  J1=L(I1),H(I1)
 1760 TYPE 176, J1,X(I1)
  176 FORMAT ('+',I1,A1,4X,$)
      ACCEPT 3, (ENTRY(N),N=1,10)
      IF (ENTRY(1).EQ.'ABORT') GO TO 200
      IF (ENTRY(1).EQ.'DELET') GO TO 1740
      IF (ENTRY(1).EQ.'STOP')  GO TO 2000
      BLURB = ENTRY(1).EQ.'EXPLA' .OR. ENTRY(1).EQ.'?'
      IF (BLURB) TYPE 1761
 1761 FORMAT (
     1  ' 	DEFINE THE CATEGORIES OF YOUR NEW VARIABLE BY FILLING'/
     2  ' 	IN THIS TABLE.  USE CATEGORY NUMBERS 0 TO 9 OR EXCLU-'/
     3  ' 	SION CATEGORIES 11, 12, AND 13.  TO START OVER, TYPE'/
     4  ' 	"DELETE".  TO QUIT, TYPE "ABORT".'//)
      IF (BLURB .OR. ENTRY(1).EQ.' ') GO TO 1760
      CALL DECODE
      READ (20,10) (JOIN(J1,J2,J3),J2=L(I2),H(I2))
      DO 1770  J2=L(I2),H(I2)
      J = JOIN(J1,J2,J3)
      IF (J.GE.0 .AND. J.LE.13 .AND. J.NE.10) GO TO 1770
      TYPE 177
  177 FORMAT ('+ILLEGAL CATEGORY--REENTER'/)
      GO TO 1760
 1770 CONTINUE
      DO 1780  J1=L(I1),H(I1)
      DO 1780  J2=L(I2),H(I2)
      J = JOIN(J1,J2,J3)
      IF (J.GT.9) GO TO 1780
      IF (J.LT.L(NEW)) L(NEW) = J
      IF (J.GT.H(NEW)) H(NEW) = J
 1780 CONTINUE
      IF (.NOT.REJECT) GO TO 1820
      DO 1785  J1=L(I1),H(I1)
      DO 1785  J2=L(I2),H(I2)
      J = JOIN(J1,J2,J3X)
      JOIN(J1,J2,J3X) = 10
      DO 1785  J3=L(I3),H(I3)
      IF (J3.NE.J3X) JOIN(J1,J2,J3) = J
 1785 CONTINUE
      GO TO 1820
 1790 TYPE 179
  179 FORMAT (' NO ROOM FOR NEW VARIABLE'/)
      GO TO 200
C
C     POOL:  CONSOLIDATE BLOCK OF VARIABLES.
 1800 IF (M.GE.128) GO TO 1790
      ZERO = ENTRY(0).NE.ANS .OR. ENTRY(1).EQ.' '
      IF (ZERO) TYPE 1801
 1801 FORMAT (' VARIABLES TO BE POOLED? ',$)
      IF (M.GE.127) GO TO 1790
      IF (ZERO) ACCEPT 3, (ENTRY(N),N=1,12)
      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 1802
 1802 FORMAT (
     1  ' 	ENTER A BLOCK OF VARIABLES (TWO NUMBERS JOINED BY A'/
     2  ' 	HYPHEN OR THE WORD "ALL") TO BE USED IN CONSTRUCTING'/
     3  ' 	AN INDEX VARIABLE, CATEGORIZING RESPONDENTS BY THEIR'/
     4  ' 	AVERAGE RESPONSE.  THE "MAP" COMMAND CAN BE USED TO'/
     5  ' 	REVERSE CATEGORIES OF CERTAIN VARIABLES OR TO EXCLUDE'/
     6  ' 	VARIABLES FROM A BLOCK.  IF YOU DO NOT WANT TO POOL'/
     7  ' 	ANY VARIABLES, TYPE "NONE".'/)
      CALL DECODE
      READ (20,10) MIN,MAX
      MAX = IABS(MAX)
      IF (ENTRY(0).EQ.'ALL') MIN = 1
      IF (ENTRY(0).EQ.'ALL') MAX = M
      IF (MIN.EQ.0) GO TO 1800
      ERROR = MIN.LT.0 .OR. MIN.GT.MAX .OR. MAX.GT.M
      IF (ERROR) TYPE 232, M
      IF (ERROR) GO TO 1800
      NVAR = MAX-MIN+1
      NEW = M+1
      L(NEW) = 9
      H(NEW) = 0
      DO 1805  I=MIN,MAX
      IF (L(I).GT.H(I)) NVAR = NVAR-1
      IF (L(I).LT.L(NEW)) L(NEW) = L(I)
      IF (H(I).GT.H(NEW)) H(NEW) = H(I)
 1805 CONTINUE
      IF (NVAR.GT.0) GO TO 1810
      TYPE 233
      GO TO 1800
 1810 TYPE 181, NEW,MIN,MAX
  181 FORMAT (//
     1  ' NEW:      VARIABLE ',I3/
     2  ' SOURCE:   VARIABLES ',I3,'  TO ',I3/)
      X(NEW) = BLANK
      DO 1815  J=0,13
 1815 MAP(NEW,J) = J
C     WRITE NEW DATA FILE.
 1820 POOL = ANS.EQ.'POOL'
      TEMP = TEMP1
      IF (SWITCH) TEMP = TEMP2
      CALL IFILE(1,DATA)
      CALL OFILE(21,TEMP)
      READ (1,32) ID
      WRITE (21,5) (A(I),I=1,48)
 1830 WRITE (21,183) NEW
  183 FORMAT (2X,I3,' VARIABLES')
      IL = 'LOW'
      READ (1,14) (R(I),I=1,M)
      R(NEW) = L(NEW)
      WRITE (21,184) IL,(R(I),I=1,NEW)
      IH = 'HIGH'
      READ (1,14) (R(I),I=1,M)
      R(NEW) = H(NEW)
      WRITE (21,184) IH,(R(I),I=1,NEW)
  184 FORMAT (A5,128I1)
      IX = NK(13)
      READ (1,3) ID
      WRITE (21,186) IX
      DO 1860  K=1,LAST
      READ (1,186) ID,(R(I),I=1,M)
      IF (POOL) GO TO 1850
      J1 = MAP(I1,JK(R(I1)))
      J2 = MAP(I2,JK(R(I2)))
      J3 = MAP(I3,JK(R(I3)))
      R(NEW) = NK(JOIN(J1,J2,J3))
      GO TO 1860
 1850 KVAR = 0
      KSUM = 0
      DO 1855  I=MIN,MAX
      IF (L(I).GT.H(I)) GO TO 1855
      J = MAP(I,JK(R(I)))
      IVAR = (J.LT.L(I) .OR. J.GT.H(I))+1
      KVAR = KVAR+IVAR
      KSUM = KSUM+IVAR*J
 1855 CONTINUE
      J = 10
      KTAB = (2*KVAR.LT.NVAR)+1
      LESS = 2*KSUM.LT.(L(NEW)+H(NEW))*KVAR
      IF (KTAB.NE.0) J = (2*KSUM+KVAR+LESS)/(2*KVAR)
      R(NEW) = NK(J)
 1860 WRITE (21,186) ID,(R(I),I=1,NEW)
  186 FORMAT (A5,128A1)
      WRITE (21,187) LAST
  187 FORMAT (/1X,I4,' RESPONDENTS')
      END FILE 21
      DATA = TEMP
      IF (SWITCH) CALL OFILE(21,TEMP1)
      SWITCH = .NOT.SWITCH
      IF (SWITCH) CALL OFILE(21,TEMP2)
      END FILE 21
      M = NEW
      GO TO 200
C
C     CUT:  DELETE HIGHEST NUMBERED VARIABLES.
 1880 TYPE 188
  188 FORMAT (
     1  ' ENTER NUMBER OF VARIABLES TO BE DELETED:'/
     2  ' 	0--FOR NO DELETIONS'/
     3  ' 	1--FOR DELETION OF THE HIGHEST NUMBERED VARIABLE'/
     4  ' 	2--FOR DELETION OF THE TWO HIGHEST VARIABLES'/
     5  ' 	ETC. (UP TO 9 AT ONE TIME)'/)
 1890 TYPE 189
  189 FORMAT (' ENTER DELETION CODE: ',$)
      ACCEPT 3, ENTRY(1)
      IF (ENTRY(1).EQ.'ABORT') GO TO 200
      IF (ENTRY(1).EQ.' ')     GO TO 1890
      IF (ENTRY(1).EQ.'STOP')  GO TO 2000
 1891 FORMAT (
     1  ' 	THIS COMMAND PERMITS THE DELETION OF THE HIGHEST NUM-'/
     2  ' 	BERED VARIABLE OR VARIABLES, COMPLEMENTING THE EFFECT'/
     3  ' 	OF THE COMMANDS "JOIN" AND "POOL".'/)
      CALL DECODE
      READ (20,101,ERR=1880) K
      M = MAX0(M-K,2)
      GO TO 200
C
C     SAVE:  PRESERVE CURRENT FORM OF DATA.
 1900 IF (SAVE.NE.' ') GO TO 1920
 1901 FORMAT (
     1  ' 	WITH THIS COMMAND YOU CAN PRESERVE THE CURRENT FORM OF'/
     2  ' 	THE DATA, MODIFIED BY ANY MAPS, JOINS, POOLS, OR CUTS,'/
     3  ' 	AS A NEW DATA FILE.  THIS FILE MUST BE GIVEN A NAME OF'/
     4  ' 	FROM ONE TO FIVE CHARACTERS.  THE NAME MAY FOLLOW THE'/
     5  ' 	WORD "SAVE" OR MAY BE ENTERED SEPARATELY.'/)
 1910 TYPE 191
  191 FORMAT (' NEW FILE NAME? ',$)
      ACCEPT 3, SAVE
      IF (SAVE.EQ.'NONE' .OR. SAVE.EQ.'ABORT') GO TO 200
      IF (SAVE.EQ.'STOP') GO TO 2000
      BLURB = SAVE.EQ.'EXPLA' .OR. SAVE.EQ.'?'
      IF (BLURB) TYPE 1911
 1911 FORMAT (
     1  ' 	THE CURRENT FORM OF THE DATA WILL BE PRESERVED AS A'/
     2  ' 	NEW DATA FILE.  ENTER THE NAME (FROM ONE TO FIVE CHAR-'/
     3  ' 	ACTERS) TO BE GIVEN TO THIS FILE.  IF YOU DO NOT WANT'/
     4  ' 	TO SAVE THE CURRENT DATA, TYPE "NONE".'/)
      IF (BLURB .OR. SAVE.EQ.' ') GO TO 1910
 1920 IF (.NOT.RENAME(SAVE,'.DAT',SAVE,'.DAT')) GO TO 1930
      TYPE 192
  192 FORMAT ('+NAME OF EXISTING DATA FILE CANNOT BE USED.'/)
      GO TO 1910
 1930 IF (RENAME(SAVE,'.DAT',TEMP,'.DAT')) DATA = SAVE
      SWITCH = SWITCH .XOR. RENAME(TEMP,'.DAT',SAVE,'.OLD')
      IF (RENAME(SAVE,'.OLD',SAVE,'.MAP')) TYPE 193, SAVE,SAVE
  193 FORMAT (' OLD FILE ',A5,'.MAP RENAMED ',A5,'.OLD'/)
      TEMP = TEMP1
      IF (SWITCH) TEMP = TEMP2
      CALL OFILE(21,TEMP)
      WRITE (21,31) DATA
      WRITE (21,183) M
      IL = 'LOW'
      WRITE (21,184) IL,(L(I),I=1,M)
      IH = 'HIGH'
      WRITE (21,184) IH,(H(I),I=1,M)
      IX = 'MAP'
      WRITE (21,186) IX,(X(I),I=1,M)
      DO 1960  J=0,13
      DO 1950  I=1,M
 1950 R(I) = NK(MAP(I,J))
 1960 WRITE (21,196) J, (R(I),I=1,M)
  196 FORMAT (I2,3X,128A1)
      END FILE 21
      SWITCH = SWITCH .XOR. RENAME(SAVE,'.MAP',TEMP,'.DAT')
      GO TO 200
C
C     RESET:  RESTORE DATA TO INITIAL STATE.
 1990 TYPE 199
  199 FORMAT (' DATA RESTORED TO INITIAL STATE'/)
 1991 FORMAT (
     1  ' 	THIS COMMAND RESTORES THE INITIAL STATE OF THE DATA,'/
     2  ' 	UNDOING THE EFFECTS OF ALL MAPS, UNMAPS, JOINS, POOLS,'/
     3  ' 	AND CUTS.'/)
      IF (DATA.EQ.TEMP) TEMP = ORIG
      DATA = ORIG
      IF (.NOT.GROUP) GO TO 1995
      CALL IFIL(21,DATA,'.MAP')
      READ (21,31) DATA
      IF (ORIG.EQ.TEMP) TEMP = DATA
 1995 CALL IFILE(1,DATA)
      READ (1,5) ID
      IF (GROUP) 80,100,100
C
C     STOP:  TERMINATE EXECUTION.
 2000 END FILE 5
      CALL TIME(NOW)
      NAME = NOW-851968
      NAMEZ = NOW-1900544
      IF (RENAME(NAME,'.OUT','FOR05','.DAT')) TYPE 2001, NAMEZ
 2001 FORMAT (' OUTPUT SAVED AS FILE ',A5,'.OUT'/)
      TYPE 34
      CALL OFIL(20,LIST,'.TMP')
      END FILE 20
      IF (DATA.NE.TEMP) STOP
 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.'/)
      CALL OFILE(21,TEMP)
      END FILE 21
      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
C
C     LOGICAL FUNCTION RENAME(NEWNAM,NEWEXT,OLDNAM,OLDEXT)
C	RETURNS VALUE .FALSE. IF FILE OLDNAM.EXT DOES NOT EXIST.
C	OTHERWISE, RENAME IS .TRUE. AND FILE IS RENAMED NEWNAM.EXT
C	WITH PROTECTION <155>.  THIS SUBPROGRAM IS WRITTEN IN THE
C	MACRO-10 ASSEMBLER LANGUAGE.