C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                           C
C                                     DECOMP                                C
C                                                                           C
C          THIS PROGRAM CARRIES OUT MULTIPLE STANDARDIZATION ANALYSIS       C
C          AND DEMOGRAPHIC DECOMPOSITION USING DAS GUPTA'S METHOD.          C
C          THE PROGRAM IS CONTROLLED BY A COMMAND FILE CONTAINING           C
C          COMMANDS SIMILAR TO THOSE USED IN SPSS-PC.                       C
C                                                                           C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C       THIS PROGRAM WAS DESIGNED AND TESTED USING MICROSOFT FORTRAN 4.10
C
C       POTENTIAL PROBLEMS IN USING THIS PROGRAM ON ANOTHER COMPILER ARE 
C       DISCUSSED IN COMMENTS CONTAINING A STRING OF SIX ASTERISKS, AS
C       FOLLOWS: ******.  OF COURSE, DEPENDING ON THE COMPILER, YOU MAY 
C       RUN INTO ADDITIONAL PROBLEMS.
C
C       THIS IS THE MAIN PROGRAM.  IT READS COMMANDS FROM THE COMMAND
C       FILE, CALLS SUBROUTINES TO INTERPRET THEM, AND THEN CALLS THE
C       SUBROUTINES TO EXECUTE INSTRUCTIONS.
C
        PROGRAM DECO
        IMPLICIT INTEGER(A-Z)
        integer*4                   Argc
        CHARACTER*3 SCRNAM
        CHARACTER*80 SETCMD
        CHARACTER*10 VARNAM,POP1N,POP2N
        CHARACTER*35 FILES,TEST
        CHARACTER*5  COMMAND
        CHARACTER*65 TITLE
        CHARACTER*35 COMNAM
        CHARACTER*500 LIST   
C
C  ****** WARNING: SOME COMPILERS WILL NOT PERMIT CHARACTER VARIABLES
C         OVER 127 BYTES   
C
        REAL TABLE
        DIMENSION SETCMD(10)
        DIMENSION VARDES(30,5)
        DIMENSION VARNAM(30)
        DIMENSION FILES(4)
        DIMENSION RECODE(200,4)
        DIMENSION TRATAB(300,2)
        DIMENSION SELDES(50,3)
        DIMENSION COMDES(10,5)
        DIMENSION BRKLOC(5)
        DIMENSION STDLOC(5)
        DIMENSION FACLOC(5)
        COMMON /TABS/ TABLE(64000,2),MAXVARS(5)        
C
C
C     THE ARRAYS ABOVE WILL CONTAIN THE EXECUTION INSTRUCTIONS, AFTER THEY
C     HAVE BEEN INTERPRETED.  THE INFORMATION IS ORGANIZED AS FOLLOWS:
C
C     VARDES: VARIABLE DESCRIPTIONS
C             ROWS  - VARIABLE NUMBER, IN ORDER SPECIFIED              
C             COL 1 - BEGINS COLUMN
C             COL 2 - ENDS COLUMN
C             COL 3 - MINIMUM VALUE
C             COL 4 - MAXIMUM VALUE
C             COL 5 - PURPOSE
C                      1 - DEPENDENT VARIABLE
C                      2 - INDEPENDENT VARIABLE 1
C                      3 - INDEPENDENT VARIABLE 2
C                      4 - INDEPENDENT VARIABLE 3
C                      5 - INDEPENDENT VARIABLE 4
C                      6 - INDEPENDENT VARIABLE 5
C                      7 - WEIGHT
C                      8 - OTHER
C                
C      VARNAM: VARIABLE NAMES, BY NUMBER
C
C      FILES:          1 - COMMAND FILE
C                      2 - DATA FILE
C                      3 - OUTPUT FILE 
C                      4 - WRITE TABLE FILE
C
C      RECODE: RECODE DESCRIPTIONS
C              ROWS  - RECODE NUMBER
C              COL 1 - VARIABLE NUMBER
C              COL 2 - GE VALUE
C              COL 3 - LE VALUE
C              COL 4 - NEW VALUE
C
C      SELDES: SELECT IF DESCRIPTIONS
C              ROWS  - SELECT IF NUMBER                 
C              COL 1 - VARIABLE NUMBER
C              COL 2 - OPERATOR
C                      1 - EQ
C                      2 - GT
C                      3 - LT
C                      4 - GE
C                      5 - LE
C              COL 3 - CONSTANT FOR COMPARISON
C
C       VARNUM - NUMBER OF VARIABLES
C       RECNUM - NUMBER OF RECODES
C       SELNUM - NUMBER OF SELECT IFS
C       POP1D  - DEFINITION OF POPULATION 1
C       POP2D  - DEFINITION OF POPULATION 2
C       WTDIG  - NUMBER OF DIGITS THAT SHOULD BE TO THE
C                RIGHT OF THE DECIMAL POINT ON VARIABLE WEIGHT
C
C       TRATAB: TRANSFORMATION TABLE
C                ROWS  - TANSFORMATION NUMBER
C                COL 1 - TRANSFORMATION TYPE
C                        1 - SELECT IF
C                        2 - RECODE
C                        3 - COMBINE
C                COL 2 - NUMBER WITHIN TRANSFORMATION TYPE
C                         (E.G. RECNUM, SELNUM)
C
C        FIRST, CALL SUBROUTINE SETUP, WHICH CHECKS TO SEE 
C        IF A 'SETUP.CMD' FILE EXISTS, AND INTERPRETS THE 
C        SET PROMPT AND SET PAGENUMS COMMANDS
C
        OPTYP=1
        CALL SETUP (OPTYP,SETCMD)
C
C
C   SET DEFAULTS
C
        PRNUM=0
        RECNUM=0
        SELNUM=0
        TRANUM=0
        COMNUM=0
        WTDIG=0
        DEPDIG=0
        CHKDAT=0
        CHKMAK=0
        COMNAM='                                   '        
        FILES(3)='declis'
        FILES(4)='dectab'
C
C       OPEN OUTPUT FILE AND INTIALIZE PAGE AND LINE NUMBERS.
C
        OPEN(23,FILE=FILES(3))
        PG=0
        LN=100
        CALL PAGE(PG,LN)
        LN=LN+1
C
C   ****** WARNING: MANY SYSTEMS WILL NOT ACCEPT FILENAME EXTENSIONS
C
C       
C       WRITE INITIAL MESSAGE AND GET COMMAND FILE NAME
C
        INQUIRE (UNIT=6,NAME=SCRNAM)
        WRITE(*,*)SCRNAM

C
C   ****** THE FOLLOWING ASSUMES THAT UNIT 6 IS SET TO FILENAME 'CON'
C          BY DEFAULT.  THIS IS USED THROUGHOUT THE PROGRAM TO SUPRESS
C          SCREEN OUTPUT IF THE 'SET SCREEN=OFF' OPTION HAS BEEN 
C          INVOKED IN A 'SETUP.CMD' FILE; WHEN THE SCREEN IS SET OFF,
C          THE FILENAME ASSOCIATED WITH UNIT 6 (SCRNAM) IS RENAMED.
C          TO GET RID OF THIS FEATURE, SEARCH THIS SOURCE FILE FOR 
C          'CON'.
C
ccc alternate method ... set SCRNAM to CON manually
        SCRNAM='CON'
**                                      ** check for command line argument
       Argc = iargc()
**                                      **  Year must always come first
        if (Argc.ge.1)then  
           call getarg(1,COMNAM)

            IF (OPTYP.EQ.1.AND.SCRNAM.EQ.'CON')THEN
            WRITE(*,1)
 1          FORMAT(/////////////////////
     x    /' _______________________________________'
     x    '_______________________________________',//
     X    10x,  '                          DECOMP',
     x    /' _______________________________________'
     x    '_______________________________________',
     X    ///10x,'               Components Analysis Program',
     X    / 10X,'                       Version 0.51',/
     X    //10x,'            Social History Research Laboratory',/
     X    10x,  '                   Department of History',/
     X    10x,  '                  University of Minnesota',/
     X    10x,  '                   Minneapolis, MN 55455',///
     X    //10X,'  (C) COPYRIGHT 1989 by Steven Ruggles;',
     X    / 10x,'      ALL RIGHTS RESERVED'/////)

            endif 
        ELSE IF (OPTYP.EQ.1.AND.SCRNAM.EQ.'CON')THEN
          WRITE(*,111)
 111        FORMAT(/////////////////////
     x    /' _______________________________________'
     x    '_______________________________________',//
     X    10x,  '                          DECOMP',
     x    /' _______________________________________'
     x    '_______________________________________',
     X    ///10x,'               Components Analysis Program',
     X    / 10X,'                       Version 0.51',/
     X    //10x,'            Social History Research Laboratory',/
     X    10x,  '                   Department of History',/
     X    10x,  '                  University of Minnesota',/
     X    10x,  '                   Minneapolis, MN 55455',///
     X    //10X,'  (C) COPYRIGHT 1989 by Steven Ruggles;',
     X    / 10x,'      ALL RIGHTS RESERVED',/////
     X    ' Enter the name of your command file -->', $)

C
C  ****** WARNING: THE BACKSLASH EDIT DESCRIPTOR IS NOT ALLOWED ON 
C         SOME COMPILERS.  IF YOU INTEND TO RUN THE PROGRAM IN BATCH
C         MODE, YOU MAY WANT TO GET RID OF THIS WRITE STATEMENT. 
c
c  note: changed to $ edit descriptor for Sun 
C     
          READ(*,2)COMNAM
 2        FORMAT(a35)
        ENDIF
C
C          CLEAR SCREEN AND OPEN COMMAND FILE
C
ccc          IF(SCRNAM.EQ.'CON')WRITE(*,150)
C
C   IF THE COMMAND FILE WAS NOT GIVEN, IT WILL BE TAKEN FROM 
C   THE COMMAND LINE
C
        OPEN(3,FILE=COMNAM,STATUS='OLD',IOSTAT=IOCHECK)
C
C   IF THE COMMAND FILE WAS NOT FOUND, WRITE ERROR MESSAGE.
C
        IF (IOCHECK.NE.0)CALL ERROR(704)
C
C   NOW GET A COMMAND. 
C
 10     CALL GETLIST(COMMAND,LIST,LONG,DONE,PG,LN,SETCMD,PRNUM)
C
C   CALL THE APPROPRIATE COMMAND INTERPRETER.  IF THERE IS AN ERROR,
C   EXIT THE PROGRAM.  IF THE COMMAND IS AN EXECUTABLE PROCEDURE,
C   CALL THE APPROPRIATE EXECUTION ROUTINE.
C
C   START WITH THE DATA LIST COMMAND
C
C
        IF (COMMAND.EQ.'DATA ')THEN
C
C   INITIALIZE RECODES, ETC. (THE DATA LIST COMMAND ERASES ANY
C           PREVIOUS DATA TRANSFORMATIONS AND DATA TABLES)
C
            RECNUM=0
            SELNUM=0
            TRANUM=0
            COMNUM=0
            WTDIG=0
            DEPDIG=0
            CALL DATLIST(LIST,LONG,FILES,VARNAM,VARDES,VARNUM,MAXNO)
C
C   INSERT A PERIOD FOR THE DELIMITER IN THE DATA FILE NAME, IF NECESSARY
C   (IT WAS PREVIOUSLY REMOVED TO AVOID CONFUSION WITH THE END-OF-COMMAND
C   PERIOD)
C
            PERLOC=INDEX(FILES(2),'^')
            IF(PERLOC.GT.0)FILES(2)(PERLOC:PERLOC)='.'
            CHKDAT=1
            CHKMAK=0            
C
C   CALL THE RECODE COMMAND INTERPRETER IF NEEDED 
C
        ELSE IF (COMMAND.EQ.'RECOD')THEN
            CALL RECDAT(LIST,LONG,RECODE,VARNAM,RECNUM,TRATAB,TRANUM)
C
C   CALL THE SELECT IF COMMAND INTERPRETER IF NEEDED 
C
        ELSE IF (COMMAND.EQ.'SELEC')THEN
            CALL SELDAT(LIST,LONG,SELDES,VARNAM,SELNUM,TRATAB,TRANUM)
C
C   CALL THE STANDARDIZE COMMAND INTERPRETER,
C   FIRST CHECKING FOR CORRECT COMMAND SEQUENCE.
C   THEN CALL STANDAR TO EXECUTE THE STANDARDIZATION. 
C
        ELSE IF (COMMAND.EQ.'STAND')THEN
            CALL CHECK(CHKDAT,CHKMAK)
            CALL STDDAT(LIST,LONG,VARNAM,VARDES,VARNUM,NUMBRK,BRKLOC,
     X                NUMSTD,STDLOC,STPOP,STCAT,FORM,WREX)
            CALL STANDAR(VARNAM,VARDES,NUMBRK,BRKLOC,NUMSTD,STDLOC,
     X                STPOP,STCAT,FORM,WREX,FILES,WTDIG,WTDIV,PG,LN)
ccc            IF(SCRNAM.EQ.'CON')WRITE(*,150)
C
C   CALL THE DECOMPOSE COMMAND INTERPRETER,
C   FIRST CHECKING FOR CORRECT COMMAND SEQUENCE.
C   THEN CALL GUPTA TO EXECUTE THE STANDARDIZATION. 
C
        ELSE IF (COMMAND.EQ.'DECOM')THEN
            CALL CHECK(CHKDAT,CHKMAK)
            CALL DECOMP (LIST,LONG,VARNAM,VARDES,VARNUM,POPLOC,
     X                POP1D,POP2D,NUMFAC,FACLOC,WREX)
            CALL GUPTA(VARNAM,VARDES,POP1D,POP2D,POPLOC,NUMFAC,
     X                FACLOC,FILES,WTDIG,WTDIV,WREX,PG,LN)
ccc            IF(SCRNAM.EQ.'CON')WRITE(*,150)
C
C   CALL THE WEIGHT COMMAND INTERPRETER IF NEEDED
C
        ELSE IF (COMMAND.EQ.'WEIGH')THEN
            CALL WEIGHT(LIST,LONG,VARNAM,VARDES,VARNUM,WTDIG)
C
C   CALL THE COMBINE COMMAND INTERPRETER IF NEEDED
C
        ELSE IF (COMMAND.EQ.'COMBI')THEN
            CALL COMBDAT (LIST,LONG,COMDES,VARNAM,VARDES,VARNUM,
     X                COMNUM,TRATAB,TRANUM,PG,LN)
C
C   CALL THE MAKETAB COMMAND INTERPRETER, FIRST CHECKING FOR
C   COMMAND SEQUENCE.  THEN CREATE THE TABLE WITH SUBROUTINE TAB.
C
        ELSE IF (COMMAND.EQ.'MAKET')THEN
            CHKMAK=1
            CALL CHECK(CHKDAT,CHKMAK)
            CALL MAKE(LIST,LONG,VARNAM,VARDES,VARNUM,DEPDIG,WRTAB)
            CALL TAB(VARDES,RECODE,SELDES,COMDES,TRATAB,FILES,MAXNO,
     X                VARNAM,TRANUM,VARNUM,WTDIG,DEPDIG,WRTAB,WTDIV,
     X                PG,LN)
ccc            IF(SCRNAM.EQ.'CON')WRITE(*,150)
C
C   CALL THE SET LISTING COMMAND INTERPRETER IF NEEDED, THEN
C   CHANGE THE OUTPUT FILE AND RESET PAGE NUMBER.
C
        ELSE IF (COMMAND.EQ.'SET L')THEN
            CALL SET(COMMAND,LIST,FILES,PG,LN)
            CLOSE(23)
            OPEN(23,FILE=FILES(3))             
            LN=100
            PG=0
            CALL PAGE(PG,LN)
C
C   CALL THE SET RESULTS COMMAND INTERPRETER IF NEEDED.
C
        ELSE IF (COMMAND.EQ.'SET R')THEN
            CALL SET(COMMAND,LIST,FILES,PG,LN)
C
C   IF SET COMMAND INVALID OR NO COMMAND FOUND, WRITE AN ERROR MESSAGE.
C
        ELSE IF (COMMAND(1:3).EQ.'SET')THEN
          CALL PAGE(PG,LN)
C
C  ****** WARNING: THE FOLLOWING STATEMENT WRITES THE BELL CHARACTER.
C                  THIS WILL NOT WORK ON ALL SYSTEMS.
C
ccc          WRITE(6,*)CHAR(007)
          WRITE(23,29)
          WRITE(*,29)
 29       FORMAT(/1X,'ERROR 4 in SET command: Command ignored'/)
        ELSE IF (COMMAND.NE.'NULL ')THEN
          IF(COMMAND(1:1).EQ.' ')THEN
            CALL ERROR (705)
          ELSE
            WRITE(23,110)COMMAND
            IF(SCRNAM.EQ.'CON')WRITE(*,110)COMMAND
 110        FORMAT(//' ERROR 3: Command ',A5,' not recognized')
            CALL FATERR
          ENDIF
        ENDIF
C
C  IF THERE ARE MORE COMMANDS, GO GET THEM AND EXECUTE THEM.
C
        IF (DONE.NE.1)GO TO 10
C
C       WRITE TERMINATION MESSAGE, DELETE WORKING TABLE, AND END.
C  
        IF(SCRNAM.EQ.'CON')THEN
ccc          WRITE(*,150)
          WRITE(*,210)
        ENDIF
        CLOSE(22,STATUS='DELETE')
ccc        CLOSE(6,STATUS='DELETE')
        ENDFILE 23
 150    FORMAT(12(1H0/))
 210    FORMAT(' No errors detected')
        END
C
C
C
        SUBROUTINE CHECK(CHKDAT,CHKMAK)
C
C       THIS SUBROUTINE CHECKS FOR VALID STATEMENT ORDER.
C
        IMPLICIT INTEGER (A-Z)
        IF (CHKDAT.EQ.0)THEN
           WRITE(*,10)
           WRITE(23,10)
           CALL FATERR
        ENDIF
        IF (CHKMAK.EQ.0)THEN
           WRITE(*,11)
           WRITE(23,11)
           CALL FATERR
        ENDIF
 10     FORMAT(//1X,'ERROR 1: DATA LIST statement not found')
 11     FORMAT(//1X,'ERROR 2: MAKETAB statement not found')
        RETURN
        END
C
C
C
       SUBROUTINE STANDAR(VARNAM,VARDES,NUMBRK,BRKLOC,NUMSTD,
     X       STDLOC,STPOP,STCAT,FORM,WREX,FILES,WTDIG,WTDIV,PG,LN)
C
C      THIS SUBROUTINE EXECUTES THE STANDARDIZE PROCEDURE
C
       IMPLICIT INTEGER(A-Z)
       INTEGER*4 INDVAL(6)
       REAL TABLE, TOTAL, RESULTS, DEFLATE, TNUM, TDEN, OLDTOT
       CHARACTER*10 VARNAM, STNAM
       CHARACTER*35 FILES
       DIMENSION FILES(4)
       DIMENSION RESULTS (250,3)
       DIMENSION TABLE(64000,2)
       DIMENSION MAXVARS(5),BRKLOC(5),STDLOC(5)
       DIMENSION VARNAM(30)
       DIMENSION VARDES(30,5)
       DIMENSION NEWPOS(5)
       DIMENSION WRFORM(7,2)
       COMMON /TABS/ TABLE,MAXVARS
C
C      RUN THE PROGRAM SEPARATELY FOR EACH BREAKDOWN VARIABLE
C
       DO 500 BRK=1,NUMBRK
C
C      INITIALIZE WORKING TABLE AND RESULTS TABLE
C
       DO 1 I=1,64000
       TABLE(I,1)=0.0
 1     TABLE(I,2)=0.0
       DO 2 I=1,250
       RESULTS(I,1)=0.0
       RESULTS(I,2)=0.0
 2     RESULTS(I,3)=0.0
C
C      DETERMINE WHICH VARIABLE IS THE CURRENT BREAKDOWN VARIABLE
C      THE LOCATION OF EACH BREAKDOWN VARIABLE IS CONTAINED IN ARRAY 
C      BRKLOC.
C
       BRKPOS=VARDES(BRKLOC(BRK),5)-1
       IF (BRKPOS.LT.1.OR.BRKPOS.GT.5)THEN
          CALL ERROR(303)
       ENDIF
C
C      CALCULATE MAXIMUM VALUE FOR BREAKDOWN VARIABLE AND INITIALIZE 
C      THE MAXIMUM OF CONTROL VARIABLES TO ONE.
C
C      NEWPOS WILL RELATE THE ORIGINAL POSITION OF THE VARIABLES TO THEIR
C      POSITION IN THE WORKING TABLE.
C
       DO 9 I=1,5
       MAXVARS(I)=1
 9     NEWPOS(I)=6
       TOTAL=0.0
       INDVAL(6)=1
       NEWPOS(1)=BRKPOS
       MAXVARS(1)=VARDES(BRKLOC(BRK),4)-VARDES(BRKLOC(BRK),3)+2
C
C      IF A PARTICULAR BREAKDOWN CATEGORY HAS BEEN SPECIFIED AS THE
C      STANDARD, ADJUST ITS VALUE.  IF THE CATEGORY FALLS OUTSIDE
C      THE RANGE OF THE VARIABLE, WRITE AN ERROR MESSAGE.
C
       IF (STPOP.EQ.3)THEN
          STVAL=STCAT-VARDES(BRKLOC(BRK),3)+2
          IF (STVAL.LT.2.OR.STVAL.GT.MAXVARS(1))THEN
             CALL ERROR(308)
          ENDIF
       ENDIF          
C
C      THE FOLLOWING SECTION INSERTS THE POSITION FOR EACH OF THE
C      CONTROL VARIABLES (WHOSE LOCATION HAS BEEN TRANSFERRED IN 
C      ARRAY STDLOC), CALCULATES THEIR MAXIMUM VALUE, AND MAKES SURE
C      THAT THE CONTROL VARIABLE IS NOT THE SAME AS THE BREAKDOWN VARIABLE.
C      (IF IT IS, WE JUST SKIP IT).
C
       NEXT=1
       NSTNOW=NUMSTD
       DO 10 I=1,NUMSTD
       IF(STDLOC(I).EQ.BRKLOC(BRK))THEN
         NSTNOW=NSTNOW-1
         IF(NSTNOW.EQ.0)GO TO 500
         GO TO 10
       ENDIF
       NEXT=NEXT+1
       NEWPOS(NEXT)=VARDES(STDLOC(I),5)-1
       IF(NEWPOS(NEXT).LT.1.OR.NEWPOS(NEXT).GT.5)THEN
          CALL ERROR(303)
       ENDIF
       MAXVARS(NEXT)=VARDES(STDLOC(I),4)-VARDES(STDLOC(I),3)+1
 10    CONTINUE
C
C       NOW WE ARE READY TO READ IN THE PRETABULATED DATA, AND STICK IT
C       IN THE APPROPRIATE PLACE.  WE USE INDVAL AND NEWPOS TO GET THEM 
C       THERE.  FIRST, REWIND THE FILE WITH THE PRETABULATED DATA.
C
        REWIND 22
        DO 30 I=1,64000
        READ(22,END=35)INDVAL(1),INDVAL(2),INDVAL(3),INDVAL(4),
     X      INDVAL(5),TNUM,TDEN
C
C       THE FIRST POSITION OF OUR WORKING TABLE WILL CONTAIN THE
C       CURRENT BREAKDOWN VARIABLE.  LEAVE AN EXTRA SPACE AT THE 
C       BEGINNING TO CONTAIN MARGINALS.
C
        A=INDVAL(NEWPOS(1))+1
        B=INDVAL(NEWPOS(2))
        C=INDVAL(NEWPOS(3))
        D=INDVAL(NEWPOS(4))
        E=INDVAL(NEWPOS(5))
C
C       CALCULATE THE INDEX AND INCREMENT THE TABLE.
C
        INDEX=IND(A,B,C,D,E)
        TABLE(INDEX,1)=TABLE(INDEX,1)+TNUM
        TABLE(INDEX,2)=TABLE(INDEX,2)+TDEN
C
C       IF STPOP IS EQUAL TO 2, TABULATE STANDARD POPULATION AS THE 
C       COMBINATION OF ALL BREAKDOWN CATEGORIES.
C
        IF (STPOP.EQ.2)THEN
          INDEX=IND(1,B,C,D,E)
          TABLE(INDEX,2)=TABLE(INDEX,2)+TDEN
C
C         IF STPOP IS SPECIFIED AS 3, CALCULATE STANDARD POPULATION
C         AS SPECIFIED BREAKDOWN CATEGORY
C
        ELSE IF (STPOP.EQ.3.AND.STVAL.EQ.A)THEN
          INDEX=IND(1,B,C,D,E)
          TABLE(INDEX,2)=TABLE(INDEX,2)+TDEN
        ENDIF
C
C       TEMPORARILY PUT THE TOTAL CASES OF EACH BREAKDOWN CATEGORY 
C       IN ARRAY RESULTS, AND ADD UP TOTAL CASES.
C
        RESULTS(A,1)=RESULTS(A,1)+TDEN
        TOTAL=TOTAL+TDEN
  30    CONTINUE
  35    CONTINUE
C
C       NOW EXCLUDE ANY MISSING CELLS. SAVE THE ORIGINAL TOTAL CASES.
C
        OLDTOT=TOTAL
        EXCLU=0
C
C       IF THE "WRITE EXCLUDED" SUBCOMMAND WAS ISSUED, PREPARE TO DO SO.
C
        IF(WREX.GT.0)THEN
           CALL EXPREP (VARDES,WRFORM,FILES,
     X     BRKLOC(BRK),WTDIG,STDLOC,NUMSTD,NVARS)
        ENDIF
C
C       NOW IT IS TIME TO WRITE THE HEADER FOR THE TABLE.
C       CHECK TO SEE IF THERE IS SUFFICIENT ROOM ON THE PAGE TO FIT
C       A SIGNIFICANT CHUNK OF THE DECOMP TABLE.  IF NOT, START A NEW 
C       PAGE. (ONLY DO THIS FOR THE FIRST BREAKDOWN VARIABLE).
C
        IF(BRK.EQ.1)THEN
          IF(LN.GT.20)LN=100
          CALL PAGE(PG,LN)
          LN=LN+9
          IF(LN.GT.10)THEN
            LN=LN+1
            WRITE(23,100)
          ENDIF
          WRITE(23,5)
 5        FORMAT(/7X,
     X   'M U L T I P L E   S T A N D A R D I Z A T I O N   '
     X   'A N A L Y S I S')
        ENDIF
C
C       THE FOLLOWING SECTION DEALS WITH THE PROBLEM OF EXCLUDED
C       CELLS.  A CELL IS EXCLUDED IF IT IS EMPTY IN ANY OF THE
C       BREAKDOWN CATEGORIES.
C
C       FOR EACH COMBINATION OF CONTROL CHARACTERISTICS, COUNT
C       THE NUMBER OF CELLS WITH ZERO CASES.
C
        DO 39 B=1,MAXVARS(2)
        DO 39 C=1,MAXVARS(3)
        DO 39 D=1,MAXVARS(4)
        DO 39 E=1,MAXVARS(5)
        ZEROS=0
        DO 36 A=2,MAXVARS(1)
        IF (RESULTS(A,1).EQ.0.0)GO TO 36
        INDEX=IND(A,B,C,D,E)
        IF(TABLE(INDEX,2).EQ.0.0)ZEROS=ZEROS+1
 36     CONTINUE
C
C       IF THERE ARE CELLS WITH ZEROS, TAKE CARE OF IT.
C
        IF(ZEROS.GT.0)THEN
            DO 37 A=2, MAXVARS(1)
            INDEX=IND(A,B,C,D,E)
C
C       IF THE "WRITE EXCLUDED" OPTION WAS SPECIFIED, DETERMINE THE
C       UNADJUSTED VALUES OF EACH VARIABLE AND CALL EXDATA TO 
C       ACTUALLY WRITE THE EXCLUDED CELLS.  ONLY DO THIS, HOWEVER,
C       IF THERE ARE CASES IN THIS PARTICULAR CELL. 
C
            IF(WREX.GT.0.AND.TABLE(INDEX,2).GT.0)THEN
              I=A+VARDES(BRKLOC(BRK),3)-2
              J=B+VARDES(STDLOC(1),3)-1
              K=C+VARDES(STDLOC(2),3)-1
              L=D+VARDES(STDLOC(3),3)-1
              M=E+VARDES(STDLOC(4),3)-1
              CALL EXDATA(WRFORM,I,J,K,L,M,
     X        NVARS,WTDIG,WTDIV,TABLE(INDEX,1),TABLE(INDEX,2))
            ENDIF
C
C       NOW COUNT THE NUMBER OF EXCLUDED CASES, ADJUST THE TOTAL
C       NUMBER OF CASES, AND ZERO OUT THE OFFENDING CELLS.
C
C INT4 WAS HERE
            EXCLU=EXCLU+(TABLE(INDEX,2))
            TOTAL=TOTAL-TABLE(INDEX,2)
            RESULTS(A,1)=RESULTS(A,1)-TABLE(INDEX,2)
            TABLE(INDEX,1)=0.0
            TABLE(INDEX,2)=0.0
 37         CONTINUE
C
C       FINALLY, ZERO OUT THE MARGINALS.
C
            INDEX1=IND(1,B,C,D,E)
            TABLE(INDEX1,1)=0.0
            TABLE(INDEX1,2)=0.0
        ENDIF
 39     CONTINUE
C
C       CALCULATE THE STANDARD POPULATION, DEPENDING ON WHICH
C       STANDARD HAS BEEN SPECIFIED.
C
C       IF STDPOP IS 1, THEN THE STANDARD IS THE AVERAGE OF THE 
C       PROPORTIONS OF THE POPULATION IN THE CELL OVER ALL 
C       BREAKDOWN CATEGORIES.  THIS IS CALCULATED AS THE SUM OF THE 
C       PROPORTIONS IN EACH CATEGORY DIVIDED BY THE NUMBER OF CATEGORIES.
C
        IF (STPOP.EQ.1)THEN       
C
C       FIRST WE NEED TO KNOW HOW MANY CATEGORIES OF THE BREAKDOWN
C       VARIABLE ARE ACTUALLY BEING USED (THAT IS, HOW MANY OF THEM HAVE
C       CASES).
C
          NCATS=0
          DO 34 A=2,MAXVARS(1)
 34       IF (RESULTS(A,1).GT.0)NCATS=NCATS+1        
C
          DO 31 B=1,MAXVARS(2)
          DO 31 C=1,MAXVARS(3)
          DO 31 D=1,MAXVARS(4)
          DO 31 E=1,MAXVARS(5)
          INDEX1=IND(1,B,C,D,E)
          DO 31 A=2,MAXVARS(1)
          INDEX2=IND(A,B,C,D,E)
          IF (RESULTS(A,1).LE.0.OR.MAXVARS(1).LT.2)GO TO 31
             TABLE(INDEX1,2)=TABLE(INDEX1,2)+(TABLE(INDEX2,2)/
     X               RESULTS(A,1))/FLOAT(NCATS)
 31       CONTINUE
C
C       IF STPOP IS SPECIFIED AS 2, CALCULATE STANDARD POPULATION
C       AS THE COMBINATION OF ALL BREAKDOWN CATEGORIES
C
        ELSE IF (STPOP.EQ.2)THEN
          DO 32 B=1,MAXVARS(2)
          DO 32 C=1,MAXVARS(3)
          DO 32 D=1,MAXVARS(4)
          DO 32 E=1,MAXVARS(5)
          INDEX1=IND(1,B,C,D,E)
          IF (TOTAL.LE.0)GO TO 32
             TABLE(INDEX1,2)=TABLE(INDEX1,2)/TOTAL
 32       CONTINUE
C
C         IF STPOP IS SPECIFIED AS 3, CALCULATE STANDARD POPULATION
C         AS SPECIFIED BREAKDOWN CATEGORY
C
        ELSE IF (STPOP.EQ.3)THEN
          IF (RESULTS(STVAL,1).EQ.0.0)THEN
             CALL ERROR(309)
          ENDIF
          DO 33 B=1,MAXVARS(2)
          DO 33 C=1,MAXVARS(3)
          DO 33 D=1,MAXVARS(4)
          DO 33 E=1,MAXVARS(5)
          INDEX1=IND(1,B,C,D,E)
          IF (TOTAL.LE.0)GO TO 33
             TABLE(INDEX1,2)=TABLE(INDEX1,2)/RESULTS(STVAL,1)
 33       CONTINUE
        ENDIF
C
C       RE-INITIALIZE RESULTS TABLE AND TOTAL.
C       TOTAL NOW WILL BE USED TO REPRESENT THE SUM OF THE STANDARD
C       POPULATION.
C       RESULTS WILL BE USED, LOGICALLY ENOUGH, TO HOLD THE RESULTS,
C       AS FOLLOWS: 
C
C       COLUMN 1 OF RESULTS: STANDARDIZED 
C       COLUMN 2             RAW MEANS
C       COLUMN 3             NUMBER OF CASES
C
        DO 38, A=1,250
 38     RESULTS(A,1)=0.0
        TOTAL=0.0
C
C       THE GUTS ARE IN THE FOLLOWING LOOP.
C
        DO 50 B=1,MAXVARS(2)
        DO 50 C=1,MAXVARS(3)
        DO 50 D=1,MAXVARS(4)
        DO 50 E=1,MAXVARS(5)
C
C       INDEX1 REFERS TO THE STANDARD POPULATION
C 
        INDEX1=IND(1,B,C,D,E)
        TOTAL=TOTAL+TABLE(INDEX1,2)
        DO 40 A=2,MAXVARS(1)
C
C       INDEX2 REFERS TO THE POPULATIONS TO BE STANDARDIZED
C
        INDEX2=IND(A,B,C,D,E)
C
C       CONVERT SUM OF NUMERATORS TO RATES OR MEANS
C
        IF (TABLE(INDEX2,2).GT.0.01)THEN
           TABLE(INDEX2,1)=TABLE(INDEX2,1)/TABLE(INDEX2,2)
        ENDIF
C
C       THE STANDARDIZED RESULTS ARE THE SUM OF CELLS, WEIGHTED BY
C       THE STANDARD POPULATION.
C       THE UNSTANDARDIZED RESULTS ARE WEIGHTED BY EACH BREAKDOWN 
C       POPULATION. 
C
        RESULTS(A,1)=RESULTS(A,1)+TABLE(INDEX2,1)*TABLE(INDEX1,2)
        RESULTS(A,2)=RESULTS(A,2)+TABLE(INDEX2,1)*TABLE(INDEX2,2)
        RESULTS(A,3)=RESULTS(A,3)+TABLE(INDEX2,2)
 40     CONTINUE
 50     CONTINUE
C
C      ADD UP THE TOTALS
C
       DO 51 A=2,MAXVARS(1)
       RESULTS(1,1)=RESULTS(1,1)+RESULTS(A,1)
       RESULTS(1,2)=RESULTS(1,2)+RESULTS(A,2)
 51    RESULTS(1,3)=RESULTS(1,3)+RESULTS(A,3)
C
C      FIND THE DEPENDENT VARIABLE LOCATION
C
       DO 52 A=1,30
 52    IF(VARDES(A,5).EQ.1)DEPLOC=A
C
C      WRITE THE SPECIFICATIONS OF THIS RUN.
C
       WRITE(23,100)
       IF (BRK.EQ.1)THEN 
         WRITE(23,62)VARNAM(DEPLOC)
 62      FORMAT(/' Standardization of ',A10)
         IF (STPOP.EQ.2)THEN
           WRITE(23,53)
 53        FORMAT(/' Standard is the total combined population')
         ELSE IF (STPOP.EQ.1)THEN
           WRITE(23,54)
 54        FORMAT(/' Standard is the average of breakdown categories')
         ELSE IF (STPOP.EQ.3)THEN
           WRITE(23,55)STCAT
 55        FORMAT(/' Standard is breakdown category',i3)
         ENDIF
         IF (FORM.EQ.1)THEN
           WRITE(23,56)
 56        FORMAT(' Results expressed as means of dependent variable')
         ELSE IF (FORM.EQ.2)THEN
           WRITE(23,57)
 57        FORMAT(' Results expressed as percentages')   
         ELSE IF (FORM.EQ.3)THEN
           WRITE(23,58)
 58        FORMAT(' Results expressed as deviations from grand mean')
         ENDIF
       ENDIF
C
C      WRITE BREAKDOWN VARIABLE.
C
 61    FORMAT(/' Breakdown by ',A10)
       SIZE=13+NUMSTD+MAXVARS(1)
       OLDTOT=FLOAT(EXCLU)/OLDTOT*100.0
C
C      FIGURE OUT HOW MUCH SPACE WILL BE NEEDED, DEPENDING ON ANY
C      EXCLUDED DATA MESSAGES THAT MAY BE WRITTEN.
C
       EXLIN=1
       IF(OLDTOT.GT.0.0.AND.OLDTOT.LT.5.0)THEN
          EXLIN=2
       ELSE 
          EXLIN=4
       ENDIF
       SIZE=SIZE+EXLIN
       IF (SIZE.LT.50)THEN
          LN=LN+SIZE-1
       ELSE
          LN=LN+9+NUMSTD
       ENDIF
C
C      IF NECESSARY, WE WILL START A FRESH PAGE.
C
       CALL PAGE(PG,LN)
       WRITE(23,61)VARNAM(BRKLOC(BRK))
       WRITE(23,64)
 63    FORMAT(14X,A10)
 64    FORMAT(/' Controlling for:')
       DO 65 I=1,NUMSTD
       IF(BRKLOC(BRK).NE.STDLOC(I))THEN
          WRITE(23,63)VARNAM(STDLOC(I))
       ENDIF
 65    CONTINUE
C
C      CALCULATE OVERALL (GRAND) UNSTANDARDIZED MEAN
C
       IF(RESULTS(1,3).GT.0.0)RESULTS(1,2)=RESULTS(1,2)/RESULTS(1,3)
C
C      IF RESULTS ARE SUPPOSED TO BE EXPRESSED AS PERCENTAGES, ADJUST.
C
       IF (FORM.EQ.2)THEN
          RESULTS(1,2)=RESULTS(1,2)*100.0
       ENDIF
C INT4 WAS HERE
       NUM=(RESULTS(1,3))
C
C      WRITE GRAND MEAN AND NUMBER OF CASES.
C
       WRITE(23,75)RESULTS(1,2),NUM
 75    FORMAT(/' Grand Mean:',F10.4,'        Total cases included:',I8)
C
C      WRITE SUBHEAD
C
       WRITE(23,69)
 69    FORMAT(/
     X'   Category of      Unstandardized      Standardized')     
       WRITE(23,70)VARNAM(BRKLOC(BRK))
 70    FORMAT(
     X'   ',A10,'           Mean                Mean         ',
     X      '       N'/)
C
C      CHECK TO MAKE SURE WE HAD VALID CASES
C                                                                    
        IF(TOTAL.EQ.0.0)THEN
          CALL ERROR(310)
        ENDIF
C
C      FIGURE OUT NECESSARY ADJUSTMENT OF BREAKDOWN CATEGORY VALUES
C
        MINBRK=VARDES(BRKLOC(BRK),3)-1
C
C       WRITE RESULTS, CALCULATING THEM ON THE FLY
C
        DO 60 I=2, MAXVARS(1)
        RESULTS(I,1)=RESULTS(I,1)/TOTAL
        IF(RESULTS(I,3).GT.0.0)THEN
          RESULTS(I,2)=RESULTS(I,2)/RESULTS(I,3)
        ENDIF
C INT4 WAS HERE
        NUM=(RESULTS(I,3))
C
C       ADJUST THE OUTPUT FORMAT IF NEEDED.
C
        IF (FORM.EQ.2)THEN
           RESULTS(I,2)=RESULTS(I,2)*100.0
           RESULTS(I,1)=RESULTS(I,1)*100.0
        ELSE IF (FORM.EQ.3)THEN
           RESULTS(I,2)=RESULTS(I,2)-RESULTS(1,2)
           RESULTS(I,1)=RESULTS(I,1)-RESULTS(1,2)
        ENDIF
C
C       CHECK THE SPACE LEFT ON THE PAGE, AND START A NEW ONE IF NEEDED.
C
        IF(SIZE.GE.50)THEN
          CALL PAGE(PG,LN)
          IF (LN.EQ.1)THEN
             LN=LN+6
             WRITE(23,69)
             WRITE(23,70)VARNAM(BRKLOC(BRK))
          ENDIF
        ENDIF
 60     WRITE(23,71)I-1+MINBRK,RESULTS(I,2),RESULTS(I,1),NUM
 71     FORMAT(7X,I3,9X,2(F10.4,10X),I8)
C
C       CHECK AGAIN.
C
        IF (SIZE.GE.50)THEN
           LN=LN+EXLIN
           CALL PAGE(PG,LN)
        ENDIF
        WRITE(23,100)
C
C       NOW WRITE TRAILING MESSAGES AND HINTS ON EXCLUDED CELLS.
C
        IF(OLDTOT.EQ.0.0)THEN
          WRITE(23,80)
 80       FORMAT(/7X,'No cases excluded on grounds of empty cells')
        ELSE IF (OLDTOT.LT.5.0)THEN
          WRITE(23,76)EXCLU,OLDTOT
 76       FORMAT(/7X,'WARNING:' I6,' cases excluded because of empty'
     X           ' Cells ',/26x,'(',f4.1,' percent of total)')
        ELSE IF(OLDTOT.LT.33.3)THEN
          WRITE(23,86)EXCLU,OLDTOT
 86       FORMAT(/7X,'DANGER:' I6,' cases excluded because of empty'
     x           ' cells ',/26x,'(',f4.1,' percent of total)',//
     X   7X,'SUGGESTION: recode variables into fewer categories,'/
     X   7X,'            eliminating'
     X   ' small populations.')
        ELSE
          WRITE(23,96)EXCLU,OLDTOT
 96       FORMAT(/7X,'DISASTER:' I6,' cases excluded because of empty'
     x           ' cells ',/26x,'(',f4.1,' percent of total)',//
     x   7x,'reconceptualize your problem or get more data.')
        ENDIF
C
C       WRITE CODEBOOK FOR EXCLUDED CASES.
C
        IF (WREX.GT.0.AND.OLDTOT.GT.0.0)THEN
           CALL EXCODE (VARNAM,WRFORM,FILES,
     X     BRKLOC(BRK),STDLOC,NUMSTD,PG,LN)
        ENDIF   
        IF(NUMBRK.GT.1.AND.BRK.EQ.NUMBRK)WRITE(23,100)
 100    FORMAT('________________________________________',
     X          '_______________________________________')

 500    CONTINUE
        LN=100 
        RETURN
        END      

       SUBROUTINE GUPTA(VARNAM,VARDES,POP1D,POP2D,POPLOC,NUMFAC,
     X                  FACLOC,FILES,WTDIG,WTDIV,WREX,PG,LN)
C
C      THIS SUBROUTINE CONTROLS THE DECOMP PROCEDURE.
C      MUCH OF THE ACTUAL WORK IS CARRIED OUT BY SUBROUTINES;
C      E.G., THE ACTUAL GUTS OF THE PROGRAM (CARRIED OUT BY 
C      THE SUBROUTINE GUTS) A LITTLE BIT OF PRELIMINARY SETUP
C      (CARRIED OUT BY THE SUBROUTINE GUPSET), AND THE DESCRIPTIVE 
C      TABULATION (CARRIED OUT BY SUBROUTINE DESTAB).
C
       IMPLICIT INTEGER(A-Z)
       CHARACTER*35 FILES
       CHARACTER*3 SCRNAM
       INTEGER*4 INDVAL(6)
       REAL EFFECT(4),TOT1,TOT2,COMB,RATE,DIF,IX,MEAN1,MEAN2,PCT1,PCT2
       REAL MISS1, MISS2, NUM1, NUM2
       REAL TABLE,N1,N2,N1T,N2T,T1,T2
       REAL TOTAL, RESULTS, TNUM, TDEN, OLDTOT 
       CHARACTER*10 VARNAM
       DIMENSION FILES(4)
       DIMENSION RESULTS (250,3)
       DIMENSION TABLE(64000,2)
       DIMENSION MAXVARS(5),FACLOC(5)
       DIMENSION VARNAM(30)
       DIMENSION VARDES(30,5)
       DIMENSION NEWPOS(5)
       DIMENSION WRFORM(7,2)
       COMMON /TABS/ TABLE,MAXVARS
C
C      INITIALIZE STUFF
C
ccc        INQUIRE(UNIT=6,NAME=SCRNAM)
        SCRNAM='CON'
        TOT1=0.0
        TOT2=0.0
        COMB=0.0
        RATE=0.0
        DO 1 I=1,64000
        TABLE(I,1)=0.0
1       TABLE(I,2)=0.0
        DO 2 I=1,4
2       EFFECT(I)=0.0
        TOTAL=0.0
        INDVAL(6)=1
C
C       CALL SETUP ROUTINE
C
        CALL GUPSET(VARDES,POP1D,POP2D,POPLOC,NUMFAC,
     X              NEWPOS,FACLOC,POPPOS,POPA,POPB)
C
C       REWIND THE FILE CONTAINING THE TABULATED DATA.
C
        REWIND 22
C
C       READ THE DATA FROM THE FILE.
C       AS WE GO, WE WILL REORGANIZE IT AND TABULATE THE MARGINALS.
C
C       FIRST, STICK THE VARIABLE VALUES FOR EACH CELL IN THE ARRAY
C       INDVAL AND THE NUMERATOR OF THE CELL IN TNUM AND THE 
C       DENOMINATOR IN TDEN.
C
        DO 30 I=1,64000
        READ(22,END=35)INDVAL(1),INDVAL(2),INDVAL(3),INDVAL(4),
     X      INDVAL(5),TNUM,TDEN
C
C       IN OUR NEW TABLE, THE COMPARISON VARIABLE WILL BE LOCATED
C       IN THE FIRST POSITION.  THE ARRAY NEWPOS (CONSTRUCTED IN 
C       SUBROUTINE GUPSET) RELATES THE POSITION OF THE VARIABLE IN
C       THE MAKETAB TABLE TO ITS NEW POSITION IN THE DECOMP TABLE.
C        
        A=0
        POP=INDVAL(NEWPOS(1))
C
C       POPA IS THE VALUE OF THE FIRST COMPARISON CATEGORY SPECIFIED
C       IN THE DECOMP COMMAND, AND POPB IS THE VALUE OF THE SECOND.
C
        IF(POP.EQ.POPA)A=1
        IF(POP.EQ.POPB)A=2
C
C       SKIP THIS CELL IF IT DOES NOT REFER TO EITHER COMPARISON CATEGORY.
C
        IF(A.EQ.0)GO TO 30        
C
C       THE FACTORS GO IN VARIABLES B THROUGH E.  ADD ONE TO EACH VALUE
C       TO MAKE ROOM FOR THE MARGINALS.
C
        B=INDVAL(NEWPOS(2))+1
        C=INDVAL(NEWPOS(3))+1
        D=INDVAL(NEWPOS(4))+1
        E=INDVAL(NEWPOS(5))+1
C
C       GET THE INDEX, AND TABULATE.
C
        INDEX=IND(A,B,C,D,E)
        TABLE(INDEX,1)=TABLE(INDEX,1)+TNUM
        TABLE(INDEX,2)=TABLE(INDEX,2)+TDEN
C
C       THE MARGINALS WILL BE TABULATED BY SUBROUTINE MARGINS.
C
        CALL MARGINS (A,B,C,D,E,TDEN,TNUM)
  30    CONTINUE
  35    CONTINUE

C
C       STICK THE TOTALS OF EACH POPULATION IN N1T AND N2T, AND THE 
C       COMBINED TOTAL IN TOTAL.
C
        N1T=TABLE(IND(1,1,1,1,1),2)
        N2T=TABLE(IND(2,1,1,1,1),2)
        TOTAL=N1T+N2T
C
C       IF THE "WRITE EXCLUDED" SUBCOMMAND WAS ISSUED, GET READY
C       FOR IT BY CALLING THE SUBROUTINE EXPREP.
C
        IF(WREX.GT.0)THEN
           CALL EXPREP (VARDES,WRFORM,FILES,POPLOC,WTDIG,
     X                  FACLOC,NUMFAC,NVARS)
        ENDIF
C
C       WRITE HEADER.  START A NEW PAGE IF THERE ISN'T MUCH ROOM
C       LEFT ON THE CURRENT ONE.
C
        IF (LN.GT.20)LN=100
        CALL PAGE(PG,LN)
        LN=LN+14       
C
C       IF WE DID NOT JUST START A NEW PAGE, WRITE A LINE ACROSS 
C       THE PAGE.
C
        IF(LN.GT.15)THEN
          WRITE(23,552)       
          LN=LN+2
        ENDIF
C
C       NOW WRITE TITLE.
C
        WRITE(23,5)
 5      FORMAT(/18X,
     X  'D E C O M P O S I T I O N   '
     X  'A N A L Y S I S')
C
C       INITIALIZE MISSING (EXCLUDED) NUMBERS AND INCLUDED NUMBERS.
C
        MISS1=0
        MISS2=0
        NUM1=0
        NUM2=0
C
C       NOW TAKE CARE OF MISSING CELLS PROBLEMS.  ANY CELL NOT 
C       REPRESENTED IN BOTH POPULATIONS WILL BE IGNORED.
C
        DO 225 I=2,MAXVARS(2)
        DO 225 J=2,MAXVARS(3)
        DO 225 K=2,MAXVARS(4)
        DO 225 L=2,MAXVARS(5)
        N1=TABLE(IND(1,I,J,K,L),2)
        N2=TABLE(IND(2,I,J,K,L),2)
        T1=TABLE(IND(1,I,J,K,L),1)
        T2=TABLE(IND(2,I,J,K,L),1)
C
C       FIRST, WE DEAL WITH THE CELLS WHERE THERE ARE SOME CASES IN 
C       POPULATION A BUT NO CASES IN POPULATION B.
C
        IF(N1.NE.0.0.AND.N2.EQ.0.0)THEN
          IF(WREX.GT.0)THEN
C
C         IF THE "WRITE EXCLUDED" COMMAND WAS SPECIFIED, DO SO.
C         FIRST FIGURE OUT WHAT THE ORIGINAL VALUES WERE.
C
            A=I+VARDES(FACLOC(1),3)-2
            B=J+VARDES(FACLOC(2),3)-2
            C=K+VARDES(FACLOC(3),3)-2
            D=L+VARDES(FACLOC(4),3)-2
            CALL EXDATA(WRFORM,POP1D,A,B,C,D,NVARS,WTDIG,WTDIV,T1,N1)
          ENDIF
C
C         COUNT THE NUMBER EXCLUDED FROM POPULATION.
C
          MISS1=MISS1+N1
C
C         ADJUST THE TOTAL N OF THE POPULATION
C
          N1T=N1T-N1
C
C         NOW WE ADJUST ALL OF THE MARGINAL N'S
C
          CALL ADJUST (1,I,J,K,L,N1,T1)
C
C       THE PROCESS IS REPEATED FOR THE CELLS THAT HAVE CASES IN
C       POPULATION B AND NO COMPARABLE CASES IN POPULATION A.
C
        ELSE IF(N2.NE.0.0.AND.N1.EQ.0.0)THEN
          IF(WREX.GT.0)THEN
            A=I+VARDES(FACLOC(1),3)-2
            B=J+VARDES(FACLOC(2),3)-2
            C=K+VARDES(FACLOC(3),3)-2
            D=L+VARDES(FACLOC(4),3)-2
            CALL EXDATA(WRFORM,POP2D,A,B,C,D,NVARS,WTDIG,WTDIV,T2,N2)
          ENDIF
          N2T=N2T-N2
          MISS2=MISS2+N2
          CALL ADJUST (2,I,J,K,L,N2,T2) 
        ENDIF
 225    CONTINUE
C
C       WE ARE READY TO CALCULATE MEANS AND AVERAGES OF DEPENDENT
C       FIRST WRITE A MESSAGE TO THE SCREEN TO LET THE USER KNOW
C       THAT IT'S GOING TO BE A WHILE.
C
        IF(SCRNAM.EQ.'CON')WRITE(*,4)
 4      FORMAT(//
     X         3X,' CALCULATING DECOMPOSITION . . . '//)
C
C       PASS THROUGH ALL CELLS
C
        DO 55 J=2,MAXVARS(2)
        DO 55 K=2,MAXVARS(3)
        DO 55 L=2,MAXVARS(4)
        DO 55 M=2,MAXVARS(5)
C
C       CALCULATE THE MEAN OF THE DEPENDENT
C
        DO 50 I=1,2
        INDEX=IND(I,J,K,L,M)

        IF(TABLE(INDEX,2).GT.0.0001)THEN
          TABLE(INDEX,1)=TABLE(INDEX,1)/TABLE(INDEX,2)
        ENDIF         
   50   CONTINUE    
C  
C       CALCULATE THE AVERAGE OF THE TWO POPULATIONS, AND STICK
C       IT IN THE SPACE PREVIOUSLY RESERVED BY SUBROUTINE GUPSET.
C        
        POP1=IND(1,J,K,L,M)
        POP2=IND(2,J,K,L,M)
        AVER=IND(3,J,K,L,M)
        TABLE(AVER,1)=(TABLE(POP1,1)+TABLE(POP2,1))/2.0
  55    CONTINUE
C
C      THE SUBROUTINE GUTS DOES THE ACTUAL DECOMPOSITION, NOW THAT
C      WE HAVE EVERYTHING NEATLY SET UP.  THE RESULTS COME OUT IN 
C      COMB, RATE, AND EFFECT.
C
       CALL GUTS (N1T,N2T,NUM1,NUM2,TOT1,TOT2,
     X                 COMB,RATE,EFFECT)

C
C      FIND THE LOCATION OF THE DEPENDENT VARIABLE.
C
       DO 551 A=1,30
 551   IF(VARDES(A,5).EQ.1)DEPLOC=A
C
C      CALCULATE TOTAL POPULATION DIFFERENCE.        
C
        DIF=TOT1-TOT2
C
C       CONVERT N'S TO INTEGERS.
C
        NU1=NUM1
        NU2=NUM2
C
C       IF EITHER POPULATION HAS NO CASES, WE'VE GOT A PROBLEM
C
        IF(NU1.EQ.0.OR.NU2.EQ.0)THEN
          CALL ERROR(407)
        ENDIF
C
C       CONVERT MISSING N'S TO INTEGERS.
C
        MI1=MISS1
        MI2=MISS2
C
C       WRITE HEADER DESCRIBING DECOMPOSITION.
C
        WRITE(23,649)VARNAM(DEPLOC),VARNAM(POPLOC),POP1D,POP2D
 649    FORMAT(/1x,' Decomposition of ',a10,/
     x         1x,' comparing ',a10,'categories',i3,' and',i3)
        WRITE(23,552)
 552    FORMAT('________________________________________',
     X          '_______________________________________')
C
C       CALL SUBROUTINE DESTAB TO GENERATE DESCRIPTIVE TABLE
C
        CALL DESTAB(VARDES,VARNAM,FACLOC,NUMFAC,N1T,N2T,
     X        MI1,MI2,POP1D,POP2D,DEPLOC,NU1,NU2,TOT1,TOT2,PG,LN)
C
C       IF THE "WRITE EXCLUDED" SUBCOMMAND WAS ISSUED AND SOME CELLS
C       WERE ACTUALLY EXCLUDED, THIS IS THE PLACE TO WRITE THE 
C       CODEBOOK FOR THE EXCLUDED DATA TO THE LISTING FILE.
C       THIS TASK IS HANDLED BY SUBROUTINE EXCODE.
C
        EXCLU=MI1+MI2
        IF (WREX.GT.0.AND.EXCLU.GT.0)THEN
           CALL EXCODE (VARNAM,WRFORM,FILES,
     X     POPLOC,FACLOC,NUMFAC,PG,LN)
        ENDIF
C
C       NOW WE ARE READY TO WRITE THE DECOMPOSITION RESULTS.
C       FIRST CALCULATE WETHER OR NOT WE WILL BE ABLE TO SQUEEZE
C       THEM ONTO THE CURRENT PAGE; IF NOT, MAKE A NEW PAGE.
C
        SPACE=20
        IF (WREX.GT.0)SPACE=21
        ROOM=63-LN
        IF (SPACE.GT.ROOM)LN=100
        CALL PAGE(PG,LN)
        IF (LN.GT.1)THEN
           WRITE(23,659)
           IF (WREX.GT.0)WRITE(23,552)
        ENDIF
C
C       WRITE THE HEADER FOR THE DECOMP TABLE.
C    
        WRITE(23,653)
 653    FORMAT(/' B. Decomposition Table')
 659    FORMAT(/)
        WRITE(23,660)
 660    FORMAT(/ 
     x  ,8x,'                          Components of        Index of'/
     x  ,8x,'                           Difference         Difference'
     x /,8x,'                          _____________       __________'
     x /)
C
C       AS WE WRITE THE RESULTS, WE WILL CALCULATE THE INDEX OF
C       DIFFERENCE FOR EACH ITEM.
C       FIRST WRITE DIFFERENCE BETWEEN POPULATIONS.  THE INDEX
C       OF THIS IS 100.0 BY DEFINITION.
C
        ix=100.0
        WRITE(23,640)dif,ix
 640    FORMAT(' Total population difference   ',3x,f10.4,12x,f5.1//)
C
C       WRITE EFFECTS OF EACH FACTOR
C 
        DO 600 FACT=1,NUMFAC
        EFFECT(FACT)=EFFECT(FACT)/24.0
        IF(DIF.NE.0.0)IX=EFFECT(FACT)/DIF*100.0
 600    WRITE(23,610)VARNAM(FACLOC(FACT)),EFFECT(FACT),ix
 610    FORMAT('    Effect of factor ',A10,3x,f10.4,11x,f6.1)
C
C       WRITE COMBINED EFFECT OF FACTORS
C
        IF(DIF.NE.0.0)IX=COMB/DIF*100.0
        WRITE(23,620)COMB,IX
 620    FORMAT(//' Combined effect of factors  ',5x,f10.4,11x,f6.1)
C
C       WRITE RATE EFFECT
C
        IF(DIF.NE.0.0)IX=RATE/DIF*100.0
        WRITE(23,630)RATE,IX   
 630    FORMAT(/' Rate effect                 ',5x,f10.4,11x,f6.1/)
        WRITE(23,552)
C
C       SET LINE NUMBER HIGH ENOUGH THAT A NEW PAGE WILL BE GENERATED 
C       UNLESS THIS IS THE END OF THE JOB.
C       
        LN=100
        RETURN
        END 


        SUBROUTINE DESTAB(VARDES,VARNAM,FACLOC,NUMFAC,N1T,N2T,
     X        MI1,MI2,POP1D,POP2D,DEPLOC,NU1,NU2,TOT1,TOT2,PG,LN)
C
C       THIS SUBROUTINE CALCULATES AND WRITES A GENERAL DESCRIPTIVE
C       TABLE WHICH IS USEFUL FOR INTERPRETING THE DECOMPOSITION RESULTS.
C
       IMPLICIT INTEGER(A-Z)
       REAL MEAN1,MEAN2,PCT1,PCT2
       REAL TABLE,N1T,N2T,TOT1,TOT2
       CHARACTER*10 VARNAM
       DIMENSION TABLE(64000,2)
       DIMENSION MAXVARS(5),FACLOC(5)
       DIMENSION VARNAM(30)
       DIMENSION VARDES(30,5)
       COMMON /TABS/ TABLE,MAXVARS


        WRITE(23,553)
 553    FORMAT(/' A. Descriptive Table')
C
C       BEFORE WRITING THE DECOMPOSITION TABLE, WE WILL CALCULATE
C       AND WRITE A SIMPLE DESCRIPTIVE TABLE GIVING THE MEAN OF THE
C       DEPENDENT FOR EACH CATEGORY OF EACH FACTOR AND THE FREQUENCY
C       DISTRIBUTION OF EACH FACTOR IN EACH POPULATION.  SUCH A TABLE
C       IS USUALLY CRITICAL TO THE INTERPRETATION OF THE DECOMPOSITION. 
C
C       FIRST WRITE THE HEADER TO THE DESCRIPTIVE SECTION
C
        WRITE(23,648)VARNAM(DEPLOC),POP1D,POP2D,POP1D,POP2D
 648    FORMAT(/
     X  23x,'Mean of ',a10,11x,'Population distribution',   
     x  /19x,'_______________________',10x,'_______________________',
     x  //21X,I3,9X,I3,19X,I3,9X,I3,
     x  /' Factor/category',
     x  '   ________________________________________________________')
C
C       WRITE THE NAME OF THE FIRST FACTOR.
C        
        LN=LN+3
        WRITE(23,569)VARNAM(FACLOC(1))
 569    FORMAT(/4X,A10)
C
C       MINBRK IS THE DIFFERENCE BETWEEN THE FACTOR'S INDEX AND 
C       THE ACTUAL VALUE OF THE VARIABLE
C
        MINBRK=VARDES(FACLOC(1),3)-1
C
C       LOOP GOES THROUGH EACH VALUE OF FIRST FACTOR
C
        DO 575 I=2,MAXVARS(2)
C
C       INITIALIZE MEANS AND PERCENTS
C
        MEAN1=0.0
        MEAN2=0.0
        PCT1=0.0
        PCT2=0.0
C
C       CALCULATE MEANS AND PERCENTS
C
        INDEX=IND(1,I,1,1,1)
        IF (TABLE(INDEX,2).GT.0.0)THEN
           MEAN1=TABLE(INDEX,1)/TABLE(INDEX,2)
        ENDIF
        IF(N1T.GT.0.0)PCT1=TABLE(INDEX,2)/N1T*100.0
        INDEX=IND(2,I,1,1,1)
        IF (TABLE(INDEX,2).GT.0.0)THEN
           MEAN2=TABLE(INDEX,1)/TABLE(INDEX,2)
        ENDIF
        IF(N2T.GT.0.0)PCT2=TABLE(INDEX,2)/N2T*100.0
C
C       SEE IF WE ARE AT THE END OF THE PAGE.
C
        CALL PAGE(PG,LN)
C
C       IF THIS IS A NEW PAGE, WRITE A NEW HEADER.
C
        IF (LN.EQ.1)THEN
          WRITE(23,853)
 853      FORMAT(/' A. Descriptive Table (Continued)')
          WRITE(23,648)VARNAM(DEPLOC),POP1D,POP2D,POP1D,POP2D
          WRITE(23,569)VARNAM(FACLOC(1))
          LN=LN+13
        ENDIF
C
C       NOW WRITE THE FACTOR CATEGORY AND THE MEANS AND PERCENTS.
C
        WRITE(23,570)I-1+MINBRK,MEAN1,MEAN2,PCT1,PCT2
 570    FORMAT(6X,i3,8x,f9.4,3x,f9.4,16X,F5.1,7X,F5.1)
 575    CONTINUE
C
C       THE FOLLOWING SECTION DOES THE SAME THING FOR THE SECOND
C       THROUGH THE FOURTH FACTORS. CHECK FIRST TO MAKE SURE THAT
C       THESE FACTORS EXIST.
C
        IF(NUMFAC.GE.2)THEN
C
C       DO THE LOOP FOR EACH FACTOR.
C
          DO 582 NF=2,NUMFAC
C
C       IF THERE IS NOT GOING TO BE ROOM FOR THE ENTIRE FACTOR ON THIS
C       PAGE, WE WANT TO START A NEW PAGE (UNLESS THE FACTOR ISN'T GOING
C       TO FIT ON A SINGLE PAGE ANYWAY). THE FOLLOWING STATEMENTS 
C       CALCULATE THE AMOUNT OF SPACE THE FACTOR WILL REQUIRE AND THE
C       AMOUNT OF ROOM LEFT ON THE PAGE, AND COMPARE THE TWO; IF THERE 
C       ISN'T ENOUGH ROOM, WE CALL A NEW PAGE.
C
          TRAIL=0
          IF(NUMFAC.EQ.NF)TRAIL=5
          SPACE=MAXVARS(NF+1)+TRAIL+2
          ROOM=63-LN
          IF (SPACE.GT.ROOM.AND.SPACE.LT.50)LN=100
          CALL PAGE(PG,LN)
C
C         IF WE DID START A NEW PAGE, WE NEED TO WRITE A NEW HEADER.
C
          IF (LN.EQ.1)THEN
            WRITE(23,853)
            WRITE(23,648)VARNAM(DEPLOC),POP1D,POP2D,POP1D,POP2D
            LN=LN+9
          ENDIF
          LN=LN+2
C
C         WRITE THE NAME OF THE FACTOR
C
          WRITE(23,569)VARNAM(FACLOC(NF))
C
C         CALCULATE MINBRK FOR THIS FACTOR
C
          MINBRK=VARDES(FACLOC(NF),3)-1
C
C         PASS THROUGH EACH CATEGORY OF THE CURRENT FACTOR
C
          DO 580 I=2,MAXVARS(NF+1)
C
C         INITIALIZE MEANS AND PERCENTS
C
          MEAN1=0.0
          MEAN2=0.0
          PCT1=0.0
          PCT2=0.0
C
C         CALCULATE MEANS AND PERCENTS, FIRST SETTING THE INDEX
C         TO THE APPROPRIATE MARGINALS FOR THIS FACTOR.
C
          IF (NF.EQ.2)THEN
             INDEX=IND(1,1,I,1,1)
          ELSE IF (NF.EQ.3)THEN
             INDEX=IND(1,1,1,I,1)
          ELSE IF (NF.EQ.4)THEN
             INDEX=IND(1,1,1,1,I)
          ENDIF   
          IF (TABLE(INDEX,2).GT.0.0)THEN
             MEAN1=TABLE(INDEX,1)/TABLE(INDEX,2)
          ENDIF
          IF(N1T.GT.0.0)PCT1=TABLE(INDEX,2)/N1T*100.0
C
C         DITTO FOR POPULATION B
C
          IF (NF.EQ.2)THEN
             INDEX=IND(2,1,I,1,1)
          ELSE IF (NF.EQ.3)THEN
             INDEX=IND(2,1,1,I,1)
          ELSE IF (NF.EQ.4)THEN
             INDEX=IND(2,1,1,1,I)
          ENDIF   
          IF (TABLE(INDEX,2).GT.0.0)THEN
             MEAN2=TABLE(INDEX,1)/TABLE(INDEX,2)
          ENDIF
          IF(N2T.GT.0.0)PCT2=TABLE(INDEX,2)/N2T*100.0
C
C         CHECK OUT PAGE POSITION AND WRITE NEW HEADER IF 
C         THIS IS A NEW PAGE
C
          CALL PAGE(PG,LN)
          IF (LN.EQ.1)THEN
            WRITE(23,853)
            WRITE(23,648)VARNAM(DEPLOC),POP1D,POP2D,POP1D,POP2D
            WRITE(23,569)VARNAM(FACLOC(NF))
            LN=LN+13
          ENDIF
C
C         FINALLY, WRITE THE MEANS AND PERCENTS.
C
          WRITE(23,570)I-1+MINBRK,MEAN1,MEAN2,PCT1,PCT2
 580      CONTINUE
 582      CONTINUE
        ENDIF
C
C       NOW WRITE TOTALS AND N'S AT THE END OF THE DESCRIPTIVE TABLE.
C
        PCT1=100.0
        LN=LN+4
        CALL PAGE(PG,LN)  
        WRITE(23,650)TOT1,TOT2,PCT1,PCT1
 650    FORMAT(/'    Total',8X,F9.4,3X,F9.4,16X,F5.1,7X,F5.1)
        WRITE(23,651)NU1,NU2,NU1,NU2
 651    FORMAT('              N',2X,I9,3X,I9,12X,I9,3X,I9)
        WRITE(23,652)MI1,MI2,MI1,MI2
 652    FORMAT(' Excluded cases',2X,I9,3X,I9,12X,I9,3X,I9)
        WRITE(23,752)
 752    FORMAT('________________________________________',
     X          '_______________________________________')
        RETURN
        END


        SUBROUTINE MARGINS (A,B,C,D,E,TDEN,TNUM)
        IMPLICIT INTEGER(A-Z)
        REAL TABLE,TDEN,TNUM
        DIMENSION TABLE(64000,2)
        DIMENSION MAXVARS(5)
        COMMON /TABS/ TABLE,MAXVARS
C
C       THIS SUBROUTINE TABULATES EVERY POSSIBLE TYPE
C       OF MARGINAL.  FOR THE THREE-WAY AND TWO-WAY MARGINALS,
C       WE WILL ONLY NEED THE NUMBER OF CASES.
C
        INDEX=IND(A,B,C,D,1)
          TABLE(INDEX,2)=TABLE(INDEX,2)+TDEN
        INDEX=IND(A,B,C,1,E)
          TABLE(INDEX,2)=TABLE(INDEX,2)+TDEN
        INDEX=IND(A,B,1,D,E)
          TABLE(INDEX,2)=TABLE(INDEX,2)+TDEN
        INDEX=IND(A,1,C,D,E)
          TABLE(INDEX,2)=TABLE(INDEX,2)+TDEN
        INDEX=IND(A,B,C,1,1)
          TABLE(INDEX,2)=TABLE(INDEX,2)+TDEN
        INDEX=IND(A,B,1,D,1)
          TABLE(INDEX,2)=TABLE(INDEX,2)+TDEN
        INDEX=IND(A,1,C,D,1)
          TABLE(INDEX,2)=TABLE(INDEX,2)+TDEN
        INDEX=IND(A,B,1,1,E)
          TABLE(INDEX,2)=TABLE(INDEX,2)+TDEN
        INDEX=IND(A,1,C,1,E)
          TABLE(INDEX,2)=TABLE(INDEX,2)+TDEN
        INDEX=IND(A,1,1,D,E)
          TABLE(INDEX,2)=TABLE(INDEX,2)+TDEN  
C
C       FOR THE ONE-WAY MARGINALS, WE NEED THE NUMERATORS AS
C       WELL, BECAUSE WE WILL NEED THEM FOR THE DESCRIPTIVE TABLE.
C                               
        INDEX=IND(A,B,1,1,1)
          TABLE(INDEX,2)=TABLE(INDEX,2)+TDEN
          TABLE(INDEX,1)=TABLE(INDEX,1)+TNUM
        INDEX=IND(A,1,1,D,1)
          TABLE(INDEX,2)=TABLE(INDEX,2)+TDEN
          TABLE(INDEX,1)=TABLE(INDEX,1)+TNUM
        INDEX=IND(A,1,C,1,1)
          TABLE(INDEX,2)=TABLE(INDEX,2)+TDEN
          TABLE(INDEX,1)=TABLE(INDEX,1)+TNUM
        INDEX=IND(A,1,1,1,E)
          TABLE(INDEX,2)=TABLE(INDEX,2)+TDEN
          TABLE(INDEX,1)=TABLE(INDEX,1)+TNUM
C
C       FINALLY, THE NO-WAY MARGINAL (THE TOTAL CASES IN EACH POPULATION)
C                                                          
        INDEX=IND(A,1,1,1,1)
          TABLE(INDEX,2)=TABLE(INDEX,2)+TDEN
        RETURN
        END


          SUBROUTINE ADJUST (A,I,J,K,L,N,T)
C
C         THIS ROUTINE ADJUSTS THE MARGINALS TO ACCOUNT FOR EXCLUDED
C         CASES.
C
          IMPLICIT INTEGER(A-Z)
          REAL TABLE,N,T
          DIMENSION TABLE(64000,2)
          DIMENSION MAXVARS(5)
          COMMON /TABS/ TABLE,MAXVARS
          TABLE(IND(A,I,J,K,1),2)=TABLE(IND(A,I,J,K,1),2)-N
          TABLE(IND(A,I,J,1,L),2)=TABLE(IND(A,I,J,1,L),2)-N
          TABLE(IND(A,I,1,K,L),2)=TABLE(IND(A,I,1,K,L),2)-N
          TABLE(IND(A,1,J,K,L),2)=TABLE(IND(A,1,J,K,L),2)-N
          TABLE(IND(A,1,1,K,L),2)=TABLE(IND(A,1,1,K,L),2)-N
          TABLE(IND(A,1,J,1,L),2)=TABLE(IND(A,1,J,1,L),2)-N
          TABLE(IND(A,1,J,K,1),2)=TABLE(IND(A,1,J,K,1),2)-N
          TABLE(IND(A,I,1,1,L),2)=TABLE(IND(A,I,1,1,L),2)-N
          TABLE(IND(A,I,J,1,1),2)=TABLE(IND(A,I,J,1,1),2)-N
          TABLE(IND(A,I,1,K,1),2)=TABLE(IND(A,I,1,K,1),2)-N
          INDEX=IND(A,I,1,1,1)
            TABLE(INDEX,2)=TABLE(INDEX,2)-N
            TABLE(INDEX,1)=TABLE(INDEX,1)-T
          INDEX=IND(A,1,J,1,1)
            TABLE(INDEX,2)=TABLE(INDEX,2)-N
            TABLE(INDEX,1)=TABLE(INDEX,1)-T
          INDEX=IND(A,1,1,K,1)
            TABLE(INDEX,2)=TABLE(INDEX,2)-N
            TABLE(INDEX,1)=TABLE(INDEX,1)-T
          INDEX=IND(A,1,1,1,L)
            TABLE(INDEX,2)=TABLE(INDEX,2)-N
            TABLE(INDEX,1)=TABLE(INDEX,1)-T
          RETURN
          END

       SUBROUTINE GUPSET(VARDES,POP1D,POP2D,POPLOC,NUMFAC,
     X                   NEWPOS,FACLOC,POPPOS,POPA,POPB)
C
C      THIS SUBROUTINE DOES A LITTLE PRELIMINARY SETUP NECESSARY
C      FOR THE DECOMP PROCEDURE.
C
       IMPLICIT INTEGER(A-Z)
       DIMENSION MAXVARS(5),FACLOC(5)
       DIMENSION VARDES(30,5)
       DIMENSION NEWPOS(5)
       DIMENSION TABLE(64000,2)
       COMMON /TABS/ TABLE,MAXVARS
C
C      CHECK TO MAKE SURE THE COMPARISON VARIABLE HAS BEEN
C      SPECIFIED IN THE PRECEEDING MAKETAB COMMAND.
C
       POPPOS=VARDES(POPLOC,5)-1
       IF (POPPOS.LT.1.OR.POPPOS.GT.5)THEN
          CALL ERROR(402)
       ENDIF
C
C      INITIALIZE MAXVARS TO TWO.  THIS LEAVES ROOM FOR THE AVERAGE OF
C      THE POPULATIONS IN POSITION THREE (WE WILL NEED TO HAVE THE 
C      AVERAGE LATER).
C
C      THE ARRAY NEWPOS WILL CONTAIN THE NEW POSITION OF EACH OF 
C      THE VARIABLES PREVIOUSLY TABULATED BY MAKETAB. INITIALIZE.
C
       DO 9 I=1,5
       MAXVARS(I)=2
 9     NEWPOS(I)=6
C
C      THE COMPARISON VARIBLE, LOCATED IN POPPOS, WILL BE STUCK IN
C      THE FIRST POSITION IN THE NEW TABLE.
C
       NEWPOS(1)=POPPOS
C
C      FIGURE THE RANGE OF THE COMPARISON VARIABLE, AND PUT IT IN
C      MAXVARS(1)
C
       MAXVARS(1)=VARDES(POPLOC,4)-VARDES(POPLOC,3)+1
C
C      MAKE SURE THE SPECIFIC COMPARISON CATEGORIES FALL WITHIN THE
C      SPECIFIED RANGE OF THE COMPARISON VARIABLE.
C
       POPA=POP1D-VARDES(POPLOC,3)+1
       POPB=POP2D-VARDES(POPLOC,3)+1
       IF(POPA.GT.MAXVARS(1).OR.POPB.GT.MAXVARS(1))THEN
         CALL ERROR(405)
       ENDIF
C
C      THE FOLLOWING LOOP DOES THE SAME PROCEDURES FOR EACH OF
C      THE FACTORS.
C
       NEXT=1
       NDENOW=NUMFAC
       DO 10 I=1,NUMFAC
C
C      IF THE COMPARISON VARIABLE WAS SPECIFIED AS A FACTOR, 
C      WE WILL SIMPLY THROW IT OUT AS A FACTOR.
C      MAKE SURE, IF IT IS THROWN OUT, THAT WE STILL HAVE AT
C      LEAST ONE FACTOR TO WORK WITH.
C
       IF(FACLOC(I).EQ.POPLOC)THEN
         NDENOW=NDENOW-1
         IF(NDENOW.EQ.0)THEN
           CALL ERROR(402)
         ENDIF         
         GO TO 10
       ENDIF
C
C      THE POSITION OF EACH OF THE FACTORS ON THE NEW TABLE IS
C      INDICATED BY NEXT.  THEIR PREVIOUS POSITION, IN THE TABLE
C      CREATED BY VARDES, CAN BE DETERMINED FROM COLUMN 5 OF VARDES.
C
       NEXT=NEXT+1
       NEWPOS(NEXT)=VARDES(FACLOC(I),5)-1
C
C      MAKE SURE WE HAVE THE RIGHT VARIABLES; IF NOT, WRITE AN ERROR.
C
       IF(NEWPOS(NEXT).LT.1.OR.NEWPOS(NEXT).GT.5)THEN
          CALL ERROR(402)
       ENDIF
C
C      CALCULATE MAXIMUM RANGE FOR EACH VARIABLE.  LEAVE ROOM FOR
C      THE MARGINALS.
C
       MAXVARS(NEXT)=VARDES(FACLOC(I),4)-VARDES(FACLOC(I),3)+2
 10    CONTINUE
C
C      NOW WE CAN RESET THE MAXVARS FOR THE COMPARISON VARIABLE;
C      WE KNOW THAT ONLY TWO CATEGORIES WILL BE COMPARED, SO WE 
C      SET IT TO THREE, LEAVING ROOM FOR MARGINALS. 
C
       MAXVARS(1)=3
C
C      NOW MAKE SURE THAT THE NEW TABLE WILL FIT IN THE MAIN ARRAY.
C
       BIGGEST=MAXVARS(1)*MAXVARS(2)*MAXVARS(3)*MAXVARS(4)
     X             *MAXVARS(5)
        IF(BIGGEST.GT.64000)THEN
          CALL ERROR(406)
        ENDIF 
        RETURN
        END
C
C
C
        SUBROUTINE WRPREP (VARNUM,VARDES,WRFORM,FILES,
     X               NUMIND,INDNAM,WTDIG,PG,LN)
C
C       THIS ROUTINE DOES THE SETUP FOR THE "WRITE TABLE" SUBCOMMAND
C       OF THE MAKETAB COMMAND.  IT ALSO WRITES A CODEBOOK FOR THE
C       TABLE TO THE LISTING FILE. 
C
        IMPLICIT INTEGER(A-Z)
        REAL TABLE
        CHARACTER*10 INDNAM
        CHARACTER*35 FILES
        DIMENSION VARDES(30,5)
        DIMENSION FILES(4)
        DIMENSION INDNAM(5)
        DIMENSION WRFORM(7,2)
        COMMON /TABS/ TABLE(64000,2),MAXVARS(5)
C
C       OPEN THE OUTPUT FILE.  THE NAME OF THE FILE IS STORED IN 
C       FILES(4)
C
        OPEN(66,FILE=FILES(4))
C
C       THE FOLLOWING LOOP FILLS AN ARRAY WRFORM.
C       THE FIRST SUBSCRIPT INDICATES THE OUTPUT VARIABLE NUMBER.
C       WRFORM (N,1) WILL CONTAIN THE STARTING COLUMN OF THE VARIABLE;
C       WRFORM (N,2) WILL CONTAIN THE ENDING COLUMN OF THE VARIABLE.
C
C       THE PROGRAM IS SET UP TO SKIP A SPACE BETWEEN EACH OUTPUT 
C       VARIABLE, IN ORDER TO ALLOW USERS TO INPUT THE TABLE INTO
C       PROGRAMS REQUIRING FREE-FORM INPUT.
C
C       START AT CHARACTER -1, AND FIRST LOOK FOR THE INDEPENDENT
C       VARIABLES.  THEY ARE IDENTIFIED IN VARDES(N,5) WITH VALUES 
C       BETWEEN 2 AND 6.
C
        CHR=-1
        DO 861 POS=2,6
        DO 861 I=1,VARNUM
C
C       IF THE CURRENT VARIABLE IS AN INDEPENDENT VARIABLE, THE 
C       BEGINNING COLUMN IS SET TWO COLUMNS BEYOND THE LAST COLUMN
C       SPECIFIED (NOTE: TO ELIMINATE THE SPACE BETWEEN VARIABLES,
C       CHANGE THIS INCREMENT TO ONE)
C       SINCE CHR WAS INITIALIZED AT COLUMN -1, THE FIRST VARIABLE
C       WILL BEGIN IN COLUMN 1.
C
        IF (VARDES(I,5).EQ.POS)THEN
           WRFORM(POS-1,1)=CHR+2
C
C       NOW DETERMINE THE ENDING COLUMN BY LOOKING AT THE MAXIMUM
C       SIZE OF THE VARIABLE.
C
           IF(VARDES(I,4).LT.10)THEN
             WRFORM(POS-1,2)=CHR+2
           ELSE IF (VARDES(I,4).LT.100)THEN
             WRFORM(POS-1,2)=CHR+3
           ELSE IF (VARDES(I,4).LT.1000)THEN
             WRFORM(POS-1,2)=CHR+4
           ELSE IF (VARDES(I,4).LT.10000)THEN
             WRFORM(POS-1,2)=CHR+5
           ELSE
             WRFORM(POS-1,2)=CHR+6
           ENDIF
           CHR=WRFORM(POS-1,2)
        ENDIF
 861    CONTINUE
C
C       THAT TAKES CARE OF THE INDEPENDENT VARIABLES.
C       WRITE THE CODES TO THE LISTING FILE.
C       FIRST, SEE IF WE WILL NEED TO START A NEW PAGE AND
C       WRITE A HEADER.
C
        LN=LN+NUMIND+10
        CALL PAGE(PG,LN)
        WRITE(23,862)files(4)
 862    FORMAT(/' The table is written to file ',a35,/
     x          ' using the following format:'//
     x  22x,'Variable'/,
     x  22x,'Name                   Columns'/)
C
C       NOW WRITE THE FIRST PART OF THE CODEBOOK.
C
        DO 872 I=1,NUMIND
 872    WRITE(23,873)INDNAM(I),WRFORM(I,1),WRFORM(I,2)
 873    FORMAT(22X,A10,12X,I2,'-',I2)
C
C       NOW SEARCH THE MAIN TABLE FOR THE LARGEST MEAN VALUE OF THE
C       DEPENDENT VARIABLE (BIGNUM) AND THE LARGEST NUMBER OF 
C       CASES (BIGDEN).
C
        BIGNUM=0
        BIGDEN=0
        DO 875 I=1,64000
        IF (TABLE(I,2).GT.0.0)THEN
          IF (TABLE(I,1)/TABLE(I,2).GT.FLOAT(BIGNUM))
     X        BIGNUM=TABLE(I,1)/TABLE(I,2)
        ENDIF
 875    IF (TABLE(I,2).GT.FLOAT(BIGDEN))BIGDEN=TABLE(I,2) 
C
C       THE MEAN OF THE DEPENDENT WILL BE WRITTEN BEGINNING TWO
C       COLUMNS AFTER THE LAST DEPENDENT VARIABLE.
C     
        WRFORM(NUMIND+1,1)=WRFORM(NUMIND,2)+2
C
C       THE END OF IT WILL DEPEND ON BIGNUM.  LEAVE FIVE ADDITIONAL
C       PLACES FOR A DECIMAL POINT AND DIGITS.
C
        IF(BIGNUM.LT.10)THEN
          WRFORM(NUMIND+1,2)=WRFORM(NUMIND+1,1)+5
        ELSE IF (BIGNUM.LT.100)THEN
          WRFORM(NUMIND+1,2)=WRFORM(NUMIND+1,1)+6
        ELSE IF (BIGNUM.LT.1000)THEN
          WRFORM(NUMIND+1,2)=WRFORM(NUMIND+1,1)+7
        ELSE IF (BIGNUM.LT.10000)THEN
          WRFORM(NUMIND+1,2)=WRFORM(NUMIND+1,1)+8
        ELSE
          WRFORM(NUMIND+1,2)=WRFORM(NUMIND+1,1)+9
        ENDIF
C
C       NOW FIGURE THE COLUMNS FOR THE NUMBER OF CASES IN THE CELL.
C       IN CASE THE WEIGHT VARIABLE HAS BEEN READ IN AS A REAL NUMBER,
C       WE WILL HAVE TO FIGURE HOW MANY PLACES TO THE RIGHT OF THE
C       DECIMAL ARE NEEDED.
C
        PLACES=0
        IF(WTDIG.GT.0)PLACES=WTDIG+1
        WRFORM(NUMIND+2,1)=WRFORM(NUMIND+1,2)+2
        IF(BIGDEN.LT.10)THEN
          WRFORM(NUMIND+2,2)=WRFORM(NUMIND+2,1)+PLACES
        ELSE IF (BIGDEN.LT.100)THEN
          WRFORM(NUMIND+2,2)=WRFORM(NUMIND+2,1)+PLACES+1
        ELSE IF (BIGDEN.LT.1000)THEN
          WRFORM(NUMIND+2,2)=WRFORM(NUMIND+2,1)+PLACES+2
        ELSE IF (BIGDEN.LT.10000)THEN
          WRFORM(NUMIND+2,2)=WRFORM(NUMIND+2,1)+PLACES+3
        ELSE IF (BIGDEN.LT.100000)THEN
          WRFORM(NUMIND+2,2)=WRFORM(NUMIND+2,1)+PLACES+4
        ELSE 
          WRFORM(NUMIND+2,2)=WRFORM(NUMIND+2,1)+PLACES+5
        ENDIF
C
C       NOW WRITE THE REST OF THE TABLE: THE COLUMNS FOR THE MEAN OF THE 
C       DEPENDENT AND NUMBER OF CASES IN THE CELL.
C
        WRITE(23,874)WRFORM(NUMIND+1,1),WRFORM(NUMIND+1,2),
     X               WRFORM(NUMIND+2,1),WRFORM(NUMIND+2,2)
 874    FORMAT(22x,'Mean of dependent',5x,I2,'-',I2,/
     X          22X,'Number of cases  ',5x,i2,'-',i2/)                             
        RETURN
        END


        SUBROUTINE WRDATA(VARNUM,VARDES,WRFORM,I,J,K,L,M,
     X               NUMIND,WTDIG,WTDIV,TNUM,TDEN)
C
C       THIS SUBROUTINE ACTUALLY WRITES THE TABLE WHEN THE "WRITE TABLE"
C       OPTION OF MAKETAB IS SPECIFIED.
C
        IMPLICIT INTEGER(A-Z)
        INTEGER*4 I,J,K,L,M
        CHARACTER*10 CONVERT
        CHARACTER*80 WRLINE
        REAL TNUM,TDEN
        DIMENSION VARDES(30,5)
        DIMENSION WRFORM(7,2)
C
C       THE DATA WILL BE CONVERTED TO A CHARACTER STRING BEFORE IT IS 
C       WRITTEN, BOTH TO SIMPLIFY THE WRITE FORMAT AND TO SPEED THE 
C       PROCESS.
C
C ****** WARNING: SOME COMPILERS DO NOT ALLOW CHARACTER STRINGS THIS LONG.
C 
C       INITIALIZE THE LINE WITH BLANKS.
C
        WRLINE(1:40) ='                                        '
        WRLINE(41:80)='                                        '
C
C       THE FOLLOWING LOOP INSERTS THE DATA INTO THE STRING WRLINE.
C       THE POSITION OF EACH VARIABLE HAS BEEN PREVIOUSLY DETERMINED
C       BY THE SUBROUTINE WRPREP, AND STORED IN ARRAY WRFORM.
C       THE VALUES OF EACH VARIABLE ARE CONVERTED TO CHARACTERS BY
C       THE FUNCTION "CONVERT".
C       (THE VALUES OF THE VARIABLES HAVE BEEN TRANSFERRED TO THIS
C       SUBROUTINE AS I,J,K,L, AND M.
C        
        DO 883 F=1,VARNUM
        POS=VARDES(F,5)-1
        IF (POS.EQ.1)THEN
           WRLINE(WRFORM(POS,1):WRFORM(POS,2))=
     X     CONVERT(I+VARDES(F,3)-1,WRFORM(POS,2)-WRFORM(POS,1)+1)
        ELSE IF (POS.EQ.2)THEN
           WRLINE(WRFORM(POS,1):WRFORM(POS,2))=
     X     CONVERT(J+VARDES(F,3)-1,WRFORM(POS,2)-WRFORM(POS,1)+1)
        ELSE IF (POS.EQ.3)THEN
           WRLINE(WRFORM(POS,1):WRFORM(POS,2))=
     X     CONVERT(K+VARDES(F,3)-1,WRFORM(POS,2)-WRFORM(POS,1)+1)
        ELSE IF (POS.EQ.4)THEN
           WRLINE(WRFORM(POS,1):WRFORM(POS,2))=
     X     CONVERT(L+VARDES(F,3)-1,WRFORM(POS,2)-WRFORM(POS,1)+1)
        ELSE IF (POS.EQ.5)THEN
           WRLINE(WRFORM(POS,1):WRFORM(POS,2))=
     X     CONVERT(M+VARDES(F,3)-1,WRFORM(POS,2)-WRFORM(POS,1)+1)
        ENDIF
 883    CONTINUE
C
C       NOW WE HAVE TO INSERT THE MEAN OF THE DEPENDENT VARIABLE.
C       TO DO THIS WE MUST SPLIT IT INT TWO PARTS.
C       DIGITS TO THE LEFT OF THE DECIMAL ARE PLACED IN THE
C       VARIABLE "INTEG."  DIGITS TO THE RIGHT OF THE DECIMAL 
C       ARE PLACED IN THE VARIABLE "FRACT."
C
        INTEG=(TNUM/TDEN)
C INT4 WAS HERE
        FRACT=((TNUM/TDEN+.00005)-(TNUM/TDEN))*10000.0
        IF (FRACT.EQ.10000)THEN
           FRACT=0
           INTEG=INTEG+1
        ENDIF
C
C       NOW INSERT THE INTEG PART, FIRST CONVERTING IT WITH "CONVERT"
C
        BEG=WRFORM(NUMIND+1,1)
        END=WRFORM(NUMIND+1,2)-5
        WRLINE(BEG:END)=CONVERT(INTEG,END-BEG+1)
C
C       NOW INSERT THE DECIMAL POINT IN THE APPROPRIATE SPOT.
C
        WRLINE(END+1:END+1)='.'
C
C       AND FINALLY INSERT THE FRACT PART.
C
        BEG=END+2
        END=WRFORM(NUMIND+1,2)
        WRLINE(BEG:END)=CONVERT(FRACT,END-BEG+1)
C
C       THE LAST ITEM TO BE WRITTEN IS THE NUMBER OF CASES IN THE CELL.
C       IF IT IS A REAL NUMBER, WE MUST AGAIN SPLIT IT INTO INTEG AND
C       FRACT, BUT IF NOT (INDICATED BY WTDIG=0) WE CAN SIMPLY CONVERT
C       IT AS AN INTEGER.
C
        IF (WTDIG.EQ.0)THEN
           INTEG=TDEN
           BEG=WRFORM(NUMIND+2,1)
           END=WRFORM(NUMIND+2,2)
C
C       INSERT INTEGER VALUE
C
           WRLINE(BEG:END)=CONVERT(INTEG,END-BEG+1)
        ELSE
C
C       OR SPLIT IT UP, AND INSERT INTEG, DECIMAL POINT, AND FRACT.
C
           INTEG=TDEN
           BEG=WRFORM(NUMIND+2,1)
           END=WRFORM(NUMIND+2,2)-WTDIG-1
           WRLINE(END+1:END+1)='.'
           WRLINE(BEG:END)=CONVERT(INTEG,END-BEG+1)
C INT4 WAS HERE
           FRACT=(TDEN-(TDEN))*WTDIV
           BEG=END+2               
           END=WRFORM(NUMIND+2,2)
           WRLINE(BEG:END)=CONVERT(FRACT,END-BEG+1)
        ENDIF
C
C       NOW THE STRING IS COMPLETE.  WRITE IT.
C
        WRITE(66,884)WRLINE(1:WRFORM(NUMIND+2,2))
 884    FORMAT(A)
        RETURN
        END


        SUBROUTINE EXPREP (VARDES,WRFORM,FILES,
     X     DEPLOC,WTDIG,LOCATE,NUMIND,NVARS)
C
C       THIS ROUTINE DOES THE SETUP FOR THE "WRITE EXCLUDED" SUBCOMMAND
C       OF A PROCEDURE COMMAND.  
C
        IMPLICIT INTEGER(A-Z)
        REAL TABLE
        CHARACTER*35 FILES
        DIMENSION LOCATE(5)
        DIMENSION VARDES(30,5)
        DIMENSION FILES(4)
        DIMENSION WRFORM(7,2)
        COMMON /TABS/ TABLE(64000,2),MAXVARS(5)
C
C       OPEN THE OUTPUT FILE.  THE NAME OF THE FILE IS STORED IN 
C       FILES(4)
C
        OPEN(66,FILE=FILES(4))
C
C       THE FOLLOWING SECTION FILLS AN ARRAY WRFORM.
C       THE FIRST SUBSCRIPT INDICATES THE OUTPUT VARIABLE NUMBER.
C       WRFORM (N,1) WILL CONTAIN THE STARTING COLUMN OF THE VARIABLE;
C       WRFORM (N,2) WILL CONTAIN THE ENDING COLUMN OF THE VARIABLE.
C
C       THE PROGRAM IS SET UP TO SKIP A SPACE BETWEEN EACH OUTPUT 
C       VARIABLE, IN ORDER TO ALLOW USERS TO INPUT THE TABLE INTO
C       PROGRAMS REQUIRING FREE-FORM INPUT.
C
C       FIRST LOOK FOR THE COMPARISON OR BREAKDOWN
C       VARIABLE, LOCATED IN POSITION DEPLOC OF VARDES.
C       THE NUMBER OF COLUMNS REQUIRED IS DETERMINED BY THE MAXIMUM
C       VALUE OF THE VARIABLE.
C

        POS=1
        WRFORM(POS,1)=1
        IF(VARDES(DEPLOC,4).LT.10)THEN
          WRFORM(POS,2)=1
        ELSE IF (VARDES(DEPLOC,4).LT.100)THEN
          WRFORM(POS,2)=2
        ELSE IF (VARDES(DEPLOC,4).LT.1000)THEN
          WRFORM(POS,2)=3
        ELSE IF (VARDES(DEPLOC,4).LT.10000)THEN
          WRFORM(POS,2)=4
        ELSE
          WRFORM(POS,2)=5
        ENDIF
        CHR=WRFORM(POS,2)
C
C       NOW DO THE INDEPENDENT VARIABLES; THEIR NUMBER IS NUMIND,
C       AND THEIR LOCATION IS GIVEN IN ARRAY LOCATE.  
C
        DO 861 I=1,NUMIND
        IF (LOCATE(I).NE.DEPLOC)THEN
           POS=POS+1
           WRFORM(POS,1)=CHR+2
           IF(VARDES(LOCATE(I),4).LT.10)THEN
             WRFORM(POS,2)=CHR+2
           ELSE IF (VARDES(LOCATE(I),4).LT.100)THEN
             WRFORM(POS,2)=CHR+3
           ELSE IF (VARDES(LOCATE(I),4).LT.1000)THEN
             WRFORM(POS,2)=CHR+4
           ELSE IF (VARDES(LOCATE(I),4).LT.10000)THEN
             WRFORM(POS,2)=CHR+5
           ELSE
             WRFORM(POS,2)=CHR+6
           ENDIF
           CHR=WRFORM(POS,2)
        ENDIF
 861    CONTINUE
C
C       NOW DETERMINE THE POSITIONS OF THE MEAN VALUE OF THE DEPENDENT
C       VARIABLE AND THE NUMBER OF CASES IN THE CELL.
C       TO FIGURE OUT HOW MANY COLUMNS WILL BE REQUIRED, WE SEARCH THE
C       MAIN TABLE FOR THE MAXIMUM VALUES, WHICH ARE STUCK IN BIGNUM
C       AND BIGDEN.
C
        BIGNUM=0
        BIGDEN=0
        DO 875 I=1,64000
        IF (TABLE(I,2).GT.0.0)THEN
          IF (TABLE(I,1)/TABLE(I,2).GT.FLOAT(BIGNUM))
     X        BIGNUM=TABLE(I,1)/TABLE(I,2)
        ENDIF
 875    IF (TABLE(I,2).GT.FLOAT(BIGDEN))BIGDEN=TABLE(I,2)
C
C       FIGURE OUT COLUMNS FOR MEAN
C      
        WRFORM(POS+1,1)=WRFORM(POS,2)+2
        IF(BIGNUM.LT.10)THEN
          WRFORM(POS+1,2)=WRFORM(POS+1,1)+5
        ELSE IF (BIGNUM.LT.100)THEN
          WRFORM(POS+1,2)=WRFORM(POS+1,1)+6
        ELSE IF (BIGNUM.LT.1000)THEN
          WRFORM(POS+1,2)=WRFORM(POS+1,1)+7
        ELSE IF (BIGNUM.LT.10000)THEN
          WRFORM(POS+1,2)=WRFORM(POS+1,1)+8
        ELSE
          WRFORM(POS+1,2)=WRFORM(POS+1,1)+9
        ENDIF
C
C       FIGURE OUT COLMNS FOR NUMBER OF CASES, LEAVING ROOM FOR
C       DECIMAL PLACES IF THE CASES ARE EXPRESSED AS REAL NUMBERS.
C
        PLACES=0
        IF(WTDIG.GT.0)PLACES=WTDIG+1
        WRFORM(POS+2,1)=WRFORM(POS+1,2)+2
        IF(BIGDEN.LT.10)THEN
          WRFORM(POS+2,2)=WRFORM(POS+2,1)+PLACES
        ELSE IF (BIGDEN.LT.100)THEN
          WRFORM(POS+2,2)=WRFORM(POS+2,1)+PLACES+1
        ELSE IF (BIGDEN.LT.1000)THEN
          WRFORM(POS+2,2)=WRFORM(POS+2,1)+PLACES+2
        ELSE IF (BIGDEN.LT.10000)THEN
          WRFORM(POS+2,2)=WRFORM(POS+2,1)+PLACES+3
        ELSE IF (BIGDEN.LT.100000)THEN
          WRFORM(POS+2,2)=WRFORM(POS+2,1)+PLACES+4
        ELSE 
          WRFORM(POS+2,2)=WRFORM(POS+2,1)+PLACES+5
        ENDIF
        NVARS=POS
        RETURN
        END


        SUBROUTINE EXCODE(VARNAM,WRFORM,FILES,DEPLOC,LOCATE,
     X                    NUMIND,PG,LN)
C
C       THIS SUBROUTINE WRITES A CODEBOOK TO THE LISTING FILE 
C       WHEN A "WRITE EXCLUDED" SUBCOMMAND IS ISSUED.
C
        IMPLICIT INTEGER(A-Z)
        CHARACTER*10 VARNAM
        CHARACTER*35 FILES
        DIMENSION LOCATE(5)
        DIMENSION VARDES(30,5)
        DIMENSION FILES(4)
        DIMENSION VARNAM(30)
        DIMENSION WRFORM(7,2)
C
C       FIRST SEE IF THERE WILL BE ENOUGH ROOM ON THE PAGE,
C       AND START A NEW PAGE IF NECESSARY.
C
        LN=LN+NUMIND+10
        CALL PAGE(PG,LN)
C
C       WRITE A HEADER.
C
        WRITE(23,862)files(4)
 862    FORMAT(/' The excluded data are written to file ',a35,/
     x          ' using the following format:'//
     x  22x,'Variable'/,
     x  22x,'Name                   Columns'/)
C
C       THE COUMNS FOR EACH VARIABLE ARE STORED IN ARRAY WRFORM.
C       WRITE THEM.
C
        WRITE(23,873)VARNAM(DEPLOC),WRFORM(1,1),WRFORM(1,2)
        POS=1
        DO 872 I=1,NUMIND
        IF (LOCATE(I).NE.DEPLOC)THEN
          POS=POS+1
          WRITE(23,873)VARNAM(LOCATE(I)),WRFORM(POS,1),WRFORM(POS,2)
        ENDIF
 872    CONTINUE
 873    FORMAT(22X,A10,12X,I2,'-',I2)
C
C       THE MEAN OF DEPENDENT AND NUMBER OF CASES COME LAST.
C
        WRITE(23,874)WRFORM(POS+1,1),WRFORM(POS+1,2),
     X               WRFORM(POS+2,1),WRFORM(POS+2,2)
 874    FORMAT(22x,'Mean of dependent',5x,I2,'-',I2,/
     X          22X,'Number of cases  ',5x,i2,'-',i2/)
        RETURN
        END



        SUBROUTINE EXDATA(WRFORM,I,J,K,L,M,
     X      NVARS,WTDIG,WTDIV,TNUM,TDEN)
C
C       THIS SUBROUTINE WRITES THE EXCLUDED CASES WHEN THE 
C       "WRITE EXCLUDED" SUBCOMMAND HAS BEEN SPECIFIED.
C
        IMPLICIT INTEGER(A-Z)
        CHARACTER*10 CONVERT
        CHARACTER*80 WRLINE
        REAL TNUM,TDEN
        DIMENSION WRFORM(7,2)
        DIMENSION INDV(5)
C
C       THE DATA WILL BE CONVERTED TO A CHARACTER STRING BEFORE IT IS 
C       WRITTEN, BOTH TO SIMPLIFY THE WRITE FORMAT AND TO SPEED THE 
C       PROCESS.
C
C ****** WARNING: SOME COMPILERS DO NOT ALLOW CHARACTER STRINGS THIS LONG.
C 
C       INITIALIZE THE LINE WITH BLANKS.
C
        WRLINE(1:40) ='                                        '
        WRLINE(41:80)='                                        '
C
C       THE FOLLOWING LOOP INSERTS THE DATA INTO THE STRING WRLINE.
C       THE POSITION OF EACH VARIABLE HAS BEEN PREVIOUSLY DETERMINED
C       BY THE SUBROUTINE EXPREP, AND STORED IN ARRAY WRFORM.
C       THE VALUES OF EACH VARIABLE ARE CONVERTED TO CHARACTERS BY
C       THE FUNCTION "CONVERT".
C       (THE VALUES OF THE VARIABLES HAVE BEEN TRANSFERRED TO THIS
C       SUBROUTINE AS I,J,K,L, AND M. FIRST STICK THEM IN THE ARRAY
C       INDV TO SIMPLFY PROCESSING).
C        
        INDV(1)=I
        INDV(2)=J
        INDV(3)=K
        INDV(4)=L
        INDV(5)=M
        DO 883 N=1,NVARS
          WRLINE(WRFORM(N,1):WRFORM(N,2))=
     X    CONVERT(INDV(N),WRFORM(N,2)-WRFORM(N,1)+1)
 883    CONTINUE
C
C       NOW WE HAVE TO INSERT THE MEAN OF THE DEPENDENT VARIABLE.
C       TO DO THIS WE MUST SPLIT IT INT TWO PARTS.
C       DIGITS TO THE LEFT OF THE DECIMAL ARE PLACED IN THE
C       VARIABLE "INTEG."  DIGITS TO THE RIGHT OF THE DECIMAL 
C       ARE PLACED IN THE VARIABLE "FRACT."
C
        POS=NVARS
        INTEG=(TNUM/TDEN)
C INT4 WAS HERE
        FRACT=((TNUM/TDEN+.00005)-(TNUM/TDEN))*10000.0
        IF (FRACT.EQ.10000)THEN
           FRACT=0
           INTEG=INTEG+1
        ENDIF
C
C       NOW INSERT THE INTEG PART.
C
        BEG=WRFORM(POS+1,1)
        END=WRFORM(POS+1,2)-5
        WRLINE(BEG:END)=CONVERT(INTEG,END-BEG+1)
C
C       NOW STICK IN THE DECIMAL POINT.
C
        WRLINE(END+1:END+1)='.'
C
C       NOW INSERT THE FRACT PART.
C   
        BEG=END+2
        END=WRFORM(POS+1,2)
        WRLINE(BEG:END)=CONVERT(FRACT,END-BEG+1)
C
C       THE LAST ITEM TO BE WRITTEN IS THE NUMBER OF CASES IN THE CELL.
C       IF IT IS A REAL NUMBER, WE MUST AGAIN SPLIT IT INTO INTEG AND
C       FRACT, BUT IF NOT (INDICATED BY WTDIG=0) WE CAN SIMPLY CONVERT
C       IT AS AN INTEGER.
C
        IF (WTDIG.EQ.0)THEN
           INTEG=TDEN
           BEG=WRFORM(POS+2,1)
           END=WRFORM(POS+2,2)
           WRLINE(BEG:END)=CONVERT(INTEG,END-BEG+1)
        ELSE
C
C       OTHERWISE, WE DO THE INTEG AND FRACT BUSINESS.
C       THE NUMBER OF PLACES TO THE RIGHT OF THE DECIMAL POINT
C       IS GIVEN IN WTDIG.
C
           INTEG=TDEN
           BEG=WRFORM(POS+2,1)
           END=WRFORM(POS+2,2)-WTDIG-1
           WRLINE(END+1:END+1)='.'
           WRLINE(BEG:END)=CONVERT(INTEG,END-BEG+1)
C INT4 WAS HERE
           FRACT=(TDEN-(TDEN))*WTDIV
           BEG=END+2               
           END=WRFORM(POS+2,2)
           WRLINE(BEG:END)=CONVERT(FRACT,END-BEG+1)
        ENDIF
C
C      THE STRING IS COMPLETE, AND CAN BE WRITTEN.
C
        WRITE(66,884)WRLINE(1:WRFORM(POS+2,2))
 884    FORMAT(A)
        RETURN
        END





        CHARACTER*10 FUNCTION CONVERT(INTEG,LEN)
C
C       THIS IS THE FUNCTION TO CONVERT INTEGERS TO CHARACTERS.
C
C ****** WARNING: THIS FUNCTION ASSUMES AN EXTENDED ASCII CHARACTER SET.
C                 IT WILL HAVE TO BE MODIFIED FOR COMPUTERS USING OTHER
C                 CHARACTER CODES.
C
        IMPLICIT INTEGER(A-Z)
        INT=INTEG
        DO 10 I=1,LEN
        INT2=(INT/10)*10
        DIGIT=INT-INT2
        PLACE=LEN-I+1
        CONVERT(PLACE:PLACE)=CHAR(DIGIT+48)
        INT=INT/10
 10     CONTINUE
        RETURN
        END

       SUBROUTINE PAGE(PG,LN)
C
C      THIS SUBROUTINE KEEPS TRACK OF LINE AND PAGE NUMBERS.
C      AT THE BEGINNING OF EACH PAGE, A HEADER IS WRITTEN
C      CONTAINING THE PAGE NUMBER AND DATE.
C
       IMPLICIT INTEGER(A-Z)
ccc       INTEGER*4 YR,MON,DAY
       CHARACTER*24 FDATE
       SAVE SKIP
C    
C      FIRST CHECK TO SEE IF PAGE NUMBERING HAS BEEN SUPPRESSED
C      SUPRESSION IS INDICATED IF PG IS EVER EQUAL TO 9999
C      SAVE THIS IN VARIABLE SKIP
C
       IF (PG.EQ.9999)SKIP=PG
C
       IF (SKIP.NE.9999)THEN
C
C      LN IS THE LINE NUMBER.  IF IT IS OVER PGSIZE, START A NEW PAGE.
C
         LN=LN+1
         IF(LN.GE.61)THEN
           LN=1
           PG=PG+1
C
C  ****** WARNING: THE FOLLOWING LIBRARY ROUTINE, WHICH GETS THE DATE
C                  WILL NOT WORK ON MOST SYSTEMS.
ccc note function changed for Sun
C
ccc           CALL IDATE(DAY,MON,YR)
C
C  ****** WARNING: THE FOLLOWING STATEMENT WRITES THE FORMFEED CHARACTER.
C                  THIS WILL NOT WORK ON ALL SYSTEMS.
C
         IF(PG.GT.1)WRITE(23,*)CHAR(012)
C
C        NOW WRITE THE PAGE HEADER.
C        DEPENDING ON THE DAY OF THE MONTH, THE WRITE FORMAT CAN
C        VARY SLIGHTLY.
C
c           IF (DAY.LT.10)THEN
c             WRITE(23,100)PG,MON,DAY,YR
c           ELSE
c             WRITE(23,101)PG,MON,DAY,YR
c           ENDIF
            WRITE(23,100)PG,FDATE()
C
C        WRITE A LINE ACROSS THE TOP OF THE PAGE.
C
           WRITE(23,102)
         ENDIF
       ENDIF
 100   FORMAT('Page',I3,15X,'DECOMP Version 0.52',14x,
     x        a24)

c 100   FORMAT('Page',I3,23X,'DECOMP Version 0.51',21x,
c     x        i2,'/',i1,'/',i4)
c 101   FORMAT('Page',I3,23X,'DECOMP Version 0.51',20x,
c     x        i2,'/',i2,'/',i4)
 102   FORMAT('________________________________________',
     X          '_______________________________________')
       RETURN
       END
C
C
C
       SUBROUTINE ERROR(ERRNUM)
C
C         THIS ROUTINE WRITES ORDINARY ERROR MESSAGES.
C         THE MESSAGES ARE STUCK IN ARRAYS AND THEN REFERRED TO
C         BY THEIR NUMBER.
C        
C         THERE ARE EIGHT CHARACTER ARRAYS TO HOLD THE MESSAGES;
C         SEVEN OF THESE REFER TO ERRORS IN SPECIFIC COMMANDS,
C         AND THE OTHER ONE HOLDS MISCELLANEOUS MESSAGES.
C
        IMPLICIT INTEGER (A-Z)
        CHARACTER*35 DATERR
        CHARACTER*35 MAKERR
        CHARACTER*55 STERR
        CHARACTER*55 DECERR
        CHARACTER*35 RECERR
        CHARACTER*35 SELERR
        CHARACTER*35 GENERR
        CHARACTER*35 COMERR
        DIMENSION DATERR(8)
        DIMENSION MAKERR(11)
        DIMENSION STERR(15)
        DIMENSION DECERR(10)
        DIMENSION RECERR(6)
        DIMENSION SELERR(3)
        DIMENSION GENERR(6)
        DIMENSION COMERR(6)
        DATA DATERR/
     x          'Too many variables listed',
     X          'Quote mark missing',
     X          'Slash not found',
     X          'Command sequence problem',
     X          'Too few variables',
     X          'Columns illegal',
     X          'Cannot read beyond column 200',
     x          'Data file not found'/
        DATA MAKERR/
     X          'Illegal use of WEIGHT variable',
     X          'Check punctuation',
     X          'Too many variables',
     X          'Independent variable(s) not found',
     X          'Missing DEPENDENT subcommand',
     X          'Missing VARIABLES subcommand',
     X          'Subcommands out of sequence',
     X          'Missing equals sign',
     X          'Incomplete statement',
     X          'Invalid minimum or maximum values',
     X          'Too many categories of variables'/
        DATA STERR/
     X          'Illegal use of WEIGHT variable',
     X          'Too many BREAKDOWN variables listed',
     X          'All variables must be from MAKETAB command',
     X          'Too many CONTROL variables listed',
     X          'Syntax of STANDARD=CATEGORY subcommand',
     X          'Cannot understand STANDARD subcommand',
     X          'BREAKDOWN variable(s) must be specified',
     X          'Specified STANDARD category out of range',
     X          'Specified STANDARD category has no cases',
     X          'All cases excluded from the analysis',
     X          'Equals sign missing',
     X          'BREAKDOWN subcommand missing',
     X          'CONTROL subcommand missing',
     X          'Option permits only one breakdown category',
     X          'CONTROL variable(s) must be specified'/
        DATA DECERR/
     X          'Illegal use of WEIGHT variable',
     X          'All variables must be from MAKETAB command',
     X          'Too many FACTORS listed',
     X          'Problem with comparison categories',
     X          'Comparison category out of variable range',
     X          'Too many categories of variables for DECOMP',
     X          'No cases found in at least one population',
     X          'Equals sign missing',
     X          'FACTOR subcommand not found',
     X          'COMPARE subcommand not found'/
        DATA RECERR/
     X          'Too many recodes',
     X          'Punctuation problem',
     X          'Range of values invalid',
     X          'ELSE operator illegal',
     X          'Incomplete statement',
     X          'Check syntax'/
        DATA SELERR/
     X          'Operator illegal or missing',
     X          'Too many SELECT IF statements',
     X          'Incomplete statement'/
        DATA GENERR/
     X          ': Command too long',
     X          ' in WEIGHT command',
     X          ': Array index exceeds 64000',
     X          ': Command file not found',
     X          ': Command must begin in column 1',
     X          ': Warning count exceeded'/
        DATA COMERR/
     X          'Punctuation problem',
     X          'Too many variables',
     X          'Invalid minimum or maximum values',
     X          'Incomplete statement',
     X          'You must have two or more variables',
     X          'Too many categories of variables'/
C
C         DEPENDING ON THE ERROR NUMBER, WRITE THE MESSAGE FROM THE
C         APPROPRIATE ARRAY.
C
        IF (ERRNUM.LT.200)THEN
          INDEX=ERRNUM-100
          WRITE(*,10)ERRNUM,DATERR(INDEX)
          WRITE(23,10)ERRNUM,DATERR(INDEX)
 10       FORMAT(///' ERROR ',I3,1x,'in DATA LIST command: ',a)
        ELSE IF (ERRNUM.LT.300)THEN
          INDEX=ERRNUM-200
          WRITE(*,11)ERRNUM,MAKERR(INDEX)
          WRITE(23,11)ERRNUM,MAKERR(INDEX)
 11       FORMAT(///' ERROR ',I3,1x,'in MAKETAB command: ',a)
        ELSE IF (ERRNUM.LT.400)THEN
          INDEX=ERRNUM-300
          WRITE(*,12)ERRNUM,STERR(INDEX)
          WRITE(23,12)ERRNUM,STERR(INDEX)
 12       FORMAT(///' ERROR ',I3,1x,'in STANDARDIZE command: ',a)
        ELSE IF (ERRNUM.LT.500)THEN
          INDEX=ERRNUM-400
          WRITE(*,13)ERRNUM,DECERR(INDEX)
          WRITE(23,13)ERRNUM,DECERR(INDEX)
 13       FORMAT(///' ERROR ',I3,1x,'in DECOMPOSE command: ',a)
        ELSE IF (ERRNUM.LT.600)THEN
          INDEX=ERRNUM-500
          WRITE(*,14)ERRNUM,RECERR(INDEX)
          WRITE(23,14)ERRNUM,RECERR(INDEX)
 14       FORMAT(///' ERROR ',I3,1x,'in RECODE command: ',a)
        ELSE IF (ERRNUM.LT.700)THEN
          INDEX=ERRNUM-600
          WRITE(*,15)ERRNUM,SELERR(INDEX)
          WRITE(23,15)ERRNUM,SELERR(INDEX)
 15       FORMAT(///' ERROR ',I3,1x,'in SELECT IF command: ',a)
        ELSE IF (ERRNUM.LT.800)THEN
          INDEX=ERRNUM-700
          WRITE(*,16)ERRNUM,GENERR(INDEX)
          WRITE(23,16)ERRNUM,GENERR(INDEX)
 16       FORMAT(///' ERROR ',I3,a)
        ELSE IF (ERRNUM.LT.900)THEN
          INDEX=ERRNUM-800
          WRITE(*,17)ERRNUM,COMERR(INDEX)
          WRITE(23,17)ERRNUM,COMERR(INDEX)
 17       FORMAT(///' ERROR ',I3,1x,'in COMBINE command: ',a)
        ENDIF
C
C         FATERR MEANS FATAL ERROR
C
        CALL FATERR
        END



        SUBROUTINE ERRNAM(ERRNUM,VARNAME)
C
C         THIS SUBROUTINE HANDLES THE ERROR MESSAGES IN WHICH
C         A VARIABLE NAME MUST BE WRITTEN.
C
          IMPLICIT INTEGER(A-Z)
          CHARACTER*10 VARNAME
        CHARACTER*11 COMMAND
        DIMENSION COMMAND(7)
        DATA COMMAND/'  MAKETAB ','STANDARDIZE',' DECOMPOSE',
     x   '   RECODE  ',' SELECT IF ','  WEIGHT  ','  COMBINE '/
C
C         MOST OF THE ERRORS (NUMBERS 1-7) ARE SIMPLY THAT A 
C         VARIABLE NAME WAS NOT FOUND.
C
        IF (ERRNUM.LT.100)THEN
           NUM=ERRNUM*100+150
C
C         NUM MAKES THE ERROR NUMBERS CONSISTENT WITH THOSE USED IN
C         SUBROUTINE ERROR
C
           WRITE(*,25)NUM,COMMAND(ERRNUM),VARNAME
           WRITE(23,25)NUM,COMMAND(ERRNUM),VARNAME
 25        FORMAT(//1X,'ERROR ',I3,' in ',A,' Command: Variable ',A,
     x         ' not found')
C
C         THE ONLY OTHER MESSAGE PERTAINS TO MIN AND MAX IN MAKETAB.
C
        ELSE IF (ERRNUM.EQ.251)THEN
           WRITE(*,26)ERRNUM,VARNAME
           WRITE(23,26)ERRNUM,VARNAME
 26        FORMAT(//1X,'ERROR ',I3,' in MAKETAB command: Minimum'
     X       ' and maximum for ',A10,'must be specified')
        ENDIF
        CALL FATERR
        END
 
        SUBROUTINE FATERR
C
C         THIS LITTLE ROUTINE JUST WRITES A TERMINAL MESSAGE AND DIES.
C
        WRITE(*,100)
        WRITE(23,100)
C
C  ****** WARNING: THE FOLLOWING STATEMENT WRITES THE BELL CHARACTER.
C                  THIS WILL NOT WORK ON ALL SYSTEMS.
C
ccc        WRITE(6,*)CHAR(007)
 100    FORMAT(/1X,'Error is fatal - program terminated')
        CLOSE(22,STATUS='DELETE')
ccc        CLOSE(6,STATUS='DELETE')
        STOP ' '
        END

        INTEGER FUNCTION SELECT(REC,BEG,END)
C
C  THIS FUNCTION CONVERTS SELECTED COLUMNS OF CHARACTER STRINGS INTO INTEGERS
C
        IMPLICIT INTEGER (A-Z)
        CHARACTER*500 REC
        DIMENSION DIGIT(8)
        NUMDIG=0
        DO 3 I=1,8
 3      DIGIT(I)=0
C
C ****** WARNING: THE FOLLOWING ASSUMES THAT THE SYSTEM IS RUNNING ON
C                 THE EXTENDED ASCII CHARACTER CODES.  THIS WILL HAVE 
C                 TO BE MODIFIED FOR COMPUTERS USING OTHER CODES.
C
C     CALCULATE THE VALUE OF EACH DIGIT SEPARATELY.
C
        DO 10 I=BEG,END
        C=ICHAR(REC(I:I))
C
C     CONVERT BLANKS TO ZEROS.
C
        IF (C.EQ.32)C=48
C
C     CONVERT SLASH CHARACTER TO NULL
C
        IF (C.EQ.47)C=0
C
C     IF THE CODE IS LESS THAN A PERIOD OR GREATER THAN A NINE,
C     WRITE AN ERROR MESSAGE.
C
        IF (C.LT.46.OR.C.GT.57)THEN
          WRITE(23,5)REC(I:I),ICHAR(REC(I:I)),I
          WRITE(*,5)REC(I:I),ICHAR(REC(I:I)),I
 5        FORMAT(/1X,'ERROR 7: Non-integer found where integer expected
     xin preceding command.',
     x           /10x,'The character is "',
     X       A1,'", ASCII decimal code is ',i3,' at column',i4/)
C
C     OTHERWISE, IF THE CHARACTER IS NOT A PERIOD, CONVERT IT TO 
C     THE APPROPRIATE INTEGER. IGNORE PERIODS, AND WRITE A WARNING
C     IF THE INTEGER HAS MORE THAN EIGHT CHARACTERS.
C
        ELSE IF (C.NE.46)THEN
          NUMDIG=NUMDIG+1
          IF (NUMDIG.LE.8)THEN
            DIGIT(NUMDIG)=C-48
          ELSE
            WRITE(23,6)
            WRITE(*,6)
 6          FORMAT(3X,'WARNING: Value over 8 characters truncated')
            NUMDIG=NUMDIG-1
          ENDIF
        ENDIF
 10     CONTINUE
C
C     NOW ADD UP THE DIGITS INTO A SINGLE INTEGER.
C
        SELECT=0
        DO 20 I=1,NUMDIG
        PLACE=NUMDIG-I
 20     SELECT=SELECT+DIGIT(I)*(10**PLACE)
        RETURN
        END  

        INTEGER FUNCTION SDATA(REC,BEG,END)
C
C  THIS FUNCTION CONVERTS SELECTED COLUMNS OF CHARACTER STRINGS INTO INTEGERS
C  IT IS STREAMLINED FOR SPEED
C
        IMPLICIT INTEGER (A-Z)
        CHARACTER*200 REC
        DIMENSION DIGIT(8)
        NUMDIG=0
        SDATA=0
        FACTOR=100000000
        DO 3 I=1,8
 3      DIGIT(I)=0
C
C ****** WARNING: THE FOLLOWING ASSUMES THAT THE SYSTEM IS RUNNING ON
C                 THE EXTENDED ASCII CHARACTER CODES.  THIS WILL HAVE 
C                 TO BE MODIFIED FOR COMPUTERS USING OTHER CODES.
C
C     CALCULATE THE VALUE OF EACH DIGIT SEPARATELY.
C
        DO 10 I=BEG,END
        C=ICHAR(REC(I:I))
C
C     CONVERT BLANKS TO ZEROS.
C
        IF (C.EQ.32)C=48
C
C     CONVERT SLASH CHARACTER TO NULL
C
        IF (C.EQ.47)C=0
C
C     IF THE CODE IS LESS THAN A PERIOD OR GREATER THAN A NINE,
C     WRITE AN ERROR MESSAGE.
C
        IF (C.LT.46.OR.C.GT.57)THEN
          WRITE(23,5)REC(I:I),ICHAR(REC(I:I)),I
          WRITE(*,5)REC(I:I),ICHAR(REC(I:I)),I
 5        FORMAT(/1X,'ERROR 6: Illegal character found in data.',
     x           /10x,'The character is "',
     X       A1,'", ASCII decimal Code is ',i3,' at column',i4/)
C
C     OTHERWISE, IF THE CHARACTER IS NOT A PERIOD, CONVERT IT TO 
C     THE APPROPRIATE INTEGER. IGNORE PERIODS.
C
        ELSE IF (C.NE.46)THEN
          NUMDIG=NUMDIG+1
          FACTOR=FACTOR/10
          SDATA=SDATA+(C-48)*FACTOR
          DIGIT(NUMDIG)=C-48
        ENDIF
 10     CONTINUE
C
C     NOW ADD UP THE DIGITS INTO A SINGLE INTEGER.
C
        SDATA=SDATA/FACTOR
        RETURN
        END  

        SUBROUTINE DATLIST(LIST,LEN,FILES,VARNAM,VARDES,VARNUM,
     X                     MAXNO)
C
C   THIS SUBROUTINE INTERPRETS THE DATA LIST COMMAND.  DETAILS ON VARIABLES 
C   ARE STORED IN ARRAY VARDES (VARIABLE DESCRIPTIONS) AS FOLLOWS:
C
C     VARDES: VARIABLE DESCRIPTIONS
C             ROWS  - VARIABLE NUMBER, IN ORDER SPECIFIED              
C             COL 1 - BEGINS COLUMN
C             COL 2 - ENDS COLUMN
C
C
        IMPLICIT INTEGER(A-Z)
        CHARACTER*10 VARNAM
        CHARACTER*35 FILES
        CHARACTER*500 LIST
        DIMENSION VARDES(30,5)
        DIMENSION VARNAM(30)
        DIMENSION FILES(4)
        CHR=0
        QUOTE1=0
        QUOTE2=0
C
C       FIND DATA FILE NAME
C
        BEG=0
        END=0
C
C       LOOK FOR FIRST QUOTE MARK -- IF WE GET TO THE END OF THE LINE, 
C       GO TO END
C        
 10     CHR=CHR+1
        IF (CHR.GT.LEN+1)GO TO 99
        IF (ICHAR(LIST(CHR:CHR)).NE.39)GO TO 10        
        CHR=CHR+1
        IF (CHR.GT.LEN+1)GO TO 99       
        BEG=CHR
        QUOTE1=CHR
C
C       LOOK FOR THE SECOND QUOTE THE SAME WAY
C
 11     CHR=CHR+1
        IF (CHR.GT.LEN+1)GO TO 99
        IF (ICHAR(LIST(CHR:CHR)).NE.39)GO TO 11        
        END=CHR-1
        QUOTE2=CHR
C
C       NOW STICK THE FILE NAME IN POSITION 2 OF ARRAY FILES
C 
        FILES(2)=LIST(BEG:END)

C
C       FIND SLASH
C
 12     CHR=CHR+1
        IF(CHR.GT.LEN+1)GO TO 99
        IF (LIST(CHR:CHR).NE.'/')GO TO 12
C
C       FIND EACH VARIABLE
C
        VARNUM=0
 20     CONTINUE
        VARNUM=VARNUM+1
C
C       NO MORE THAN 30 VARIABLES MAY BE DEFINED
C
        IF (VARNUM.GT.30)THEN
           CALL ERROR(101)
        ENDIF
C
C       THE CHARACTER | SERVES AS A DELIMITER (SEE SUBROUTINE GETLIST)
C       SET BEG TO NEXT CAHARACTER AFTER THE SECOND QUOTE.
C       IF IT IS A DELIMITER, GO TO THE NEXT CHARACTER.
C    
        BEG=CHR+1
        CHR=CHR+1
        IF(CHR.GT.LEN+1)GO TO 99
        IF(LIST(CHR:CHR).EQ.'|')THEN
          BEG=CHR+1
        ENDIF  
 21     CHR=CHR+1
        IF(CHR.GT.LEN+1)GO TO 99
C
C       NOW LOOK FOR NEXT DELIMITER.
C
        IF(LIST(CHR:CHR).NE.'|')GO TO 21
        END=CHR-1
C
C       THIS SHOULD DEFINE A VARIABLE NAME
C
        VARNAM(VARNUM)=LIST(BEG:END)
C
C       THE NEXT COLUMNS AFTER THE LAST DELIMITER SHOULD BE A COLUMN NUMBER.
C       IT WILL BE TERMINATED BY A DASH OR A DELIMITER
C
        BEG=CHR+1
 22     CHR=CHR+1
        IF(CHR.GT.LEN+1)GO TO 99
        IF(LIST(CHR:CHR).NE.'-'.AND.LIST(CHR:CHR).NE.'|'.AND.
     X     CHR.NE.LEN+1)GO TO 22
C
C       STICK THE COLUMN NUMBER IN THE APPROPRIATE POSITION OF 
C       ARRAY VARDES AFTER CONVERTING IT TO AN INTEGER USING 
C       FUNCTION SELECT.
C
        END=CHR-1
        VARDES(VARNUM,1)=SELECT(LIST,BEG,END)
        IF (LIST(CHR:CHR).EQ.'|'.OR.CHR.EQ.LEN+1)THEN
           VARDES(VARNUM,2)=VARDES(VARNUM,1)
           GO TO 20
        ENDIF 
C
C       IF THE COLUMN NUMBER WAS TERMINATED WITH A DASH, LOOK FOR ANOTHER.
C
        BEG=CHR+1
 23     CHR=CHR+1
        IF(CHR.GT.LEN+1)GO TO 99
        IF(LIST(CHR:CHR).NE.'|'.AND.CHR.NE.LEN+1)GO TO 23
C
C       STICK IT IN THE APPROPRIATE PLACE.
C
        END=CHR-1
        VARDES(VARNUM,2)=SELECT(LIST,BEG,END)
C
C       NOW GO UP AND LOOK FOR ANOTHER VARIABLE.
C
        GO TO 20
 99     CONTINUE
C
C       ADJUST VARNUM; WE'VE COUNTED ONE TOO MANY.
C 
        VARNUM=VARNUM-1        
C
C       NOW CHECK VALIDITY OF DATA LIST COMMAND.
C       THE FOLLOWING BLOCK CHECKS THE NUMBER OF VARIABLES, THE
C       EXISTANCE OF A SLASH, AND THE EXISTENCE AND ORDER OF
C       QUOTE MARKS.
C
       SLASH=INDEX(LIST,'/')
       IF (QUOTE2.EQ.0)THEN
          CALL ERROR(102)
       ELSE IF (QUOTE2-QUOTE1.GT.35)THEN
          CALL ERROR(102)
       ELSE IF (SLASH.EQ.0)THEN
          CALL ERROR(103)
       ELSE IF (SLASH.LT.QUOTE2)THEN
          CALL ERROR(104)
       ELSE IF (VARNUM.LT.3)THEN
          CALL ERROR(105)
       ENDIF
C
C      NOW CHECK TO SEE THAT INDICATED COLUMNS ARE LEGIT.
C
       MAXNO=0
       DO 210 I=1,VARNUM
       DIF=VARDES(I,2)-VARDES(I,1)
       IF (DIF.LT.0.OR.DIF.GT.8.OR.VARDES(I,1).EQ.0.OR.
     X                              VARDES(I,2).EQ.0)THEN
          CALL ERROR(106)
        ENDIF 
        IF(VARDES(I,2).GT.MAXNO)MAXNO=VARDES(I,2)
 210    CONTINUE
        IF (MAXNO.GT.200)THEN 
           CALL ERROR(107)
        ENDIF
        RETURN
        END



        SUBROUTINE CASECONV(LINE)
C
C       THIS SUBROUTINE CONVERTS LOWER CASE LETTERS TO CAPS
C
        IMPLICIT INTEGER(A-Z)
        CHARACTER*80 LINE
        numquot=0
        LCA=ICHAR('a')
        LCZ=ICHAR('z')
        DIFCAS=LCA-ICHAR('A')
        DO 2 I=1,80
        DECVAL=ICHAR(LINE(I:I))
        if (decval.eq.39)numquot=numquot+1
        if (numquot.ne.1)then           
          IF (DECVAL.GE.LCA.AND.DECVAL.LE.LCZ)THEN
             DECVAL=DECVAL-DIFCAS
             LINE(I:I)=CHAR(DECVAL)
          ENDIF
        endif
 2      CONTINUE
        RETURN
        END


        SUBROUTINE GETLIST(COMMAND,LIST,LEN,DONE,PG,LN,SETCMD,PRNUM)
        IMPLICIT INTEGER(A-Z)
C
C  THIS SUBROUTINE GETS A COMMAND, REMOVES THE SPACES, STICKS IT ALL IN ONE
C  BIG STRING, AND STICKS IN ALTERNATE DELIMITERS FOR SPACES.
C
        CHARACTER*3 SCRNAM
        CHARACTER*5 COMMAND
        CHARACTER*80 LINE
        CHARACTER*80 SETCMD
        CHARACTER*500 LIST
        DIMENSION SETCMD(10)
ccc        INQUIRE(UNIT=6,NAME=SCRNAM)
       SCRNAM='CON'
C
        DO 55 I=1,500
 55     LIST(I:I)=' '
        DONE=0
 1      LEN=0
        COMMAND='NULL '
C
C         READ FIRST LINE OF COMMAND
C
        IF (PRNUM.LT.10)THEN
           PRNUM=PRNUM+1
           LINE=SETCMD(PRNUM)
        ELSE
           READ(3,10,END=50)LINE
        ENDIF
 10     FORMAT(A80)
C
C         CONVERT LOWER CASE TO CAPS ON FIRST LINE OF COMMAND
C 
        CALL CASECONV(LINE)
C
C           SKIP THE LINE IF IT IS A COMMENT OR BLANK, BUT
C           ECHO IT TO THE FILE IF IT BEGINS WITH AN ASTERISK
C
        IF (LINE(1:1).EQ.'*')THEN
           CALL PAGE(PG,LN)
           WRITE(23,12)LINE(1:79)
           GO TO 1
        ENDIF
        IF (LINE(1:1).EQ.'['.OR.LINE(1:50).EQ.
     X  '                                                  ')
     X  GO TO 1
C
C           ECHO LINE TO OUTPUT FILE AND SCREEN.  IF THIS IS THE
C           FIRST LINE ON A PAGE, SKIP A SPACE.
C
C           SUBROUTINE PAGE CONTROLS PAGE NUMBERS AND HEADERS.
C
        CALL PAGE(PG,LN)
        IF (LN.EQ.1)THEN
           LN=LN+1
           WRITE(23,*)
        ENDIF  
        WRITE(23,12)LINE(1:79)
        IF(SCRNAM.EQ.'CON')WRITE(*,11)LINE(1:79)
 11     FORMAT(1X,A79)
 12     FORMAT(A79)
C
C           CHECK FOR SOME ALTERNATE COMMAND FORMS
C
        COMMAND=LINE(1:5)
        IF (COMMAND.EQ.'DATAL')THEN
           COMMAND='DATA '
        ELSE IF (COMMAND.EQ.'MAKE ')THEN
           COMMAND='MAKET'
        ELSE IF (COMMAND.EQ.'SETLI')THEN
           COMMAND='SET L'
        ELSE IF (COMMAND.EQ.'SETRE')THEN
           COMMAND='SET R'
        ENDIF
C
C           DO NO ALTERATIONS FOR SET LISTING, SET RESULTS,
C           OR WEIGHT COMMANDS
C
        IF (COMMAND.EQ.'SET L'.OR.
     X      COMMAND.EQ.'SET R'.OR.COMMAND.EQ.'WEIGH')THEN
           LIST(1:80)=LINE
           GO TO 99
        ENDIF
C
C          CHANGE SPACE DELIMITERS TO ~ IN SELECT IF COMMAND 
C
C  ****** WARNING: THE ~ CHARACTER IS NOT AVAILABLE ON SOME SYSTEMS.
C         YOU MAY HAVE TO CHANGE IT FOR SOMETHING ELSE
C       
        IF (COMMAND.EQ.'SELEC')THEN
           BEG=INDEX(LINE,' GE ')
           END=BEG+3
           IF (BEG.GT.0)LINE(BEG:END)='~GE~'
           BEG=INDEX(LINE,' GT ')
           END=BEG+3
           IF (BEG.GT.0)LINE(BEG:END)='~GT~'
           BEG=INDEX(LINE,' LE ')
           END=BEG+3
           IF (BEG.GT.0)LINE(BEG:END)='~LE~'
           BEG=INDEX(LINE,' LT ')
           END=BEG+3
           IF (BEG.GT.0)LINE(BEG:END)='~LT~'
           BEG=INDEX(LINE,' EQ ')
           END=BEG+3
           IF (BEG.GT.0)LINE(BEG:END)='~EQ~'
           BEG=INDEX(LINE,' NE ')
           END=BEG+3
           IF (BEG.GT.0)LINE(BEG:END)='~NE~'
         ENDIF 
C             
C        CHANGE SPACE DELIMITERS IN DATA LIST COMMAND TO |
C        ALSO CHANGE PERIOD IN FILENAME IN DATA LIST COMMAND TO A ^, 
C        IN ORDER TO AVOID CONFUSION WITH THE END-OF-COMMAND PERIOD.
C
C  ****** WARNING: THE | CHARACTER IS NOT AVAILABLE ON SOME SYSTEMS.
C         YOU MAY HAVE TO CHANGE IT FOR SOMETHING ELSE
C       
C
        QUOTE1=0
        QUOTE2=0
 4      DO 20 I=1,80
          IF (COMMAND.EQ.'DATA '.AND.I.LT.80)THEN
             IF (I.EQ.1)THEN
                 LEN=LEN+1
                 LIST(LEN:LEN)='|'
             ENDIF
             IF(LINE(I:I).EQ.' '.AND.LINE(I+1:I+1).NE.' ')THEN
               LINE(I:I)='|'
             ENDIF
          ENDIF
          IF (LINE(I:I).EQ.''''.AND.QUOTE1.EQ.0)THEN
             QUOTE1=I
          ELSE IF (LINE(I:I).EQ.''''.AND.QUOTE1.NE.0)THEN
             QUOTE2=I
          ELSE IF (LINE(I:I).EQ.'.'.AND.QUOTE1.NE.0.AND.QUOTE2.EQ.0)
     X      THEN
              LINE(I:I)='^'
          ELSE IF (LINE(I:I).EQ.'|'.AND.QUOTE1.NE.0.AND.QUOTE2.EQ.0)
     X      THEN
              LINE(I:I)=' '
          ENDIF
C
C   NOW MOVE THE COLUMN FROM STRING LINE TO THE APPROPRIATE POSITION IN
C   THE STRING LIST.  MAXIMIMUM COMMAND LENGTH IS 500 CHARACTERS, ONCE
C   THE SPACES ARE REMOVED.
C
          IF(LINE(I:I).EQ.'.')THEN
             GO TO 99
          ELSE IF(LINE(I:I).NE.' ')THEN
            LEN=LEN+1
            IF (LEN.GT.499)THEN
              CALL ERROR(701)
            ENDIF
            LIST(LEN:LEN)=LINE(I:I)
          ENDIF
 20     CONTINUE
C
C         READ NEXT LINE OF THE COMMAND.
C
 21    IF (PRNUM.LT.10)THEN
           PRNUM=PRNUM+1
           LINE=SETCMD(PRNUM)
        ELSE
           READ(3,10,END=50)LINE
        ENDIF
C
C         CONVERT LOWER CASE TO CAPS FOR SUBSEQUENT LINES
C
        CALL CASECONV(LINE)
C
C         SKIP COMMENTS
C
        IF (LINE(1:1).EQ.'*')THEN
           CALL PAGE(PG,LN)
           WRITE(23,12)LINE(1:79)
           GO TO 21
        ENDIF
        IF (LINE(1:1).EQ.'['.OR.LINE(1:50).EQ.
     X  '                                                  ')
     X  GO TO 21
C
C           ECHO LINE TO OUTPUT FILE AND SCREEN
C
        CALL PAGE(PG,LN)
        WRITE(23,12)LINE(1:79)
        IF(SCRNAM.EQ.'CON')WRITE(*,11)LINE(1:79)

        GO TO 4
 50     DONE=1  
 99     CONTINUE
        RETURN
        END



       SUBROUTINE GET (LINE,MAXNO,DONE)
       IMPLICIT INTEGER (A-Z)
C
C  THIS SUBROUTINE GETS DATA STRINGS.
C
       CHARACTER*200 LINE
       READ(8,11,END=25)LINE(1:MAXNO)
 11    FORMAT(A)
       RETURN
C 
C   IF THE END OF THE DATA FILE IS ENCOUNTERED, SO INDICATE.
C
 25    DONE=1
       RETURN
       END


       SUBROUTINE TAB (VARDES,RECODE,SELDES,COMDES,TRATAB,FILES,MAXNO,
     X         VARNAM,TRANUM,VARNUM,WTDIG,DEPDIG,WRTAB,WTDIV,PG,LN)
C
C  THIS IS THE MAIN TABULATION ROUTINE.
C
        IMPLICIT INTEGER(A-Z)
        INTEGER*4 I,J,K,L,M
        REAL TABLE, WT, TNUM, TDEN
        CHARACTER*3 SCRNAM
        CHARACTER*10 VARNAM
        CHARACTER*10 INDNAM
        CHARACTER*10 BADVAR
        CHARACTER*35 FILES
        CHARACTER*200 RECORD

        DIMENSION VARVAL(30)
        DIMENSION VARDES(30,5)
        DIMENSION VARNAM(30)
        DIMENSION FILES(4)
        DIMENSION RECODE(200,4)
        DIMENSION SELDES(50,3)
        DIMENSION COMDES(10,5)
        DIMENSION TRATAB(300,2)
        DIMENSION INDVAL(5)
        DIMENSION INDNAM(5)
        DIMENSION WRFORM(7,2)
        COMMON /TABS/ TABLE(64000,2),MAXVARS(5)

C       INITIALIZE WORKING TABLES

        DO 1 I=1,64000
        TABLE(I,1)=0.0
 1      TABLE(I,2)=0.0
        DO 9 I=1,5
 9      MAXVARS(I)=1
C
C       SET WARNING COUNT TO ZERO
C
        WARN=0
C
C       CALCULATE MAXIMUM RANGE OF EACH INDEPENDENT VARIABLE,
C       AND STICK IT IN ARRAY MAXVARS.
C       COUNT INDEPENDENT VARIABLES AND STORE THEIR NAMES IN 
C       ARRAY INDNAM, AND LOCATE THE POSITION OF THE DEPENDENT 
C       VARIABLE AND THE WEIGHT VARIABLE, IF IT EXISTS.
C
C  ****** WARNING: SOME COMPILERS GET UPSET WHEN YOU MIX INTEGER*2 AND
C         INTEGER*4 VARIABLES IN A DO STATEMENT.  THIS IS DONE OFTEN
C         IN THIS ROUTINE
C
        WTPOS=999
        DEPPOS=999
        NUMIND=0
        DO 10 I=1,VARNUM
        IF(VARDES(I,5).GT.1.AND.VARDES(I,5).LE.6)THEN        
          MAXVARS(VARDES(I,5)-1)=VARDES(I,4)-VARDES(I,3)+1
          INDNAM(VARDES(I,5)-1)=VARNAM(I)
          NUMIND=NUMIND+1
        ELSE IF(VARDES(I,5).EQ.1)THEN
          DEPPOS=I
        ELSE IF (VARDES(I,5).EQ.7)THEN
          WTPOS=I
        ENDIF
 10     CONTINUE
C
C       MAKE SURE THE DEPENDENT VARIABLE IS PROPERLY 
C       IDENTIFIED
C        
        IF(DEPPOS.EQ.999)CALL ERROR(212)
C
C       SEE IF THE TABLE WILL EXCEED THE SIZE LIMIT.
C
        BIGGEST=MAXVARS(1)*MAXVARS(2)*MAXVARS(3)*MAXVARS(4)
     X             *MAXVARS(5)
        IF(BIGGEST.GT.64000)CALL ERROR(211)
C
C       CALCULATE DIVISION FACTOR RELEVANT TO WTDIG (WEIGHT), 
C       BASED ON THE NUMBER OF DIGITS TO THE RIGHT OF THE DECIMAL
C       POINT.
C
        WTDIV=1
        IF (WTDIG.EQ.1)THEN
           WTDIV=10
        ELSE IF (WTDIG.GT.1)THEN
           WTDIV=10**WTDIG
        ENDIF
C
C       DO THE SAME FOR DEPDIG (DEPENDENT VARIABLE DIVISION FACTOR)
C
        DEPDIV=1
        IF (DEPDIG.EQ.1)THEN
           DEPDIV=10
        ELSE IF (DEPDIG.GT.1)THEN
           DEPDIV=10**DEPDIG
        ENDIF
C
C       OPEN RAW DATA FILE AND INITIALIZE READ SUBROUTINE
C
C  ****** WARNING: MOST COMPILERS WILL NOT ACCEPT THE BLOCKSIZE
C         OPTION ON THE OPEN COMMAND.
C
        OPEN (8,FILE=FILES(2),STATUS='OLD',ERR=20)
        DONE=0
C
C       IF THE RAW DATA FILE WAS NOT FOUND, WRITE ERROR MESSAGE
C
        GO TO 21
 20     CONTINUE           
        CALL ERROR(108)
 21     CONTINUE
C
C       BEGIN PROCESSING
C       BEGIN MAIN LOOP.  FIRST SKIP A COUPLE LINES ON THE SCREEN,
C       AND WRITE THE CASE NUMBER EVERY 100 LINES READ.
C
        SCRNAM='CON'
ccc        INQUIRE(UNIT=6,NAME=SCRNAM)
        IF(SCRNAM.EQ.'CON')WRITE(*,29)
  29    FORMAT(/)
        REWIND 8

        DO 801 CASE=1,50000
        IF(SCRNAM.EQ.'CON')WRITE(*,30)CASE*100000-100000
  30    FORMAT('Case',I10)
        DO 800 NUM=1,100000
C
C       SUBROUTINE GET PUTS THE DATA INTO THE STRING  "RECORD"
C       WHEN DONE, JUMP OUT OF LOOP.
C
        CALL GET (RECORD,MAXNO,DONE)
        IF(DONE.EQ.1)GO TO 850
C
C       CONVERT VARIABLES TO INTEGERS, USING FUNCTION "SDATA"
C
        DO 50 I=1, VARNUM
        IF(VARDES(I,1).NE.9999)THEN
          IF(VARDES(I,3).EQ.0.AND.VARDES(I,4).EQ.0)VARDES(I,3)=1
          VARVAL(I)=SDATA(RECORD,VARDES(I,1),VARDES(I,2))
        ENDIF
 50     CONTINUE
C
C       DO TRANSFORMATIONS
C
        CALL TRANS (TRATAB,TRANUM,SELDES,RECODE,COMDES,VARVAL,
     X                  VARDES,VARNUM,RANGE,QUIT)
C
C       IF THIS CASE SHOULD BE SKIPPED BECAUSE OF A SELECT IF
C       COMMAND, JUMP TO THE END OF THE LOOP.
C        
        IF (QUIT.EQ.1)GO TO 800
C
C       FIND DEPENDENT VARIABLE, INDEPENDENT VARIABLES,
C       WEIGHT, AND POPULATION DEFINITION VARIABLE.
C       PUT THE VALUE OF THE INDEPENDENT VARIABLES IN
C       ARRAY INDVAL, AND THE OTHERS IN DEPVAL AND WTVAL.
C
        WTVAL=1
        DO 79 I=1,5
 79     INDVAL(I)=1
C
C       
        DEPVAL=VARVAL(DEPPOS)
        IF(WTPOS.LE.VARNUM)WTVAL=VARVAL(WTPOS)
        DO 80 I=1,VARNUM
        IF (VARDES(I,5).GE.2.AND.VARDES(I,5).LE.6)
     X             INDVAL(VARDES(I,5)-1)=VARVAL(I)
 80     CONTINUE             
C
C       INSURE THAT THE VALUES OF THE INDEPENDENT VARIABLES FALL
C       WITHIN SPECIFIED RANGE, AND WRITE WARNING IF NOT.
C
        DO 90 I=1,NUMIND
        IF (INDVAL(I).LT.1.OR.INDVAL(I).GT.MAXVARS(I).OR.RANGE.GT.0)
     X                                                           THEN
           WARN=WARN+1
           LN=LN+4
           CALL PAGE(PG,LN)          
           BADVAR=INDNAM(I)
           IF (RANGE.GT.0)BADVAR=VARNAM(RANGE)
           WRITE(23,89)BADVAR,CASE*100-100+NUM           
           WRITE(*,89)BADVAR,CASE*100-100+NUM
           
 89        FORMAT(/
     X           3X,'WARNING: Variable ',a10,'outside ',
     X     'specified range at case number ',i6,
     X          /'            Case ignored'//)
           IF (WARN.GT.25)CALL ERROR(706)     
           GO TO 800
        ENDIF          
 90     CONTINUE
C
C       CALCULATE WEIGHT
C
        WT=FLOAT(WTVAL)/FLOAT(WTDIV)
C      
C       CALCULATE TABULATION INDEX AND TABULATE.  FUNCTION IND WILL
C       GENERATE THE INDEX.
C        
        A=INDVAL(1)
        B=INDVAL(2)
        C=INDVAL(3)
        D=INDVAL(4)
        E=INDVAL(5)
        INDEX=IND(A,B,C,D,E)
        TABLE(INDEX,2)=TABLE(INDEX,2)+WT
        TABLE(INDEX,1)=TABLE(INDEX,1)+(FLOAT(DEPVAL)/FLOAT(DEPDIV))*WT
 800    CONTINUE
 801    CONTINUE
 850    CONTINUE
C
C       IF THE USER HAS SPECIFIED THE WRITE TABLE OPTION, CALL SUBROUTINE
C       TO PREPARE FOR IT.
C
        IF(WRTAB.GT.0)CALL WRPREP (VARNUM,VARDES,WRFORM,FILES,
     X     NUMIND,INDNAM,WTDIG,PG,LN)
C
C       WRITE TABULATED DATA TO TEMPORARY WORK FILE FOR LATER USE
C
C ****** WARNING: MOST COMPILERS WILL NOT ACCEPT THE BLOCKSIZE OPTION,
C        AND SOME DON'T LIKE FILENAME EXTENSIONS OR BINARY FILES.  
C        IF BINARY FILES ARE NOT ALLOWED, USE UNFORMATTED.
C
        OPEN(22,FILE='WRKFILE.TMP',FORM='UNFORMATTED')
        REWIND 22 
        DO 900 I=1,MAXVARS(1)
        DO 900 J=1,MAXVARS(2)
        DO 900 K=1,MAXVARS(3)
        DO 900 L=1,MAXVARS(4)
        DO 900 M=1,MAXVARS(5)
        A=I
        B=J
        C=K
        D=L
        E=M
        INDEX=IND(A,B,C,D,E)
        IF (TABLE(INDEX,2).GT.0.0)THEN
           WRITE(22)I,J,K,L,M,TABLE(INDEX,1),TABLE(INDEX,2)
C
C    WRITE ASCII FILE IF WRITE TABLE OPTION IS SPECIFIED
C    (FIRST CONVERT INDEPENDENT VALUES)
C
           IF (WRTAB.GT.0)THEN
              TNUM=TABLE(INDEX,1)
              TDEN=TABLE(INDEX,2)
              CALL WRDATA(VARNUM,VARDES,WRFORM,I,J,K,L,M,
     X                  NUMIND,WTDIG,WTDIV,TNUM,TDEN)
           ENDIF  
        ENDIF         

 900    CONTINUE
  
        RETURN
        END



        SUBROUTINE TRANS (TRATAB,TRANUM,SELDES,RECODE,COMDES,VARVAL,
     X                        VARDES,VARNUM,RANGE,QUIT)
        IMPLICIT INTEGER(A-Z)
C
C   THIS SUBROUTINE CARRIES OUT THE DATA TRANSFORMATIONS.
C 
        DIMENSION VARVAL(30)
        DIMENSION RECODE(200,4)
        DIMENSION SELDES(50,3)
        DIMENSION COMDES(10,5)
        DIMENSION TRATAB(300,2)
        DIMENSION VARTEM(30)
        DIMENSION VARDES(30,5)
        DIMENSION COMVAL(4,2)
C
C       MOVE VALUES TO ARRAY VARTEM TEMPORARILY
C     
        DO 49 I=1,VARNUM
 49     VARTEM(I)=VARVAL(I)
C
C       INITIALIZE FLAGS.
C
        RANGE=0
        QUIT=0
        DO 50 T=1,TRANUM
C
C       FOR EACH TRANSFORMATION, FIND OUT WHAT TYPE IT IS AND DO IT.
C
        IF(TRATAB(T,1).EQ.1)THEN
C        
C       DO SELECT IFS (SEE SELDES DESCRIPTIONS)
C          
          S=TRATAB(T,2)
          IF (SELDES(S,2).EQ.1)THEN
            IF(VARTEM(SELDES(S,1)).NE.SELDES(S,3))QUIT=1
          ELSE IF (SELDES(S,2).EQ.2)THEN
            IF(VARTEM(SELDES(S,1)).LE.SELDES(S,3))QUIT=1         
          ELSE IF (SELDES(S,2).EQ.3)THEN
            IF(VARTEM(SELDES(S,1)).GE.SELDES(S,3))QUIT=1         
          ELSE IF (SELDES(S,2).EQ.4)THEN
            IF(VARTEM(SELDES(S,1)).LT.SELDES(S,3))QUIT=1         
          ELSE IF (SELDES(S,2).EQ.5)THEN
            IF(VARTEM(SELDES(S,1)).GT.SELDES(S,3))QUIT=1         
          ELSE IF (SELDES(S,2).EQ.6)THEN
            IF(VARTEM(SELDES(S,1)).EQ.SELDES(S,3))QUIT=1         
          ENDIF

        ELSE IF (TRATAB(T,1).EQ.2.AND.QUIT.EQ.0)THEN
C
C       DO RECODES (SEE RECODE DESCRIPTIONS)
C
          R=TRATAB(T,2)
          IF (VARVAL(RECODE(R,1)).GE.RECODE(R,2).AND.
     X        VARVAL(RECODE(R,1)).LE.RECODE(R,3))
     X        VARTEM(RECODE(R,1))=RECODE(R,4)
C
C       DO COMBINATIONS.  THIS IS A LITTLE MORE COMPLICATED.
C       A NEW VARIABLE IS CREATED FROM UP TO FOUR OTHERS.
C
        ELSE IF (TRATAB(T,1).EQ.3.AND.QUIT.EQ.0)THEN
           COMNUM=TRATAB(T,2)
C
C       ARRAY COMVAL (4,2) WILL HOLD THE VALUES AND RANGES OF 
C       THESE VARIABLES.  THE ROWS INDICATE VARIABLE NUMBERS, 
C          COLUMN 1 WILL CONTAIN THE RANGES OF THESE VARIABLES;
C          COLUMN 2 WILL CONTAIN THEIR VALUES.      
C
C       VARIABLE LOC INDICATES POSITION IN VARDES OF THE CURRENT 
C       VARIABLE TO BE COMBINED
C
C       VARIABLE RANGE WILL BE SET TO THE CURRENT VARIABLE NUMBER 
C       IF THE VALUE OF THE VARIABLE IS OUT OF THE SPECIFIED MINIMUM
C       OR MAXIMUM.
C
C
C       THE FOLLOWING LOOP LOCATES RANGES AND VALUES AND STICKS THEM
C       IN ARRAY COMVAL
C
           DO 40 C=1,4
           COMVAL(C,1)=1
           COMVAL(C,2)=1
           LOC=30
           IF (COMDES(COMNUM,C).NE.99)THEN
              LOC=COMDES(COMNUM,C)
              COMVAL(C,1)=VARDES(LOC,4)-VARDES(LOC,3)+1
              IF (VARTEM(LOC).LT.VARDES(LOC,3).OR.VARTEM(LOC).GT.
     X            VARDES(LOC,4))THEN
                  RANGE=LOC
              ENDIF
              COMVAL(C,2)=VARTEM(LOC)-VARDES(LOC,3)+1
           ENDIF
 40        CONTINUE
C
C      FUNCTION IND2 WILL CALCULATE THE NEW VALUE OF THE COMBINED
C      VARIABLE, BASED ON THE VALUES AND RANGES DETERMINED ABOVE.
C      THE NEW VALUE IS PLACED IN THE INDICATED POSITION FOR THE NEW
C      VARIABLE.
C
           NEWLOC=COMDES(COMNUM,5)
           VARTEM(NEWLOC)=IND2(COMVAL(4,2),COMVAL(3,2),COMVAL(2,2),
     X            COMVAL(1,2),COMVAL(4,1),COMVAL(3,1),COMVAL(2,1))
           VARVAL(NEWLOC)=VARTEM(NEWLOC)
        ENDIF
C
C       TRANSFORMATION LOOP ENDS HERE
C
 50     CONTINUE 
C
C       RETURN VALUES FROM VARTEM TO VARVAL
C
        DO 71 I=1,VARNUM
 71     VARVAL(I)=VARTEM(I)-VARDES(I,3)+1

        RETURN
        END




        SUBROUTINE SET(COMMAND,LIST,FILES,PG,LN)
C
C   THIS SUBROUTINE INTERPRETS THE SET COMMANDS.  
C
        IMPLICIT INTEGER(A-Z)
        CHARACTER*5 COMMAND
        CHARACTER*35 FILES
        CHARACTER*500 LIST
        DIMENSION FILES(4)
C
C       FIND QUOTATION MARKS
C
        QUOTE1=0
        QUOTE2=0
        DO 20 I=1,80
        IF (LIST(I:I).EQ.''''.AND.QUOTE1.EQ.0)THEN
           QUOTE1=I
        ELSE IF (LIST(I:I).EQ.''''.AND.QUOTE1.NE.0)THEN
           QUOTE2=I
        ENDIF
 20     CONTINUE
C
C       IF THEY ARE NOT BOTH FOUND, WRITE ERROR MESSAGE
C
        IF(QUOTE1.EQ.0.OR.QUOTE2.EQ.0.OR.QUOTE1+1.EQ.QUOTE2)THEN
          LN=LN+2
          CALL PAGE(PG,LN)
C
C  ****** WARNING: THE FOLLOWING STATEMENT WRITES THE BELL CHARACTER.
C                  THIS WILL NOT WORK ON ALL SYSTEMS.
C
ccc          WRITE(6,*)CHAR(007)
          WRITE(23,29)
          WRITE(*,29)
 29       FORMAT(/1X,'ERROR 4 in SET command: Command ignored'/)
          RETURN
        ENDIF
C
C       OTHERWISE, GET NEW NAME AND STICK IT IN THE APPROPRIATE
C       POSITION OF ARRAY FILES
C           POSITION 3 FOR SET LISTING COMMAND
C           POSITION 4 FOR SET RESULTS COMMAND
C
        BEG=QUOTE1+1
        END=QUOTE2-1
        FNUM=3
        IF (COMMAND.EQ.'SET R')FNUM=4
        FILES(FNUM)=LIST(BEG:END)
        RETURN
        END




 

 
        SUBROUTINE RECDAT(LIST,LEN,RECODE,VARNAM,RECNUM,TRATAB,TRANUM)
C
C   THIS SUBROUTINE INTERPRETS THE RECODE COMMAND.  THE RECODES ARE STORED
C   IN THE ARRAY RECODE, AS FOLLOWS:
C
C      RECODE: RECODE DESCRIPTIONS
C              ROWS  - RECODE NUMBER
C              COL 1 - VARIABLE NUMBER
C              COL 2 - GE VALUE
C              COL 3 - LE VALUE
C              COL 4 - NEW VALUE
C
        IMPLICIT INTEGER(A-Z)
        CHARACTER*10 VARNAM
        CHARACTER*500 LIST
        CHARACTER*10 THISV
        DIMENSION RECODE(200,4)
        DIMENSION TRATAB(300,2)
        DIMENSION VARNAM(30)
C
C       FIND FIRST VARIABLE NAME; IT SHOULD BEGIN RIGHT AFTER THE 
C       KEYWORD RECODE, AND END RIGHT BEFORE THE FIRST (.
C
        CHR=INDEX(LIST,'RECODE')+6
        BEG=CHR
 10     CHR=CHR+1
        IF (CHR.GT.LEN+1)GO TO 99
        IF (LIST(CHR:CHR).NE.'(')GO TO 10        
        END=CHR-1
C
C       STICK THE VARIABLE NAME IN STRING THISV, AND CHECK TO MAKE
C       SURE IT WAS DEFINED IN THE DATA LIST COMMAND.
C       IF NOT, WRITE AN ERROR MESSAGE.
C
        THISV=LIST(BEG:END)
        VARNUM=0
        DO 11 I=1,30
 11     IF(THISV.EQ.VARNAM(I))VARNUM=I
C
C       START FINDING RECODES. INCREMENT RECODE NUMBER 
C       AND TRANSFORMATION NUMBER.
C
 20     RECNUM=RECNUM+1
        TRANUM=TRANUM+1
C
C       NO MORE THAN 200 RECODES ALLOWED.
C
        IF (RECNUM.GT.200)THEN
           CALL ERROR(501)
        ENDIF
C 
C       FILL IN THE RECODE VARIABLE NUMBER AND SET RANGES TO -9999999
C       TEMPORARILY. FILL IN THE TRANSFORMATION TYPE AND RECODE NUMBER
C       IN THE TRANSFORMATION TABLE.
C 
        RECODE(RECNUM,1)=VARNUM        
        RECODE(RECNUM,3)=-99999999
        RECODE(RECNUM,4)=-99999999 
        TRATAB(TRANUM,1)=2
        TRATAB(TRANUM,2)=RECNUM
C
C       NOW MOVE TO THE COLUMN AFTER THE (. THIS IS WHERE THE FIRST
C       VALUE SHOULD APPEAR.
C    
 19     CHR=CHR+1
        IF (CHR.GT.LEN+1)GO TO 99       
        IF (LIST(CHR:CHR).EQ.'(')GO TO 19
        BEG=CHR
C
C       NOW LOOK FOR A CHARACTER THAT WILL INDICATE THE COLUMN
C       RIGHT AFTER THE END OF THE VALUE.
C
 21     CHR=CHR+1
        IF (CHR.GT.LEN+1)GO TO 99
        IF (LIST(CHR:CHR).NE.','.AND.LIST(CHR:CHR).NE.'-'.AND.
     X      LIST(CHR:CHR).NE.'='.AND.LIST(CHR:CHR).NE.'T'.AND.
     X      LIST(CHR:CHR).NE.'E')GO TO 21
C
C       IF THE USER TRIED TO USE AN "ELSE" OPERATOR, 
C       WRITE AN ERROR MESSAGE.  
C 
        IF (LIST(CHR:CHR).EQ.'E')THEN
          IF (LIST(CHR:CHR+3).EQ.'ELSE')THEN
              CALL ERROR(504)
          ELSE
              CALL ERROR(506)
          ENDIF
        ENDIF   
C
C       CONVERT THE VALUE TO AN INTEGER WITH FUNCTION SELECT,
C       AND STICK IT IN THE APPROPRIATE POSITION OF ARRAY RECODE.
C
        END=CHR-1
        RECODE(RECNUM,2)=SELECT(LIST,BEG,END)
C
C       IF WE ARE DONE WITH THE VALUES (AS INDICATED BY THE 
C       PRESENCE OF AN EQUALS SIGN), JUMP TO 40 TO LOOK FOR NEW 
C       VALUE.
C       
        IF (LIST(CHR:CHR).EQ.'=')GO TO 40
C
C       IF THIS IS A "THRU", FIND THE "U'.
C        
        IF (LIST(CHR:CHR).EQ.'T')THEN
 22        CHR=CHR+1
           IF(CHR.GT.LEN+1)GO TO 99
           IF(LIST(CHR:CHR).NE.'U')GO TO 22
        ENDIF   
C
C       IF THE COMMAND INDICATES A RANGE OF VALUES, FIND THE 
C       SECOND VALUE. STICK IT IN THE APPROPRIATE POSITION OF 
C       RECODE.  IF THE END OF THE VALUE IS DEFINED BY AN EQUALS
C       SIGN, JUMP TO 40
C
        BEG=CHR+1
        IF (LIST(CHR:CHR).EQ.'U'.OR.LIST(CHR:CHR).EQ.'-')THEN
 23        CHR=CHR+1
           IF(CHR.GT.LEN+1)GO TO 99
           IF(LIST(CHR:CHR).NE.','.AND.LIST(CHR:CHR).NE.'=')GO TO 23
           END=CHR-1
           RECODE(RECNUM,3)=SELECT(LIST,BEG,END)
           IF(LIST(CHR:CHR).EQ.'=')GO TO 40
        ENDIF
C
C       SINCE WE HAVE NOT YET ENCOUNTERED AN EQUALS SIGN, GO LOOK
C       FOR MORE VALUES.
C          
        GO TO 20
 40     CONTINUE
C
C       NOW FIND THE NEW VALUE. IF WE ENCOUNTER A "(" OR A "="
C       BEFORE WE ENCOUNTER A ")", THERE IS A SYNTAX ERROR;
C       WRITE A MESSAGE.
C
        BEG=CHR+1
 42     CHR=CHR+1              
        IF(CHR.GT.LEN+1)GO TO 99
        IF(LIST(CHR:CHR).EQ.'('.OR.LIST(CHR:CHR).EQ.'=')THEN
          CALL ERROR(502)
        ENDIF
C
C       STICK THE NEW VALUE IN ITS APPROPRIATE SPOT.
C 
        IF(LIST(CHR:CHR).NE.')')GO TO 42
        END=CHR-1
        RECODE(RECNUM,4)=SELECT(LIST,BEG,END)
C
C       WE ARE DONE WITH THIS SET OF PARENTHESES; GO LOOK TO 
C       SEE IF THERE ARE MORE, AND PROCESS THEM IF NECESSARY.
C
        GO TO 20
 99     RECNUM=RECNUM-1
        TRANUM=TRANUM-1
C
C       NOW FILL IN THE CELLS OF RECODE THAT HAVE NOT YET
C       BEEN ASSIGNED.  IF A MAXIMIMUM OF A RANGE WAS NOT
C       ASSIGNED, IT IS THE SAME AS THE MINIMUM.
C       IF A NEW VALUE WAS NOT ASSIGNED, IT IS THE SAME AS
C       THE LAST NEW VALUE ASSIGNED WITHIN ANY GIVEN SET OF
C       PARENTHESES.
C  
        DO 100 I=1,RECNUM
        P=RECNUM-I+1
        IF (RECODE(I,3).EQ.-99999999)RECODE(I,3)=RECODE(I,2)
 100    IF (RECODE(P,4).EQ.-99999999)RECODE(P,4)=RECODE(P+1,4)
C
C       CHECK FOR RECODE ERRORS: 
C       --THE LOWER BOUND OF A RANGE OF VALUES MAY NOT BE 
C         GREATER THAN THE UPPER BOUND
C       --ALL VARIABLES MUST HAVE APPEARED IN DATA LIST
C       --THE STATEMENT MUST END WITH A ")."
C
        DO 220 I=1,RECNUM
        IF (RECODE(I,2).GT.RECODE(I,3))THEN
          CALL ERROR(503)
        ENDIF
        IF (RECODE(I,1).EQ.0)THEN
          CALL ERRNAM(4,THISV)
        ENDIF
220    CONTINUE
       IF(LIST(LEN:LEN).NE.')')THEN
         CALL ERROR(505)
       ENDIF   
       RETURN
       END



        SUBROUTINE STDDAT (LIST,LEN,VARNAM,VARDES,VARNUM,NUMBRK,BRKLOC,
     X                  NUMSTD,STDLOC,STPOP,STCAT,FORM,WREX)
C
C       THIS SUBROUTINE INTERPRETS THE STANDARDIZE COMMAND.
C
        IMPLICIT INTEGER(A-Z)
        CHARACTER*10 VARNAM
        CHARACTER*10 THISV,POP1N,POP2N
        CHARACTER*500 LIST
        DIMENSION VARDES(30,5)
        DIMENSION VARNAM(30)
        DIMENSION BRKLOC(5)
        DIMENSION STDLOC(5)
C
C       INITIALIZE NUMBER OF BREAKDOWN VARIABLES AND NUMBER
C       OF STANDARDIZE VARIABLES
C
        NUMBRK=0
        NUMSTD=0
C
C       LOOK FOR "BREAKDOWN=" OR "BREAK=".  IF THERE IS SOMETHING
C       WRONG WITH THE SYNTAX HERE, WRITE AN ERROR MESSAGE.
C
        CHR=INDEX(LIST,'BREAKDOWN=')+10
        IF(CHR.EQ.10)THEN
           CHR=INDEX(LIST,'BREAK=')+6
           IF (CHR.EQ.6)THEN
              IF(INDEX(LIST,'BREAK').GT.0)THEN
                CALL ERROR(311)
              ELSE
                CALL ERROR(312)
              ENDIF
           ENDIF
        ENDIF
C
C       THE LIST OF BREAKDOWN VARIABLES SHOULD BEGIN AT THIS COLUMN.
C
        BEG=CHR
C
C       LOOK FOR A COMMA OR A SLASH, WHICH WILL INDICATE THE END
C       OF THE VARIABLE NAME.
C
 10     CHR=CHR+1
        IF (CHR.GT.LEN+1)GO TO 99
        IF (LIST(CHR:CHR).NE.','.AND.LIST(CHR:CHR).NE.'/')GO TO 10
        END=CHR-1
        THISV=LIST(BEG:END)
C
C       SEARCH FOR VARIABLE NUMBER
C
        BRKNUM=0
        DO 11 I=1,VARNUM
 11     IF(THISV.EQ.VARNAM(I))BRKNUM=I
C
C       IF THE VARIABLE WAS NOT FOUND, WRITE AN ERROR MESSAGE.
C
        IF (BRKNUM.EQ.0)THEN
           CALL ERRNAM(2,THISV)
         ENDIF
C
C       IF THE VARIABLE WAS PREVIOUSLY SPECIFIED AS THE WEIGHT 
C       VARIABLE, WRITE AN ERROR MESSAGE.
C
        IF (VARDES(BRKNUM,5).EQ.7)THEN
           CALL ERROR(301)
        ENDIF
C
C       INCREMENT NUMBER OF BREAKDOWN VARIABLES.
C       IF MORE THAN FIVE SPECIFIED, WRITE ERROR MESSAGE.
C
        NUMBRK=NUMBRK+1
        IF (NUMBRK.GT.5)THEN
           CALL ERROR(302)
        ENDIF
C
C       CHECK TO ENSURE THAT THE VARIABLE WAS MENTIONED IN
C       THE PRECEDING MAKETAB COMMAND.
C
        MLOC=VARDES(BRKNUM,5)-1
        IF(MLOC.LT.1.OR.MLOC.GT.5)THEN
          CALL ERROR(303)
        ENDIF
C
C       STICK THE VARIABLE NUMBER IN THE APPROPRIATE POSITION 
C       OF ARRAY BRKLOC
C           
        BRKLOC(NUMBRK)=BRKNUM
        BEG=CHR+1
C
C       IF THIS IS NOT THE END OF THE BREAKDOWN VARIABLES,
C       GO BACK AND FIND ANOTHER ONE.
C
        IF (LIST(CHR:CHR).NE.'/')GO TO 10
C
C       NOW LOOK FOR THE CONTROL VARIABLES, USING THE SAME LOGIC.
C
C       LOOK FOR "CONTROL=" OR "CONT=".  IF THERE IS SOMETHING
C       WRONG WITH THE SYNTAX HERE, WRITE AN ERROR MESSAGE.
C
        CHR=INDEX(LIST,'CONTROL=')+8
        IF(CHR.EQ.8)THEN
           CHR=INDEX(LIST,'CONT=')+5
           IF (CHR.EQ.5)THEN
              IF(INDEX(LIST,'CONT').GT.0)THEN
                CALL ERROR(311)
              ELSE
                CALL ERROR(313)
              ENDIF
           ENDIF
        ENDIF
C
C       THE LIST OF CONTROL VARIABLES SHOULD BEGIN AT THIS COLUMN.
C
        BEG=CHR
C
C       LOOK FOR A COMMA OR A SLASH, WHICH WILL INDICATE THE END
C       OF THE VARIABLE NAME.
C
 40     CHR=CHR+1
        IF (LIST(CHR:CHR).NE.','.AND.LIST(CHR:CHR).NE.'/'
     X      .AND.CHR.LT.LEN+1)GO TO 40        
        END=CHR-1
        THISV=LIST(BEG:END)
C
C       SEARCH FOR VARIABLE NUMBER
C
        STDNUM=0
        DO 41 I=1,VARNUM
 41     IF(THISV.EQ.VARNAM(I))STDNUM=I
C
C       IF THE VARIABLE WAS NOT FOUND, WRITE AN ERROR MESSAGE.
C
        IF (STDNUM.EQ.0)THEN
           CALL ERRNAM(2,THISV)
        ENDIF
C
C       IF THE VARIABLE WAS PREVIOUSLY SPECIFIED AS THE WEIGHT 
C       VARIABLE, WRITE AN ERROR MESSAGE.
C
        IF (VARDES(STDNUM,5).EQ.7)THEN
           CALL ERROR(301)
        ENDIF
C
C       INCREMENT NUMBER OF CONTROL VARIABLES.
C       IF MORE THAN FIVE SPECIFIED, WRITE ERROR MESSAGE.
C
        NUMSTD=NUMSTD+1
        IF (NUMSTD.GT.5)THEN
            CALL ERROR(304)
        ENDIF
C
C       IF FIVE CONTROL VARIABLES WERE SPECIFIED, THE BREAKDOWN 
C       VARIABLES MUST BE IDENTICAL SO THAT ONLY FOUR
C       CONTROL VARIABLES ARE USED SIMULTANEOUSLY.  CHECK TO SEE IF
C       THIS IS THE CASE.
C
        IF (NUMSTD.EQ.5.AND.NUMBRK.NE.5)CALL ERROR(304)
C
C       CHECK TO ENSURE THAT THE VARIABLE WAS MENTIONED IN
C       THE PRECEDING MAKETAB COMMAND.
C
        MLOC=VARDES(STDNUM,5)-1
        IF(MLOC.LT.1.OR.MLOC.GT.5)THEN
          CALL ERROR(303)
        ENDIF
C
C       STICK THE VARIABLE NUMBER IN THE APPROPRIATE POSITION 
C       OF ARRAY STDLOC
C           
        STDLOC(NUMSTD)=STDNUM
C
C       IF THIS IS NOT THE END OF THE CONTROL VARIABLES,
C       GO BACK AND FIND ANOTHER ONE.
C
        BEG=CHR+1
        IF (LIST(CHR:CHR).NE.'/'.AND.CHR.LT.LEN+1)GO TO 40
C
C       NOW INTERPRET THE "STANDARD=" SUBCOMMAND, IF PRESENT.
C
        STCAT=0
        STPOP=0
        FORM=1
        CHR=INDEX(LIST,'STANDARD=AV')
        IF (CHR.GT.0)STPOP=1
        IF (STPOP.EQ.0)THEN
           CHR=INDEX(LIST,'STANDARD=TO')
           IF (CHR.GT.0)STPOP=2
           IF (STPOP.EQ.0)THEN
              CHR=INDEX(LIST,'STANDARD=CA')
              IF (CHR.GT.0)THEN
C
C       IF THE STANDARD IS A CATEGORY OF THE BREAKDOWN VARIABLE,
C       FIND THE CATEGORY, WHICH SHOULD BE IN PARENTHESES.
C       ONLY ONE BREAKDOWN VARIABLE IS ALLOWED IF THIS OPTION
C       IS CHOSEN; IF THERE IS MORE THAN ONE, WRITE ERROR MESSAGE.
C
                 IF (NUMBRK.GT.1)THEN
                    CALL ERROR(314)
                 ENDIF
                 STPOP=3
                 BEG=INDEX(LIST,'(')+1
                 END=INDEX(LIST,')')-1
                 IF (END.LT.BEG.OR.BEG.LE.CHR)THEN
                    CALL ERROR(305)
                 ENDIF
                 STCAT=SELECT(LIST,BEG,END)
              ENDIF
           ENDIF          
        ENDIF
C
C       IF A STANDARD SUBCOMMAND IS THERE BUT HAS NOT BEEN
C       INTERPRETED, WRITE ERROR. OTHERWISE, ASSIGN DEFAULT.
C
        IF (STPOP.EQ.0)THEN
           CHR=INDEX(LIST,'STANDARD=')
           IF (CHR.GT.0)THEN
              CALL ERROR(306)
           ELSE
              STPOP=2
           ENDIF
        ENDIF
C
C       NOW INTERPRET "FORMAT=" SUBCOMMAND.
C
        CHR=INDEX(LIST,'FORMAT=PE')
        IF (CHR.GT.0)THEN
           FORM=2
        ELSE 
           CHR=INDEX(LIST,'FORMAT=DE')
           IF (CHR.GT.0)FORM=3
        ENDIF    
C
C       NOW CHECK TO SEE IF A "/WRITE EXCLUDED" SUBCOMMAND IS PRESENT.
C
        WREX=INDEX(LIST,'/WRI')
 99     CONTINUE
C
C       CHECK TO MAKE SURE A STANDARDIZE VARIABLE WAS SPECIFIED.
C
        IF (NUMSTD.LT.1.AND.NUMBRK.GE.1)THEN
          CALL ERROR(315)
        ENDIF
C
C       CHECK TO MAKE SURE A BREAKDOWN VARIABLE WAS SPECIFIED.
C
        IF (NUMBRK.LT.1)THEN
          CALL ERROR(307)
        ENDIF
        RETURN
        END


        SUBROUTINE WEIGHT(LIST,LEN,VARNAM,VARDES,VARNUM,WTDIG)
C
C       THIS ROUTINE INTERPRETS THE WEIGHT COMMAND.
C
        IMPLICIT INTEGER (A-Z)
        CHARACTER*10 VARNAM,THISV
        CHARACTER*500 LIST
        DIMENSION VARDES(30,5)
        DIMENSION VARNAM(30)
        LEN=80
        WTNUM=0
C
C       CHECK TO SEE IF " BY " WAS SPECIFIED.  
C       IF NOT, ASSUME THAT THE VARIABLE NAME BEGINS RIGHT AFTER
C       THE "WEIGHT" KEYWORD.
C 
        CHR=INDEX(LIST,' BY ')+3
        IF (CHR.EQ.3)THEN
          CHR=INDEX(LIST,'WEIGHT ')+6
          IF (CHR.EQ.6)THEN
            CALL ERROR(702)
          ENDIF
        ENDIF
C
C       SKIP ANY LEADING SPACES.
C
 10     CHR=CHR+1
        IF (CHR.GT.LEN+1)GO TO 99
        IF (LIST(CHR:CHR).EQ.' ')GO TO 10
        BEG=CHR
C
C       LOOK FOR A TRAILING SPACE, PERIOD OR COMMA TO DEFINE END
C       OF VARIABLE NAME.
C
 15     CHR=CHR+1
        IF(CHR.GT.LEN+1)GO TO 99
        IF(LIST(CHR:CHR).NE.' '.AND.LIST(CHR:CHR).NE.'.'
     X     .AND.LIST(CHR:CHR).NE.'(')GO TO 15
        END=CHR-1
        THISV=LIST(BEG:END)
C
C       LOOK FOR VARIABLE NAME
C
        DO 25 I=1,VARNUM
 25     IF(THISV.EQ.VARNAM(I))WTNUM=I
C
C       IF NO NAME FOUND, WRITE ERROR MESSAGE.
C        
 99     IF(WTNUM.EQ.0)THEN
          CALL ERRNAM(6,THISV)
        ELSE
          VARDES(WTNUM,5)=7
        ENDIF
C
C       NOW LOOK FOR DECIMAL PLACES, IF THEY EXIST.
C
        WTDIG=0
        CHR=INDEX(LIST,'(')
        IF (CHR.GT.0)THEN
           BEG=CHR+1
           END=INDEX(LIST,')')-1
C
C       CHECK SYNTAX
C
           IF (BEG.GT.END.OR.END.LT.1)THEN
              CALL ERROR(702)
           ENDIF
C
C       PUT NUMBER OF DIGITS IN WTDIG
C
           WTDIG=SELECT(LIST,BEG,END)
           IF(WTDIG.GT.5)WTDIG=5
        ENDIF
        RETURN
        END
                

        BLOCK DATA
C
C       THIS INITIALIZES THE COMMON BLOCK
C
        COMMON /TABS/ TABLE,MAXVARS 
        DIMENSION TABLE(64000,2)
        DIMENSION MAXVARS(5)
        DATA TABLE/128000*0.0/,MAXVARS/5*0/
        END



        SUBROUTINE MAKE (LIST,LEN,VARNAM,VARDES,VARNUM,DEPDIG,WRTAB)
C
C       THIS ROUTINE INTERPRETS THE MAKETAB COMMAND.
C
        IMPLICIT INTEGER(A-Z)
        CHARACTER*10 VARNAM
        CHARACTER*10 THISV
        CHARACTER*500 LIST
        DIMENSION VARDES(30,5)
        DIMENSION VARNAM(30)
C
C       INITIALIZE ALL VARIABLE TYPES TO "OTHER," IF THEY HAVE NOT
C       ALREADY BEEN SET TO BE A WEIGHT VARIABLE.
C
        DO 5 I=1,VARNUM
 5      IF(VARDES(I,5).NE.7)VARDES(I,5)=8
        NUMIND=0
C
C       LOOK FOR DEPENDENT VARIABLE, WHICH SHOULD BEGIN IMMEDIATELY
C       AFTER THE EQUALS SIGN.
C
        CHR=INDEX(LIST,'=')+1
        BEG=CHR
C
C       THE LAST CHARACHTER OF THE DEPENDENT VARIABLE SHOULD BE 
C       FOLLOWED BY A "/" OR A "(".  LOCATE IT, AND GRAB VARIABLE 
C       NAME.
C
 10     CHR=CHR+1
        IF (CHR.GT.LEN+1)GO TO 99
        IF (LIST(CHR:CHR).NE.'/'.AND.LIST(CHR:CHR).NE.'(')GO TO 10        
        END=CHR-1
        THISV=LIST(BEG:END)
C
C       SEARCH FOR VARIABLE NUMBER.  IF NOT FOUND, WRITE ERROR MESSAGE.
C
        DEPNUM=0
        DO 11 I=1,VARNUM
 11     IF(THISV.EQ.VARNAM(I))DEPNUM=I
        IF (DEPNUM.EQ.0)THEN
           CALL ERRNAM(1,THISV)
        ENDIF
C
C       DEPENDENT VARIABLE CANNOT BE WEIGHT VARIABLE.  IF IT IS, 
C       WRITE ERROR MESSAGE.
C
        IF (VARDES(DEPNUM,5).EQ.7)THEN
           CALL ERROR(201)
        ENDIF
C
C       NOW IDENTIFY DEPENDENT VARIABLE IN VARDES.
C
        VARDES(DEPNUM,5)=1
C
C       LOOK FOR NEXT EQUALS SIGN.  THE FIRST INDEPENDENT VARIABLE
C       SHOULD FOLLOW IT IMMEDIATELY.
C
 19     CHR=CHR+1
        IF (CHR.GT.LEN+1)GO TO 99       
        IF (LIST(CHR:CHR).NE.'=')GO TO 19
C
C       BEFORE PROCEEDING, CHECK TO SEE IF THERE ARE DIGITS TO
C       THE RIGHT OF THE DECIMAL PLACE ON THE DEPENDENT VARIABLE
C       SPECIFIED.  IF SO, SEE HOW MANY AND PUT THAT NUMBER IN 
C       DEPDIG.
C
        DEPDIG=0
        NCHR=INDEX(LIST,'(')
        IF (NCHR.LT.CHR.AND.NCHR.GT.0)THEN
           BEG=NCHR+1
           END=INDEX(LIST,')')-1
           IF (END.GE.BEG)DEPDIG=SELECT(LIST,BEG,END)
        ENDIF
C
C       NOW WE ARE READY TO LOCATE THE DEPENDENT VARIABLES.
C
 20     BEG=CHR+1
 21     CHR=CHR+1
C
C       IF WE ENCOUNTER A SLASH OR THE END OF THE LINE, WE ARE DONE.
C
        IF (CHR.GT.LEN+1.OR.LIST(CHR:CHR).EQ.'/')GO TO 99
C
C       A ")" OR A "," AT THIS POINT INDICATES A SYNTAX ERROR.
C
        IF (LIST(CHR:CHR).EQ.')'.OR.LIST(CHR:CHR).EQ.',')THEN
           CALL ERROR(202)
        ENDIF
C
C       THE LAST COLUMN OF THE INDEPENDENT VARIABLE NAME WILL
C       BE PRECEDED BY A "("
C
        IF (LIST(CHR:CHR).NE.'(')GO TO 21
        END=CHR-1
C
C       SEARCH FOR INDEPENDENT VARIABLE.  IF IT HAS NOT BEEN 
C       PREVIOUSLY DEFINED, WRITE AN ERROR MESSAGE.
C
        THISV=LIST(BEG:END)
        INDNUM=0
        DO 23 I=1,VARNUM
 23     IF(THISV.EQ.VARNAM(I))INDNUM=I
        IF (INDNUM.EQ.0)THEN
           CALL ERRNAM(1,THISV)
        ENDIF
C
C       INCREMENT NUMBER OF INDEPENDENT VARIABLES.  IF THERE ARE
C       MORE THAN FIVE, WRITE AN ERROR MESSAGE.
C
        NUMIND=NUMIND+1
        IF (NUMIND.GT.5)THEN
           CALL ERROR(203)
        ENDIF
C
C       IF THE VARIABLE HAS BEEN PREVIOUSLY SPECIFIED AS THE 
C       DEPENDENT VARIABLE OR THE WEIGHT VARIABLE, WRITE AN
C       ERROR MESSAGE.
C
        IF (VARDES(INDNUM,5).EQ.7.OR.VARDES(INDNUM,5).EQ.1)THEN
           CALL ERROR(201)
        ENDIF
C
C       IDENTIFY THIS VARIABLE AS AN INDEPENDENT VARIABLE IN 
C       ARRAY VARDES.
C         
          VARDES(INDNUM,5)=NUMIND+1
C
C         NOW GET MINIMUM AND MAXIMUM.  THE NEXT COLUMN SHOULD BE
C         THE START OF THE MINIMUM.                  
C
          BEG=CHR+1
 30       CHR=CHR+1
          IF(CHR.GT.LEN+1)GO TO 99
C
C         AN ASTERISK IS ALLOWED IN LIEU OF THE MINIMUM AND THE 
C         MAXIMUM ONLY IF THE MIN AND MAX HAVE BEEN PREVIOUSLY 
C         DEFINED BY A COMBINE COMMAND. OTHERWISE, WRITE AN ERROR
C         MESSAGE.
C
          IF (LIST(CHR:CHR).EQ.'*')THEN
             IF(VARDES(INDNUM,3).NE.0.OR.VARDES(INDNUM,4).NE.0)THEN
               CHR=CHR+1
               GO TO 20
             ELSE
               CALL ERRNAM(251,VARNAM(INDNUM))
             ENDIF
          ENDIF
C
C         CHECK SYNTAX.
C
          IF(LIST(CHR:CHR).EQ.'('.OR.LIST(CHR:CHR).EQ.')')THEN
            CALL ERROR(202)
          ENDIF
C
C         A COMMA INDICATES THE END OF THE MINIMUM
C
          IF(LIST(CHR:CHR).NE.',')GO TO 30
          END=CHR-1
C
C         STICK MINIMUM IN APPROPRIATE SLOT OF VARDES
C
          VARDES(INDNUM,3)=SELECT(LIST,BEG,END)
C
C         NOW FIND MAXIMUM
C
          BEG=CHR+1
 31       CHR=CHR+1
          IF(CHR.GT.LEN+1)GO TO 99
C
C         CHECK FOR SYNTAX ERRORS
C
          IF(LIST(CHR:CHR).EQ.'('.OR.LIST(CHR:CHR).EQ.',')THEN
            CALL ERROR(202)
          ENDIF
C
C         ")" INDICATES THE END OF THE MAXIMUM
C
          IF(LIST(CHR:CHR).NE.')')GO TO 31
C
C         STICK MAXIMUM IN APPROPRIATE SLOT OF VARDES
C          
          END=CHR-1
          VARDES(INDNUM,4)=SELECT(LIST,BEG,END)
C
C         NO GO LOOK FOR MORE INDEPENDENT VARIABLES
C          
          GO TO 20
 99       CONTINUE
C
C         CHECK FOR A "WRITE TABLE" SUBCOMMAND
C          
          WRTAB=INDEX(LIST,'/WRI')
C
C         CHECK FOR ERRORS: 
C           MISSING DEPENDENT SUBCOMMAND
C           MISSING VARIABLES SUBCOMMAND
C           MISSING EQUALS SIGN
C           TOO FEW INDEPENDENTS
C           WRONG END OF STATEMENT
C
          TEST1=INDEX(LIST,'DEPENDENT=')
          IF (TEST1.EQ.0)TEST1=INDEX(LIST,'DEP=')
          TEST2=INDEX(LIST,'DEP')
          TEST3=INDEX(LIST,'VARIABLES=')
          IF (TEST3.EQ.0)TEST3=INDEX(LIST,'VARIABLE=')
          IF (TEST3.EQ.0)TEST3=INDEX(LIST,'VARS=')
          IF (TEST3.EQ.0)TEST3=INDEX(LIST,'VAR=')
          TEST4=INDEX(LIST,'VAR')
          IF (TEST2.EQ.0)THEN
             CALL ERROR(205)
          ELSE IF (TEST4.EQ.0)THEN
             CALL ERROR(206)
          ELSE IF (TEST4.LE.TEST2)THEN
             CALL ERROR(207)
          ELSE IF (TEST1.EQ.0.OR.TEST3.EQ.0)THEN
             CALL ERROR(208)
          ELSE IF (NUMIND.LT.1)THEN
             CALL ERROR(204)
          ELSE IF(LIST(LEN:LEN).NE.')'.AND.WRTAB.EQ.0)THEN
             CALL ERROR(209)
          ENDIF
C
C         CHECK TO SEE IF MINIMUM IS LESS THAN MAXIMUM
C   
          DO 250 I=1,VARNUM
          IF (VARDES(I,5).GE.2.AND.VARDES(I,5).LE.5)THEN
             IF(VARDES(I,3).GT.VARDES(I,4))THEN
               CALL ERROR(210)
             ENDIF
          ENDIF
 250      CONTINUE
          RETURN
          END



       FUNCTION IND(I,J,K,L,M)
C
C      THIS FUNCTION CALCULATES THE INDEX FOR TABULATING THE 
C      VARIABLES
C
       COMMON /TABS/ TABLE(64000,2),MAXVARS(5)
       IND=I+J*MAXVARS(1)+K*MAXVARS(1)*MAXVARS(2)
     X          +L*MAXVARS(1)*MAXVARS(2)*MAXVARS(3)
     X          +M*MAXVARS(1)*MAXVARS(2)*MAXVARS(3)*MAXVARS(4)
     X         -(MAXVARS(1)+MAXVARS(1)*MAXVARS(2)
     X          +MAXVARS(1)*MAXVARS(2)*MAXVARS(3)
     X          +MAXVARS(1)*MAXVARS(2)*MAXVARS(3)*MAXVARS(4))
       IF(IND.GT.64000)CALL ERROR(703)
       RETURN
       END



        SUBROUTINE SELDAT(LIST,LEN,SELDES,VARNAM,SELNUM,TRATAB,TRANUM)
C
C      THIS ROUTINE INTERPRETS THE SELECT IF COMMAND.  THE RESULTS 
C      ARE STORED IN ARRAY SELDES (SELECT IF DESCRIPTIONS)
C
C      SELDES: SELECT IF DESCRIPTIONS
C              ROWS  - SELECT IF NUMBER                 
C              COL 1 - VARIABLE NUMBER
C              COL 2 - VALUE
C              COL 3 - OPERATOR
C                      1 - EQ
C                      2 - GT
C                      3 - LT
C                      4 - GE
C                      5 - LE
C              COL 4 - CONSTANT FOR COMPARISON
C
        IMPLICIT INTEGER(A-Z)
        CHARACTER*10 VARNAM
        CHARACTER*500 LIST
        CHARACTER*10 THISV

        DIMENSION SELDES(50,3)
        DIMENSION VARNAM(30)
        DIMENSION TRATAB(300,2)
C
C       FIND FIRST VARIABLE NAME; IT SHOULD APPEAR AFTER THE "("
C
        CHR=INDEX(LIST,'(')+1
        BEG=CHR
C
C       FIND THE "~" DELIMITER, WHICH INDICATES AN OPERATOR
C       BEGINS AND THE VARIABLE NAME ENDS.
C
C ****** WARNING: THE CHARACTER ~ MAY NOT BE AVAILABLE ON SOME 
C                 SYSTEMS; SUBSTITUTE SOMETHING ELSE.
C
 10     CHR=CHR+1
        IF (CHR.GT.LEN+1)GO TO 99
        IF (LIST(CHR:CHR).NE.'~')GO TO 10        
        END=CHR-1
        THISV=LIST(BEG:END)
C
C       SEARCH FOR VARIABLE NUMBER; 
C
        VARNUM=0
        DO 11 I=1,30
 11     IF(THISV.EQ.VARNAM(I))VARNUM=I
C
C       FIND THE OPERATOR
C        
        OP=0
        CHR=INDEX(LIST,'~EQ~')+4
        IF(CHR.GT.4)THEN
           OP=1
        ELSE        
          CHR=INDEX(LIST,'~GT~')+4
          IF(CHR.GT.4)THEN
            OP=2
          ELSE
            CHR=INDEX(LIST,'~LT~')+4
            IF(CHR.GT.4)THEN
              OP=3
            ELSE
              CHR=INDEX(LIST,'~GE~')+4
              IF(CHR.GT.4)THEN
                OP=4
              ELSE
              CHR=INDEX(LIST,'~LE~')+4
              IF(CHR.GT.4)THEN
                OP=5
              ELSE
                CHR=INDEX(LIST,'~NE~')+4
                IF(CHR.GT.4)THEN
                  OP=6
                ELSE
                  CALL ERROR(601)
                ENDIF
              ENDIF
            ENDIF
          ENDIF
        ENDIF
      ENDIF
C
C     INCREMENT SELECT IF NUMBER AND TRANSFORMATION NUMBER
C
        SELNUM=SELNUM+1
        TRANUM=TRANUM+1
C
C     A MAXIMUM OF 50 SELECT IF'S ARE ALLOWED.
C
        IF (SELNUM.GT.50)THEN
           CALL ERROR(602)
        ENDIF
C
C     STICK THE INFORMATION GATHERED SO FAR IN THE APPROPRIATE
C     SLOTS OF SELDES.
C
        SELDES(SELNUM,1)=VARNUM
        SELDES(SELNUM,2)=OP
        TRATAB(TRANUM,1)=1
        TRATAB(TRANUM,2)=SELNUM
C
C       NOW FIND THE CONSTANT; IT SHOULD BEGIN RIGHT AFTER THE
C       OPERATOR        
C    
        BEG=CHR
C
C       THE CONSTANT ENDS RIGHT BEFORE THE ")"
C
 21     CHR=CHR+1
        IF (CHR.GT.LEN+1)GO TO 99
        IF (LIST(CHR:CHR).NE.')')GO TO 21
C
C       CONVERT IT TO AN INTEGER WITH SELECT AND STICK IT IN THE
C       APPROPRIATE SLOT OF SELDES
C
        END=CHR-1
        SELDES(SELNUM,3)=SELECT(LIST,BEG,END)
C
C       CHECK FOR SELECT ERRORS
C
 99     CONTINUE
C
C       IF THE VARIABLE WAS NOT FOUND,
C       WRITE AN ERROR MESSAGE.
C
       IF (SELDES(SELNUM,1).EQ.0)THEN
          CALL ERRNAM(5,THISV)
       ENDIF
C
C      MAKE SURE STATEMENT ENDS WITH A ")". 
C
       IF(LIST(LEN:LEN).NE.')')THEN
          CALL ERROR(603)
       ENDIF
       RETURN
       END

 
        SUBROUTINE DECOMP (LIST,LEN,VARNAM,VARDES,VARNUM,POPLOC,
     X         POP1D,POP2D,NUMFAC,FACLOC,WREX)
C
C       THIS SUBROUTINE INTERPRETS THE DECOMPOSE COMMAND
C
        IMPLICIT INTEGER(A-Z)
        CHARACTER*10 VARNAM
        CHARACTER*10 THISV 
        CHARACTER*500 LIST
        DIMENSION VARDES(30,5)
        DIMENSION VARNAM(30)
        DIMENSION FACLOC(5)
C
C       INITIALIZE NUMBER OF FACTORS
C
        NUMFAC=0
C
C       LOCATE "COMPARE" SUBCOMMAND; WRITE ERROR MESSAGE IF
C       IT IS MISSING OR INCOMPLETE
C
        CHR=INDEX(LIST,'COMPARE=')+8
        IF(CHR.EQ.8)THEN
          IF(INDEX(LIST,'COMPARE').GT.0)THEN
             CALL ERROR(408)
          ELSE
             CALL ERROR(410)
          ENDIF
        ENDIF
C
C       FIND COMPARISON VARIABLE; IT SHOULD BEGIN RIGHT AFTER
C       THE EQUALS SIGN.
C
        BEG=CHR
 10     CHR=CHR+1
        IF (CHR.GT.LEN+1)GO TO 99
C
C       THE VARIABLE WILL END RIGHT BEFORE THE "("
C
        IF (LIST(CHR:CHR).NE.'(')GO TO 10
        END=CHR-1
        THISV=LIST(BEG:END)
C
C       SEARCH FOR VARIABLE NUMBER; WRITE ERROR IF VARIABLE NOT
C       FOUND
C
        POPNUM=0
        DO 11 I=1,VARNUM
 11     IF(THISV.EQ.VARNAM(I))POPNUM=I
        IF (POPNUM.EQ.0)THEN
           CALL ERRNAM(3,THISV)
        ENDIF
C
C       WRITE ERROR MESSAGE IF THE COMPARISON VARIABLE IS ALSO
C       THE WEIGHT VARIABLE
C
        IF (VARDES(POPNUM,5).EQ.7)THEN
           CALL ERROR(401)
        ENDIF
C
C       WRITE ERROR MESSAGE IF COMPARISON VARIABLE WAS NOT DECLARED
C       AS A VARIABLE IN THE PRECEDING MAKETAB COMMAND.
C
        MLOC=VARDES(POPNUM,5)-1
        IF(MLOC.LT.1.OR.MLOC.GT.5)THEN
          CALL ERROR (402)
        ENDIF
C
C       STORE COMPARISON VARIABLE IN POPLOC AD SEARCH FOR COMPARISON
C       CATEGORIES, WHICH SHOULD BEGIN IN THE NEXT COLUMN
C          
        POPLOC=POPNUM
        POP1D=9999
        POP2D=9999
        BEG=CHR+1
 20     CHR=CHR+1
        IF(CHR.GT.LEN+1)GO TO 99
C
C       A COLON SHOULD SEPARATE THE TWO COMPARISON CATEGORIES
C
        IF (LIST(CHR:CHR).NE.':')GO TO 20
        END=CHR-1
C
C       CONVERT CATEGORY 1 TO AN INTEGER USING FUNCTION SELECT
C
        POP1D=SELECT(LIST,BEG,END)
C
C       LOCATE SECOND COMPARISON CATEGORY, WHICH SHOULD BE FOLLOWED 
C       BY A ")"
C
        BEG=CHR+1
 21     CHR=CHR+1
        IF(CHR.GT.LEN+1)GO TO 99
        IF (LIST(CHR:CHR).NE.')')GO TO 21
        END=CHR-1
C
C       CONVERT CATEGORY 2 TO AN INTEGER USING FUNCTION SELECT
C
        POP2D=SELECT(LIST,BEG,END)
C
C       NOW LOCATE "FACTORS=" SUBCOMMAND; WRITE ERROR MESSAGE IF IT
C       IS MISSING OR INCOMPLETE
C       

        CHR=INDEX(LIST,'FACTORS=')+8
        IF(CHR.EQ.8)THEN
           CHR=INDEX(LIST,'FACTOR=')+7
           IF (CHR.EQ.7)THEN
              IF(INDEX(LIST,'FACTOR').GT.0)THEN
                CALL ERROR(408)
              ELSE
                CALL ERROR(409)
              ENDIF
           ENDIF
        ENDIF
C
C       THE FIRST FACTOR SHOULD BEGIN IMMEDIATELY FOLLOWING THE 
C       EQUALS SIGN, AND END RIGHT BEFORE A COMMA, SLASH, OR THE
C       END OF THE COMMAND
C
        BEG=CHR

 40     CHR=CHR+1
        IF (LIST(CHR:CHR).NE.','.AND.CHR.LT.LEN+1
     X      .AND.LIST(CHR:CHR).NE.'/')GO TO 40        
        END=CHR-1
        THISV=LIST(BEG:END)
C
C       SEARCH FOR VARIABLE NUMBER; IF IT IS NOT FOUND, WRITE AN
C       ERROR MESSAGE. 
C
        FACNUM=0
        DO 41 I=1,VARNUM
 41     IF(THISV.EQ.VARNAM(I))FACNUM=I
        IF (FACNUM.EQ.0)THEN
           CALL ERRNAM(3,THISV)
        ENDIF
C
C       THE WEIGHT VARIABLE IS NOT ALLOWED TO BE A FACTOR
C
        IF (VARDES(FACNUM,5).EQ.7)THEN
           CALL ERROR(401)
        ENDIF
C
C       NO MORE THAN FOUR FACTORS ARE ALLOWED
C
        NUMFAC=NUMFAC+1
        IF (NUMFAC.GT.4)THEN
           CALL ERROR(403)
        ENDIF
C
C       ALL FACTORS MUST HAVE BEEN DECLARED AS VARIABLES IN THE 
C       PRECEDING MAKETAB COMMAND
C
        FACLOC(NUMFAC)=FACNUM
        MLOC=VARDES(FACNUM,5)-1
        IF(MLOC.LT.1.OR.MLOC.GT.5)THEN
          CALL ERROR(402)
        ENDIF
C
C       IF WE HAVE NOT ENCOUNTERED THE END OF THE LIST OF FACTORS,
C       AS INDICATED BY A SLASH OR THE END OF THE COMMAND, GO BACK
C       AND LOCATE MORE FACTORS.
C          
        BEG=CHR+1
        IF(CHR.LT.LEN+1.AND.LIST(CHR:CHR).NE.'/')GO TO 40
C
C       SEE IF THERE IS A "/WRITE EXCLUDED" SUBCOMMAND.
C
        WREX=INDEX(LIST,'/WRI')
 99     CONTINUE
C
C       NOW CHECK TO MAKE SURE THAT THE COMPARISON CATEGORIES WERE
C       DEFINED  
C
        IF (POP1D.EQ.9999.OR.POP2D.EQ.9999)THEN
          CALL ERROR(404)
        ENDIF
        RETURN
        END




       SUBROUTINE GUTS(N1T,N2T,NUM1,NUM2,TOT1,TOT2,
     X                 COMB,RATE,EFFECT)
C
C      THIS ROUTINE IS THE GUTS OF THE DECOMPOSITION
C
       IMPLICIT INTEGER(A-Z)
       CHARACTER*3 SCRNAM
       REAL A1(4),A2(6),A3(4),B1(4),B2(6),B3(4)
       REAL EFFECT(4),TOT1,TOT2,COMB,RATE
       REAL NUM1, NUM2
       REAL TABLE,N1,N2,AV,N1T,N2T,T1,T2
       DIMENSION TABLE(64000,2)
       DIMENSION MAXVARS(5)
       CHARACTER*6 ORDER(24)
       COMMON /TABS/ TABLE,MAXVARS
ccc       INQUIRE(UNIT=6,NAME=SCRNAM)

       SCRNAM='CON'
C
C      THERE ARE 24 EQUATIONS NECESSARY FOR DAS GUPTA'S METHODS,
C      BUT THEY CAN BE EXPRESSED AS A SINGLE EQUATION BY SUBSTITUTING
C      TERMS.  THE ARRAY ORDER CONTAINS THE INFORMATION NECESSARY TO
C      SUBSTITUTE THE TERMS IN THE CORRECT ORDER.
C
       ORDER(1)='125314'
       ORDER(2)='136314'
       ORDER(3)='144224'
       ORDER(4)='125224'
       ORDER(5)='136134'
       ORDER(6)='144134'
       ORDER(7)='215613'
       ORDER(8)='233613'
       ORDER(9)='242423'
       ORDER(10)='215423'
       ORDER(11)='233143'
       ORDER(12)='242143'
       ORDER(13)='316512'
       ORDER(14)='323512'
       ORDER(15)='341432'
       ORDER(16)='316432'
       ORDER(17)='323242'
       ORDER(18)='341242'
       ORDER(19)='414521'
       ORDER(20)='422521'
       ORDER(21)='431631'
       ORDER(22)='414631'
       ORDER(23)='422341'
       ORDER(24)='431341'
C
C      THE FOLLOWING LOOP CALCULATES THE RATE EFFECT AND THE
C      COMBINED EFFECT OF FACTORS.  THESE ARE PRETTY SIMPLE:
C      THE COMBINED EFFECT OF FACTORS IS THE SUM OF THE AVERAGE 
C      OF THE RATES FOR THE TWO POPULATIONS TIMES THE DIFFERENCE 
C      OF THE PROPORTIONS OF THE POPULATION IN EACH CELL.  THE 
C      RATE EFFECT IS THE SUM OF THE AVERAGE OF THE PROPORTIONS 
C      TIMES THE DIFFERENCE IN THE RATES OVER ALL CELLS.  THE 
C      SUM OF THE RATE EFFECT AND THE EFFECT OF FACTORS SHOULD 
C      BE EQUAL TO THE TOTAL POPULATION DIFFERENCE.  THIS LOOP 
C      ALSO SUMS THE CASES IN EACH POPULATION AND CALCULATES THE
C      OVERALL RATE IN EACH POPULATION.
C
       DO 226 I=2,MAXVARS(2)
       DO 226 J=2,MAXVARS(3)
       DO 226 K=2,MAXVARS(4)
       DO 226 L=2,MAXVARS(5)
       N1=TABLE(IND(1,I,J,K,L),2)
       N2=TABLE(IND(2,I,J,K,L),2)
       IF(N1.GT.0.0.AND.N2.GT.0.0)THEN
         T1=TABLE(IND(1,I,J,K,L),1)
         T2=TABLE(IND(2,I,J,K,L),1)
         AV=TABLE(IND(3,I,J,K,L),1)
          NUM1=NUM1+N1
          NUM2=NUM2+N2
          TOT1=TOT1+(T1*N1/N1T)
          TOT2=TOT2+(T2*N2/N2T)
          COMB=COMB+AV*(N1/N1T-N2/N2T)
          RATE=RATE+(N1/N1T+N2/N2T)/2.0
     X           *(T1-T2)
        ENDIF
 226    CONTINUE
C
C       NOW WE ARE READY FOR THE GUTS OF THE GUTS.
C       FOR EACH FACTOR, THE EQUATION MUST BE CARRIED OUT IN 
C       EACH OF SIX POSSIBLE ORDERS, MAKING A TOTAL OF 24 
C       PASSES THROUGH THE MAIN TABLE.
C
        ORDFAC=0
        DO 500 FACT=1,4
        DO 500 ORD=1,6
C
C       SEND A MESSAGE TO THE SCREEN INFORMING THE ANALYST OF
C       OUR PROGRESS (WITH A COMPLICATED PROBLEM AND A SLOW 
C       COMPUTER, THIS LOOP CAN TAKE QUITE A LONG TIME, SO THIS
C       MESSAGE JUST REASSURES THE USER THAT SOMETHING IS HAPPENING.
C
        ORDFAC=ORDFAC+1
ccc        IF(SCRNAM.EQ.'CON')WRITE(*,249)FACT,ORD
ccc 249    FORMAT(3X,'Calculating factor number',i2,' Order number',i2, $)
C
C       EXTRACT THE POINTERS FROM ARRAY ORDER.
C
        P1=SELECT(ORDER(ORDFAC),1,1)
        P2=SELECT(ORDER(ORDFAC),2,2)
        P3=SELECT(ORDER(ORDFAC),3,3)
        P4=SELECT(ORDER(ORDFAC),4,4)
        P5=SELECT(ORDER(ORDFAC),5,5)
        P6=SELECT(ORDER(ORDFAC),6,6)
C
C       THIS LOOP RUNS THROUGH ALL THE CELLS
C
        DO 300 I=2,MAXVARS(2)
        DO 300 J=2,MAXVARS(3)
        DO 300 K=2,MAXVARS(4)
        DO 300 L=2,MAXVARS(5)
C
C       GET THE NUMBER OF CASES IN THE CELL AND THE AVERAGE OF
C       THE RATES
C
        N1=TABLE(IND(1,I,J,K,L),2)
        N2=TABLE(IND(2,I,J,K,L),2)
        AV=TABLE(IND(3,I,J,K,L),1)
C
C       SKIP THE CELL IF IT IS EMPTY IN EITHER POPULATION
C        
        IF(N1.EQ.0.0.OR.N2.EQ.0.0)GO TO 300
C
C       GET ALL THE TERMS OF THE EQUATION, WHICH ARE ALL OF THE
C       POSSIBLE MARGINALS
C         
        A3(1)=TABLE(IND(1,I,J,K,1),2)
        A3(2)=TABLE(IND(1,I,J,1,L),2)
        A3(3)=TABLE(IND(1,I,1,K,L),2)
        A3(4)=TABLE(IND(1,1,J,K,L),2)
        A2(1)=TABLE(IND(1,1,1,K,L),2)
        A2(2)=TABLE(IND(1,1,J,1,L),2)
        A2(3)=TABLE(IND(1,1,J,K,1),2)
        A2(4)=TABLE(IND(1,I,1,1,L),2)
        A2(5)=TABLE(IND(1,I,J,1,1),2)
        A2(6)=TABLE(IND(1,I,1,K,1),2)
        A1(1)=TABLE(IND(1,I,1,1,1),2)
        A1(2)=TABLE(IND(1,1,J,1,1),2)
        A1(3)=TABLE(IND(1,1,1,K,1),2)
        A1(4)=TABLE(IND(1,1,1,1,L),2)
        B3(1)=TABLE(IND(2,I,J,K,1),2)
        B3(2)=TABLE(IND(2,I,J,1,L),2)
        B3(3)=TABLE(IND(2,I,1,K,L),2)
        B3(4)=TABLE(IND(2,1,J,K,L),2)
        B2(1)=TABLE(IND(2,1,1,K,L),2)
        B2(2)=TABLE(IND(2,1,J,1,L),2)
        B2(3)=TABLE(IND(2,1,J,K,1),2)
        B2(4)=TABLE(IND(2,I,1,1,L),2)
        B2(5)=TABLE(IND(2,I,J,1,1),2)
        B2(6)=TABLE(IND(2,I,1,K,1),2)
        B1(1)=TABLE(IND(2,I,1,1,1),2)
        B1(2)=TABLE(IND(2,1,J,1,1),2)
        B1(3)=TABLE(IND(2,1,1,K,1),2)
        B1(4)=TABLE(IND(2,1,1,1,L),2)
C
C       THIS IS IT! (SEE DAS GUPTA, 1978 FOR AN EXPLANATION)
C
        EFFECT(FACT)=EFFECT(FACT)+(AV*(N1/A1(P1)+N2/B1(P1))/2.0
     X  *(A1(P1)/N1T-B1(P1)/N2T))+(AV*(N1/A2(P3)+N2/B2(P3))/2.0
     X  *(A1(P2)/N1T+B1(P2)/N2T)/2.0*(A2(P3)/A1(P2)-B2(P3)/B1(P2)))
     X  +(AV*(N1/A3(P5)+N2/B3(P5))/2.0*(A1(P2)/N1T+B1(P2)/N2T)/2.0
     X  *(A2(P4)/A1(P2)+B2(P4)/B1(P2))/2.0
     X  *(A3(P5)/A2(P4)-B3(P5)/B2(P4)))+(AV*(A1(P2)/N1T+B1(P2)/N2T)/2.0
     X  *(A2(P4)/A1(P2)+B2(P4)/B1(P2))/2.0
     X  *(A3(P6)/A2(P4)+B3(P6)/B2(P4))/2.0*(N1/A3(P6)-N2/B3(P6)))     
 300    CONTINUE
 500    CONTINUE
        RETURN
        END






        SUBROUTINE COMBDAT (LIST,LEN,COMDES,VARNAM,VARDES,VARNUM,
     X                             COMNUM,TRATAB,TRANUM,PG,LN)
C
C       THIS ROUTINE INTERPRETS THE COMBINE COMMAND.
C
        IMPLICIT INTEGER(A-Z)
        CHARACTER*10 VARNAM
        CHARACTER*500 LIST
        CHARACTER*10 THISV

        DIMENSION VARDES(30,5)
        DIMENSION VARNAM(30)
        DIMENSION COMDES(10,5)
        DIMENSION TRATAB(300,2)
C
C       COMDES: COMBINE DESCRIPTIONS
C                
C                 ROWS: COMBINATION VARIABLE NUMBER
C                COL 1: VARIABLE NUMBER OF FIRST VARIABLE TO COMBINE
C                COL 2: VARIABLE NUMBER OF SECOND VARIABLE TO COMBINE
C                COL 3: VARIABLE NUMBER OF THIRD VARIABLE TO COMBINE
C                COL 4: VARIABLE NUMBER OF FOURTH VARIABLE TO COMBINE
C                COL 5: VARIABLE NUMBER OF NEW COMBINED VARIABLE 
C
C       FIND FIRST VARIABLE NAME.  THIS WILL BE THE NAME OF THE NEW 
C       VARIABLE TO BE CREATED.
C
        BEG=INDEX(LIST,'COMBINE')+7
        END=INDEX(LIST,'=')-1
        THISV=LIST(BEG:END)
C
C       INCREMENT VARIABLE NUMBER, COMBINATION NUMBER, AND 
C       TRANSFORMATION NUMBER.  INSERT FIRST VARIABLE NUMBER
C       IN THE ARRAY COMBDES, TRANSFORMATION TYPE IN ARRAY TRATAB,
C       ETC.
C
        NUMIND=0
        VARNUM=VARNUM+1
        COMNUM=COMNUM+1
        TRANUM=TRANUM+1
        COMDES(COMNUM,5)=VARNUM
        TRATAB(TRANUM,1)=3
        TRATAB(TRANUM,2)=COMNUM
        VARDES(VARNUM,1)=9999
        DO 5 I=1,4
 5      COMDES(COMNUM,I)=99
        VARNAM(VARNUM)=THISV        
C
C       NOW FIND THE OTHER VARIABLES, WHICH SHOULD BEGIN RIGHT
C       AFTER THE EQUALS SIGN.
C
        CHR=INDEX(LIST,'=')
 20     BEG=CHR+1
 21     CHR=CHR+1
        IF (CHR.GT.LEN+1)GO TO 99
C
C       CHECK FOR SYNTAX ERRORS.
C
        IF (LIST(CHR:CHR).EQ.')'.OR.LIST(CHR:CHR).EQ.',')THEN
           CALL ERROR(801)
        ENDIF
C
C       THE END OF THE VARIABLE NAME SHOULD APPEAR RIGHT BEFORE
C       THE "("
C
        IF (LIST(CHR:CHR).NE.'(')GO TO 21
        END=CHR-1
C
C       SEARCH FOR INDEPENDENT VARIABLE.  CHECK TO MAKE SURE IT 
C       HAS BEEN DEFINED IN THE PRECEDING DATA LIST COMMAND.
C
        THISV=LIST(BEG:END)
        INDNUM=0
        DO 23 I=1,VARNUM
 23     IF(THISV.EQ.VARNAM(I))INDNUM=I
        IF (INDNUM.EQ.0)THEN
           CALL ERRNAM(7,THISV)
        ENDIF
C
C       INCREMENT NUMBER OF VARIABLES FOUND.
C       ONLY FOUR COMBINE VARIABLES ARE ALLOWED.
C
        NUMIND=NUMIND+1
        IF (NUMIND.GT.4)THEN
            CALL ERROR(802)
        ENDIF
C
C       NOW GET MINIMUM AND MAXIMUM; THEY ARE IN PARENTHESES, 
C       SEPARATED BY A COMMA.                  
C
        BEG=CHR+1
 30     CHR=CHR+1
        IF(CHR.GT.LEN+1)GO TO 99
C
C       CHECK PUNCTUATION.
C
        IF(LIST(CHR:CHR).EQ.'('.OR.LIST(CHR:CHR).EQ.')')THEN
          CALL ERROR(801)
        ENDIF
        IF(LIST(CHR:CHR).NE.',')GO TO 30
        END=CHR-1
C
C       STICK MINIMUM IN APPROPRIATE POSITION OF VARDES.
C
        VARDES(INDNUM,3)=SELECT(LIST,BEG,END)
        BEG=CHR+1
 31     CHR=CHR+1
        IF(CHR.GT.LEN+1)GO TO 99
C
C       CHECK PUNCTUATION
C
        IF(LIST(CHR:CHR).EQ.'('.OR.LIST(CHR:CHR).EQ.',')THEN
          CALL ERROR(801)
        ENDIF
        IF(LIST(CHR:CHR).NE.')')GO TO 31
        END=CHR-1
C
C       STICK MAXIMUM IN APPROPRIATE POSITION OF VARDES, AND STICK 
C       VARIABLE NUMBER IN APPROPRIATE POSITION OF COMBDES.
C
        VARDES(INDNUM,4)=SELECT(LIST,BEG,END)
        COMDES(COMNUM,NUMIND)=INDNUM
C
C       ENSURE THAT MINIMUM IS LESS THAN MAXIMUM.
C
        IF(VARDES(INDNUM,3).GT.VARDES(INDNUM,4))THEN
           CALL ERROR(803)
        ENDIF
C
C       NOW GO BACK AND LOOK FOR MORE COMBINE VARIABLES.
C   
        GO TO 20
 99     CONTINUE
C
C       CHECK FOR APPROPRIATE COMMAND TERMINATION AND ENSURE THAT
C       AT LEAST TWO VARIABLES HAVE BEEN SPECIFIED TO COMBINE.
C
        IF(LIST(LEN:LEN).NE.')')THEN
          CALL ERROR(804)
        ELSE IF (NUMIND.LT.2)THEN
          CALL ERROR(805)
        ENDIF
C
C         CALCULATE MINIMUM AND MAXIMUM OF NEW COMBINED VARIABLE
C
        I=1
        J=1
        K=1
        L=1
        LOC1=30
        LOC2=30
        LOC3=30
        LOC4=30
        IF (COMDES(COMNUM,1).NE.99)THEN
           LOC1=COMDES(COMNUM,1)
           I=VARDES(LOC1,4)-VARDES(LOC1,3)+1
        ENDIF
        IF (COMDES(COMNUM,2).NE.99)THEN
           LOC2=COMDES(COMNUM,2)
           J=VARDES(LOC2,4)-VARDES(LOC2,3)+1
        ENDIF
        IF (COMDES(COMNUM,3).NE.99)THEN
           LOC3=COMDES(COMNUM,3)
           K=VARDES(LOC3,4)-VARDES(LOC3,3)+1
        ENDIF
        IF (COMDES(COMNUM,4).NE.99)THEN
           LOC4=COMDES(COMNUM,4)
           L=VARDES(LOC4,4)-VARDES(LOC4,3)+1
        ENDIF
        MIN=1
        MAX=IND2(L,K,J,I,L,K,J)
C
C       STICK MIN AND MAX IN THE APPROPRIATE SLOTS OF VARDES.       
C 
        VARDES(VARNUM,3)=MIN
        VARDES(VARNUM,4)=MAX
C
C       WRITE TRANSLATION TABLE TO OUTPUT FILE.  START NEW PAGE IF
C       NECESSARY.  THE FOLLOWING CODE WILL WRITE THE HEADING.
C
        LN=LN+6
        CALL PAGE(PG,LN)
        WRITE(23,245)VARNAM(VARNUM)
 245    FORMAT(/1X,'COMBINE has constructed the new variable ',a10,
     x         /1x,'The following codes were assigned:'/)
        IF(NUMIND.EQ.2)THEN
          WRITE(23,246)VARNAM(VARNUM),VARNAM(LOC1),VARNAM(LOC2)
        ELSE IF(NUMIND.EQ.3)THEN
          WRITE(23,247)VARNAM(VARNUM),VARNAM(LOC1),VARNAM(LOC2),
     X                  VARNAM(LOC3)
        ELSE IF(NUMIND.EQ.4)THEN
          WRITE(23,248)VARNAM(VARNUM),VARNAM(LOC1),VARNAM(LOC2),
     X                  VARNAM(LOC3),VARNAM(LOC4)
        ENDIF
  246   FORMAT(21X,3(A10,5X)/)
  247   FORMAT(13X,4(A10,5X)/)
  248   FORMAT(6X,5(A10,5X)/) 
C
C       NOW WRITE THE TABLE.
C
        DO 250 A=1,I
        DO 250 B=1,J
        DO 250 C=1,K
        DO 250 D=1,L
        V1=A+(VARDES(LOC1,3)-1)
        V2=B+(VARDES(LOC2,3)-1)
        V3=C+(VARDES(LOC3,3)-1)
        V4=D+(VARDES(LOC4,3)-1)
C
C       FUNCTION IND2 CALCULATES THE COMBINED VALUES. 
C
        VCOM=IND2(D,C,B,A,L,K,J)
C
C       IF WE HAVE STARTED A NEW PAGE OF THE OUTPUT FILE, 
C       WRITE A NEW HEADING.
C
        CALL PAGE(PG,LN)
        IF (LN.EQ.1)THEN
          LN=LN+4
          WRITE(23,*)
          CALL PAGE(PG,LN)
          IF(NUMIND.EQ.2)THEN
            WRITE(23,246)VARNAM(VARNUM),VARNAM(LOC1),VARNAM(LOC2)
          ELSE IF(NUMIND.EQ.3)THEN
            WRITE(23,247)VARNAM(VARNUM),VARNAM(LOC1),VARNAM(LOC2),
     X                    VARNAM(LOC3)
          ELSE IF(NUMIND.EQ.4)THEN
            WRITE(23,248)VARNAM(VARNUM),VARNAM(LOC1),VARNAM(LOC2),
     X                    VARNAM(LOC3),VARNAM(LOC4)
          ENDIF
        ENDIF
C
C       WRITE VALUES
C
        IF (NUMIND.EQ.2)THEN
           WRITE(23,255)VCOM,V1,V2
        ELSE IF (NUMIND.EQ.3)THEN
           WRITE(23,256)VCOM,V1,V2,V3
        ELSE IF (NUMIND.EQ.4)THEN
           WRITE(23,257)VCOM,V1,V2,V3,V4          
        ENDIF
 250    CONTINUE
        WRITE(23,*)
 255    FORMAT(15X,3(I10,5X))
 256    FORMAT(7X,4(I10,5X))
 257    FORMAT(5(I10,5X))
        RETURN
        END



        FUNCTION IND2(I,J,K,L,A,B,C)
C
C       THIS FUNCTION IS USED TO CALCULATE COMBINED VALUES.
C       IT IS CALLED FROM SUBROUTINES COMBINE AND TRANS
C
        IMPLICIT INTEGER(A-Z)
        IND2=I+J*A+K*A*B+L*A*B*C
     X          -(A+A*B+A*B*C)
        IF(IND2.LT.1.OR.IND2.GT.64000)THEN
          CALL ERROR(806)
        ENDIF
        RETURN
        END
C
C
C
        SUBROUTINE SETUP(OPTYP,SETCMD)
C
C       THIS SUBROUTINE INTERPRETS THE SETUP.CMD FILE
C
        IMPLICIT INTEGER(A-Z)
        LOGICAL EXISTS
        CHARACTER*80 SETCMD
        CHARACTER*35 SETNAM
        DIMENSION SETCMD(10)
C
C       INITIALIZE THE SETUP COMMAND ARRAY, "SETCMD",
C       AND THE SETUP.CMD LOCATION, "SETNAM"
C
        DO 5 I=1,10
        SETCMD(I)(1:50)=
     X     '                                                  '
  5     CONTINUE
        SETNAM='UNKNOWN'
C
C       FIND THE SETUP.CMD FILE.
C       FIRST LOOK LOCALLY, THEN AT \DECOMP\ SUBDIRECTORIES
C       ON DRIVES C: D: AND E:
C

        INQUIRE(FILE='SETUP.CMD',EXIST=EXISTS)
        IF (EXISTS)THEN
           SETNAM='SETUP.CMD'
        ELSE
           INQUIRE(FILE='C:\DECOMP\SETUP.CMD',EXIST=EXISTS)
           IF (EXISTS)THEN
              SETNAM='C:\DECOMP\SETUP.CMD'
           ELSE
              INQUIRE(FILE='D:\DECOMP\SETUP.CMD',EXIST=EXISTS)
              IF (EXISTS)THEN
                 SETNAM='D:\DECOMP\SETUP.CMD'
              ELSE
                 INQUIRE(FILE='E:\DECOMP\SETUP.CMD',EXIST=EXISTS)
                 IF (EXISTS)SETNAM='E:\DECOMP\SETUP.CMD'
              ENDIF
           ENDIF
        ENDIF
C
C       IF A SETUP.CMD FILE HAS BEEN FOUND, LOOK FOR SET PROMPT AND
C       SET PAGENUMS COMMANDS.
C
        IF (SETNAM(1:7).NE.'UNKNOWN')THEN
        OPEN(2,FILE=SETNAM,STATUS='OLD')
        DO 50 I=1,10
        READ(2,100,END=99)SETCMD(I)
        IF (SETCMD(I)(1:3).NE.'set'.AND.SETCMD(I)(1:3).NE.'SET')GO TO 50
        P=INDEX(SETCMD(I),'PROMPT')
        IF (P.EQ.0)P=INDEX(SETCMD(I),'prompt')
        IF (P.NE.0)THEN
           P=INDEX(SETCMD(I),'OFF')
           IF (P.EQ.0)P=INDEX(SETCMD(I),'off')
C
C          IF SET PROMPT = OFF, ASSIGN 2 TO OPTYP
C
           IF (P.NE.0)OPTYP=2
           SETCMD(I)(1:50)=
     X     '                                                  '
        ELSE
           P=INDEX(SETCMD(I),'PAGE')
           IF (P.EQ.0)P=INDEX(SETCMD(I),'page')
           IF (P.NE.0)THEN
              P=INDEX(SETCMD(I),'OFF')
              IF (P.EQ.0)P=INDEX(SETCMD(I),'off')
C
C             IF SET PAGENUMS = OFF, TELL THE "PAGE" SUBROUTINE 
C
              IF (P.NE.0)CALL PAGE(9999,9999)
              SETCMD(I)(1:50)=
     X        '                                                  '
           ELSE
             P=INDEX(SETCMD(I),'SCREEN')
             IF (P.EQ.0)P=INDEX(SETCMD(I),'screen')
             IF (P.NE.0)THEN
                P=INDEX(SETCMD(I),'OFF')
                IF (P.EQ.0)P=INDEX(SETCMD(I),'off')
C
C               IF SET SCREEN = OFF, OPEN A SCRATCH FILE FOR SCREEN OUTPUT 
C
ccc                IF (P.NE.0)OPEN(6,FILE='ERRORS.TMP')
                SETCMD(I)(1:50)=
     X        '                                                  '
             ENDIF
           ENDIF 
        ENDIF

  50    CONTINUE
        ENDIF
  99    CONTINUE
 100    FORMAT(A80)
        RETURN
        END

